diff options
author | Harald Anlauf <anlauf@gmx.de> | 2021-10-15 21:23:17 +0200 |
---|---|---|
committer | Harald Anlauf <anlauf@gmx.de> | 2021-10-15 21:23:17 +0200 |
commit | 1e819bd95ebeefc1dc469daa1855ce005cb77822 (patch) | |
tree | e92e1e5ba1f1abf39844b4c0e87c50145c49f75e /gcc/fortran/resolve.c | |
parent | 4aef14b09557ce072f1269bd8a05fa2b1df0eda2 (diff) | |
download | gcc-1e819bd95ebeefc1dc469daa1855ce005cb77822.zip gcc-1e819bd95ebeefc1dc469daa1855ce005cb77822.tar.gz gcc-1e819bd95ebeefc1dc469daa1855ce005cb77822.tar.bz2 |
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 <tobias@codesourcery.com>
Diffstat (limited to 'gcc/fortran/resolve.c')
-rw-r--r-- | gcc/fortran/resolve.c | 28 |
1 files changed, 28 insertions, 0 deletions
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 0d0af39..5ccd907 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; |