Message ID | trinity-feb5b84d-1f05-42ed-a103-13450ad7ef55-1634246822349@3c-app-gmx-bs21 |
---|---|
State | New |
Headers | show |
Series | PR fortran/102685 - ICE in output_constructor_regular_field, at varasm.c:5514 | expand |
Hi Harald, dear all, On 14.10.21 23:27, Harald Anlauf via Fortran wrote: > the attached patch adds a check for the shape of arrays in derived type > constructors. This brings it in line with other major brands. > ... > In developing the patch I encountered a difficulty with testcase > dec_structure_6.f90, which uses a DEC extension, namelist "old-style > CLIST initializers in STRUCTURE". I could not figure out how to > determine the shape of the initializer; it seemed to be always zero. > I've added code to accept this, but only under -fdec-structure, and > added a TODO in a comment. If somebody reading this could give me > a hint to solve end, I would adjust the patch accordingly. See attached patch – it does initialize the variables similarly to other shapes in that file, except that it has to take the shape from the LHS as seemingly (same testfile) having a 1-dim array can be used to initialize a 2-dim array. You can approve that patch and integrate it then in your own patch :-) > Regtested on x86_64-pc-linux-gnu. OK? Or further comments? LGTM – with the DECL exception removed from resolve.c. Thanks, Tobias PS: Without the auto-reshape part, a simple 'gfc_array_size (expr, &expr->shape[0]))" would have been sufficient. ----------------- Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955
Hi Tobias, all, > > In developing the patch I encountered a difficulty with testcase > > dec_structure_6.f90, which uses a DEC extension, namelist "old-style > > CLIST initializers in STRUCTURE". I could not figure out how to > > determine the shape of the initializer; it seemed to be always zero. > > I've added code to accept this, but only under -fdec-structure, and > > added a TODO in a comment. If somebody reading this could give me > > a hint to solve end, I would adjust the patch accordingly. > > See attached patch – it does initialize the variables similarly to other > shapes in that file, except that it has to take the shape from the LHS > as seemingly (same testfile) having a 1-dim array can be used to > initialize a 2-dim array. > > You can approve that patch and integrate it then in your own patch :-) your fix to match_clist_expr LGTM. I can really use it. > LGTM – with the DECL exception removed from resolve.c. I've removed the DEC exception, cleaned up, regtested again. Committed and pushed: https://gcc.gnu.org/g:1e819bd95ebeefc1dc469daa1855ce005cb77822 Thanks, Harald > Thanks, > > Tobias > > PS: Without the auto-reshape part, a simple 'gfc_array_size (expr, > &expr->shape[0]))" would have been sufficient. > ----------------- > Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955 >
Fortran: validate shape of arrays in constructors against declarations gcc/fortran/ChangeLog: PR fortran/102685 * 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. diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 0d0af39d23f..d035b30ad7d 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -29,6 +29,7 @@ along with GCC; see the file COPYING3. If not see #include "data.h" #include "target-memory.h" /* for gfc_simplify_transfer */ #include "constructor.h" +#include "parse.h" /* Types used in equivalence statements. */ @@ -1454,6 +1455,42 @@ resolve_structure_cons (gfc_expr *expr, int init) } } + /* Validate shape. We silently accept some cases where the apparent + shape of the constructor is zero, and we cannot check 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); + /* Shape agrees for this dimension. */ + if (mpz_cmp (cons->expr->shape[n], len) == 0) + continue; + /* Accept DEC old-style initializers in STRUCTURE, where shape + is currently not correctly set (it is zero. Why?). + TODO: Fix this or find a better solution. */ + if (flag_dec_structure + && mpz_cmp_si (cons->expr->shape[n], 0) == 0) + continue; + 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);