public inbox for gcc-cvs@sourceware.org help / color / mirror / Atom feed
From: Harald Anlauf <anlauf@gcc.gnu.org> To: gcc-cvs@gcc.gnu.org Subject: [gcc r11-9357] Fortran: improve check of arguments to the RESHAPE intrinsic Date: Sat, 4 Dec 2021 21:47:51 +0000 (GMT) [thread overview] Message-ID: <20211204214751.121C6385840D@sourceware.org> (raw) https://gcc.gnu.org/g:9d7add04d97cf7ac8e20cc8645c3c4173697d4ca commit r11-9357-g9d7add04d97cf7ac8e20cc8645c3c4173697d4ca Author: Harald Anlauf <anlauf@gmx.de> Date: Fri Nov 26 21:00:35 2021 +0100 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. (cherry picked from commit 4d540c7a4a7fb87b04d06e1ee7f9b004116279a4) Diff: --- 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(-) diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index e97b13838fb..7b4b5916d07 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -4695,6 +4695,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; @@ -4728,7 +4729,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; @@ -4744,38 +4749,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; } } @@ -4852,8 +4826,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
reply other threads:[~2021-12-04 21:47 UTC|newest] Thread overview: [no followups] expand[flat|nested] mbox.gz Atom feed
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=20211204214751.121C6385840D@sourceware.org \ --to=anlauf@gcc.gnu.org \ --cc=gcc-cvs@gcc.gnu.org \ /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: linkBe 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).