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.
@@ -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 ();
new file mode 100644
@@ -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