From patchwork Tue Apr 21 21:55:39 2020 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Thomas Koenig X-Patchwork-Id: 1274540 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=8.43.85.97; helo=sourceware.org; envelope-from=gcc-patches-bounces@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=none (p=none dis=none) header.from=gcc.gnu.org Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.a=rsa-sha256 header.s=default header.b=ru66WFCh; dkim-atps=neutral Received: from sourceware.org (server2.sourceware.org [8.43.85.97]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature RSA-PSS (4096 bits) server-digest SHA256) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 496HSM2zMjz9sSg for ; Wed, 22 Apr 2020 07:55:47 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 70220386F824; Tue, 21 Apr 2020 21:55:45 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 70220386F824 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1587506145; bh=vF/vvNFKa/ORwyidAvLf5AR4p0BBBZWoRn6DV5DRV0A=; h=To:Subject:Date:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:From; b=ru66WFChGtRCLN3YAalnd3ABDXvLMD8zWGPuPz7mjRDiP294nUIuy75PFCdKdJmDf T2++FLs8+Cr3GxU1noUhvzucBhzEINKjWTSao9cfOuFe7ctLuipfpdotAvPmFGvFO+ Q57dBdJ0/6GguEV4hKhX4iIq+qVApPCOVF86f3hs= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from cc-smtpout3.netcologne.de (cc-smtpout3.netcologne.de [89.1.8.213]) by sourceware.org (Postfix) with ESMTPS id 40A9B386F460; Tue, 21 Apr 2020 21:55:43 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.3.2 sourceware.org 40A9B386F460 Received: from cc-smtpin2.netcologne.de (cc-smtpin2.netcologne.de [89.1.8.202]) by cc-smtpout3.netcologne.de (Postfix) with ESMTP id B694312976; Tue, 21 Apr 2020 23:55:41 +0200 (CEST) Received: from localhost (localhost [127.0.0.1]) by cc-smtpin2.netcologne.de (Postfix) with ESMTP id A6E4311EE2; Tue, 21 Apr 2020 23:55:41 +0200 (CEST) Received: from [2001:4dd7:4da9:0:8f7e:7854:b0d:2bec] (helo=cc-smtpin2.netcologne.de) by localhost with ESMTP (eXpurgate 4.11.6) (envelope-from ) id 5e9f6bdd-4f6f-7f0000012729-7f000001e2b6-1 for ; Tue, 21 Apr 2020 23:55:41 +0200 Received: from linux-p51k.fritz.box (2001-4dd7-4da9-0-8f7e-7854-b0d-2bec.ipv6dyn.netcologne.de [IPv6:2001:4dd7:4da9:0:8f7e:7854:b0d:2bec]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by cc-smtpin2.netcologne.de (Postfix) with ESMTPSA; Tue, 21 Apr 2020 23:55:39 +0200 (CEST) To: "fortran@gcc.gnu.org" , gcc-patches Subject: [patch, fortran] Fix PR 93956, wrong pointer when returned via function Message-ID: <04e8ec8a-89d1-fa5f-6e8d-52c9eeedb3d5@netcologne.de> Date: Tue, 21 Apr 2020 23:55:39 +0200 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:68.0) Gecko/20100101 Thunderbird/68.7.0 MIME-Version: 1.0 Content-Language: de-DE X-Spam-Status: No, score=-20.3 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, GIT_PATCH_1, GIT_PATCH_2, GIT_PATCH_3, RCVD_IN_DNSWL_LOW, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.2 X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-Patchwork-Original-From: Thomas Koenig via Gcc-patches From: Thomas Koenig Reply-To: Thomas Koenig Errors-To: gcc-patches-bounces@gcc.gnu.org Sender: "Gcc-patches" Hello world, this one took a bit of detective work. When array pointers point to components of derived types, we currently set the span field and then create an array temporary when we pass the array pointer to a procedure as a non-pointer or non-target argument. (This is inefficient, but that's for another release). Now, the compiler detected this case when there was a direct assignment like p => a%b, but not when p was returned either as a function result or via an argument. This patch fixes that. Regression-tested. OK for trunk, gcc 9 and gcc8 (all are affected)? Regards Thomas 2020-04-21 Thomas Koenig PR fortran/93956 * expr.c (gfc_check_pointer_assign): Also set subref_array_pointer when a function returns a pointer. * interface.c (gfc_set_subref_array_pointer_arg): New function. (gfc_procedure_use): Call it. 2020-04-21 Thomas Koenig PR fortran/93956 * gfortran.dg/pointer_assign_13.f90: New test. diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index a9fa03ad153..618c98a592d 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -4242,8 +4242,11 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue, if (rvalue->expr_type == EXPR_NULL) return true; - if (rvalue->expr_type == EXPR_VARIABLE && is_subref_array (rvalue)) - lvalue->symtree->n.sym->attr.subref_array_pointer = 1; + /* A function may also return subref arrray pointer. */ + + if ((rvalue->expr_type == EXPR_VARIABLE && is_subref_array (rvalue)) + || rvalue->expr_type == EXPR_FUNCTION) + lvalue->symtree->n.sym->attr.subref_array_pointer = 1; attr = gfc_expr_attr (rvalue); diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index ba1c8bc322e..58b7abf31e9 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -3788,6 +3788,36 @@ check_intents (gfc_formal_arglist *f, gfc_actual_arglist *a) return true; } +/* Go through the argument list of a procedure and look for + pointers which may be set, possibly introducing a span. */ + +static void +gfc_set_subref_array_pointer_arg (gfc_formal_arglist *dummy_args, + gfc_actual_arglist *actual_args) +{ + gfc_formal_arglist *f; + gfc_actual_arglist *a; + gfc_symbol *a_sym; + for (f = dummy_args, a = actual_args; f && a ; f = f->next, a = a->next) + { + + if (f->sym == NULL) + continue; + + if (!f->sym->attr.pointer || f->sym->attr.intent == INTENT_IN) + continue; + + if (a->expr == NULL || a->expr->expr_type != EXPR_VARIABLE) + continue; + a_sym = a->expr->symtree->n.sym; + + if (!a_sym->attr.pointer) + continue; + + a_sym->attr.subref_array_pointer = 1; + } + return; +} /* Check how a procedure is used against its interface. If all goes well, the actual argument list will also end up being properly @@ -3968,6 +3998,10 @@ gfc_procedure_use (gfc_symbol *sym, gfc_actual_arglist **ap, locus *where) if (warn_aliasing) check_some_aliasing (dummy_args, *ap); + /* Set the subref_array_pointer_arg if needed. */ + if (dummy_args) + gfc_set_subref_array_pointer_arg (dummy_args, *ap); + return true; }