PR fortran/65454 - accept both old and new-style relational operators

Message ID trinity-f427da03-7891-47cf-a09b-3b3c12dfddea-1633728816689@3c-app-gmx-bap16
State New
Headers
Series PR fortran/65454 - accept both old and new-style relational operators |

Commit Message

Harald Anlauf Oct. 8, 2021, 9:33 p.m. UTC
  Dear Fortranners,

F2018:10.1.5.5.1(2) requires the same interpretation of old and new-style
relational operators.  We internally distinguish between old and new style,
but try to map appropriately when used.

This mapping was missing when reading a module via
  USE module, ONLY: OPERATOR(op)
where op used a style different from the INTERFACE OPERATOR statement in
the declaring module.  The attached patch remedies this.

Note: we do neither change the module format nor actually remap an operator.
We simply improve the check whether the requested operator symbol exists in
the old-style or new-style version.

Regtested on x86_64-pc-linux-gnu.  OK for mainline?

Thanks,
Harald
  

Comments

Jerry D Oct. 8, 2021, 10:28 p.m. UTC | #1
On 10/8/21 2:33 PM, Harald Anlauf via Fortran wrote:
> Dear Fortranners,
>
> F2018:10.1.5.5.1(2) requires the same interpretation of old and new-style
> relational operators.  We internally distinguish between old and new style,
> but try to map appropriately when used.
>
> This mapping was missing when reading a module via
>    USE module, ONLY: OPERATOR(op)
> where op used a style different from the INTERFACE OPERATOR statement in
> the declaring module.  The attached patch remedies this.
>
> Note: we do neither change the module format nor actually remap an operator.
> We simply improve the check whether the requested operator symbol exists in
> the old-style or new-style version.
>
> Regtested on x86_64-pc-linux-gnu.  OK for mainline?
>
> Thanks,
> Harald
>
Looks all good Harald, OK and thanks for the support!

Jerry
  
Harald Anlauf Oct. 9, 2021, 7:26 p.m. UTC | #2
Hi Jerry,

> Gesendet: Samstag, 09. Oktober 2021 um 00:28 Uhr
> Looks all good Harald, OK and thanks for the support!

Thanks for the quick review!

Harald
  

Patch

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