From: Harald Anlauf <anlauf@gmx.de>
To: Mikael Morin <morin-mikael@orange.fr>
Cc: fortran@gcc.gnu.org, gcc-patches@gcc.gnu.org
Subject: [PATCH, v3] PR fortran/103411 - ICE in gfc_conv_array_initializer, at fortran/trans-array.c:6377
Date: Fri, 26 Nov 2021 21:07:49 +0100 [thread overview]
Message-ID: <trinity-8e3d0fba-5bd0-47a8-bd01-628ca1077020-1637957268799@3c-app-gmx-bs30> (raw)
In-Reply-To: <37adabd5-e32b-cdc1-883e-ac473444a7b7@orange.fr>
[-- Attachment #1: Type: text/plain, Size: 1702 bytes --]
Hi Mikael,
> Gesendet: Freitag, 26. November 2021 um 15:45 Uhr
> Von: "Mikael Morin" <morin-mikael@orange.fr>
> An: "Harald Anlauf" <anlauf@gmx.de>, fortran@gcc.gnu.org
> Cc: gcc-patches@gcc.gnu.org
> Betreff: Re: [PATCH, v2] PR fortran/103411 - ICE in gfc_conv_array_initializer, at fortran/trans-array.c:6377
>
> Le 25/11/2021 à 22:52, Harald Anlauf a écrit :
> >
> > 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 ;-)
> >
> Great let’s go with that.
> Can you set shape_is_constant just after the simplification?
> That is
>
> gfc_simplify_expr (shape, 0);
> if (gfc_is_constant_expr (shape))
> shape_is_const = true;
>
> if (shape->expr_type == EXPR_ARRAY && shape_is_const)
> ...
>
>
> This removes the need for multiple case initialization of shape_is_const
> which I overlooked in my previous review.
>
> And the EXPR_ARRAY vs EXPR_VARIABLE change becomes unneeded because the
> simplification should produce an EXPR_ARRAY.
ah, I did not expect that. And indeed it seems to do the job! Furthermore
it turns out that the new patch (v3) removes more code than it adds. :-)
I extended the testcase slightly and regtested again.
That should hopefully be the final version...
Thanks for the really constructive comments!
Harald
[-- Attachment #2: 0001-Fortran-improve-check-of-arguments-to-the-RESHAPE-in.patch.v3 --]
[-- Type: application/octet-stream, Size: 6390 bytes --]
From 4d540c7a4a7fb87b04d06e1ee7f9b004116279a4 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Fri, 26 Nov 2021 21:00:35 +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 | 43 +++++--------------------
gcc/testsuite/gfortran.dg/pr68153.f90 | 2 +-
gcc/testsuite/gfortran.dg/reshape_7.f90 | 2 +-
gcc/testsuite/gfortran.dg/reshape_9.f90 | 31 ++++++++++++++++++
4 files changed, 41 insertions(+), 37 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..3e65f3d8b1f 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;
if (!array_check (source, 0))
return false;
@@ -4732,7 +4733,11 @@ 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);
+ shape_is_const = gfc_is_constant_expr (shape);
+
+ if (shape->expr_type == EXPR_ARRAY && shape_is_const)
{
gfc_expr *e;
int i, extent;
@@ -4748,38 +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);
- return false;
- }
- }
- }
- 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)
- {
- int i, extent;
- gfc_expr *e, *v;
-
- v = shape->symtree->n.sym->value;
-
- for (i = 0; i < shape_size; i++)
- {
- e = gfc_constructor_lookup_expr (v->value.constructor, i);
- if (e == NULL)
- break;
-
- gfc_extract_int (e, &extent);
-
- if (extent < 0)
- {
- gfc_error ("Element %d of actual argument of RESHAPE at %L "
- "cannot be negative", i + 1, &shape->where);
+ gfc_current_intrinsic, &shape->where, extent);
return false;
}
}
@@ -4856,8 +4830,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->expr_type == EXPR_ARRAY && shape_is_const
&& !(source->expr_type == EXPR_VARIABLE && source->symtree->n.sym->as
&& source->symtree->n.sym->as->type == AS_ASSUMED_SIZE))
{
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..dc52e26cc86
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/reshape_9.f90
@@ -0,0 +1,31 @@
+! { 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,3) = 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], &
+ [(u(i)*(-1)**i,i=2,3)]) ! { dg-error "has negative element" }
+ 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,4], u([5,3]))
+ print *, reshape([1,2,3] , u([5,3])) ! { dg-error "not enough elements" }
+ print *, reshape([1,2,3,4], v(1,2:))
+ print *, reshape([1,2,3], v(1,2:)) ! { dg-error "not enough elements" }
+ print *, reshape([1,2,3,4], v(1,[2,1]))
+ print *, reshape([1,2,3] , v(1,[2,1])) ! { dg-error "not enough elements" }
+end
--
2.26.2
next prev parent reply other threads:[~2021-11-26 20:07 UTC|newest]
Thread overview: 9+ messages / expand[flat|nested] mbox.gz Atom feed top
2021-11-24 21:32 [PATCH] " Harald Anlauf
2021-11-25 16:46 ` Mikael Morin
2021-11-25 20:03 ` Harald Anlauf
2021-11-25 20:03 ` Harald Anlauf
2021-11-25 21:02 ` Mikael Morin
2021-11-25 21:52 ` [PATCH, v2] " Harald Anlauf
2021-11-26 14:45 ` Mikael Morin
2021-11-26 20:07 ` Harald Anlauf [this message]
2021-11-26 21:45 ` [PATCH, v3] " Mikael Morin
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=trinity-8e3d0fba-5bd0-47a8-bd01-628ca1077020-1637957268799@3c-app-gmx-bs30 \
--to=anlauf@gmx.de \
--cc=fortran@gcc.gnu.org \
--cc=gcc-patches@gcc.gnu.org \
--cc=morin-mikael@orange.fr \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).