Fortran: accept both old and new-style relational operators in USE, ONLY

F2018:10.1.5.5.1(2) requires the same interpretation of old and new-style
relational operators.  As gfortran internally distinguishes between
these versions, we must match equivalent notations in
	USE module, ONLY: OPERATOR(op)
statements when reading modules.

gcc/fortran/ChangeLog:

	PR fortran/65454
	* module.c (read_module): Handle old and new-style relational
	operators when used in USE module, ONLY: OPERATOR(op).

gcc/testsuite/ChangeLog:

	PR fortran/65454
	* gfortran.dg/interface_operator_3.f90: New test.

diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index 1804066bc8c7da131010c21868a01e7b06a0f682..7b98ba539d6b33c0c8c30cbddbefb5fc94e2f88a 100644 (file)
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -5592,6 +5592,9 @@ read_module (void)
 
   for (i = GFC_INTRINSIC_BEGIN; i != GFC_INTRINSIC_END; i++)
     {
+      gfc_use_rename *u = NULL, *v = NULL;
+      int j = i;
+
       if (i == INTRINSIC_USER)
        continue;
 
@@ -5599,18 +5602,73 @@ read_module (void)
        {
          u = find_use_operator ((gfc_intrinsic_op) i);
 
-         if (u == NULL)
+         /* F2018:10.1.5.5.1 requires same interpretation of old and new-style
+            relational operators.  Special handling for USE, ONLY.  */
+         switch (i)
+           {
+           case INTRINSIC_EQ:
+             j = INTRINSIC_EQ_OS;
+             break;
+           case INTRINSIC_EQ_OS:
+             j = INTRINSIC_EQ;
+             break;
+           case INTRINSIC_NE:
+             j = INTRINSIC_NE_OS;
+             break;
+           case INTRINSIC_NE_OS:
+             j = INTRINSIC_NE;
+             break;
+           case INTRINSIC_GT:
+             j = INTRINSIC_GT_OS;
+             break;
+           case INTRINSIC_GT_OS:
+             j = INTRINSIC_GT;
+             break;
+           case INTRINSIC_GE:
+             j = INTRINSIC_GE_OS;
+             break;
+           case INTRINSIC_GE_OS:
+             j = INTRINSIC_GE;
+             break;
+           case INTRINSIC_LT:
+             j = INTRINSIC_LT_OS;
+             break;
+           case INTRINSIC_LT_OS:
+             j = INTRINSIC_LT;
+             break;
+           case INTRINSIC_LE:
+             j = INTRINSIC_LE_OS;
+             break;
+           case INTRINSIC_LE_OS:
+             j = INTRINSIC_LE;
+             break;
+           default:
+             break;
+           }
+
+         if (j != i)
+           v = find_use_operator ((gfc_intrinsic_op) j);
+
+         if (u == NULL && v == NULL)
            {
              skip_list ();
              continue;
            }
 
-         u->found = 1;
+         if (u)
+           u->found = 1;
+         if (v)
+           v->found = 1;
        }
 
       mio_interface (&gfc_current_ns->op[i]);
-      if (u && !gfc_current_ns->op[i])
-       u->found = 0;
+      if (!gfc_current_ns->op[i] && !gfc_current_ns->op[j])
+       {
+         if (u)
+           u->found = 0;
+         if (v)
+           v->found = 0;
+       }
     }
 
   mio_rparen ();

