From patchwork Sun May 13 13:50:20 2012 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 158836 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 D3154B7008 for ; Sun, 13 May 2012 23:50:57 +1000 (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=1337521859; h=Comment: DomainKey-Signature:Received:Received:Received:Received: Message-ID:Date:From:User-Agent:MIME-Version:To:Subject: References:In-Reply-To:Content-Type:Mailing-List:Precedence: List-Id:List-Unsubscribe:List-Archive:List-Post:List-Help:Sender: Delivered-To; bh=5qHVkNp8wbfVNbwaCz5CP228ta8=; b=OZ+ZrwjBguX9RQF LssKgfvS9AKN72iJorv1rYkB9ZuCz+YLfbTMtLHj1pU2jbZ/zKm57rpPxC3k4w9t ZyetD30bQPxFq8ZwWpHKjure1XL7bHqduz9s18JjyfgB/hxs1EHIy1kPVU6Yh7x2 ePPawfyqPcu8BeiX1eyfmbFZr43o= 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:References:In-Reply-To:Content-Type:Mailing-List:Precedence:List-Id:List-Unsubscribe:List-Archive:List-Post:List-Help:Sender:Delivered-To; b=BFsgcc6xDanJdvjsyAelymKjeFbJ+w/xHFgfCUmeJlBAyizywZGQy8JQ4Ldxip 11/Y2trz8gojOCMb1/WcnRY1gKk/N7NwoF9w147qbNiT4Oro0n8RfgMnGVVDADfj 6AHfqC7il9mT0KoLVMZNetJIeljVxnTV6TegDnuyCXcr8=; Received: (qmail 5865 invoked by alias); 13 May 2012 13:50:42 -0000 Received: (qmail 5846 invoked by uid 22791); 13 May 2012 13:50:38 -0000 X-SWARE-Spam-Status: No, hits=-2.5 required=5.0 tests=AWL, BAYES_00, KHOP_THREADED, RCVD_IN_DNSWL_NONE, TW_CP 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; Sun, 13 May 2012 13:50:24 +0000 Received: from [192.168.178.22] (port-92-204-48-84.dynamic.qsc.de [92.204.48.84]) by mx02.qsc.de (Postfix) with ESMTP id 5F58227FD6; Sun, 13 May 2012 15:50:22 +0200 (CEST) Message-ID: <4FAFBC1C.8070902@net-b.de> Date: Sun, 13 May 2012 15:50:20 +0200 From: Tobias Burnus User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:11.0) Gecko/20120328 Thunderbird/11.0.1 MIME-Version: 1.0 To: gcc patches , gfortran , Paul Richard Thomas Subject: Re: [Fortran, (RFC) patch] PR49110/51055 Assignment to alloc. deferred-length character vars References: <4FAD1CD1.9080603@net-b.de> In-Reply-To: <4FAD1CD1.9080603@net-b.de> 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 Tobias Burnus wrote: > Note that the patch assumes that the function's result variable's > length specification expression is completely known to the caller. I > think that's always the case in gfortran - or is it not? Thinking about it, I came to the conclusion has explicitly been designed such that it is known. Note: The attached patch is required in addition to make sure that the variable has the correct name mangling and to ensure that the string length is TREE_PUBLIC() = 1, when needed. The trans-expr.c part of the patch has been posted at http://gcc.gnu.org/ml/fortran/2012-05/msg00054.html Compile ("-c") the following code - with the function commented or not and with PUBLIC and PRIVATE - and look resulting .o file via nm. It shouldn't show the "str" variable (and the length variable) if (and only) if it is private and not used in the function result expression. Result for the program as shown below: 0000000000000008 B .__m_MOD_str 0000000000000000 T __m_MOD_bar 0000000000000000 B __m_MOD_str module m ! character(len=:), PRIVATE, allocatable :: str character(len=:), PUBLIC, allocatable :: str contains ! Note due to technical reasons (TBP, generic, cf. resolve.c), ! a "PRIVATE :: bar" still counts a publicly using "str". function bar() character(len=len(str)) :: str end function bar end module m Tobias diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index b03d393..3c1118e 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -1087,11 +1087,14 @@ gfc_create_string_length (gfc_symbol * sym) if (sym->ts.u.cl->backend_decl == NULL_TREE) { tree length; - char name[GFC_MAX_MANGLED_SYMBOL_LEN + 2]; + const char *name; /* Also prefix the mangled name. */ - strcpy (&name[1], sym->name); - name[0] = '.'; + if (sym->module) + name = gfc_get_string (".__%s_MOD_%s", sym->module, sym->name); + else + name = gfc_get_string (".%s", sym->name); + length = build_decl (input_location, VAR_DECL, get_identifier (name), gfc_charlen_type_node); @@ -1101,6 +1104,13 @@ gfc_create_string_length (gfc_symbol * sym) gfc_defer_symbol_init (sym); sym->ts.u.cl->backend_decl = length; + + if (sym->attr.save || sym->ns->proc_name->attr.flavor == FL_MODULE) + TREE_STATIC (length) = 1; + + if (sym->ns->proc_name->attr.flavor == FL_MODULE + && (sym->attr.access != ACCESS_PRIVATE || sym->attr.public_used)) + TREE_PUBLIC (length) = 1; } gcc_assert (sym->ts.u.cl->backend_decl != NULL_TREE); @@ -1395,29 +1405,7 @@ gfc_get_symbol_decl (gfc_symbol * sym) gfc_finish_var_decl (decl, sym); - if (sym->ts.type == BT_CHARACTER) - { - /* Character variables need special handling. */ - gfc_allocate_lang_decl (decl); - - if (TREE_CODE (length) != INTEGER_CST) - { - char name[GFC_MAX_MANGLED_SYMBOL_LEN + 2]; - - if (sym->module) - { - /* Also prefix the mangled name for symbols from modules. */ - strcpy (&name[1], sym->name); - name[0] = '.'; - strcpy (&name[1], - IDENTIFIER_POINTER (DECL_ASSEMBLER_NAME (length))); - gfc_set_decl_assembler_name (decl, get_identifier (name)); - } - gfc_finish_var_decl (length, sym); - gcc_assert (!sym->value); - } - } - else if (sym->attr.subref_array_pointer) + if (sym->attr.subref_array_pointer) { /* We need the span for these beasts. */ gfc_allocate_lang_decl (decl);