From: Thomas Koenig Date: Thu, 2 Jun 2011 09:09:53 +0000 (+0000) Subject: backport: re PR fortran/45786 (Relational operators .eq. and == are not recognized... X-Git-Tag: releases/gcc-4.5.4~610 X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=50c0fd6086a2ab9a6a6de1bad07b04f115a5d53c;p=thirdparty%2Fgcc.git backport: re PR fortran/45786 (Relational operators .eq. and == are not recognized as equivalent) 2011-06-02 Thomas Koenig 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 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 9ea57f4008ed..4a9037b08bfb 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,13 @@ +2011-06-02 Thomas Koenig + + 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 692078a11d4f..19fdede27c26 100644 --- 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 3fcc5ccba7c7..64d1de9ae43a 100644 --- 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 d26edd68c56d..ff081b4e6a30 100644 --- 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 5008295ba8db..9deeb8d5cca7 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2011-06-02 Thomas Koenig + + Backport from trunk + PR fortran/45786 + * gfortran.dg/operator_7.f90: New test case. + 2011-05-31 Duncan Sands 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 index 000000000000..66d8dd187eec --- /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" } }