diff mbox

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

Message ID 4DE25376.7000803@netcologne.de
State New
Headers show

Commit Message

Thomas Koenig May 29, 2011, 2:08 p.m. UTC 
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" } }

Comments

Steve Kargl May 29, 2011, 4:44 p.m. UTC | #1 
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. UTC | #2 
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
diff mbox

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;