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 <tkoe...@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 <tkoe...@gcc.gnu.org>
PR fortran/45786
* gfortran.dg/operator_7.f90: New test case.
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;
! { 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" } }
