backport: re PR fortran/45786 (Relational operators .eq. and == are not recognized...

2011-06-02  Thomas Koenig  <tkoenig@gcc.gnu.org>

	Backport from trunk
	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-06-02  Thomas Koenig  <tkoenig@gcc.gnu.org>

	Backport from trunk
	PR fortran/45786
	* gfortran.dg/operator_7.f90:  New test case.

From-SVN: r174560

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 9ea57f4008ed6e097ba22d23dbe17eba26131734..4a9037b08bfb6339488c74c38172478ed1d5b575 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,13 @@
+2011-06-02  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+       Backport from trunk
+       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-04-28  Release Manager
 
        * GCC 4.5.3 released.

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 692078a11d4f3f3f703c59d75e71fe3d50c10d2e..19fdede27c26c76213146cd19f7b089b0039d17f 100644 (file)
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -6062,8 +6062,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
            {

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 3fcc5ccba7c7208a9b3c75835e53d6439196dd90..64d1de9ae43a2b9a08bb2067eb84498001041925 100644 (file)
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2718,6 +2718,7 @@ void gfc_set_current_interface_head (gfc_interface *);
 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);
+gfc_intrinsic_op gfc_equivalent_op (gfc_intrinsic_op);
 
 /* io.c */
 extern gfc_st_label format_asterisk;

diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index d26edd68c56dc42e41fa742c9b0d419c7cc36ede..ff081b4e6a3006ab23ac80a097e7a65fa192597a 100644 (file)
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -1213,6 +1213,54 @@ 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
@@ -1253,75 +1301,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;
        }
     }
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 5008295ba8dbe48a767ed82a58300bcd0de38efe..9deeb8d5cca7052d55e51f801412a25f7ddc914d 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2011-06-02  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+       Backport from trunk
+       PR fortran/45786
+       * gfortran.dg/operator_7.f90:  New test case.
+
 2011-05-31  Duncan Sands  <baldrick@free.fr>
 
        Backported from 4.6 branch

diff --git a/gcc/testsuite/gfortran.dg/operator_7.f90 b/gcc/testsuite/gfortran.dg/operator_7.f90
new file mode 100644 (file)
index 0000000..66d8dd1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/operator_7.f90
@@ -0,0 +1,27 @@
+! { 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" } }