From patchwork Thu Feb 11 12:05:05 2016 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Andre Vehreschild X-Patchwork-Id: 581837 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 AAC1D1402F0 for ; Thu, 11 Feb 2016 23:05:50 +1100 (AEDT) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b=rmHoSIch; dkim-atps=neutral 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:subject:message-id:in-reply-to:references:mime-version :content-type; q=dns; s=default; b=y3NaAHmbchoRnjyLh1c253N9EWKbK IqhaxLUx1ebnuw/Kb0YxlyTcw+zV6FIV+X98biJBnq5APNBj0iRvj6WepNHVUvNr cc7VJ7DxgIQrREISnZD3HCu3Y/JncYPq+cMDNW3jLeXLwnCiVUpLCThOGtYRrWTJ 2Lvs+YOUu1Kom0= 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:subject:message-id:in-reply-to:references:mime-version :content-type; s=default; bh=udv7hRautjRk1e+UUVF+y2M29so=; b=rmH oSIchJfJ8Wdnzxkz4cAJizdmxKPvx4HkZeOR1HVJ+bJvCEnmDn+V4ZqlWI3SOEY5 Nskfx5ZoM4PcoVaZx9j8NdxMtrC2tLwOuTjVPI2IgbMI4S4HH8rUp9I9mOQUvyRC yE0aaz6+QuZoXWwMTH0EN3YLUeDg3HVNN0Xs7pFo= Received: (qmail 35074 invoked by alias); 11 Feb 2016 12:05:13 -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 35049 invoked by uid 89); 11 Feb 2016 12:05:12 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-1.6 required=5.0 tests=AWL, BAYES_00, FREEMAIL_FROM, FREEMAIL_REPLY, RCVD_IN_DNSWL_LOW, SPF_PASS autolearn=no version=3.3.2 spammy=*sym, vehregccgnuorg, sk:attrco, vehre@gcc.gnu.org X-Spam-User: qpsmtpd, 2 recipients X-HELO: mout.gmx.net Received: from mout.gmx.net (HELO mout.gmx.net) (212.227.15.15) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with (AES256-GCM-SHA384 encrypted) ESMTPS; Thu, 11 Feb 2016 12:05:10 +0000 Received: from vepi2 ([92.213.0.123]) by mail.gmx.com (mrgmx003) with ESMTPSA (Nemesis) id 0MS5QA-1aasRs0B58-00THD6; Thu, 11 Feb 2016 13:05:06 +0100 Date: Thu, 11 Feb 2016 13:05:05 +0100 From: Andre Vehreschild To: GCC-Patches-ML , GCC-Fortran-ML Subject: Re: [PING, patch, Fortran, pr69296, v1] [6 Regression] [F03] Problem with associate and vector subscript Message-ID: <20160211130505.101f01f3@vepi2> In-Reply-To: <20160202183727.342df757@vepi2> References: <20160202183727.342df757@vepi2> MIME-Version: 1.0 X-UI-Out-Filterresults: notjunk:1; V01:K0:uxTEZwHBpTw=:iJH9bpVRUS2Bml2Dkyj9Cl 9dYMP9OXpMi+Or7zl6y5CteU+MsmvJTqiiiE3tBeIBfGavf6oYYGjFEYFKrOgqp2mGdavCKHp NVcxjh8V3ZS27qHa9lPpWm7lTQe/XuhdIVUvRPyzxqHcRu5CyY4ttAZRhOb7EaxGPcei6DeQP 5SCyomWnjtbrCzgcQbB3ElcPdAjLOAMPsN1S4jftb23t3S29FCc1a/pKzYGZzPgraMAc7fuwO A76/DaqI27OV0YBQqOoMduMzKQ1UfZ7Gr6MCDBPa8I1sbf0U0Xg/FSK+BLAV6DRdpeNuIasBX Wd4edg+W2RcKs6ci9o+kfPKmhy5/Nr/GQ9pAUMrs0i+BIkrO7UC5jkzUQcqyTx0ivbBPoRX8l x8mjiCSYq/FhdBVZj49L2Q9HqrwNT1fKgcxc+kZKowatg0NOuwYDv4pCKaCpyBiGblbg51RE0 6yOC9mERjWDqktT8F+2Ycon+gLAydwRASSTYEbIu9h4B6Y9jBzkQy4wuvf1g9/Wstw8vxhzJG MwtiDV76zHnh+zgA4wr/XZcXYM8Z85ej+rDWndgeTM2262uJccU839cevo+qHj66SnPO3YVm8 DvGi8ryWUrkg/6EAInjRbkLyKVmVLxYMaIReduukAytuePSkvpnYHi1wOt955lNqubKvv9qrS xTxDgi2p0KQo+3ALGnmVPtfmXl1RAz5mypX8eqtvSCXKeYF3QyqRNLWBCC4M0qe03ZJXjcbZq EREN1dPoM+jdOnqqayCekCZ07oIsML+8RhMuyBBXP7qtCKgMxuLDqiG64YinohHnMYe9iMa06 htJR7PbJMDghCcu8GbqtnaprU9NQqtixOD/caRgrT5NzvSsXq2Q0vhQijIiumFgp4tI9GvIui k9Kb26DaeFaYkJurRMgm9WvOu7UsMx26Mc0TuJ95Q= PING On Tue, 2 Feb 2016 18:37:27 +0100 Andre Vehreschild wrote: > Hi all, > > the attached patch fixes a regression that was most likely introduced > by one of my former patches, when in an associate() the rank of the > associated variable could not be determined at parse time correctly. > The patch now adds a flag to the association list indicating, that the > rank of the associated variable has been guessed only. In the resolve > phase the rank is corrected when the guess was wrong. > > Bootstrapped and regtested ok on x86_64-linux-gnu/F23. > > Ok for trunk? > > Regards, > Andre diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 8441b8c..33fffd8 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -2344,6 +2344,9 @@ typedef struct gfc_association_list for memory handling. */ unsigned dangling:1; + /* True when the rank of the target expression is guessed during parsing. */ + unsigned rankguessed:1; + char name[GFC_MAX_SYMBOL_LEN + 1]; gfc_symtree *st; /* Symtree corresponding to name. */ locus where; diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 5dcab70..7bce47f 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -4098,6 +4098,7 @@ parse_associate (void) int dim, rank = 0; if (array_ref) { + a->rankguessed = 1; /* Count the dimension, that have a non-scalar extend. */ for (dim = 0; dim < array_ref->dimen; ++dim) if (array_ref->dimen_type[dim] != DIMEN_ELEMENT diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 8752fd4..8fb7a95 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -4777,7 +4777,7 @@ fail: /* Given a variable expression node, compute the rank of the expression by examining the base symbol and any reference structures it may have. */ -static void +void expression_rank (gfc_expr *e) { gfc_ref *ref; @@ -8153,16 +8153,19 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target) if (target->rank != 0) { gfc_array_spec *as; - if (sym->ts.type != BT_CLASS && !sym->as) + /* The rank may be incorrectly guessed at parsing, therefore make sure + it is corrected now. */ + if (sym->ts.type != BT_CLASS && (!sym->as || sym->assoc->rankguessed)) { - as = gfc_get_array_spec (); + if (!sym->as) + sym->as = gfc_get_array_spec (); + as = sym->as; as->rank = target->rank; as->type = AS_DEFERRED; as->corank = gfc_get_corank (target); sym->attr.dimension = 1; if (as->corank != 0) sym->attr.codimension = 1; - sym->as = as; } } else diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 5143c31..cb54499 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -1569,7 +1569,9 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block) if (sym->attr.subref_array_pointer) { gcc_assert (e->expr_type == EXPR_VARIABLE); - tmp = e->symtree->n.sym->backend_decl; + tmp = e->symtree->n.sym->ts.type == BT_CLASS + ? gfc_class_data_get (e->symtree->n.sym->backend_decl) + : e->symtree->n.sym->backend_decl; tmp = gfc_get_element_type (TREE_TYPE (tmp)); tmp = fold_convert (gfc_array_index_type, size_in_bytes (tmp)); gfc_add_modify (&se.pre, GFC_DECL_SPAN(desc), tmp); diff --git a/gcc/testsuite/gfortran.dg/associate_19.f03 b/gcc/testsuite/gfortran.dg/associate_19.f03 new file mode 100644 index 0000000..76534c5 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/associate_19.f03 @@ -0,0 +1,23 @@ +! { dg-do run } +! +! Contributed by mrestelli@gmail.com +! Adapated by Andre Vehreschild +! Test that fix for PR69296 is working. + +program p + implicit none + + integer :: j, a(2,6), i(3,2) + + a(1,:) = (/ ( j , j=1,6) /) + a(2,:) = (/ ( -10*j , j=1,6) /) + + i(:,1) = (/ 1 , 3 , 5 /) + i(:,2) = (/ 4 , 5 , 6 /) + + associate( ai => a(:,i(:,1)) ) + if (any(shape(ai) /= [2, 3])) call abort() + if (any(reshape(ai, [6]) /= [1 , -10, 3, -30, 5, -50])) call abort() + end associate + +end program p diff --git a/gcc/testsuite/gfortran.dg/associate_20.f03 b/gcc/testsuite/gfortran.dg/associate_20.f03 new file mode 100644 index 0000000..9d420ef --- /dev/null +++ b/gcc/testsuite/gfortran.dg/associate_20.f03 @@ -0,0 +1,31 @@ +! { dg-do run } +! +! Contributed by mrestelli@gmail.com +! Adapated by Andre Vehreschild +! Test that fix for PR69296 is working. + +program p + implicit none + + type foo + integer :: i + end type + + integer :: j, i(3,2) + class(foo), allocatable :: a(:,:) + + allocate (a(2,6)) + + a(1,:)%i = (/ ( j , j=1,6) /) + a(2,:)%i = (/ ( -10*j , j=1,6) /) + + i(:,1) = (/ 1 , 3 , 5 /) + i(:,2) = (/ 4 , 5 , 6 /) + + associate( ai => a(:,i(:,1))%i ) + if (any(shape(ai) /= [2, 3])) call abort() + if (any(reshape(ai, [6]) /= [1 , -10, 3, -30, 5, -50])) call abort() + end associate + + deallocate(a) +end program p