===================================================================
@@ -1378,6 +1378,51 @@ add_init_expr_to_sym (const char *name,
}
}
+ /* If sym is implied-shape, set its upper bounds from init. */
+ if (sym->attr.flavor == FL_PARAMETER && sym->attr.dimension
+ && sym->as->type == AS_IMPLIED_SHAPE)
+ {
+ int dim;
+
+ if (init->rank == 0)
+ {
+ gfc_error ("Can't initialize implied-shape array at %L"
+ " with scalar", &sym->declared_at);
+ return FAILURE;
+ }
+ gcc_assert (sym->as->rank == init->rank);
+
+ /* Shape should be present, we get an initialization expression. */
+ gcc_assert (init->shape);
+
+ for (dim = 0; dim < sym->as->rank; ++dim)
+ {
+ int k;
+ gfc_expr* lower;
+ gfc_expr* e;
+
+ lower = sym->as->lower[dim];
+ if (lower->expr_type != EXPR_CONSTANT)
+ {
+ gfc_error ("Non-constant lower bound in implied-shape"
+ " declaration at %L", &lower->where);
+ return FAILURE;
+ }
+
+ /* All dimensions must be without upper bound. */
+ gcc_assert (!sym->as->upper[dim]);
+
+ k = lower->ts.kind;
+ e = gfc_get_constant_expr (BT_INTEGER, k, &sym->declared_at);
+ mpz_add (e->value.integer,
+ lower->value.integer, init->shape[dim]);
+ mpz_sub_ui (e->value.integer, e->value.integer, 1);
+ sym->as->upper[dim] = e;
+ }
+
+ sym->as->type = AS_EXPLICIT;
+ }
+
/* Need to check if the expression we initialized this
to was one of the iso_c_binding named constants. If so,
and we're a parameter (constant), let it be iso_c.
@@ -1650,6 +1695,34 @@ variable_decl (int elem)
else if (current_as)
merge_array_spec (current_as, as, true);
+ /* At this point, we know for sure if the symbol is PARAMETER and can thus
+ determine (and check) whether it can be implied-shape. If it
+ was parsed as assumed-size, change it because PARAMETERs can not
+ be assumed-size. */
+ if (as)
+ {
+ if (as->type == AS_IMPLIED_SHAPE && current_attr.flavor != FL_PARAMETER)
+ {
+ m = MATCH_ERROR;
+ gfc_error ("Non-PARAMETER symbol '%s' at %L can't be implied-shape",
+ name, &var_locus);
+ goto cleanup;
+ }
+
+ if (as->type == AS_ASSUMED_SIZE && as->rank == 1
+ && current_attr.flavor == FL_PARAMETER)
+ as->type = AS_IMPLIED_SHAPE;
+
+ if (as->type == AS_IMPLIED_SHAPE
+ && gfc_notify_std (GFC_STD_F2008,
+ "Fortran 2008: Implied-shape array at %L",
+ &var_locus) == FAILURE)
+ {
+ m = MATCH_ERROR;
+ goto cleanup;
+ }
+ }
+
char_len = NULL;
cl = NULL;
===================================================================
@@ -463,6 +463,12 @@ gfc_match_array_spec (gfc_array_spec **a
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)
@@ -475,6 +481,15 @@ gfc_match_array_spec (gfc_array_spec **a
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)
{
@@ -513,6 +528,12 @@ gfc_match_array_spec (gfc_array_spec **a
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;
}
@@ -570,6 +591,7 @@ coarray:
else
switch (as->cotype)
{ /* See how current spec meshes with the existing. */
+ case AS_IMPLIED_SHAPE:
case AS_UNKNOWN:
goto cleanup;
===================================================================
@@ -157,7 +157,7 @@ expr_t;
/* Array types. */
typedef enum
{ AS_EXPLICIT = 1, AS_ASSUMED_SHAPE, AS_DEFERRED,
- AS_ASSUMED_SIZE, AS_UNKNOWN
+ AS_ASSUMED_SIZE, AS_IMPLIED_SHAPE, AS_UNKNOWN
}
array_type;
===================================================================
@@ -11673,20 +11673,24 @@ resolve_symbol (gfc_symbol *sym)
}
/* Assumed size arrays and assumed shape arrays must be dummy
- arguments. */
+ arguments. Array-spec's of implied-shape should have been resolved to
+ AS_EXPLICIT already. */
- if (sym->as != NULL
- && ((sym->as->type == AS_ASSUMED_SIZE && !sym->as->cp_was_assumed)
- || sym->as->type == AS_ASSUMED_SHAPE)
- && sym->attr.dummy == 0)
- {
- if (sym->as->type == AS_ASSUMED_SIZE)
- gfc_error ("Assumed size array at %L must be a dummy argument",
- &sym->declared_at);
- else
- gfc_error ("Assumed shape array at %L must be a dummy argument",
- &sym->declared_at);
- return;
+ if (sym->as)
+ {
+ gcc_assert (sym->as->type != AS_IMPLIED_SHAPE);
+ if (((sym->as->type == AS_ASSUMED_SIZE && !sym->as->cp_was_assumed)
+ || sym->as->type == AS_ASSUMED_SHAPE)
+ && sym->attr.dummy == 0)
+ {
+ if (sym->as->type == AS_ASSUMED_SIZE)
+ gfc_error ("Assumed size array at %L must be a dummy argument",
+ &sym->declared_at);
+ else
+ gfc_error ("Assumed shape array at %L must be a dummy argument",
+ &sym->declared_at);
+ return;
+ }
}
/* Make sure symbols with known intent or optional are really dummy
===================================================================
@@ -0,0 +1,37 @@
+! { dg-do run }
+! { dg-options "-std=f2008 -fall-intrinsics" }
+
+! Test for correct semantics of implied-shape arrays.
+
+! Contributed by Daniel Kraft, d@domob.eu.
+
+PROGRAM main
+ IMPLICIT NONE
+
+ INTEGER, PARAMETER :: n = 3
+
+ ! Should be able to reduce complex expressions.
+ REAL, PARAMETER :: arr1(n:*) = SQRT ((/ 1.0, 2.0, 3.0 /)) + 42
+
+ ! With dimension statement.
+ REAL, DIMENSION(*), PARAMETER :: arr2 = arr1
+
+ ! Rank > 1.
+ INTEGER, PARAMETER :: arr3(n:*, *) = RESHAPE ((/ 1, 2, 3, 4 /), (/ 2, 2/))
+
+ ! Character array.
+ CHARACTER(LEN=*), PARAMETER :: arr4(*) = (/ CHARACTER(LEN=3) :: "ab", "cde" /)
+
+ IF (LBOUND (arr1, 1) /= n .OR. UBOUND (arr1, 1) /= n + 2) CALL abort ()
+ IF (SIZE (arr1) /= 3) CALL abort ()
+
+ IF (LBOUND (arr2, 1) /= 1 .OR. UBOUND (arr2, 1) /= 3) CALL abort ()
+ IF (SIZE (arr2) /= 3) CALL abort ()
+
+ IF (ANY (LBOUND (arr3) /= (/ n, 1 /) .OR. UBOUND (arr3) /= (/ n + 1, 2 /))) &
+ CALL abort ()
+ IF (SIZE (arr3) /= 4) CALL abort ()
+
+ IF (LBOUND (arr4, 1) /= 1 .OR. UBOUND (arr4, 1) /= 2) CALL abort ()
+ IF (SIZE (arr4) /= 2) CALL abort ()
+END PROGRAM main
===================================================================
@@ -0,0 +1,35 @@
+! { dg-do compile }
+! { dg-options "-std=f2008" }
+
+! Test for errors with implied-shape declarations.
+
+! Contributed by Daniel Kraft, d@domob.eu.
+
+PROGRAM main
+ IMPLICIT NONE
+
+ INTEGER :: n
+ INTEGER, PARAMETER :: mat(2, 2) = RESHAPE ((/ 1, 2, 3, 4 /), (/ 2, 2 /))
+
+ ! Malformed declaration.
+ INTEGER, PARAMETER :: arr1(*, *, 5) = mat ! { dg-error "Bad array specification for implied-shape array" }
+
+ ! Rank mismatch in initialization.
+ INTEGER, PARAMETER :: arr2(*, *) = (/ 1, 2, 3, 4 /) ! { dg-error "Incompatible ranks" }
+
+ ! Non-PARAMETER implied-shape, with and without initializer.
+ INTEGER :: arr3(*, *) ! { dg-error "Non-PARAMETER" }
+ INTEGER :: arr4(*, *) = mat ! { dg-error "Non-PARAMETER" }
+
+ ! Missing initializer.
+ INTEGER, PARAMETER :: arr5(*) ! { dg-error "is missing an initializer" }
+
+ ! Initialization from scalar.
+ INTEGER, PARAMETER :: arr6(*) = 0 ! { dg-error "with scalar" }
+
+ ! Automatic bounds.
+ n = 2
+ BLOCK
+ INTEGER, PARAMETER :: arr7(n:*) = (/ 2, 3, 4 /) ! { dg-error "Non-constant lower bound" }
+ END BLOCK
+END PROGRAM main
===================================================================
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+
+! Test for rejection of implied-shape prior to Fortran 2008.
+
+! Contributed by Daniel Kraft, d@domob.eu.
+
+PROGRAM main
+ IMPLICIT NONE
+ INTEGER, PARAMETER :: arr(*) = (/ 2, 3, 4 /) ! { dg-error "Fortran 2008" }
+END PROGRAM main