From patchwork Tue Jan 13 11:42:13 2015 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Andre Vehreschild X-Patchwork-Id: 428340 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]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 5A4B114017B for ; Tue, 13 Jan 2015 22:42:32 +1100 (AEDT) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:in-reply-to:references :mime-version:content-type; q=dns; s=default; b=T963LulyL2D/pbU5 /H4cgXgQoMTc0AmKGjxdFGxYbDcn2zccyIz1S39c2XOfa7paBZWtIdi51wBiy1yE ixjOm7+fyaBclNX8knVMiwlvhPKC6ycvqU8E4vtcH0CA7JNsxeqN6yIIsFfyGp1o Njp+hC6JIqF8uXjjOBenMubu/hE= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:in-reply-to:references :mime-version:content-type; s=default; bh=BTJdiR+rn+jKGY33q41CgN eUQzQ=; b=gFS6poOTDLKv+AHDzfRxCods8jbn9kD02t8zoN58yVc+n/D0KuiN0N ErW4sEFAhNbQcIhUp4C716CLExjyvokugkiHzpCTeYWjiVY1Cc+z6d1QDdq9xEl9 LbZY1DOMlDVHE1TXQPpJerDodzbRgnvBpwyy4YpxybeP3zRWA/LZQ= Received: (qmail 32165 invoked by alias); 13 Jan 2015 11:42:23 -0000 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 Received: (qmail 32142 invoked by uid 89); 13 Jan 2015 11:42:22 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-1.3 required=5.0 tests=AWL, BAYES_00, FREEMAIL_FROM, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=ham version=3.3.2 X-Spam-User: qpsmtpd, 2 recipients X-HELO: mout.gmx.net Received: from mout.gmx.net (HELO mout.gmx.net) (212.227.15.19) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with (AES256-GCM-SHA384 encrypted) ESMTPS; Tue, 13 Jan 2015 11:42:20 +0000 Received: from vepi2 ([84.63.49.248]) by mail.gmx.com (mrgmx001) with ESMTPSA (Nemesis) id 0M3RVA-1XtbVA1gLA-00qyx4; Tue, 13 Jan 2015 12:42:16 +0100 Date: Tue, 13 Jan 2015 12:42:13 +0100 From: Andre Vehreschild To: Paul Richard Thomas Cc: GCC-Fortran-ML , GCC-Patches-ML Subject: Re: [Fortran, Patch] PR60334 - Segmentation fault on character pointer assignments Message-ID: <20150113124213.35899adc@vepi2> In-Reply-To: References: <20150110155903.622217bc@vepi2> <20150111162105.6fb725dc@vepi2> MIME-Version: 1.0 X-UI-Out-Filterresults: notjunk:1; Hi Paul, thanks for the reviewed and the valued comments. Just for completeness I have attached the patch with the changes requested. Bootstraps and regtests ok on x86_64-linux-gnu. Regards, Andre On Mon, 12 Jan 2015 22:07:29 +0100 Paul Richard Thomas wrote: > Hi Andre, > > + if (INDIRECT_REF_P (parmse.string_length)) > + /* In chains of functions/procedure calls the string_length already > + is a pointer to the variable holding the length. Therefore > + remove the deref on call. */ > + parmse.string_length = TREE_OPERAND (parmse.string_length, 0); > > This is OK but I would use instead: > + if (POINTER_TYPE_P (parmse.string_length)) > + /* In chains of functions/procedure calls the string_length already > + is a pointer to the variable holding the length. Therefore > + remove the deref on call. */ > + parmse.string_length = build_fold_indirect_ref > (parmse.string_length); > > If you look in ~/gcc/fold-const.c:15751, you will see that > TREE_OPERAND (parmse.string_length, 0) but that it is preceded by > cleaning up of NOOPS and, in any case, its usage will preserve the > standard API.... just in case the internals change :-) > > of course, using TREE_OPERAND (xxx, 0) in the various fortran class > functions makes such an assumption ;-) > > Apart from that, the patch is fine. > > I'll have a session of doing some commits later this week and will do > this patch at that time. > > Cheers > > Paul > > On 11 January 2015 at 16:21, Andre Vehreschild wrote: > > Hi Paul, > > > > thanks for the review. I do not have commits rights. > > > > Unfortunately is the patch not ok. I figured today, that it needs an > > extension when function calls that return deferred char len arrays are > > nested. In this special case the string length would have been lost. The > > attached extended version fixes this issue. > > > > Sorry for the duplicate work. > > > > Bootstraps and regtests ok on x86_64-linux-gnu. > > > > Regards, > > Andre > > > > On Sun, 11 Jan 2015 16:11:10 +0100 > > Paul Richard Thomas wrote: > > > >> Dear Andre, > >> > >> This is OK for trunk. I have not been keeping track of whether or not > >> you have commit rights yet. If not, I will get to it sometime this > >> week. > >> > >> Thanks for the patch. > >> > >> Paul > >> > >> On 10 January 2015 at 15:59, Andre Vehreschild wrote: > >> > Hi all, > >> > > >> > attached patch fixes the bug reported in pr 60334. The issue here was > >> > that the function's result being (a pointer to) a deferred length char > >> > array. The string length for the result value was wrapped in a local > >> > variable, whose value was never written back to the string length of the > >> > result. This lead the calling routine to take the length of the result > >> > to be random leading to a crash. > >> > > >> > This patch addresses the issue by preventing the instantiation of the > >> > local var and instead using a reference to the parameter. This not only > >> > saves one value on the stack, but also because for small functions the > >> > compiler will hold all parameters in registers for a significant level > >> > of optimization, all the overhead of memory access (I hope :-). > >> > > >> > Bootstraps and regtests ok on x86_64-linux-gnu. > >> > > >> > - Andre > >> > -- > >> > Andre Vehreschild * Kreuzherrenstr. 8 * 52062 Aachen > >> > Tel.: +49 241 9291018 * Email: vehre@gmx.de > >> > >> > >> > > > > > > -- > > Andre Vehreschild * Kreuzherrenstr. 8 * 52062 Aachen > > Tel.: +49 241 9291018 * Email: vehre@gmx.de > > > diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 1e74125..86873f7 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -1333,12 +1333,30 @@ gfc_get_symbol_decl (gfc_symbol * sym) (sym->ts.u.cl->passed_length == sym->ts.u.cl->backend_decl)) sym->ts.u.cl->backend_decl = NULL_TREE; - if (sym->ts.deferred && fun_or_res - && sym->ts.u.cl->passed_length == NULL - && sym->ts.u.cl->backend_decl) + if (sym->ts.deferred && byref) { - sym->ts.u.cl->passed_length = sym->ts.u.cl->backend_decl; - sym->ts.u.cl->backend_decl = NULL_TREE; + /* The string length of a deferred char array is stored in the + parameter at sym->ts.u.cl->backend_decl as a reference and + marked as a result. Exempt this variable from generating a + temporary for it. */ + if (sym->attr.result) + { + /* We need to insert a indirect ref for param decls. */ + if (sym->ts.u.cl->backend_decl + && TREE_CODE (sym->ts.u.cl->backend_decl) == PARM_DECL) + sym->ts.u.cl->backend_decl = + build_fold_indirect_ref (sym->ts.u.cl->backend_decl); + } + /* For all other parameters make sure, that they are copied so + that the value and any modifications are local to the routine + by generating a temporary variable. */ + else if (sym->attr.function + && sym->ts.u.cl->passed_length == NULL + && sym->ts.u.cl->backend_decl) + { + sym->ts.u.cl->passed_length = sym->ts.u.cl->backend_decl; + sym->ts.u.cl->backend_decl = NULL_TREE; + } } if (sym->ts.u.cl->backend_decl == NULL_TREE) diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 6bd3b03..196d119 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -5058,10 +5058,19 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, so that the value can be returned. */ if (parmse.string_length && fsym && fsym->ts.deferred) { - tmp = parmse.string_length; - if (TREE_CODE (tmp) != VAR_DECL) - tmp = gfc_evaluate_now (parmse.string_length, &se->pre); - parmse.string_length = gfc_build_addr_expr (NULL_TREE, tmp); + if (POINTER_TYPE_P (parmse.string_length)) + /* In chains of functions/procedure calls the string_length already + is a pointer to the variable holding the length. Therefore + remove the deref on call. */ + parmse.string_length = build_fold_indirect_ref ( + parmse.string_length); + else + { + tmp = parmse.string_length; + if (TREE_CODE (tmp) != VAR_DECL) + tmp = gfc_evaluate_now (parmse.string_length, &se->pre); + parmse.string_length = gfc_build_addr_expr (NULL_TREE, tmp); + } } /* Character strings are passed as two parameters, a length and a diff --git a/gcc/testsuite/gfortran.dg/deferred_type_param_6.f90 b/gcc/testsuite/gfortran.dg/deferred_type_param_6.f90 index eb00778..a2fabe8 100644 --- a/gcc/testsuite/gfortran.dg/deferred_type_param_6.f90 +++ b/gcc/testsuite/gfortran.dg/deferred_type_param_6.f90 @@ -2,15 +2,23 @@ ! ! PR fortran/51055 ! PR fortran/49110 -! +! PR fortran/60334 subroutine test() implicit none integer :: i = 5 character(len=:), allocatable :: s1 + character(len=:), pointer :: s2 + character(len=5), target :: fifeC = 'FIVEC' call sub(s1, i) if (len(s1) /= 5) call abort() if (s1 /= "ZZZZZ") call abort() + s2 => subfunc() + if (len(s2) /= 5) call abort() + if (s2 /= "FIVEC") call abort() + s1 = addPrefix(subfunc()) + if (len(s1) /= 7) call abort() + if (s1 /= "..FIVEC") call abort() contains subroutine sub(str,j) character(len=:), allocatable :: str @@ -19,6 +27,17 @@ contains if (len(str) /= 5) call abort() if (str /= "ZZZZZ") call abort() end subroutine sub + function subfunc() result(res) + character(len=:), pointer :: res + res => fifec + if (len(res) /= 5) call abort() + if (res /= "FIVEC") call abort() + end function subfunc + function addPrefix(str) result(res) + character(len=:), pointer :: str + character(len=:), allocatable :: res + res = ".." // str + end function addPrefix end subroutine test program a