|| gfc_specification_expr (e) == FAILURE)
return FAILURE;
- if (check_constant && gfc_is_constant_expr (e) == 0)
+ if (check_constant && !gfc_is_constant_expr (e))
{
- gfc_error ("Variable '%s' at %L in this context must be constant",
- e->symtree->n.sym->name, &e->where);
+ if (e->expr_type == EXPR_VARIABLE)
+ gfc_error ("Variable '%s' at %L in this context must be constant",
+ e->symtree->n.sym->name, &e->where);
+ else
+ gfc_error ("Expression at %L in this context must be constant",
+ &e->where);
return FAILURE;
}
array_type current_type;
gfc_array_spec *as;
int i;
-
- as = gfc_get_array_spec ();
- as->corank = 0;
- as->rank = 0;
- for (i = 0; i < GFC_MAX_DIMENSIONS; i++)
- {
- as->lower[i] = NULL;
- as->upper[i] = NULL;
- }
+ as = gfc_get_array_spec ();
if (!match_dim)
goto coarray;
as->rank++;
current_type = match_array_element_spec (as);
+ /* Note that current_type == AS_ASSUMED_SIZE for both assumed-size
+ and implied-shape specifications. If the rank is at least 2, we can
+ distinguish between them. But for rank 1, we currently return
+ ASSUMED_SIZE; this gets adjusted later when we know for sure
+ whether the symbol parsed is a PARAMETER or not. */
+
if (as->rank == 1)
{
if (current_type == AS_UNKNOWN)
case AS_UNKNOWN:
goto cleanup;
+ case AS_IMPLIED_SHAPE:
+ if (current_type != AS_ASSUMED_SHAPE)
+ {
+ gfc_error ("Bad array specification for implied-shape"
+ " array at %C");
+ goto cleanup;
+ }
+ break;
+
case AS_EXPLICIT:
if (current_type == AS_ASSUMED_SIZE)
{
goto cleanup;
case AS_ASSUMED_SIZE:
+ if (as->rank == 2 && current_type == AS_ASSUMED_SIZE)
+ {
+ as->type = AS_IMPLIED_SHAPE;
+ break;
+ }
+
gfc_error ("Bad specification for assumed size array at %C");
goto cleanup;
}
else
switch (as->cotype)
{ /* See how current spec meshes with the existing. */
+ case AS_IMPLIED_SHAPE:
case AS_UNKNOWN:
goto cleanup;
if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Array constructor "
"including type specification at %C") == FAILURE)
goto cleanup;
+
+ if (ts.deferred)
+ {
+ gfc_error ("Type-spec at %L cannot contain a deferred "
+ "type parameter", &where);
+ goto cleanup;
+ }
}
}
sym = expr->symtree->n.sym;
- for (c = base; c; c = c->previous)
+ for (c = base; c && c->iterator; c = c->previous)
if (sym == c->iterator->var->symtree->n.sym)
return SUCCESS;
has_ts = (expr->ts.u.cl && expr->ts.u.cl->length_from_typespec);
if (! cl
- || (current_length != -1 && current_length < found_length))
+ || (current_length != -1 && current_length != found_length))
gfc_set_constant_character_len (found_length, p->expr,
has_ts ? -1 : found_length);
}
}
-/* Get the number of elements in an array section. */
+/* Get the number of elements in an array section. Optionally, also supply
+ the end value. */
gfc_try
-gfc_ref_dimen_size (gfc_array_ref *ar, int dimen, mpz_t *result)
+gfc_ref_dimen_size (gfc_array_ref *ar, int dimen, mpz_t *result, mpz_t *end)
{
mpz_t upper, lower, stride;
gfc_try t;
mpz_set_ui (*result, 0);
t = SUCCESS;
+ if (end)
+ {
+ mpz_init (*end);
+
+ mpz_sub_ui (*end, *result, 1UL);
+ mpz_mul (*end, *end, stride);
+ mpz_add (*end, *end, lower);
+ }
+
cleanup:
mpz_clear (upper);
mpz_clear (lower);
for (d = 0; d < ar->dimen; d++)
{
- if (gfc_ref_dimen_size (ar, d, &size) == FAILURE)
+ if (gfc_ref_dimen_size (ar, d, &size, NULL) == FAILURE)
{
mpz_clear (*result);
return FAILURE;
if (ref->u.ar.dimen_type[i] != DIMEN_ELEMENT)
dimen--;
- return gfc_ref_dimen_size (&ref->u.ar, i - 1, result);
+ return gfc_ref_dimen_size (&ref->u.ar, i - 1, result, NULL);
}
}
{
if (ar->dimen_type[i] != DIMEN_ELEMENT)
{
- if (gfc_ref_dimen_size (ar, i, &shape[d]) == FAILURE)
+ if (gfc_ref_dimen_size (ar, i, &shape[d], NULL) == FAILURE)
goto cleanup;
d++;
}