From patchwork Thu Jan 2 15:43:29 2020 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 1217094 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-516579-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=none (p=none dis=none) header.from=net-b.de Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="dpVlaCBl"; 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 47pXQ31nFLz9sNH for ; Fri, 3 Jan 2020 02:43:53 +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:cc :from:subject:message-id:date:mime-version:content-type; q=dns; s=default; b=eu5jCy7X+ades2IicwV6ISlYdTbayG1JeShyZuWH2fw+rQBKXu iXARLizxdEa2oAGzNFYDtghdwMRNzDJkfUBlMw/14mStiqrUMON7kvS42L21VC2b fgz1AMg1LFFe9JsbekyBYcLyCGEfh+Wh89SHMK2BvuWsAgTj12ErvunTc= 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:cc :from:subject:message-id:date:mime-version:content-type; s= default; bh=IRS/KGUorgY8TvU+5/5+xSaKhiU=; b=dpVlaCBl1lu6i2AeEqth QDyHDGkPjdmxNzNlvHIDbf3BsAzWnuTUbvBReKw1o+WolhDoz4S7ZePiUvURqRp+ gZQLvXsdB+W9TiQAp7b+ITkFrFBk0dhjJgqv504/BhQDvYeesFo0UTeZDCn5nDof Lh91Xo+QHiYetvpbS7TjnBk= Received: (qmail 28300 invoked by alias); 2 Jan 2020 15:43:45 -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 28285 invoked by uid 89); 2 Jan 2020 15:43:44 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: =?iso-8859-1?q?No=2C_score=3D-4=2E2_required=3D5=2E0?= =?iso-8859-1?q?_tests=3DAWL=2CBAYES_00=2CGARBLED_SUBJECT=2CGIT_PAT?= =?iso-8859-1?q?CH_2=2CGIT_PATCH_3=2CKAM_ASCII_DIVIDERS=2CKAM_NUMSU?= =?iso-8859-1?q?BJECT=2CRCVD_IN_DNSWL_LOW_autolearn=3Dham_version?= =?iso-8859-1?q?=3D3=2E3=2E1_spammy=3DH*Ad=3AU*burnus=2C_Bad=2C_is?= =?iso-8859-1?q?=C2=2C_is?= X-HELO: mx-relay47-hz2.antispameurope.com Received: from mx-relay47-hz2.antispameurope.com (HELO mx-relay47-hz2.antispameurope.com) (94.100.136.247) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Thu, 02 Jan 2020 15:43:42 +0000 Received: from s041.bre.qsc.de ([195.90.7.81]) by mx-relay47-hz2.antispameurope.com; Thu, 02 Jan 2020 16:43:39 +0100 Received: from localhost.localdomain (nat-wv.mentorg.com [192.94.38.34]) by s041.bre.qsc.de (Postfix) with ESMTPSA id 39C4C2C005A; Thu, 2 Jan 2020 16:43:35 +0100 (CET) To: gcc-patches , fortran Cc: Tobias Burnus From: Tobias Burnus Subject: =?utf-8?q?=5BPatch=2C_committed=2C_Fortran=5D_PR68020_=E2=80=93_?= =?utf-8?q?Fix_implied-shape_handling_for_rank_=3E_2?= Message-ID: Date: Thu, 2 Jan 2020 16:43:29 +0100 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:68.0) Gecko/20100101 Thunderbird/68.3.1 MIME-Version: 1.0 X-cloud-security-sender: burnus@net-b.de X-cloud-security-recipient: gcc-patches@gcc.gnu.org X-cloud-security-Virusscan: CLEAN X-cloud-security-disclaimer: This E-Mail was scanned by E-Mailservice on mx-relay47-hz2.antispameurope.com with 9CBD84028E X-cloud-security-connect: s041.bre.qsc.de[195.90.7.81], TLS=1, IP=195.90.7.81 X-cloud-security: scantime:.2316 implied-shape: Used with PARAMETER; takes the shape of the RHS and (F2018, R824) "implied-shape-spec  is  assumed-implied-spec, assumed-implied-spec-list" When matching an element in an array spec of this type, i.e. (R821) "assumed-implied-spec is [lower-bound: ] *", the matcher always returns AS_ASSUMED_SIZE as – without further knowledge – the two, assumed-size and implied-shape, are indistinguishable: current_type = match_array_element_spec (as); When matching the lowest dimension (as->rank = 1), as->type is set to current_type – for the same reason as above. However, when matching the second time an element of type "AS_ASSUMED_SIZE", one knows that it cannot be a valid assumed-size array – but it can be a valid implied-shape array. Hence, it is turned into the latter: as->type = AS_IMPLIED_SHAPE. If we now patch the third, etc. dimension, current_type is still assumed-size but as->type is now implied-size. Seemingly, the code writer was confused between assumed-shape and assumed-size … Committed as Rev. 279835 after building an regtesting the attached patch. Tobias Index: gcc/testsuite/gfortran.dg/implied_shape_4.f90 =================================================================== --- gcc/testsuite/gfortran.dg/implied_shape_4.f90 (nonexistent) +++ gcc/testsuite/gfortran.dg/implied_shape_4.f90 (revision 279835) @@ -0,0 +1,45 @@ +! { dg-do run } +! { dg-additional-options "-std=f2008" } +! +! PR fortran/68020 +! +! Contributed by Gerhard Steinmetz +! +subroutine rank_1_2 + integer, parameter :: a(1, 2) = 0 + integer, parameter :: x(*, *) = a + integer, parameter :: y(11:*, 12:*) = a + integer :: k + if (any (lbound(x) /= [1,1])) stop 1 + if (any (ubound(x) /= [1,2])) stop 2 + if (any (lbound(y) /= [11,12])) stop 3 + if (any (ubound(y) /= [11,13])) stop 4 +end + +subroutine rank_3 + integer, parameter :: a(1, 2, 3) = 0 + integer, parameter :: x(*, *, *) = a + integer, parameter :: y(11:*, 12:*, 13:*) = a + integer :: k + if (any (lbound(x) /= [1,1,1])) stop 5 + if (any (ubound(x) /= [1,2,3])) stop 6 + if (any (lbound(y) /= [11,12,13])) stop 7 + if (any (ubound(y) /= [11,13,15])) stop 8 +end + +subroutine rank_4 + integer, parameter :: a(1, 2, 3, 4) = 0 + integer, parameter :: x(*, *, *, *) = a + integer, parameter :: y(11:*, 12:*, 13:*, 14:*) = a + integer :: k + if (any (lbound(x) /= [1,1,1,1])) stop 9 + if (any (ubound(x) /= [1,2,3,4])) stop 10 + if (any (lbound(y) /= [11,12,13,14])) stop 11 + if (any (ubound(y) /= [11,13,15,17])) stop 12 +end + +program p + call rank_1_2 + call rank_3 + call rank_4 +end program p Index: gcc/testsuite/gfortran.dg/implied_shape_5.f90 =================================================================== --- gcc/testsuite/gfortran.dg/implied_shape_5.f90 (nonexistent) +++ gcc/testsuite/gfortran.dg/implied_shape_5.f90 (revision 279835) @@ -0,0 +1,29 @@ +! { dg-do run } +! +! PR fortran/68020 +! +! Reject mixing explicit-shape and implied-shape arrays +! +subroutine rank_1_2 + integer, parameter :: a(1, 2) = 0 + integer, parameter :: y(11:11, 12:*) = a ! { dg-error "Assumed size array at .1. must be a dummy argument" } + integer, parameter :: x(:, *) = a ! { dg-error "Bad specification for deferred shape array" } +end + +subroutine rank_3 + integer, parameter :: a(1, 2, 3) = 0 + integer, parameter :: y(11:*, 12:14, 13:*) = a ! { dg-error "Bad specification for assumed size array" } + integer, parameter :: x(11:*, :, 13:*) = a ! { dg-error "Bad specification for assumed size array" } +end + +subroutine rank_4 + integer, parameter :: a(1, 2, 3, 4) = 0 + integer, parameter :: y(11:*, 12:*, 13:*, 14:17) = a ! { dg-error "Bad array specification for implied-shape array" } + integer, parameter :: y(11:*, 12:*, 13:*, 14:) = a ! { dg-error "Bad array specification for implied-shape array" } +end + +program p + call rank_1_2 + call rank_3 + call rank_4 +end program p Index: gcc/testsuite/ChangeLog =================================================================== --- gcc/testsuite/ChangeLog (revision 279834) +++ gcc/testsuite/ChangeLog (revision 279835) @@ -1,3 +1,9 @@ +2020-01-02 Tobias Burnus + + PR fortran/68020 + * gfortran.dg/implied_shape_4.f90: New. + * gfortran.dg/implied_shape_5.f90: New. + 2020-01-02 Jakub Jelinek PR ipa/93087 Index: gcc/fortran/array.c =================================================================== --- gcc/fortran/array.c (revision 279834) +++ gcc/fortran/array.c (revision 279835) @@ -599,7 +599,7 @@ goto cleanup; case AS_IMPLIED_SHAPE: - if (current_type != AS_ASSUMED_SHAPE) + if (current_type != AS_ASSUMED_SIZE) { gfc_error ("Bad array specification for implied-shape" " array at %C"); Index: gcc/fortran/ChangeLog =================================================================== --- gcc/fortran/ChangeLog (revision 279834) +++ gcc/fortran/ChangeLog (revision 279835) @@ -1,3 +1,9 @@ +2020-01-02 Tobias Burnus + + PR fortran/68020 + * array.c (gfc_match_array_spec): Fix implied-type matching + for rank > 2. + 2020-01-01 Thomas Koenig PR fortran/93113