Patchwork [fortran] Fix PR 45786, operator == versus .eq. in public/private

login
register
mail settings
Submitter Thomas Koenig
Date May 29, 2011, 2:08 p.m.
Message ID <4DE25376.7000803@netcologne.de>
Download mbox | patch
Permalink /patch/97842/
State New
Headers show

Comments

Thomas Koenig - May 29, 2011, 2:08 p.m.
Hello world,

the attached patch fixes PR 45786, where using == instead of .eq. in a
PUBLIC statement caused us to miss exporting the symbol.  I introduced a
function for equivalencing INTRINSIC_EQ with INTRINSIC_EQ_OS (and
others), which I also used in another place to tidy up the code a bit.

Regression-tested on trunk.  OK for trunk and 4.6?  What about 4.5?

	Thomas

2011-05-29  Thomas Koenig  <tkoenig@gcc.gnu.org>

         PR fortran/45786
         * interface.c (gfc_equivalent_op):  New function.
         (gfc_check_interface):  Use gfc_equivalent_op instead
         of switch statement.
         * decl.c (access_attr_decl):  Also set access to an
         equivalent operator.

2011-05-29  Thomas Koenig  <tkoenig@gcc.gnu.org>

         PR fortran/45786
         * gfortran.dg/operator_7.f90:  New test case.
! { dg-do compile }
! PR fortran/45786 - operators were not correctly marked as public
! if the alternative form was used.
! Test case contributed by Neil Carlson.
module foo_type
  private
  public :: foo, operator(==)
  type :: foo
    integer :: bar
  end type
  interface operator(.eq.)
    module procedure eq_foo
  end interface
contains
  logical function eq_foo (a, b)
    type(foo), intent(in) :: a, b
    eq_foo = (a%bar == b%bar)
  end function
end module

 subroutine use_it (a, b)
  use foo_type
  type(foo) :: a, b
  print *, a == b
end subroutine

! { dg-final { cleanup-modules "foo_type" } }
Steve Kargl - May 29, 2011, 4:44 p.m.
On Sun, May 29, 2011 at 04:08:54PM +0200, Thomas Koenig wrote:
> 
> Regression-tested on trunk.  OK for trunk and 4.6?  What about 4.5?
> 
> 	Thomas
> 
> 2011-05-29  Thomas Koenig  <tkoenig@gcc.gnu.org>
> 
>         PR fortran/45786
>         * interface.c (gfc_equivalent_op):  New function.
>         (gfc_check_interface):  Use gfc_equivalent_op instead
>         of switch statement.
>         * decl.c (access_attr_decl):  Also set access to an
>         equivalent operator.
> 
> 2011-05-29  Thomas Koenig  <tkoenig@gcc.gnu.org>
> 
>         PR fortran/45786
>         * gfortran.dg/operator_7.f90:  New test case.

OK for trunk and 4.6.  If it applies cleanly to 4.5 and
passes regression testing, then you can also commit to
4.5 at your discretion.
Thomas Koenig - May 29, 2011, 6:42 p.m.
Hi Steve,

> On Sun, May 29, 2011 at 04:08:54PM +0200, Thomas Koenig wrote:
>>
>> Regression-tested on trunk.  OK for trunk and 4.6?  What about 4.5?
>>

>
> OK for trunk and 4.6.  If it applies cleanly to 4.5 and
> passes regression testing, then you can also commit to
> 4.5 at your discretion.

Committed to trunk:

Sende          fortran/decl.c
Sende          fortran/gfortran.h
Sende          fortran/interface.c
Hinzufügen     testsuite/gfortran.dg/operator_7.f90
Übertrage Daten ....
Revision 174412 übertragen.

Will commit to 4.6 in a couple of days, and check out 4.5 like you said.

Thanks for the review!

	Thomas

Patch

Index: interface.c
===================================================================
--- interface.c	(Revision 174391)
+++ interface.c	(Arbeitskopie)
@@ -1264,7 +1264,55 @@  check_uop_interfaces (gfc_user_op *uop)
     }
 }
 
+/* Given an intrinsic op, return an equivalent op if one exists,
+   or INTRINSIC_NONE otherwise.  */
 
