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 1804066bc8c..7b98ba539d6 100644 --- 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 index 00000000000..6a580b2f1cf --- /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