From patchwork Wed Nov 24 21:32:57 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Harald Anlauf X-Patchwork-Id: 48114 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 1BEC5385781E for ; Wed, 24 Nov 2021 21:33:46 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 1BEC5385781E DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1637789626; bh=IPsOHLwBQ7ewglPDayN+c0s8c+NxBYMP31pT3sV/rKw=; h=To:Subject:Date:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:From; b=vHQ7/+TdpObWLHBzTzs4AXWKdB23jGPd2mBjkCrqOrPZSd0yhEhYrwwWgVoBzIhKg RFc94mISOtvJfCd+Sh+fg2ok3zABamf1dQRlgpNqGHvLdPVmX2hsY/dp8OD3z+1wGL N3AseSkAvXI15q+rEK3mqH7dGP32DCrg6Tiit8Rs= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mout.gmx.net (mout.gmx.net [212.227.15.15]) by sourceware.org (Postfix) with ESMTPS id 6F5F33858413; Wed, 24 Nov 2021 21:32:59 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 6F5F33858413 X-UI-Sender-Class: 01bb95c1-4bf8-414a-932a-4f6e2808ef9c Received: from [79.251.13.189] ([79.251.13.189]) by web-mail.gmx.net (3c-app-gmx-bs39.server.lan [172.19.170.91]) (via HTTP); Wed, 24 Nov 2021 22:32:57 +0100 MIME-Version: 1.0 Message-ID: To: fortran , gcc-patches Subject: [PATCH] PR fortran/103411 - ICE in gfc_conv_array_initializer, at fortran/trans-array.c:6377 Date: Wed, 24 Nov 2021 22:32:57 +0100 Importance: normal Sensitivity: Normal X-Priority: 3 X-Provags-ID: V03:K1:AmMKnoQWyANxKRNbkhCxDXeKSIZ/ISB913Ufc3jB/AW4bNHFRLDUSoIzA5zezGfi+gqWs fcGWhh68WP8ZuuS6wQOAtDbF3/OzLeupvc7sdpcSw80QcI4xia/3KDOlvv0aOE/Iktchp4y/q0/s YNEgq+KaD/TApHflpighmgx/WEJmC4KPFTXiNncWxd0M9TaWHrOLqb0u3cjXQuIOQIVeHAHFo9Uq LXAxVuOUqp2gRMSDcKNi67sJtr0bJrFsCM4M/r/g1K9iRN+7bbwIHvISwOx5VCAldhKybEY2VRzM 8U= X-UI-Out-Filterresults: notjunk:1;V03:K0:2C5QO3dHN6M=:5DoOHkhI9nZQd2dXTLmIZ9 D2Kt1ZWsI1GIBoBBA0RYaO5J+Lxu03eu+/B+OqUFRhg2Gf712+v8+u7RbuaCjCaydB8O2jT32 15mUFDEblHXuNAk4mRXggPEtWRRgLVN8VkIbEPapNUjKVPoAz3zCdRozsM53lQK/ks07taxtM az36kSPhNzf4+7iy0f31Kztnetvjol3xaz7N9vZNgFCQ5TztmEcHHWTpinFWYOL+uv0mU2rj6 lw/S//bI1JWReLYRkpobiuDRcoHRrrrQlZi/arWA4CoeLEQvQjoaLGqp8Wvq7WXoNV09YkPXD QTfqYqyReQa5FYKFm+sAq+6sea/m6YcPFIGgDZQKSwnFQcwaZFjXtYEQ19dFu+0IX6yNuNGgh D7+QMPGriKU5tS5a3FsEtcEPK9834xhwRo+QOR/6orCCbFEi93Mz3coYCUjsnZX5IG33i7QEL aBZQA9q2IfPp1dYdm9rqbMmZ8i1qs1NKb35B488Oz+chra91twVR+R10H9ofueHGkPPeT3He4 AX1USXW5MX1Q9ldyAPxU53vjXneOCPlcHUiV6x/3fG72ePAGe+yxFGkiazORbXjQXlwTp59M8 cie2WicWNmrW9uMRhgzJUnjiN+lenW8cGpWgXT1qPUtPYmDiZgpROyMAJwCQd5WPih087A+pa Z8ndEDRVjNKeAbAo35UD5j/k8z5ggmAK36GrajQe7aZPsveyAY+R/UTOuB9LF4puH+0m2owlT +erBq3JlaLMVTKOsQFqcbEHnAcpydU3VgmZHR5/Dhymbt5l84pKfj5dkkvo2L7L55NjI+APV3 wD0ezHm X-Spam-Status: No, score=-11.9 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, FREEMAIL_FROM, GIT_PATCH_0, KAM_NUMSUBJECT, RCVD_IN_DNSWL_LOW, RCVD_IN_MSPIKE_H2, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.4 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) 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: Harald Anlauf via Gcc-patches From: Harald Anlauf Reply-To: Harald Anlauf Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" Dear all, when checking the SOURCE and SHAPE arguments to the RESHAPE intrinsic, for absent PAD argument we failed to handle the case when SHAPE was a parameter. Fortunately, the proper check was already there, and the code just needs some tweaking, as well as one of the testcases. Regtested on x86_64-pc-linux-gnu. OK for mainline? Thanks, Harald From d6af2a33bad852bcea39b8c5b2e7c27976bde2a1 Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Wed, 24 Nov 2021 22:22:24 +0100 Subject: [PATCH] Fortran: improve check of arguments to the RESHAPE intrinsic gcc/fortran/ChangeLog: PR fortran/103411 * check.c (gfc_check_reshape): Improve check of size of source array for the RESHAPE intrinsic against the given shape when pad is not given, and shape is a parameter. gcc/testsuite/ChangeLog: PR fortran/103411 * gfortran.dg/reshape_7.f90: Adjust test to improved check. * gfortran.dg/reshape_9.f90: New test. --- gcc/fortran/check.c | 17 +++++++++++++---- gcc/testsuite/gfortran.dg/reshape_7.f90 | 2 +- gcc/testsuite/gfortran.dg/reshape_9.f90 | 14 ++++++++++++++ 3 files changed, 28 insertions(+), 5 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/reshape_9.f90 diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index 5a5aca10ebe..837eb0912c0 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -4699,6 +4699,7 @@ gfc_check_reshape (gfc_expr *source, gfc_expr *shape, mpz_t size; mpz_t nelems; int shape_size; + bool shape_is_const = false; if (!array_check (source, 0)) return false; @@ -4736,6 +4737,7 @@ gfc_check_reshape (gfc_expr *source, gfc_expr *shape, { gfc_expr *e; int i, extent; + shape_is_const = true; for (i = 0; i < shape_size; ++i) { e = gfc_constructor_lookup_expr (shape->value.constructor, i); @@ -4748,7 +4750,7 @@ gfc_check_reshape (gfc_expr *source, gfc_expr *shape, gfc_error ("%qs argument of %qs intrinsic at %L has " "negative element (%d)", gfc_current_intrinsic_arg[1]->name, - gfc_current_intrinsic, &e->where, extent); + gfc_current_intrinsic, &shape->where, extent); return false; } } @@ -4766,6 +4768,7 @@ gfc_check_reshape (gfc_expr *source, gfc_expr *shape, int i, extent; gfc_expr *e, *v; + shape_is_const = true; v = shape->symtree->n.sym->value; for (i = 0; i < shape_size; i++) @@ -4856,8 +4859,7 @@ gfc_check_reshape (gfc_expr *source, gfc_expr *shape, } } - if (pad == NULL && shape->expr_type == EXPR_ARRAY - && gfc_is_constant_expr (shape) + if (pad == NULL && shape_is_const && !(source->expr_type == EXPR_VARIABLE && source->symtree->n.sym->as && source->symtree->n.sym->as->type == AS_ASSUMED_SIZE)) { @@ -4866,10 +4868,17 @@ gfc_check_reshape (gfc_expr *source, gfc_expr *shape, { gfc_constructor *c; bool test; + gfc_constructor_base b; + if (shape->expr_type == EXPR_ARRAY) + b = shape->value.constructor; + else if (shape->expr_type == EXPR_VARIABLE) + b = shape->symtree->n.sym->value->value.constructor; + else + gcc_unreachable (); mpz_init_set_ui (size, 1); - for (c = gfc_constructor_first (shape->value.constructor); + for (c = gfc_constructor_first (b); c; c = gfc_constructor_next (c)) mpz_mul (size, size, c->expr->value.integer); diff --git a/gcc/testsuite/gfortran.dg/reshape_7.f90 b/gcc/testsuite/gfortran.dg/reshape_7.f90 index d752650aa4e..4216cb60cbb 100644 --- a/gcc/testsuite/gfortran.dg/reshape_7.f90 +++ b/gcc/testsuite/gfortran.dg/reshape_7.f90 @@ -4,7 +4,7 @@ subroutine p0 integer, parameter :: sh(2) = [2, 3] integer, parameter :: & - & a(2,2) = reshape([1, 2, 3, 4], sh) ! { dg-error "Different shape" } + & a(2,2) = reshape([1, 2, 3, 4], sh) ! { dg-error "not enough elements" } if (a(1,1) /= 0) STOP 1 end subroutine p0 diff --git a/gcc/testsuite/gfortran.dg/reshape_9.f90 b/gcc/testsuite/gfortran.dg/reshape_9.f90 new file mode 100644 index 00000000000..c46e211b47e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/reshape_9.f90 @@ -0,0 +1,14 @@ +! { dg-do compile } +! PR fortran/103411 - ICE in gfc_conv_array_initializer + +program p + integer, parameter :: a(2) = [2,2] + integer, parameter :: d(2,2) = reshape([1,2,3,4,5], a) + integer, parameter :: c(2,2) = reshape([1,2,3,4], a) + integer, parameter :: b(2,2) = & + reshape([1,2,3], a) ! { dg-error "not enough elements" } + print *, reshape([1,2,3], a) ! { dg-error "not enough elements" } + print *, reshape([1,2,3,4], a) + print *, reshape([1,2,3,4,5], a) + print *, b, c, d +end -- 2.26.2