From patchwork Sun May 21 20:48:22 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Harald Anlauf X-Patchwork-Id: 1784214 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@legolas.ozlabs.org Authentication-Results: legolas.ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=2620:52:3:1:0:246e:9693:128c; helo=sourceware.org; envelope-from=gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: legolas.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=RsdH4UVt; dkim-atps=neutral Received: from sourceware.org (server2.sourceware.org [IPv6:2620:52:3:1:0:246e:9693:128c]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature ECDSA (P-384) server-digest SHA384) (No client certificate requested) by legolas.ozlabs.org (Postfix) with ESMTPS id 4QPXjt5QYZz20PS for ; Mon, 22 May 2023 06:48:49 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 6992B3858431 for ; Sun, 21 May 2023 20:48:45 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 6992B3858431 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1684702125; bh=8+xVi8PMZzKFxggsIT4s5BJe2SesEOaf544AW0rJma8=; h=To:Subject:Date:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:From; b=RsdH4UVt6rqPeKR958/PrKrrnQJr03sKKMRmebP6saaUGiSRioAfTjTuOYH4krhkS qURrR/1F/J5WjOOLKk4Bt2cifG8LfqHWWPw1266PFkHhR0geaccmzOKP1xW1toFk6p X5IO71eNU1nlrVY6PEqkzhIw9RFMLVfhydDi9Hrc= 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.17.20]) by sourceware.org (Postfix) with ESMTPS id 1AB253858D20; Sun, 21 May 2023 20:48:24 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 1AB253858D20 X-UI-Sender-Class: 724b4f7f-cbec-4199-ad4e-598c01a50d3a Received: from [79.232.144.61] ([79.232.144.61]) by web-mail.gmx.net (3c-app-gmx-bap32.server.lan [172.19.172.102]) (via HTTP); Sun, 21 May 2023 22:48:22 +0200 MIME-Version: 1.0 Message-ID: To: fortran , gcc-patches Subject: [PATCH] Fortran: checking and simplification of RESHAPE intrinsic [PR103794] Date: Sun, 21 May 2023 22:48:22 +0200 Importance: normal Sensitivity: Normal X-Priority: 3 X-Provags-ID: V03:K1:MUYEuQP1SrG5i5fypX+0zG/quKBuYnad5Y5g1af4nbq11iFnZ3jyrSr0MgmUf+TNA3luV I5sXen2wogoyP7euVVQkSXfKezYTNqkcRyLSsSx5Bi15xOkn93RT/JSpmdn4Xjm1qQdkbKalPlHg 9cJW2mbw51k4auCvd6pOISxE2mbm2uMNsS5ft+fHf+EoQgFdxpHKKxenFCykxsKSDve/c6syebqd qOuvvn99J8EWhKIX9Iuu5jY9frjmtRaoz9LkHboqy9kPXqXvCJQDhEIfslfUEx8Cwza0VzPDx4Rk XM= UI-OutboundReport: notjunk:1;M01:P0:RBRBOnxBSG0=;aoPad8mHKBFFtXSY+bx/68IusO4 IEjvU778TfkjjGMC2DsriZw9ooCTpqKyGwJHGjbWfziz5OXBiS8f5Bw5GsySBI5X4WrUZMlvQ NGZOI1SaoWX7RktGFVPlzx7P5if+ymr444JCTQuRTUfcE6cla0DXMXYUXHWta/ofTLFeAwPii wXjUDth+gFrWquhbSX6sRKaMM9OtM0/fXWVgNU3ZUH2N979s+GuwwI/D72J0+tyGJYj2Fq7bj GEk2+NbhImq2MIf5RBGBgAUmvBj4Tm1mdmX9dPMzlE236PmJ+Ctp1mrHH/yN1gkVvZCs6s49f ew53QpC2i2od1aaSbQ6G9XNqmWq+Enie8IISJzADrAI7cSHercLKm0gwsvC00g/CQoUKfWPb6 RXJ8VJ6XhY3ci1f5U2UYUhhwt9BsWNHxwTbgUooE01uwcabAd3QBAWGEl4+uSbaS3wlK2otbt A3NBuz/Qt9Ry17BoeRGol0asToCNtCP4Mw/8oL3DLIVbzKfMmYzONNKewscnoj95+kS0RR/7X sVVB4PE3IOiaxFJSbXgSUqj/HDsEUzYZOTp7tenxbyBzSAnQn/Ez1PsEsJeAt3uo71qHewFg3 CMtk2zUg7AsKYXQWmIqfbyyGpU4FEJRM3/DBkl4c+38a/bAKpnD8vait5WWKK5tIJcVBDLr8S FKjXrCQP0a6eKNQD0XZTTtxFccsWNYgoAdcmrijVa1H7s3kiKwf5GjI+Gkyw67mYl5mOW1cVn vMy6zI2Eb31P3ZbPRUjfZaDFsG0PYiKJSY/57V85ESwIgXhm2gxdLowr9Db9mjBNNdXZP734a CLDXRISNwUjuyL9Smj4dzFeGWDJHyi5l6AjGU3oUenXvM= X-Spam-Status: No, score=-12.8 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, FREEMAIL_FROM, GIT_PATCH_0, RCVD_IN_DNSWL_LOW, RCVD_IN_MSPIKE_H2, SPF_HELO_NONE, SPF_PASS, TXREP, T_SCC_BODY_TEXT_LINE autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) 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+incoming=patchwork.ozlabs.org@gcc.gnu.org Sender: "Gcc-patches" Dear all, checking and simplification of the RESHAPE intrinsic could fail in various ways for sufficiently complicated arguments, like array constructors. Debugging revealed that in these cases we determined that the array arguments were constant but we did not properly simplify and expand the constructors. A possible solution is the extend the test for constant arrays - which already does an expansion for initialization expressions - to also perform an expansion for small constructors in the non-initialization case. Regtested on x86_64-pc-linux-gnu. OK for mainline? Thanks, Harald From bfb708fdb6c313473a3054be710c630dcdebf69d Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Sun, 21 May 2023 22:25:29 +0200 Subject: [PATCH] Fortran: checking and simplification of RESHAPE intrinsic [PR103794] gcc/fortran/ChangeLog: PR fortran/103794 * check.cc (gfc_check_reshape): Expand constant arguments SHAPE and ORDER before checking. * gfortran.h (gfc_is_constant_array_expr): Add prototype. * iresolve.cc (gfc_resolve_reshape): Expand constant argument SHAPE. * simplify.cc (is_constant_array_expr): If array is determined to be constant, expand small array constructors if needed. (gfc_is_constant_array_expr): Wrapper for is_constant_array_expr. (gfc_simplify_reshape): Fix check for insufficient elements in SOURCE when no padding specified. gcc/testsuite/ChangeLog: PR fortran/103794 * gfortran.dg/reshape_10.f90: New test. * gfortran.dg/reshape_11.f90: New test. --- gcc/fortran/check.cc | 6 +++-- gcc/fortran/gfortran.h | 1 + gcc/fortran/iresolve.cc | 2 +- gcc/fortran/simplify.cc | 25 ++++++++++++++--- gcc/testsuite/gfortran.dg/reshape_10.f90 | 34 ++++++++++++++++++++++++ gcc/testsuite/gfortran.dg/reshape_11.f90 | 15 +++++++++++ 6 files changed, 77 insertions(+), 6 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/reshape_10.f90 create mode 100644 gcc/testsuite/gfortran.dg/reshape_11.f90 diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc index 3dd1711aa14..4086dc71d34 100644 --- a/gcc/fortran/check.cc +++ b/gcc/fortran/check.cc @@ -4723,7 +4723,7 @@ gfc_check_reshape (gfc_expr *source, gfc_expr *shape, } gfc_simplify_expr (shape, 0); - shape_is_const = gfc_is_constant_expr (shape); + shape_is_const = gfc_is_constant_array_expr (shape); if (shape->expr_type == EXPR_ARRAY && shape_is_const) { @@ -4732,6 +4732,8 @@ gfc_check_reshape (gfc_expr *source, gfc_expr *shape, for (i = 0; i < shape_size; ++i) { e = gfc_constructor_lookup_expr (shape->value.constructor, i); + if (e == NULL) + break; if (e->expr_type != EXPR_CONSTANT) continue; @@ -4764,7 +4766,7 @@ gfc_check_reshape (gfc_expr *source, gfc_expr *shape, if (!type_check (order, 3, BT_INTEGER)) return false; - if (order->expr_type == EXPR_ARRAY && gfc_is_constant_expr (order)) + if (order->expr_type == EXPR_ARRAY && gfc_is_constant_array_expr (order)) { int i, order_size, dim, perm[GFC_MAX_DIMENSIONS]; gfc_expr *e; diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 9dd6b45f112..8cfa8fd3afd 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -3970,6 +3970,7 @@ bool gfc_fix_implicit_pure (gfc_namespace *); void gfc_convert_mpz_to_signed (mpz_t, int); gfc_expr *gfc_simplify_ieee_functions (gfc_expr *); +bool gfc_is_constant_array_expr (gfc_expr *); bool gfc_is_size_zero_array (gfc_expr *); /* trans-array.cc */ diff --git a/gcc/fortran/iresolve.cc b/gcc/fortran/iresolve.cc index 7880aba63bb..571e1bd3441 100644 --- a/gcc/fortran/iresolve.cc +++ b/gcc/fortran/iresolve.cc @@ -2424,7 +2424,7 @@ gfc_resolve_reshape (gfc_expr *f, gfc_expr *source, gfc_expr *shape, break; } - if (shape->expr_type == EXPR_ARRAY && gfc_is_constant_expr (shape)) + if (shape->expr_type == EXPR_ARRAY && gfc_is_constant_array_expr (shape)) { gfc_constructor *c; f->shape = gfc_get_shape (f->rank); diff --git a/gcc/fortran/simplify.cc b/gcc/fortran/simplify.cc index 6ba2040e61c..3f77203e62e 100644 --- a/gcc/fortran/simplify.cc +++ b/gcc/fortran/simplify.cc @@ -254,12 +254,19 @@ is_constant_array_expr (gfc_expr *e) break; } - /* Check and expand the constructor. */ - if (!array_OK && gfc_init_expr_flag && e->rank == 1) + /* Check and expand the constructor. We do this when either + gfc_init_expr_flag is set or for not too large array constructors. */ + bool expand; + expand = (e->rank == 1 + && e->shape + && (mpz_cmp_ui (e->shape[0], flag_max_array_constructor) < 0)); + + if (!array_OK && (gfc_init_expr_flag || expand) && e->rank == 1) { + bool saved_init_expr_flag = gfc_init_expr_flag; array_OK = gfc_reduce_init_expr (e); /* gfc_reduce_init_expr resets the flag. */ - gfc_init_expr_flag = true; + gfc_init_expr_flag = saved_init_expr_flag; } else return array_OK; @@ -284,6 +291,13 @@ is_constant_array_expr (gfc_expr *e) return array_OK; } +bool +gfc_is_constant_array_expr (gfc_expr *e) +{ + return is_constant_array_expr (e); +} + + /* Test for a size zero array. */ bool gfc_is_size_zero_array (gfc_expr *array) @@ -7001,6 +7015,11 @@ gfc_simplify_reshape (gfc_expr *source, gfc_expr *shape_exp, if (npad <= 0) { mpz_clear (index); + if (pad == NULL) + gfc_error ("Without padding, there are not enough elements " + "in the intrinsic RESHAPE source at %L to match " + "the shape", &source->where); + gfc_free_expr (result); return NULL; } j = j - nsource; diff --git a/gcc/testsuite/gfortran.dg/reshape_10.f90 b/gcc/testsuite/gfortran.dg/reshape_10.f90 new file mode 100644 index 00000000000..a148e0a2031 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/reshape_10.f90 @@ -0,0 +1,34 @@ +! { dg-do compile } +! { dg-options "-fmax-array-constructor=65536 -fdump-tree-original" } +! PR fortran/103794 + +program p + integer :: i, j + integer, parameter :: a(2) = 2 + integer, parameter :: e(*) = [(reshape([1,2,3,4], (a*i)), i=1,1)] + integer, parameter :: f(*,*) = reshape([1,2,3,4], [(a*i, i=1,1)]) + integer, parameter :: g(*,*) = reshape([([1,2,3,4],j=1,16383)],[(a*i,i=1,1)]) + integer, parameter :: s1(*) = & + shape(reshape([([1,2,3,4],j=1,16383)],[(a*i,i=1,1)])) + logical, parameter :: l1 = all (e == [1,2,3,4]) + logical, parameter :: l2 = all (f == reshape([1,2,3,4],[2,2])) + logical, parameter :: l3 = size (s1) == 2 .and. all (s1 == 2) + logical, parameter :: l4 = all (f == g) + print *, e + print *, f + if (.not. l1) stop 1 + if (.not. l2) stop 2 + if (.not. l3) stop 3 + if (.not. l4) stop 4 + if (any (shape (reshape([1,2], [([2]*i, i=1,1)])) /= 2)) stop 5 + ! The following is compile-time simplified due to shape(): + print *, shape(reshape([([1,2,3,4],j=1,20000)],[(a*i,i=1,1)])) + if (any (shape(reshape([([1,2,3,4],j=1,20000)],[(a*i,i=1,1)])) /= 2)) stop 6 + if (any (reshape([([1,2,3,4],j=1,16383)],[(a*i,i=1,1)]) /= f)) stop 7 + ! The following is not compile-time simplified: + print *, reshape([([1,2,3,4],j=1,20000)],[(a*i,i=1,1)]) + if (any (reshape([([1,2,3,4],j=1,20000)],[(a*i,i=1,1)]) /= f)) stop 8 +end + +! { dg-final { scan-tree-dump-times "_gfortran_reshape_4" 2 "original" } } +! { dg-final { scan-tree-dump-times "_gfortran_stop_numeric" 1 "original" } } diff --git a/gcc/testsuite/gfortran.dg/reshape_11.f90 b/gcc/testsuite/gfortran.dg/reshape_11.f90 new file mode 100644 index 00000000000..17c14061494 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/reshape_11.f90 @@ -0,0 +1,15 @@ +! { dg-do compile } +! { dg-options "-fmax-array-constructor=65536" } +! PR fortran/103794 + +program p + integer :: i, j + integer, parameter :: a(2) = 2, m = 20000 + integer, parameter :: e(*) = & + [(reshape([1,2,3], (a*i)), i=1,1)] ! { dg-error "not enough elements" } + integer, parameter :: g(*,*) = & + reshape([([1,2,3,4],j=1,m)],[(a*i,i=1,1)]) ! { dg-error "number of elements" } + print *, reshape([([1,2,3,4],j=1,m)],[(a*i,i=1,1)]) + print *, reshape([1,2,3], [(a*i, i=1,1)]) ! { dg-error "not enough elements" } + print *, [(reshape([1,2,3], (a*i)),i=1,1)] ! { dg-error "not enough elements" } +end -- 2.35.3