aboutsummaryrefslogtreecommitdiff
path: root/gcc/fortran/resolve.c
diff options
context:
space:
mode:
authorHarald Anlauf <anlauf@gmx.de>2021-10-15 21:23:17 +0200
committerHarald Anlauf <anlauf@gmx.de>2021-10-15 21:23:17 +0200
commit1e819bd95ebeefc1dc469daa1855ce005cb77822 (patch)
treee92e1e5ba1f1abf39844b4c0e87c50145c49f75e /gcc/fortran/resolve.c
parent4aef14b09557ce072f1269bd8a05fa2b1df0eda2 (diff)
downloadgcc-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.c28
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;