diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index e987159f037..aaf15315213 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,13 @@ +2010-08-13 Daniel Kraft + + * gfortran.h (array_type): New type `AS_IMPLIED_SHAPE'. + * array.c (gfc_match_array_spec): Match implied-shape specification and + handle AS_IMPLIED_SHAPE correctly otherwise. + * decl.c (add_init_expr_to_sym): Set upper bounds for implied-shape. + (variable_decl): Some checks for implied-shape declaration. + * resolve.c (resolve_symbol): Assert that array-spec is no longer + AS_IMPLIED_SHAPE in any case. + 2010-08-12 Joseph Myers * lang.opt (MD, MMD): Change to MDX and MMDX. diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c index cd261bf9b90..a26be7891de 100644 --- a/gcc/fortran/array.c +++ b/gcc/fortran/array.c @@ -463,6 +463,12 @@ gfc_match_array_spec (gfc_array_spec **asp, bool match_dim, bool match_codim) 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 **asp, bool match_dim, bool match_codim) 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 **asp, bool match_dim, bool match_codim) 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; diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index acc85d25484..91eb7109c80 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -1378,6 +1378,51 @@ add_init_expr_to_sym (const char *name, gfc_expr **initp, locus *var_locus) } } + /* 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; diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 898f3079a98..60ab1759059 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -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; diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 9933b5d0d91..0e68af629a3 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -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) { - 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; + 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 diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 04670c0b148..5821cfaf4ca 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2010-08-13 Daniel Kraft + + * gfortran.dg/implied_shape_1.f08: New test. + * gfortran.dg/implied_shape_2.f90: New test. + * gfortran.dg/implied_shape_3.f08: New test. + 2010-08-12 Jerry DeLisle PR libfortran/42526 diff --git a/gcc/testsuite/gfortran.dg/implied_shape_1.f08 b/gcc/testsuite/gfortran.dg/implied_shape_1.f08 new file mode 100644 index 00000000000..07a1ce83509 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/implied_shape_1.f08 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/implied_shape_2.f90 b/gcc/testsuite/gfortran.dg/implied_shape_2.f90 new file mode 100644 index 00000000000..a6e11f55847 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/implied_shape_2.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/implied_shape_3.f08 b/gcc/testsuite/gfortran.dg/implied_shape_3.f08 new file mode 100644 index 00000000000..6cf13bb4013 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/implied_shape_3.f08 @@ -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