diff --git a/gcc/testsuite/gfortran.dg/interface_operator_3.f90 b/gcc/testsuite/gfortran.dg/interface_operator_3.f90
new file mode 100644 (file)
index 0000000..6a580b2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_operator_3.f90
@@ -0,0 +1,141 @@
+! { dg-do compile }
+! PR fortran/65454 - accept both old and new-style relational operators
+
+module m
+  implicit none
+  private :: t1
+  type t1
+     integer :: i
+  end type t1
+  interface operator (==)
+     module procedure :: my_cmp
+  end interface
+  interface operator (/=)
+     module procedure :: my_cmp
+  end interface
+  interface operator (<=)
+     module procedure :: my_cmp
+  end interface
+  interface operator (<)
+     module procedure :: my_cmp
+  end interface
+  interface operator (>=)
+     module procedure :: my_cmp
+  end interface
+  interface operator (>)
+     module procedure :: my_cmp
+  end interface
+contains
+  elemental function my_cmp (a, b) result (c)
+    type(t1), intent(in) :: a, b
+    logical              :: c
+    c = a%i == b%i
+  end function my_cmp
+end module m
+
+module m_os
+  implicit none
+  private :: t2
+  type t2
+     integer :: i
+  end type t2
+  interface operator (.eq.)
+     module procedure :: my_cmp
+  end interface
+  interface operator (.ne.)
+     module procedure :: my_cmp
+  end interface
+  interface operator (.le.)
+     module procedure :: my_cmp
+  end interface
+  interface operator (.lt.)
+     module procedure :: my_cmp
+  end interface
+  interface operator (.ge.)
+     module procedure :: my_cmp
+  end interface
+  interface operator (.gt.)
+     module procedure :: my_cmp
+  end interface
+contains
+  elemental function my_cmp (a, b) result (c)
+    type(t2), intent(in) :: a, b
+    logical              :: c
+    c = a%i .eq. b%i
+  end function my_cmp
+end module m_os
+
+! new style only
+module m1
+  use m,    only: operator(==), operator(/=)
+  use m,    only: operator(<=), operator(<)
+  use m,    only: operator(>=), operator(>)
+end module m1
+
+! old -> new style
+module m2
+  use m_os, only: operator(==), operator(/=)
+  use m_os, only: operator(<=), operator(<)
+  use m_os, only: operator(>=), operator(>)
+end module m2
+
+! new -> old style
+module m3
+  use m,    only: operator(.eq.), operator(.ne.)
+  use m,    only: operator(.le.), operator(.lt.)
+  use m,    only: operator(.ge.), operator(.gt.)
+end module m3
+
+! old style only
+module m4
+  use m_os, only: operator(.eq.), operator(.ne.)
+  use m_os, only: operator(.le.), operator(.lt.)
+  use m_os, only: operator(.ge.), operator(.gt.)
+end module m4
+
+! new -> all styles
+module m5
+  use m,    only: operator(.eq.), operator(.ne.), operator(==), operator(/=)
+  use m,    only: operator(.le.), operator(.lt.), operator(<=), operator(<)
+  use m,    only: operator(.ge.), operator(.gt.), operator(>=), operator(>)
+end module m5
+
+! old -> all styles
+module m6
+  use m_os, only: operator(.eq.), operator(.ne.), operator(==), operator(/=)
+  use m_os, only: operator(.le.), operator(.lt.), operator(<=), operator(<)
+  use m_os, only: operator(.ge.), operator(.gt.), operator(>=), operator(>)
+end module m6
+
+! all -> all styles
+module m7
+  use m,    only: operator(.eq.), operator(.ne.), operator(==), operator(/=)
+  use m,    only: operator(.le.), operator(.lt.), operator(<=), operator(<)
+  use m,    only: operator(.ge.), operator(.gt.), operator(>=), operator(>)
+  use m_os, only: operator(.eq.), operator(.ne.), operator(==), operator(/=)
+  use m_os, only: operator(.le.), operator(.lt.), operator(<=), operator(<)
+  use m_os, only: operator(.ge.), operator(.gt.), operator(>=), operator(>)
+end module m7
+
+module m_eq
+  implicit none
+  private :: t3
+  type t3
+     integer :: i
+  end type t3
+  interface operator (==)
+     module procedure :: my_cmp
+  end interface
+contains
+  elemental function my_cmp (a, b) result (c)
+    type(t3), intent(in) :: a, b
+    logical              :: c
+    c = a%i == b%i
+  end function my_cmp
+end module m_eq
+
+module m8
+  use m_eq, only: operator(==), operator(.eq.)
+  use m_eq, only: operator(/=)   ! { dg-error "operator ./=. referenced" }
+  use m_eq, only: operator(.ne.) ! { dg-error "operator .\.ne\.. referenced" }
+end module m8