From patchwork Wed Oct 17 10:02:11 2012 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 191996 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 EAFAF2C00B4 for ; Wed, 17 Oct 2012 21:02:25 +1100 (EST) Comment: DKIM? See http://www.dkim.org DKIM-Signature: v=1; a=rsa-sha1; c=relaxed/relaxed; d=gcc.gnu.org; s=default; x=1351072946; h=Comment: DomainKey-Signature:Received:Received:Received:Received: Message-ID:Date:From:User-Agent:MIME-Version:To:Subject: Content-Type:Mailing-List:Precedence:List-Id:List-Unsubscribe: List-Archive:List-Post:List-Help:Sender:Delivered-To; bh=pey2gHN 1BTGlkIGnKR6eZgtDwfw=; b=GfpPLOxeN8V6U2YANSQSgZxlb6CDLmAd4CHgoju 54S6VTzNDw62Xdm+bq8xivSLRtHJI5G2dUdww3EWGFAnnLa6wVcAWBDMREUsV9W0 1d4EkhYM3EAAl5Kjv1KkJlcdKh7bj2PwC5uF4TMYtvu2pMaMzUHyk7FSRFKr/3PJ SL3Y= Comment: DomainKeys? See http://antispam.yahoo.com/domainkeys DomainKey-Signature: a=rsa-sha1; q=dns; c=nofws; s=default; d=gcc.gnu.org; h=Received:Received:X-SWARE-Spam-Status:X-Spam-Check-By:Received:Received:Message-ID:Date:From:User-Agent:MIME-Version:To:Subject:Content-Type:Mailing-List:Precedence:List-Id:List-Unsubscribe:List-Archive:List-Post:List-Help:Sender:Delivered-To; b=JtP/2QLIig67p0pRAij3DHF7a+OHHfJ8MbovoEyqkocca8FJQdU0+R0Lf4xwvr xmQcB+PuePSzxDrJciChtjEd7xQM0pmqlx/EQbIt6uRGZ0Kq9K8XKwNQFnDq/ETQ fe7UhOrBKEN8R7HXVod/983qpauFNKzihcoR6kqsy8nxY=; Received: (qmail 6846 invoked by alias); 17 Oct 2012 10:02:21 -0000 Received: (qmail 6824 invoked by uid 22791); 17 Oct 2012 10:02:20 -0000 X-SWARE-Spam-Status: No, hits=0.3 required=5.0 tests=AWL, BAYES_00, KAM_STOCKTIP, RCVD_IN_DNSWL_NONE X-Spam-Check-By: sourceware.org Received: from mx02.qsc.de (HELO mx02.qsc.de) (213.148.130.14) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Wed, 17 Oct 2012 10:02:15 +0000 Received: from [192.168.178.22] (port-92-195-26-156.dynamic.qsc.de [92.195.26.156]) by mx02.qsc.de (Postfix) with ESMTP id BB30124FDD; Wed, 17 Oct 2012 12:02:12 +0200 (CEST) Message-ID: <507E8223.2020601@net-b.de> Date: Wed, 17 Oct 2012 12:02:11 +0200 From: Tobias Burnus User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:15.0) Gecko/20120825 Thunderbird/15.0 MIME-Version: 1.0 To: gcc patches , gfortran Subject: [Patch, Fortran] PR54884 - Fix TREE_PUBLIC()=0 regression for module procedures 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 In GCC 4.8, module variables/procedures are marked as TREE_PUBLIC() if they are PRIVATE and not publicly visible used in PUBLIC procedures; the latter happens either via generic interfaces or via specification expressions. (The bug is old [early 4.8] but due to a recent follow up patch, the chance to run into this issue has increased.) This patch adds the public_use attribute logic (also) to resolve_function, before it was only in resolve_symbol. When doing so, I realized that it was also set for "other" as the specification_expr variable wasn't properly reset. I fixed that but I had also to add a few additional "specification_expr = true" as the current code only handled gfc_resolve_array_spec by chance. Build and regtested on x86-64-gnu-linux. OK for the trunk? Tobias 2012-10-17 Tobias Burnus PR fortran/54884 * resolve.c (specification_expr): Change to bool. (resolve_formal_arglist, resolve_symbol): Set specification_expr to true before resolving the array spec. (resolve_variable, resolve_charlen, resolve_fl_variable): Properly reset specification_expr. (resolve_function): Set public_use when used in a specification expr. 2012-10-17 Tobias Burnus PR fortran/54884 * gfortran.dg/public_private_module_7.f90: New. diff --git a/gcc/fortran/cpp.c b/gcc/fortran/cpp.c index c45af39..f54ba96 100644 --- a/gcc/fortran/cpp.c +++ b/gcc/fortran/cpp.c @@ -38,6 +38,10 @@ along with GCC; see the file COPYING3. If not see #include "cppbuiltin.h" #include "mkdeps.h" +#ifndef TARGET_SYSTEM_ROOT +# define TARGET_SYSTEM_ROOT NULL +#endif + #ifndef TARGET_CPU_CPP_BUILTINS # define TARGET_CPU_CPP_BUILTINS() #endif @@ -267,7 +271,7 @@ gfc_cpp_init_options (unsigned int decoded_options_count, gfc_cpp_option.multilib = NULL; gfc_cpp_option.prefix = NULL; - gfc_cpp_option.sysroot = NULL; + gfc_cpp_option.sysroot = TARGET_SYSTEM_ROOT; gfc_cpp_option.deferred_opt = XNEWVEC (gfc_cpp_deferred_opt_t, decoded_options_count); diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 722e036..ac3021e 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -81,7 +81,7 @@ static int omp_workshare_flag; static int formal_arg_flag = 0; /* True if we are resolving a specification expression. */ -static int specification_expr = 0; +static bool specification_expr = false; /* The id of the last entry seen. */ static int current_entry_id; @@ -278,6 +278,7 @@ resolve_formal_arglist (gfc_symbol *proc) { gfc_formal_arglist *f; gfc_symbol *sym; + bool saved_specification_expr; int i; if (proc->result != NULL) @@ -336,7 +337,10 @@ resolve_formal_arglist (gfc_symbol *proc) as = sym->ts.type == BT_CLASS && sym->attr.class_ok ? CLASS_DATA (sym)->as : sym->as; + saved_specification_expr = specification_expr; + specification_expr = true; gfc_resolve_array_spec (as, 0); + specification_expr = saved_specification_expr; /* We can't tell if an array with dimension (:) is assumed or deferred shape until we know if it has the pointer or allocatable attributes. @@ -3119,6 +3123,12 @@ resolve_function (gfc_expr *expr) return FAILURE; } + if (sym && specification_expr && sym->attr.function + && gfc_current_ns->proc_name + && gfc_current_ns->proc_name->attr.flavor == FL_MODULE) + sym->attr.public_used = 1; + + /* Switch off assumed size checking and do this again for certain kinds of procedure, once the procedure itself is resolved. */ need_full_assumed_size++; @@ -5368,7 +5378,7 @@ resolve_variable (gfc_expr *e) gfc_entry_list *entry; gfc_formal_arglist *formal; int n; - bool seen; + bool seen, saved_specification_expr; /* If the symbol is a dummy... */ if (sym->attr.dummy && sym->ns == gfc_current_ns) @@ -5401,7 +5411,8 @@ resolve_variable (gfc_expr *e) } /* Now do the same check on the specification expressions. */ - specification_expr = 1; + saved_specification_expr = specification_expr; + specification_expr = true; if (sym->ts.type == BT_CHARACTER && gfc_resolve_expr (sym->ts.u.cl->length) == FAILURE) t = FAILURE; @@ -5409,14 +5420,12 @@ resolve_variable (gfc_expr *e) if (sym->as) for (n = 0; n < sym->as->rank; n++) { - specification_expr = 1; if (gfc_resolve_expr (sym->as->lower[n]) == FAILURE) t = FAILURE; - specification_expr = 1; if (gfc_resolve_expr (sym->as->upper[n]) == FAILURE) t = FAILURE; } - specification_expr = 0; + specification_expr = saved_specification_expr; if (t == SUCCESS) /* Update the symbol's entry level. */ @@ -10175,28 +10184,35 @@ static gfc_try resolve_charlen (gfc_charlen *cl) { int i, k; + bool saved_specification_expr; if (cl->resolved) return SUCCESS; cl->resolved = 1; - + saved_specification_expr = specification_expr; + specification_expr = true; if (cl->length_from_typespec) { if (gfc_resolve_expr (cl->length) == FAILURE) - return FAILURE; + { + specification_expr = saved_specification_expr; + return FAILURE; + } if (gfc_simplify_expr (cl->length, 0) == FAILURE) - return FAILURE; + { + specification_expr = saved_specification_expr; + return FAILURE; + } } else { - specification_expr = 1; if (resolve_index_expr (cl->length) == FAILURE) { - specification_expr = 0; + specification_expr = saved_specification_expr; return FAILURE; } } @@ -10220,9 +10236,11 @@ resolve_charlen (gfc_charlen *cl) && mpz_cmp (cl->length->value.integer, gfc_integer_kinds[k].huge) > 0) { gfc_error ("String length at %L is too large", &cl->length->where); + specification_expr = saved_specification_expr; return FAILURE; } + specification_expr = saved_specification_expr; return SUCCESS; } @@ -10682,6 +10700,7 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag) int no_init_flag, automatic_flag; gfc_expr *e; const char *auto_save_msg; + bool saved_specification_expr; auto_save_msg = "Automatic object '%s' at %L cannot have the " "SAVE attribute"; @@ -10692,7 +10711,8 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag) /* Set this flag to check that variables are parameters of all entries. This check is effected by the call to gfc_resolve_expr through is_non_constant_shape_array. */ - specification_expr = 1; + saved_specification_expr = specification_expr; + specification_expr = true; if (sym->ns->proc_name && (sym->ns->proc_name->attr.flavor == FL_MODULE @@ -10706,7 +10726,7 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag) constant. */ gfc_error ("The module or main program array '%s' at %L must " "have constant shape", sym->name, &sym->declared_at); - specification_expr = 0; + specification_expr = saved_specification_expr; return FAILURE; } @@ -10716,6 +10736,7 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag) gfc_error ("Entity '%s' at %L has a deferred type parameter and " "requires either the pointer or allocatable attribute", sym->name, &sym->declared_at); + specification_expr = saved_specification_expr; return FAILURE; } @@ -10729,12 +10750,14 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag) { gfc_error ("Entity with assumed character length at %L must be a " "dummy argument or a PARAMETER", &sym->declared_at); + specification_expr = saved_specification_expr; return FAILURE; } if (e && sym->attr.save == SAVE_EXPLICIT && !gfc_is_constant_expr (e)) { gfc_error (auto_save_msg, sym->name, &sym->declared_at); + specification_expr = saved_specification_expr; return FAILURE; } @@ -10748,12 +10771,14 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag) { gfc_error ("'%s' at %L must have constant character length " "in this context", sym->name, &sym->declared_at); + specification_expr = saved_specification_expr; return FAILURE; } if (sym->attr.in_common) { gfc_error ("COMMON variable '%s' at %L must have constant " "character length", sym->name, &sym->declared_at); + specification_expr = saved_specification_expr; return FAILURE; } } @@ -10784,6 +10809,7 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag) if (automatic_flag && sym->attr.save == SAVE_EXPLICIT) { gfc_error (auto_save_msg, sym->name, &sym->declared_at); + specification_expr = saved_specification_expr; return FAILURE; } } @@ -10817,13 +10843,19 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag) sym->name, &sym->declared_at); else goto no_init_error; + specification_expr = saved_specification_expr; return FAILURE; } no_init_error: if (sym->ts.type == BT_DERIVED || sym->ts.type == BT_CLASS) - return resolve_fl_variable_derived (sym, no_init_flag); + { + gfc_try res = resolve_fl_variable_derived (sym, no_init_flag); + specification_expr = saved_specification_expr; + return res; + } + specification_expr = saved_specification_expr; return SUCCESS; } @@ -12569,6 +12601,7 @@ resolve_symbol (gfc_symbol *sym) gfc_component *c; symbol_attribute class_attr; gfc_array_spec *as; + bool saved_specification_expr; if (sym->attr.artificial) return; @@ -12689,7 +12722,12 @@ resolve_symbol (gfc_symbol *sym) } } else if (mp_flag && sym->attr.flavor == FL_PROCEDURE && sym->attr.function) - gfc_resolve_array_spec (sym->result->as, false); + { + bool saved_specification_expr = specification_expr; + specification_expr = true; + gfc_resolve_array_spec (sym->result->as, false); + specification_expr = saved_specification_expr; + } if (sym->ts.type == BT_CLASS && sym->attr.class_ok) { @@ -13105,7 +13143,10 @@ resolve_symbol (gfc_symbol *sym) if (sym->attr.function && sym->as) formal_arg_flag = 1; + saved_specification_expr = specification_expr; + specification_expr = true; gfc_resolve_array_spec (sym->as, check_constant); + specification_expr = saved_specification_expr; formal_arg_flag = 0; --- /dev/null 2012-10-14 08:57:40.159727696 +0200 +++ gcc/gcc/testsuite/gfortran.dg/public_private_module_7.f90 2012-10-17 00:15:53.000000000 +0200 @@ -0,0 +1,29 @@ +! { dg-do compile } +! { dg-options "-O2" } +! +! PR fortran/54884 +! +! Check that get_key_len is not optimized away as it +! is used in a publicly visible specification expression. +! +module m_common_attrs + private + !... + public :: get_key +contains + pure function get_key_len() result(n) + n = 5 + end function get_key_len + pure function other() result(n) + n = 5 + end function other + ! ... + function get_key() result(key) + ! ... + character(len=get_key_len()) :: key + key = '' + end function get_key +end module m_common_attrs + +! { dg-final { scan-assembler-not "__m_common_attrs_MOD_other" } } +! { dg-final { scan-assembler "__m_common_attrs_MOD_get_key_len" } }