diff options
Diffstat (limited to 'gcc/fortran')
| -rw-r--r-- | gcc/fortran/decl.c | 9 | ||||
| -rw-r--r-- | gcc/fortran/resolve.c | 28 |
2 files changed, 34 insertions, 3 deletions
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index d6a22d1..86adb81 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 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; |