From patchwork Thu Nov 25 21:52:43 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Harald Anlauf X-Patchwork-Id: 48163 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 C74563858002 for ; Thu, 25 Nov 2021 21:53:34 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org C74563858002 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1637877214; bh=mktXJLV+5Esk20XhInOYWxkegzVjMLyyQzZuI5OAlHE=; h=Subject:To:References:Date:In-Reply-To:List-Id:List-Unsubscribe: List-Archive:List-Post:List-Help:List-Subscribe:From:Reply-To: From; b=GbwnjAFvZoHAgiE/0gaEIsCLvn71kQ6gKEGNbSJlkeJmVihaHC8wEPrW0pM03UbiR /9AgU8pB8QjSlNnM0Nc2kl2OCl0TVCVHb7x9giTcnLwyD+hM97TJKASw7a+ZuxvIeP csVVMZwecpq6xTKOMwXv9zHpoWTkZW+y6BrLsRfA= 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.18]) by sourceware.org (Postfix) with ESMTPS id 4730D3858C27; Thu, 25 Nov 2021 21:52:47 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 4730D3858C27 X-UI-Sender-Class: 01bb95c1-4bf8-414a-932a-4f6e2808ef9c Received: from gluon.fritz.box ([79.251.11.137]) by mail.gmx.net (mrgmx004 [212.227.17.190]) with ESMTPSA (Nemesis) id 1MCbIn-1miQRT3dlz-009iF3; Thu, 25 Nov 2021 22:52:44 +0100 Subject: [PATCH, v2] PR fortran/103411 - ICE in gfc_conv_array_initializer, at fortran/trans-array.c:6377 To: Mikael Morin , fortran , gcc-patches Newsgroups: gmane.comp.gcc.fortran,gmane.comp.gcc.patches References: <4fb65fbe-c10f-3fd4-9961-9978ff386bf9@orange.fr> <24ff1ac7-79ce-2843-a199-9e85865304f6@gmx.de> <14808971-a1a7-4742-7a06-7d9102bf2b24@orange.fr> Message-ID: <8655f973-aea7-50d6-09e1-7b377a38be58@gmx.de> Date: Thu, 25 Nov 2021 22:52:43 +0100 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:78.0) Gecko/20100101 Thunderbird/78.12.0 MIME-Version: 1.0 In-Reply-To: <14808971-a1a7-4742-7a06-7d9102bf2b24@orange.fr> Content-Language: en-US X-Provags-ID: V03:K1:qWHf7jOgvZi0LHKGUUTXdyyPDLLr5AyXRdiHukfAhbqDm1N4U4B f92hgcGSXH4ck4hI/CfHS4KW/cU9TRT//evcAUhUvQx9W7L+3WetdAzz8UQxCxEwJnjrbKx afE2+hHqIdkyYDHSN6o156wEdQDZpow4TMMySvwy9LjcoeqX5YEMxF0OjiKqYiAOVGn0cBk lBZAlFZ0x/R2FpnQIG5Nw== X-UI-Out-Filterresults: notjunk:1;V03:K0:dbfQpzD9Hrw=:jE/w/Kkzkau4lS/OHsR7+S NpIrHqBPgxCmaQIhsoOewhekSSLYKV96Mn2CI7VelDL93DqXixsIOwkbh8xj3nK6dUyepNSYP RTilmmtNrnUgEmxF5qE6sGSixNQjqENLBOnV2P7fI2vLF+KTmzqMbZNEPktsFUZIkVQcq7B84 Vr3CH3N+8WbCfWxeUGFAOsq9fddtqsGjUqxBVXSlbWsm7Yn2LWxzu4TbTAfGuqFAtkR8eb/r9 3mSQCEX+Zu3ZGZk8tc34z8T8iSzP4SgD70ljg13oWBQD1Jb2vwQWXn75ebgvpbYAmMRGZtYqw KsffOPOHsvJZGEzEwTsspOpAebmDrC0/EHg3n8FMUJ3LNO/lZhz9Gxw/ulakiKXv/X3hMacYt 25be4WZsx/r2f2W91jqdnKz/zYdk0Ljg09NubCt4W7TLZKw6B00gcRGOAeFoIu/uz7GrYfYD5 F53vC5V9ftVduWgquGnXQVhL0VKVdDR4GaLY/mCZFUgPDb+UWAYzcMh77lAEZ+eG/15zzvMzQ 9B3LPO4s1up5LwrRO6+nRkhFuil1F37WVHhFdYjo7uRHWFxcS7TPSasIAtx5gbRJEOivbdmVz F1maj3ogfe7t3x8Ri170qPJ/SynyqiMtrj7UhBKtsijWwcUmQlryYnmw7XiOj3XoTYYOpJf8C FdNj6DlA/Alz1Us4PmRLqMurHhv1+QE9wOYpalypXboGFPtiNpvQMYGGDaNN7x5T18WPc5+m5 ioHaBNy8i4iSF0qO8DFj9sPPWiZQPOZgLa5jPiMJ63lQjAseiajL/FH0vdj5a+93hS0RqbqyB jIOc+/4gHtKyER6RMc22SspABdjaDvuKT15afmvrPV9gwNgQkeQpHoTH9Aym60oyz8PXXmcUS f08Gvhi08k+538wAOf737istLHq4ANYuMK5yu8CJHkhvAEn98g0HVMZ+TExSGUeX3JQtFDWds jtq7ZhXqEcmvyBgNG8QnnmRbPgnGtrLtiUJ6cAgkssScCJkIFlTZOC05ky/w3DXJ6fcsByeTa Ls/7uiQiEzim0pE9C+D6tVSvlh3Y4w91i1YIdXjZcu6hhRVwqM2+FbpqQxCt7IWcJgc9n4cMb 4qnxpRth3iHORw= X-Spam-Status: No, score=-10.6 required=5.0 tests=BAYES_00, BODY_8BITS, 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" Hi Mikael, Am 25.11.21 um 22:02 schrieb Mikael Morin: > Le 25/11/2021 à 21:03, Harald Anlauf a écrit : >> Hi Mikael, >> >> Am 25.11.21 um 17:46 schrieb Mikael Morin: >>> Hello, >>> >>> Le 24/11/2021 à 22:32, Harald Anlauf via Fortran a écrit : >>>> 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 >>>> @@ -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; >>> >>> This misses a check that shape->symtree->n.sym->value is an array, so >>> that it makes sense to access its constructor. >> >> there are checks further above for the cases >>    shape->expr_type == EXPR_ARRAY >> and for >>    shape->expr_type == EXPR_VARIABLE >> which look at the elements of array shape to see if they are >> non-negative. >> >> Only in those cases where the full "if ()'s" pass we set >> shape_is_const = true; and proceed.  The purpose of the auxiliary >> bool shape_is_const is to avoid repeating the lengthy if's again. >> Only then the above cited code segment should get executed. >> >> For shape->expr_type == EXPR_ARRAY there is really no change in logic. >> For shape->expr_type == EXPR_VARIABLE the above snipped is now executed, >> but then we already had >> >>    else if (shape->expr_type == EXPR_VARIABLE && shape->ref >>         && shape->ref->u.ar.type == AR_FULL && shape->ref->u.ar.dimen >> == 1 >>         && shape->ref->u.ar.as >>         && shape->ref->u.ar.as->lower[0]->expr_type == EXPR_CONSTANT >>         && shape->ref->u.ar.as->lower[0]->ts.type == BT_INTEGER >>         && shape->ref->u.ar.as->upper[0]->expr_type == EXPR_CONSTANT >>         && shape->ref->u.ar.as->upper[0]->ts.type == BT_INTEGER >>         && shape->symtree->n.sym->attr.flavor == FL_PARAMETER >>         && shape->symtree->n.sym->value) >> >> In which situations do I miss anything new? >> > Yes, I agree with all of this. > My comment wasn’t about a check on shape->expr_type, but on > shape->value->expr_type if shape->expr_type is a (parameter) variable. > >>> Actually, this only supports the case where the parameter value is >>> defined by an array; but it could be an intrinsic call, a sum of >>> parameters, a reference to an other parameter, etc. >> >> E.g. the following (still) does get rejected: >> >>    print *, reshape([1,2,3,4,5], a+1) >>    print *, reshape([1,2,3,4,5], a+a) >>    print *, reshape([1,2,3,4,5], 2*a) >>    print *, reshape([1,2,3,4,5], [3,3]) >>    print *, reshape([1,2,3,4,5], spread(3,dim=1,ncopies=2)) >> >> and has been rejected before. >> > >>> The usual way to handle this is to call gfc_reduce_init_expr which (pray >>> for it) will make an array out of whatever the shape expression is. >> >> Can you give an example where it fails? >> >> I think the current code would almost certainly fail, too. >> > Probably, I was just trying to avoid followup bugs. ;-) > > I have checked the following: > >   integer, parameter :: a(2) = [1,1] >   integer, parameter :: b(2) = a + 1 >   print *, reshape([1,2,3,4], b) > end > > and it doesn’t fail as I thought it would. well, that one is actually better valid, since b=[2,2]. > So yes, I was wrong; b has been expanded to an array before. Motivated by your reasoning I tried gfc_reduce_init_expr. That attempt failed miserably (many regressions), and I think it is not right. Then I found that array sections posed a problem that wasn't detected before. gfc_simplify_expr seemed to be a better choice that makes more sense for the present situations and seems to work here. And it even detects many more invalid cases now than e.g. Intel ;-) I've updated the patch and testcase accordingly. > Can you add an assert or a comment saying that the parameter value has > been expanded to a constant array? > > Ok with that change. > Given the above discussion, I'll give you another day or two to have a further look. Otherwise Gerhard will... ;-) Cheers, Harald From 56fd0d23ac0a5bda802e5cce3024b947e497555a Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Thu, 25 Nov 2021 22:39:44 +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. Try other simplifications of shape. gcc/testsuite/ChangeLog: PR fortran/103411 * gfortran.dg/pr68153.f90: Adjust test to improved check. * gfortran.dg/reshape_7.f90: Likewise. * gfortran.dg/reshape_9.f90: New test. --- gcc/fortran/check.c | 22 +++++++++++++++++----- gcc/testsuite/gfortran.dg/pr68153.f90 | 2 +- gcc/testsuite/gfortran.dg/reshape_7.f90 | 2 +- gcc/testsuite/gfortran.dg/reshape_9.f90 | 24 ++++++++++++++++++++++++ 4 files changed, 43 insertions(+), 7 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..29c8554911f 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; @@ -4732,10 +4733,14 @@ gfc_check_reshape (gfc_expr *source, gfc_expr *shape, "than %d elements", &shape->where, GFC_MAX_DIMENSIONS); return false; } - else if (shape->expr_type == EXPR_ARRAY && gfc_is_constant_expr (shape)) + + gfc_simplify_expr (shape, 0); + + if (shape->expr_type == EXPR_ARRAY && gfc_is_constant_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 +4753,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 +4771,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 +4862,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 +4871,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/pr68153.f90 b/gcc/testsuite/gfortran.dg/pr68153.f90 index 1a360f80cd6..46a3bc029d7 100644 --- a/gcc/testsuite/gfortran.dg/pr68153.f90 +++ b/gcc/testsuite/gfortran.dg/pr68153.f90 @@ -5,5 +5,5 @@ ! program foo integer, parameter :: a(2) = [2, -2] - integer, parameter :: b(2,2) = reshape([1, 2, 3, 4], a) ! { dg-error "cannot be negative" } + integer, parameter :: b(2,2) = reshape([1, 2, 3, 4], a) ! { dg-error "negative" } end program foo 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..b12ecee399b --- /dev/null +++ b/gcc/testsuite/gfortran.dg/reshape_9.f90 @@ -0,0 +1,24 @@ +! { dg-do compile } +! PR fortran/103411 - ICE in gfc_conv_array_initializer +! Based on testcase by G. Steinmetz +! Test simplifications for checks of shape argument to reshape intrinsic + +program p + integer :: i + integer, parameter :: a(2) = [2,2] + integer, parameter :: u(5) = [1,2,2,42,2] + integer, parameter :: v(1,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 + print *, reshape([1,2,3], [(u(i),i=1,2)]) + print *, reshape([1,2,3], [(u(i),i=2,3)]) ! { dg-error "not enough elements" } + print *, reshape([1,2,3,4], u(5:3:-2)) + print *, reshape([1,2,3], u(5:3:-2)) ! { dg-error "not enough elements" } + print *, reshape([1,2,3], v(1,:)) ! { dg-error "not enough elements" } +end -- 2.26.2