From patchwork Thu Jan 9 13:44:30 2020 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 1220379 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=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-517004-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=none (p=none dis=none) header.from=codesourcery.com Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.a=rsa-sha1 header.s=default header.b=toYJYUa8; dkim-atps=neutral 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 47tnRR0h33z9sPJ for ; Fri, 10 Jan 2020 00:44:49 +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:to :from:subject:message-id:date:mime-version:content-type; q=dns; s=default; b=O27B4T/GIwEGypgVuMMmxT5S/lCcRjza3DG8n9dEGiXTyfcyX8 Q3O8Ymig6SY+SOoLKwMFKDd+BubQo5TIeqSuRgMD/prXjLNaZYeKoAcvXDMAmObP s88niSGFaXxaRAHEtJvrms9fB5WkfYb591AZ9RGD63nb/nQG4gIjd1uqA= 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:to :from:subject:message-id:date:mime-version:content-type; s= default; bh=Pq+bzlmxk9cuZv0ufnRCLcu9zpw=; b=toYJYUa8nQNOLzJb2g+A Gl6spze0XSYyKUg/169vfjxZP5/2LtgqpbuCmtTX2nBdy6LIP5123/czlRyI1fbr 3yu5CsDHF3YC6bWq+27/eNx+8ZVf88UM10CMWkqdYdSCOH5dhr8pyixh5HsyU+Rh 40WAGyUYKpynUHQzk7/abIU= Received: (qmail 18231 invoked by alias); 9 Jan 2020 13:44:40 -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 18153 invoked by uid 89); 9 Jan 2020 13:44:40 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-20.0 required=5.0 tests=AWL, BAYES_00, GIT_PATCH_0, GIT_PATCH_1, GIT_PATCH_2, GIT_PATCH_3, SPF_PASS autolearn=ham version=3.3.1 spammy=atttribute X-HELO: esa4.mentor.iphmx.com Received: from esa4.mentor.iphmx.com (HELO esa4.mentor.iphmx.com) (68.232.137.252) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Thu, 09 Jan 2020 13:44:37 +0000 IronPort-SDR: JWRUVGs0ilrfXcJZHR1CnamyX3PagtAPkoJom/T2OWrrYuwb3/ZufrWQULfXZcGkPZSG1yoICr AiiEyLe9IOpdwFaI0YdCYKL4Hx1e9ikR0K7XuqVJpSDgNXvxqhBmHSN30MIsTt4GQDioy+NN/2 etaGAwLcPRLfzlu8qTcUpNXXHBMKk94SrbthsRXPfc/rsJmNLNrnMvUYV3gNp+tkCRvXjtPFyj 4YECJqN/gcif3gSyZpIsnqVgk75HuUg0lwck3V5Uk4hUXZ76a0tidQUryuQ6SYiG8qmtKwDh8O d9s= Received: from orw-gwy-01-in.mentorg.com ([192.94.38.165]) by esa4.mentor.iphmx.com with ESMTP; 09 Jan 2020 05:44:36 -0800 IronPort-SDR: BprBHZsM/63D/AAqpvqmW83LCZ49tuzd73FhMOepcYjow3WO/VvJeWvTnlKqGHjLZvssN79+9R jDPA5aGqAyNAAOrkWD5eBkuw1N6VO3ux6W2N8HlOgKTNyBVssEwrmGkrbbrDorcOvbo950z7B+ GIBB3ihLcQuwCSNQFcy7VephHlsIQNvQzRhuP0rfsJvWHcvy8qMlJ3x67tDUoIb3Av0G9jw+Il X5AdTuQJYvE/DywWp43NyJyen37vwRhq7fDgiedWT7e8cuaRd5UWoBI7jFVegGS/D6rsp0cyY7 cJk= To: gcc-patches , fortran From: Tobias Burnus Subject: [Patch, committed, Fortran] PR84135 fix merging dimension into codimension array spec Message-ID: <40115728-61c7-f27f-0738-9c06c767cd8a@codesourcery.com> Date: Thu, 9 Jan 2020 14:44:30 +0100 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:68.0) Gecko/20100101 Thunderbird/68.3.1 MIME-Version: 1.0 X-IsSubscribed: yes Committed as obvious (r280046). I will backport to GCC 8 + 9 in the next days. * * * Background – slightly more convoluted than the actual patch :-) If the to-be-used array spec ("to") has a codimension, one needs to move it to the right such that the shape for the regular-array dimension fit there. However, one needs to start shifting from the right, otherwise, all codimensions have the value of the first codimension! This happens in merge_array_spec for 'current_as' if one has a 'dimension' attribute followed by a 'codimension' atttribute. – It happens likewise (but in gfc_set_array_spec) if one has declared a symbol with codimension (in one of three ways) and then has a 'dimension' statement. It gets more interesting if one has both a dimension and codimension attribute (hence: rank + corank in current_as) – and then in the var spec one overrides this by a codimension (z6 in the example). In that case, only the codimension data has to be taken from current_as. Here, the code missed to take into account that the first "from->rank" elements of upper/lower have to be skipped over, i.e. one needs to copy 'from->rank + 0' to 'from->rank + from->corank' instead of 0 to corank! Cheers, Tobias PR fortran/84135 * array.c (gfc_set_array_spec): Fix shifting of codimensions when adding a dimension. * decl.c (merge_array_spec): Ditto. Fix using correct codimensions. PR fortran/84135 * gfortran.dg/coarray/codimension_3.f90: New. diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c index e5b4ad7b4b2..157acb8cd90 100644 --- a/gcc/fortran/array.c +++ b/gcc/fortran/array.c @@ -887,7 +887,7 @@ gfc_set_array_spec (gfc_symbol *sym, gfc_array_spec *as, locus *error_loc) if (sym->as->rank + sym->as->corank > GFC_MAX_DIMENSIONS) goto too_many; - for (i = 0; i < sym->as->corank; i++) + for (i = sym->as->corank - 1; i >= 0; i--) { sym->as->lower[as->rank + i] = sym->as->lower[i]; sym->as->upper[as->rank + i] = sym->as->upper[i]; diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 67c67667d9e..499d2429aba 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -928,8 +928,6 @@ done: static bool merge_array_spec (gfc_array_spec *from, gfc_array_spec *to, bool copy) { - int i, j; - if ((from->type == AS_ASSUMED_RANK && to->corank) || (to->type == AS_ASSUMED_RANK && from->corank)) { @@ -944,18 +942,18 @@ merge_array_spec (gfc_array_spec *from, gfc_array_spec *to, bool copy) to->cray_pointee = from->cray_pointee; to->cp_was_assumed = from->cp_was_assumed; - for (i = 0; i < to->corank; i++) + for (int i = to->corank - 1; i >= 0; i--) { /* Do not exceed the limits on lower[] and upper[]. gfortran cleans up elsewhere. */ - j = from->rank + i; + int j = from->rank + i; if (j >= GFC_MAX_DIMENSIONS) break; to->lower[j] = to->lower[i]; to->upper[j] = to->upper[i]; } - for (i = 0; i < from->rank; i++) + for (int i = 0; i < from->rank; i++) { if (copy) { @@ -974,23 +972,24 @@ merge_array_spec (gfc_array_spec *from, gfc_array_spec *to, bool copy) to->corank = from->corank; to->cotype = from->cotype; - for (i = 0; i < from->corank; i++) + for (int i = 0; i < from->corank; i++) { /* Do not exceed the limits on lower[] and upper[]. gfortran cleans up elsewhere. */ - j = to->rank + i; + int k = from->rank + i; + int j = to->rank + i; if (j >= GFC_MAX_DIMENSIONS) break; if (copy) { - to->lower[j] = gfc_copy_expr (from->lower[i]); - to->upper[j] = gfc_copy_expr (from->upper[i]); + to->lower[j] = gfc_copy_expr (from->lower[k]); + to->upper[j] = gfc_copy_expr (from->upper[k]); } else { - to->lower[j] = from->lower[i]; - to->upper[j] = from->upper[i]; + to->lower[j] = from->lower[k]; + to->upper[j] = from->upper[k]; } } } diff --git a/gcc/testsuite/gfortran.dg/coarray/codimension_3.f90 b/gcc/testsuite/gfortran.dg/coarray/codimension_3.f90 new file mode 100644 index 00000000000..d596f5ae1fe --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray/codimension_3.f90 @@ -0,0 +1,76 @@ +! { dg-do run } +! +! PR fortran/84135 +! +! Co-contributed by G. Steinmetz +! +! Ensure that coarray shape remains correct +! after merging the shape from 'dimension' +! +program p + integer :: i + integer, dimension(3) :: x[2,*] + data (x(i:i+2:i+1), i=1,2) /1,2,3/ + integer, dimension(3) :: y[2,3,-3:4,5,7:*] = [1,2,3] + integer :: z, z2[2:4,7:9,-2:2,-7:8,-4:*] + codimension :: z[2:4,7:9,-2:2,-7:8,-4:*] + integer, codimension[1:*] :: z3[2:4,7:9,-2:2,-7:8,-4:*] + dimension :: z(1:2,-3:-2,7:7), z2(1:2,-3:-2,7:7), z3(1:2,-3:-2,7:7) + integer, codimension[2:4,7:9,-2:2,-7:8,-4:*], dimension(1:2,-3:-2,7:7) :: z4 + integer, codimension[*], dimension(1:2,-3:-2,7:7) :: z5[2:4,7:9,-2:2,-7:8,-4:*] + integer, codimension[2:4,7:9,-2:2,-7:8,-4:*], dimension(3) :: z6(1:2,-3:-2,7:7) + integer, codimension[*], dimension(4) :: z7(1:2,-3:-2,7:7)[2:4,7:9,-2:2,-7:8,-4:*] + + if (any (lcobound(x) /= [1, 1])) stop 1 + if (any (lcobound(y) /= [1, 1, -3, 1, 7])) stop 3 + if (any (lcobound(z) /= [2,7,-2,-7,-4])) stop 4 + if (any (lcobound(z2) /= lcobound(z))) stop 4 + if (any (lcobound(z3) /= lcobound(z))) stop 5 + if (any (lcobound(z4) /= lcobound(z))) stop 6 + if (any (lcobound(z5) /= lcobound(z))) stop 7 + if (any (lcobound(z6) /= lcobound(z))) stop 8 + if (any (lcobound(z7) /= lcobound(z))) stop 9 + + if (any (lbound(x) /= [1])) stop 11 + if (any (lbound(y) /= [1])) stop 12 + if (any (lbound(z) /= [1,-3,7])) stop 13 + if (any (lbound(z2) /= lbound(z))) stop 14 + if (any (lbound(z3) /= lbound(z))) stop 15 + if (any (lbound(z4) /= lbound(z))) stop 16 + if (any (lbound(z5) /= lbound(z))) stop 17 + if (any (lbound(z6) /= lbound(z))) stop 18 + if (any (lbound(z7) /= lbound(z))) stop 19 + + if (any (ubound(x) /= [3])) stop 21 + if (any (ubound(y) /= [3])) stop 22 + if (any (ubound(z) /= [2,-2,7])) stop 23 + if (any (ubound(z2) /= ubound(z))) stop 24 + if (any (ubound(z3) /= ubound(z))) stop 25 + if (any (ubound(z4) /= ubound(z))) stop 26 + if (any (ubound(z5) /= ubound(z))) stop 27 + if (any (ubound(z6) /= ubound(z))) stop 28 + if (any (ubound(z7) /= ubound(z))) stop 29 + + if (any (ucobound(z2) /= ucobound(z))) stop 31 + if (any (ucobound(z3) /= ucobound(z))) stop 32 + if (any (ucobound(z4) /= ucobound(z))) stop 33 + if (any (ucobound(z5) /= ucobound(z))) stop 34 + if (any (ucobound(z6) /= ucobound(z))) stop 35 + if (any (ucobound(z7) /= ucobound(z))) stop 36 + + if (num_images() == 1) then + if (any (ucobound(x) /= [2, lbound(x,dim=1)])) stop 37 + if (any (ucobound(y) /= [2, 3, 4, 5, 7])) stop 38 + if (any (ucobound(z) /= [4,9,2,8,-4])) stop 39 + else + if (ucobound(x, dim=1) /= 2) stop 41 + if (ucobound(y, dim=1) /= 2) stop 42 + if (ucobound(y, dim=2) /= 3) stop 43 + if (ucobound(y, dim=3) /= 4) stop 44 + if (ucobound(y, dim=4) /= 5) stop 45 + if (ucobound(z, dim=1) /= 4) stop 46 + if (ucobound(z, dim=2) /= 9) stop 47 + if (ucobound(z, dim=3) /= 2) stop 48 + if (ucobound(z, dim=4) /= 8) stop 49 + endif +end