From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 2071) id CF1963858428; Sun, 7 Nov 2021 20:54:52 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org CF1963858428 MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Type: text/plain; charset="utf-8" From: Harald Anlauf To: gcc-cvs@gcc.gnu.org Subject: [gcc r11-9216] Fortran: validate shape of arrays in constructors against declarations X-Act-Checkin: gcc X-Git-Author: Harald Anlauf X-Git-Refname: refs/heads/releases/gcc-11 X-Git-Oldrev: db1da3d37e33b0adcd7fed68cfdb96e8ee265ccf X-Git-Newrev: b1cab51131ad4d5501bf3f01e694704142a10c1a Message-Id: <20211107205452.CF1963858428@sourceware.org> Date: Sun, 7 Nov 2021 20:54:52 +0000 (GMT) X-BeenThere: gcc-cvs@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-cvs mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Sun, 07 Nov 2021 20:54:52 -0000 https://gcc.gnu.org/g:b1cab51131ad4d5501bf3f01e694704142a10c1a commit r11-9216-gb1cab51131ad4d5501bf3f01e694704142a10c1a Author: Harald Anlauf Date: Fri Oct 15 21:23:17 2021 +0200 Fortran: validate shape of arrays in constructors against declarations gcc/fortran/ChangeLog: PR fortran/102685 * decl.c (match_clist_expr): Set rank/shape of clist initializer to match LHS. * resolve.c (resolve_structure_cons): In a structure constructor, compare shapes of array components against declared shape. gcc/testsuite/ChangeLog: PR fortran/102685 * gfortran.dg/derived_constructor_char_1.f90: Fix invalid code. * gfortran.dg/pr70931.f90: Likewise. * gfortran.dg/transfer_simplify_2.f90: Likewise. * gfortran.dg/pr102685.f90: New test. Co-authored-by: Tobias Burnus (cherry picked from commit 1e819bd95ebeefc1dc469daa1855ce005cb77822) Diff: --- gcc/fortran/decl.c | 9 ++++--- gcc/fortran/resolve.c | 28 ++++++++++++++++++++ .../gfortran.dg/derived_constructor_char_1.f90 | 2 +- gcc/testsuite/gfortran.dg/pr102685.f90 | 30 ++++++++++++++++++++++ gcc/testsuite/gfortran.dg/pr70931.f90 | 3 ++- gcc/testsuite/gfortran.dg/transfer_simplify_2.f90 | 2 +- 6 files changed, 68 insertions(+), 6 deletions(-) diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index d2b667e45c6..602ad3e59bd 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -896,9 +896,6 @@ match_clist_expr (gfc_expr **result, gfc_typespec *ts, gfc_array_spec *as) expr->ts = *ts; expr->value.constructor = array_head; - expr->rank = as->rank; - expr->shape = gfc_get_shape (expr->rank); - /* Validate sizes. We built expr ourselves, so cons_size will be constant (we fail above for non-constant expressions). We still need to verify that the sizes match. */ @@ -911,6 +908,12 @@ match_clist_expr (gfc_expr **result, gfc_typespec *ts, gfc_array_spec *as) mpz_clear (cons_size); if (cmp) goto cleanup; + + /* Set the rank/shape to match the LHS as auto-reshape is implied. */ + expr->rank = as->rank; + expr->shape = gfc_get_shape (as->rank); + for (int i = 0; i < as->rank; ++i) + spec_dimen_size (as, i, &expr->shape[i]); } /* Make sure scalar types match. */ diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 71ce8804c0e..277af0e61b0 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -1454,6 +1454,34 @@ resolve_structure_cons (gfc_expr *expr, int init) } } + /* Validate shape, except for dynamic or PDT arrays. */ + if (cons->expr->expr_type == EXPR_ARRAY && rank == cons->expr->rank + && comp->as && !comp->attr.allocatable && !comp->attr.pointer + && !comp->attr.pdt_array) + { + mpz_t len; + mpz_init (len); + for (int n = 0; n < rank; n++) + { + gcc_assert (comp->as->upper[n]->expr_type == EXPR_CONSTANT + && comp->as->lower[n]->expr_type == EXPR_CONSTANT); + mpz_set_ui (len, 1); + mpz_add (len, len, comp->as->upper[n]->value.integer); + mpz_sub (len, len, comp->as->lower[n]->value.integer); + if (mpz_cmp (cons->expr->shape[n], len) != 0) + { + gfc_error ("The shape of component %qs in the structure " + "constructor at %L differs from the shape of the " + "declared component for dimension %d (%ld/%ld)", + comp->name, &cons->expr->where, n+1, + mpz_get_si (cons->expr->shape[n]), + mpz_get_si (len)); + t = false; + } + } + mpz_clear (len); + } + if (!comp->attr.pointer || comp->attr.proc_pointer || cons->expr->expr_type == EXPR_NULL) continue; diff --git a/gcc/testsuite/gfortran.dg/derived_constructor_char_1.f90 b/gcc/testsuite/gfortran.dg/derived_constructor_char_1.f90 index 892a9c9f4c1..91fc4c902d8 100644 --- a/gcc/testsuite/gfortran.dg/derived_constructor_char_1.f90 +++ b/gcc/testsuite/gfortran.dg/derived_constructor_char_1.f90 @@ -5,7 +5,7 @@ ! ! Type :: t5 - character (len=5) :: txt(4) + character (len=5) :: txt(2) End Type t5 character (len=3), parameter :: str3(2) = [ "ABC", "ZYX" ] diff --git a/gcc/testsuite/gfortran.dg/pr102685.f90 b/gcc/testsuite/gfortran.dg/pr102685.f90 new file mode 100644 index 00000000000..d325c27b32a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr102685.f90 @@ -0,0 +1,30 @@ +! { dg-do compile } +! PR fortran/102685 + +program p + type t + integer :: a(2) + end type + type(t), parameter :: x0 = t([2]) ! { dg-error "shape of component" } + type(t), parameter :: x1(2) = t([2]) ! { dg-error "shape of component" } + type(t), parameter :: x(2) = t([integer::]) ! { dg-error "shape of component" } + + type u + integer :: a + integer :: b(0) + end type + type(u), parameter :: z0(2) = u(1, [integer::]) ! valid + type(u), parameter :: z1 = u(1, 2 ) ! valid + type(u), parameter :: z2(2) = u(1, 2 ) ! valid + type(u), parameter :: z3 = u(1, [2]) ! { dg-error "shape of component" } + type(u), parameter :: z4(2) = u(1, [2]) ! { dg-error "shape of component" } + + type v + integer :: a(2,1) + end type + type(v), parameter :: y0 = v(reshape([1,2],[2,1])) ! valid + type(v), parameter :: y1 = v(reshape([1,2],[1,2])) ! { dg-error "shape of component" } + type(v), parameter :: y(1) = v(reshape([1,2],[1,2])) ! { dg-error "shape of component" } + + print *, x0,x,x1,y0,y1,y,z0,z1,z2,z3,z4 +end diff --git a/gcc/testsuite/gfortran.dg/pr70931.f90 b/gcc/testsuite/gfortran.dg/pr70931.f90 index 08ecd687752..4444b5eec3b 100644 --- a/gcc/testsuite/gfortran.dg/pr70931.f90 +++ b/gcc/testsuite/gfortran.dg/pr70931.f90 @@ -5,6 +5,7 @@ program p integer :: a integer :: b(0) end type - type(t), parameter :: z = t(1, [2]) +! type(t), parameter :: z = t(1, [2]) ! original invalid code + type(t), parameter :: z = t(1, [integer::]) print *, z end diff --git a/gcc/testsuite/gfortran.dg/transfer_simplify_2.f90 b/gcc/testsuite/gfortran.dg/transfer_simplify_2.f90 index e0f3f94c4ca..b428fa64b56 100644 --- a/gcc/testsuite/gfortran.dg/transfer_simplify_2.f90 +++ b/gcc/testsuite/gfortran.dg/transfer_simplify_2.f90 @@ -145,7 +145,7 @@ contains real(4) :: x(2) end type mytype - type (mytype), parameter :: dt1(2) = transfer (c1, mytype ((/1.0,2.0,3.0,4.0/)), 2) + type (mytype), parameter :: dt1(2) = transfer (c1, mytype ((/1.0,2.0/)), 2) type (mytype) :: dt2(2) dt2 = transfer (c2, dt2);