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: 96903 Return-Path: Delivered-To: ouuuleilei@gmail.com Received: by 2002:a59:b0ea:0:b0:3b6:4342:cba0 with SMTP id b10csp1047649vqo; Sun, 21 May 2023 13:49:11 -0700 (PDT) X-Google-Smtp-Source: ACHHUZ7fQrD6vm91+8l9poRqEBHgt89JFA/Kww/kH8GRPxnuGp/rGs9HnT354KTeXXwb+MXhk4Oz X-Received: by 2002:a17:906:a1d0:b0:94f:31da:8c37 with SMTP id bx16-20020a170906a1d000b0094f31da8c37mr7476658ejb.52.1684702151153; Sun, 21 May 2023 13:49:11 -0700 (PDT) ARC-Seal: i=1; a=rsa-sha256; t=1684702151; cv=none; d=google.com; s=arc-20160816; b=Oi7cnF4nfk0G1kl2RLPWd3+cSVGWAKlGu1k9kZUiIgevjnawwA7asyPhJmXH9Qbrn9 6NfGBq50JQsV+oAQ149TaSoVN8L5GKq926e+w3uymb8ZgF/xL2Z3wnvsSFS7CVn2XVz3 S6lz5g5tsBPQMC8hpdtKku0Mu9YxqLOpvzphno4O1va9rB9QiOYuiiUPFxC4Sqb/TTfK 1uhv45NnlsW1WV9N9vnD9vA9IgINjDIvctNbPWnLdNpZD5euUBQnQzQoHMh6yXN3PpN6 5UmVPENOQFFWK+P6E/IncHGhrAeIoBvzX/TNgVjRfQT4WQyCkwx7XO+LcTy8vvf+/KVj u5Ig== ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=google.com; s=arc-20160816; h=sender:errors-to:reply-to:from:list-subscribe:list-help:list-post :list-archive:list-unsubscribe:list-id:precedence:ui-outboundreport :sensitivity:importance:date:subject:to:message-id:mime-version :dmarc-filter:delivered-to:dkim-signature:dkim-filter; bh=8+xVi8PMZzKFxggsIT4s5BJe2SesEOaf544AW0rJma8=; b=GVFR15VFRlYIjX+LtqOX/bOGEQF5KiacgRJTzNDWv2UaqX0t/uGuJ/0J3rPfS82MA9 fowb+9tRm679eawWo7K06qCXDM7hUHZogag0W+FIuxHSeg6upoGMZy6gBJPj/rxEsroq 1p7gSCKd4/fh6JPb1RQI5PNPhZjaxi8MOAwiHtPFNBr0LOammLHAYX5JVJ8hxSwlOAOI IBh0sCG7Q/CbbtK9mn5Hz7CBd1UcIjJZnZtn8eRCrGT55Yt39Dr8LIG15mYIW7rv0Rsp EBx9v/VxvmzNSKf9Vr5EVn+0NM4c2/qNN1SknVvzQf6qzZCq971aQzqzQRj6Z8EBiUj/ RPGg== ARC-Authentication-Results: i=1; mx.google.com; dkim=pass header.i=@gcc.gnu.org header.s=default header.b=JS1nTh7j; spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 2620:52:3:1:0:246e:9693:128c as permitted sender) smtp.mailfrom="gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org"; dmarc=pass (p=NONE sp=NONE dis=NONE) header.from=gnu.org Received: from sourceware.org (server2.sourceware.org. [2620:52:3:1:0:246e:9693:128c]) by mx.google.com with ESMTPS id gx13-20020a170906f1cd00b009537a538322si2314285ejb.836.2023.05.21.13.49.10 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Sun, 21 May 2023 13:49:11 -0700 (PDT) Received-SPF: pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 2620:52:3:1:0:246e:9693:128c as permitted sender) client-ip=2620:52:3:1:0:246e:9693:128c; Authentication-Results: mx.google.com; dkim=pass header.i=@gcc.gnu.org header.s=default header.b=JS1nTh7j; spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 2620:52:3:1:0:246e:9693:128c as permitted sender) smtp.mailfrom="gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org"; dmarc=pass (p=NONE sp=NONE dis=NONE) header.from=gnu.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id AB3513858C20 for ; Sun, 21 May 2023 20:49:09 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org AB3513858C20 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1684702149; bh=8+xVi8PMZzKFxggsIT4s5BJe2SesEOaf544AW0rJma8=; h=To:Subject:Date:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:From; b=JS1nTh7jdcLaHkc8c4AiEeLX+mOZcmoPM7S+G35cYOonnCV0g3uIE6wkaL1JNS7oX jjFrXhokR4nMCgCmVSFpr6IjONmfRY4eiYCK6F/YiGpO+m+8mp3p054ayQgDRLavCu pfzCvWUkiz+tx4RqGmxt5PDwW6p8pSylVxPWRib8= 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+ouuuleilei=gmail.com@gcc.gnu.org Sender: "Gcc-patches" X-getmail-retrieved-from-mailbox: =?utf-8?q?INBOX?= X-GMAIL-THRID: =?utf-8?q?1766538242435367744?= X-GMAIL-MSGID: =?utf-8?q?1766538242435367744?= 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