OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

gfortran.h (array_type): New type `AS_IMPLIED_SHAPE'.

Browse Source 
2010-08-13  Daniel Kraft  <d@domob.eu>

	* 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-13  Daniel Kraft  <d@domob.eu>

	* gfortran.dg/implied_shape_1.f08: New test.
	* gfortran.dg/implied_shape_2.f90: New test.
	* gfortran.dg/implied_shape_3.f08: New test.

From-SVN: r163221
This commit is contained in:
Daniel Kraft 2010-08-13 09:26:05 +02:00 committed by Daniel Kraft
parent cf677bb867
commit f5ca06e678
9 changed files with 211 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
gcc/fortran/ChangeLog
View File

@ -1,3 +1,13 @@
2010-08-13 Daniel Kraft <d@domob.eu>
* 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 <joseph@codesourcery.com>
* lang.opt (MD, MMD): Change to MDX and MMDX.

22
gcc/fortran/array.c
View File

@ -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;

73
gcc/fortran/decl.c
View File

@ -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;

2
gcc/fortran/gfortran.h
View File

@ -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;

28
gcc/fortran/resolve.c
View File

@ -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

6
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,9 @@
2010-08-13 Daniel Kraft <d@domob.eu>
* 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 <jvdelisle@gcc.gnu.org>
PR libfortran/42526

37
gcc/testsuite/gfortran.dg/implied_shape_1.f08 Normal file
View File

@ -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

11
gcc/testsuite/gfortran.dg/implied_shape_2.f90 Normal file
View File

@ -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

35
gcc/testsuite/gfortran.dg/implied_shape_3.f08 Normal file
View File

@ -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