+gfc_intrinsic_op
+gfc_equivalent_op (gfc_intrinsic_op op)
+{
+  switch(op)
+    {
+    case INTRINSIC_EQ:
+      return INTRINSIC_EQ_OS;
+
+    case INTRINSIC_EQ_OS:
+      return INTRINSIC_EQ;
+
+    case INTRINSIC_NE:
+      return INTRINSIC_NE_OS;
+
+    case INTRINSIC_NE_OS:
+      return INTRINSIC_NE;
+
+    case INTRINSIC_GT:
+      return INTRINSIC_GT_OS;
+
+    case INTRINSIC_GT_OS:
+      return INTRINSIC_GT;
+
+    case INTRINSIC_GE:
+      return INTRINSIC_GE_OS;
+
+    case INTRINSIC_GE_OS:
+      return INTRINSIC_GE;
+
+    case INTRINSIC_LT:
+      return INTRINSIC_LT_OS;
+
+    case INTRINSIC_LT_OS:
+      return INTRINSIC_LT;
+
+    case INTRINSIC_LE:
+      return INTRINSIC_LE_OS;
+
+    case INTRINSIC_LE_OS:
+      return INTRINSIC_LE;
+
+    default:
+      return INTRINSIC_NONE;
+    }
+}
+
 /* For the namespace, check generic, user operator and intrinsic
    operator interfaces for consistency and to remove duplicate
    interfaces.  We traverse the whole namespace, counting on the fact
@@ -1304,75 +1352,19 @@  gfc_check_interfaces (gfc_namespace *ns)
 
       for (ns2 = ns; ns2; ns2 = ns2->parent)
 	{
+	  gfc_intrinsic_op other_op;
+	  
 	  if (check_interface1 (ns->op[i], ns2->op[i], 0,
 				interface_name, true))
 	    goto done;
 
-	  switch (i)
-	    {
-	      case INTRINSIC_EQ:
-		if (check_interface1 (ns->op[i], ns2->op[INTRINSIC_EQ_OS],
-				      0, interface_name, true)) goto done;
-		break;
-
-	      case INTRINSIC_EQ_OS:
-		if (check_interface1 (ns->op[i], ns2->op[INTRINSIC_EQ],
-				      0, interface_name, true)) goto done;
-		break;
-
-	      case INTRINSIC_NE:
-		if (check_interface1 (ns->op[i], ns2->op[INTRINSIC_NE_OS],
-				      0, interface_name, true)) goto done;
-		break;
-
-	      case INTRINSIC_NE_OS:
-		if (check_interface1 (ns->op[i], ns2->op[INTRINSIC_NE],
-				      0, interface_name, true)) goto done;
-		break;
-
-	      case INTRINSIC_GT:
-		if (check_interface1 (ns->op[i], ns2->op[INTRINSIC_GT_OS],
-				      0, interface_name, true)) goto done;
-		break;
-
-	      case INTRINSIC_GT_OS:
-		if (check_interface1 (ns->op[i], ns2->op[INTRINSIC_GT],
-				      0, interface_name, true)) goto done;
-		break;
-
-	      case INTRINSIC_GE:
-		if (check_interface1 (ns->op[i], ns2->op[INTRINSIC_GE_OS],
-				      0, interface_name, true)) goto done;
-		break;
-
-	      case INTRINSIC_GE_OS:
-		if (check_interface1 (ns->op[i], ns2->op[INTRINSIC_GE],
-				      0, interface_name, true)) goto done;
-		break;
-
-	      case INTRINSIC_LT:
-		if (check_interface1 (ns->op[i], ns2->op[INTRINSIC_LT_OS],
-				      0, interface_name, true)) goto done;
-		break;
-
-	      case INTRINSIC_LT_OS:
-		if (check_interface1 (ns->op[i], ns2->op[INTRINSIC_LT],
-				      0, interface_name, true)) goto done;
-		break;
-
-	      case INTRINSIC_LE:
-		if (check_interface1 (ns->op[i], ns2->op[INTRINSIC_LE_OS],
-				      0, interface_name, true)) goto done;
-		break;
-
-	      case INTRINSIC_LE_OS:
-		if (check_interface1 (ns->op[i], ns2->op[INTRINSIC_LE],
-				      0, interface_name, true)) goto done;
-		break;
-
-	      default:
-		break;
-            }
+	  /* i should be gfc_intrinsic_op, but has to be int with this cast
+	     here for stupid C++ compatibility rules.  */
+	  other_op = gfc_equivalent_op ((gfc_intrinsic_op) i);
+	  if (other_op != INTRINSIC_NONE
+	    &&  check_interface1 (ns->op[i], ns2->op[other_op],
+				  0, interface_name, true))
+	    goto done;
 	}
     }
 
Index: decl.c
===================================================================
--- decl.c	(Revision 174391)
+++ decl.c	(Arbeitskopie)
@@ -6478,8 +6478,19 @@  access_attr_decl (gfc_statement st)
 	case INTERFACE_INTRINSIC_OP:
 	  if (gfc_current_ns->operator_access[op] == ACCESS_UNKNOWN)
 	    {
+	      gfc_intrinsic_op other_op;
+
 	      gfc_current_ns->operator_access[op] =
 		(st == ST_PUBLIC) ? ACCESS_PUBLIC : ACCESS_PRIVATE;
+
+	      /* Handle the case if there is another op with the same
+		 function, for INTRINSIC_EQ vs. INTRINSIC_EQ_OS and so on.  */
+	      other_op = gfc_equivalent_op (op);
+
+	      if (other_op != INTRINSIC_NONE)
+		gfc_current_ns->operator_access[other_op] =
+		  (st == ST_PUBLIC) ? ACCESS_PUBLIC : ACCESS_PRIVATE;
+
 	    }
 	  else
 	    {
Index: gfortran.h
===================================================================
--- gfortran.h	(Revision 174391)
+++ gfortran.h	(Arbeitskopie)
@@ -2816,6 +2816,7 @@  gfc_symtree* gfc_find_sym_in_symtree (gfc_symbol*)
 bool gfc_arglist_matches_symbol (gfc_actual_arglist**, gfc_symbol*);
 bool gfc_check_operator_interface (gfc_symbol*, gfc_intrinsic_op, locus);
 int gfc_has_vector_subscript (gfc_expr*);
+gfc_intrinsic_op gfc_equivalent_op (gfc_intrinsic_op);
 
 /* io.c */
 extern gfc_st_label format_asterisk;