From patchwork Sun May 29 14:08:54 2011 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Thomas Koenig X-Patchwork-Id: 97842 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id 3AD72B6F81 for ; Mon, 30 May 2011 00:09:20 +1000 (EST) Received: (qmail 26810 invoked by alias); 29 May 2011 14:09:15 -0000 Received: (qmail 26784 invoked by uid 22791); 29 May 2011 14:09:14 -0000 X-SWARE-Spam-Status: No, hits=-1.0 required=5.0 tests=AWL, BAYES_00, RCVD_IN_DNSWL_NONE, T_RP_MATCHES_RCVD X-Spam-Check-By: sourceware.org Received: from cc-smtpout2.netcologne.de (HELO cc-smtpout2.netcologne.de) (89.1.8.212) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Sun, 29 May 2011 14:08:58 +0000 Received: from cc-smtpin2.netcologne.de (cc-smtpin2.netcologne.de [89.1.8.202]) by cc-smtpout2.netcologne.de (Postfix) with ESMTP id 0987B124F4; Sun, 29 May 2011 16:08:57 +0200 (CEST) Received: from [192.168.0.197] (xdsl-84-44-155-192.netcologne.de [84.44.155.192]) by cc-smtpin2.netcologne.de (Postfix) with ESMTPSA id BB56C11E8E; Sun, 29 May 2011 16:08:55 +0200 (CEST) Message-ID: <4DE25376.7000803@netcologne.de> Date: Sun, 29 May 2011 16:08:54 +0200 From: Thomas Koenig User-Agent: Mozilla/5.0 (X11; U; Linux x86_64; de; rv:1.9.2.17) Gecko/20110414 SUSE/3.1.10 Thunderbird/3.1.10 MIME-Version: 1.0 To: "fortran@gcc.gnu.org" , gcc-patches Subject: [patch, fortran] Fix PR 45786, operator == versus .eq. in public/private Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org 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 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 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" } } 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;