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

re PR fortran/18918 (Eventually support Fortran 2008's coarrays [co-arrays])

Browse Source 
2010-04-06  Tobias Burnus  <burnus@net-b.de>

        PR fortran/18918
        * gfortran.h (gfc_array_spec): Add cotype.
        * array.c (gfc_match_array_spec,gfc_set_array_spec): Use it
        and defer error diagnostic.
        * resolve.c (resolve_fl_derived): Add missing check.
        (resolve_symbol): Add cotype/type check.
        * parse.c (parse_derived): Fix setting of coarray_comp.

2010-04-06  Tobias Burnus  <burnus@net-b.de>

        PR fortran/18918
        * gfortran.dg/coarray_4.f90: Fix test.
        * gfortran.dg/coarray_6.f90: Add more tests.

From-SVN: r158014
This commit is contained in:
Tobias Burnus 2010-04-06 20:23:56 +02:00 committed by Tobias Burnus
parent d079b87fab
commit 178f9aa17e
8 changed files with 68 additions and 45 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-04-06 Tobias Burnus <burnus@net-b.de>
PR fortran/18918
* gfortran.h (gfc_array_spec): Add cotype.
* array.c (gfc_match_array_spec,gfc_set_array_spec): Use it
and defer error diagnostic.
* resolve.c (resolve_fl_derived): Add missing check.
(resolve_symbol): Add cotype/type check.
* parse.c (parse_derived): Fix setting of coarray_comp.
2010-04-06 Tobias Burnus <burnus@net-b.de>
PR fortran/18918

46
gcc/fortran/array.c
View File

@ -342,7 +342,6 @@ match
gfc_match_array_spec (gfc_array_spec **asp, bool match_dim, bool match_codim)
{
array_type current_type;
array_type coarray_type = AS_UNKNOWN;
gfc_array_spec *as;
int i;
@ -467,23 +466,10 @@ coarray:
if (current_type == AS_UNKNOWN)
goto cleanup;
if (as->rank && as->type != AS_DEFERRED && current_type == AS_DEFERRED)
{
gfc_error ("Array at %C has non-deferred shape and deferred "
"coshape");
goto cleanup;
}
if (as->rank && as->type == AS_DEFERRED && current_type != AS_DEFERRED)
{
gfc_error ("Array at %C has deferred shape and non-deferred "
"coshape");
goto cleanup;
}
if (as->corank == 1)
coarray_type = current_type;
as->cotype = current_type;
else
switch (coarray_type)
switch (as->cotype)
{ /* See how current spec meshes with the existing. */
case AS_UNKNOWN:
goto cleanup;
@ -491,7 +477,7 @@ coarray:
case AS_EXPLICIT:
if (current_type == AS_ASSUMED_SIZE)
{
coarray_type = AS_ASSUMED_SIZE;
as->cotype = AS_ASSUMED_SIZE;
break;
}
@ -518,7 +504,7 @@ coarray:
if (current_type == AS_ASSUMED_SHAPE)
{
as->type = AS_ASSUMED_SHAPE;
as->cotype = AS_ASSUMED_SHAPE;
break;
}
@ -553,10 +539,11 @@ coarray:
goto cleanup;
}
if (as->rank == 0 && coarray_type == AS_ASSUMED_SIZE)
as->type = AS_EXPLICIT;
else if (as->rank == 0)
as->type = coarray_type;
if (as->cotype == AS_ASSUMED_SIZE)
as->cotype = AS_EXPLICIT;
if (as->rank == 0)
as->type = as->cotype;
done:
if (as->rank == 0 && as->corank == 0)
@ -613,26 +600,13 @@ gfc_set_array_spec (gfc_symbol *sym, gfc_array_spec *as, locus *error_loc)
return SUCCESS;
}
if (sym->as->type == AS_DEFERRED && as->type != AS_DEFERRED)
{
gfc_error ("'%s' at %L has deferred shape and non-deferred coshape",
sym->name, error_loc);
return FAILURE;
}
if (sym->as->type != AS_DEFERRED && as->type == AS_DEFERRED)
{
gfc_error ("'%s' at %L has non-deferred shape and deferred coshape",
sym->name, error_loc);
return FAILURE;
}
if (as->corank)
{
/* The "sym" has no corank (checked via gfc_add_codimension). Thus
the codimension is simply added. */
gcc_assert (as->rank == 0 && sym->as->corank == 0);
sym->as->cotype = as->cotype;
sym->as->corank = as->corank;
for (i = 0; i < as->corank; i++)
{

2
gcc/fortran/gfortran.h
View File

@ -868,7 +868,7 @@ typedef struct
{
int rank; /* A rank of zero means that a variable is a scalar. */
int corank;
array_type type;
array_type type, cotype;
struct gfc_expr *lower[GFC_MAX_DIMENSIONS], *upper[GFC_MAX_DIMENSIONS];
/* These two fields are used with the Cray Pointer extension. */

3
gcc/fortran/parse.c
View File

@ -2115,7 +2115,8 @@ endType:
sym->attr.proc_pointer_comp = 1;
/* Looking for coarray components. */
if (c->attr.codimension || c->attr.coarray_comp)
if (c->attr.codimension
|| (c->attr.coarray_comp && !c->attr.pointer && !c->attr.allocatable))
sym->attr.coarray_comp = 1;
/* Look for private components. */

18
gcc/fortran/resolve.c
View File

@ -10481,7 +10481,8 @@ resolve_fl_derived (gfc_symbol *sym)
/* F2008, C444. */
if (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.coarray_comp
&& (c->attr.codimension || c->attr.pointer || c->attr.dimension))
&& (c->attr.codimension || c->attr.pointer || c->attr.dimension
|| c->attr.allocatable))
{
gfc_error ("Component '%s' at %L with coarray component "
"shall be a nonpointer, nonallocatable scalar",
@ -11319,11 +11320,6 @@ resolve_symbol (gfc_symbol *sym)
}
}
if (sym->attr.codimension && sym->attr.allocatable
&& sym->as->type != AS_DEFERRED)
gfc_error ("Allocatable coarray variable '%s' at %L must have "
"deferred shape", sym->name, &sym->declared_at);
/* F2008, C526. */
if (((sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.coarray_comp)
|| sym->attr.codimension)
@ -11355,6 +11351,16 @@ resolve_symbol (gfc_symbol *sym)
gfc_error ("Variable '%s' at %L is a coarray or has a coarray "
"component and is not ALLOCATABLE, SAVE nor a "
"dummy argument", sym->name, &sym->declared_at);
/* F2008, C528. */
else if (sym->attr.codimension && !sym->attr.allocatable
&& sym->as->cotype == AS_DEFERRED)
gfc_error ("Coarray variable '%s' at %L shall not have codimensions with "
"deferred shape", sym->name, &sym->declared_at);
else if (sym->attr.codimension && sym->attr.allocatable
&& (sym->as->type != AS_DEFERRED || sym->as->cotype != AS_DEFERRED))
gfc_error ("Allocatable coarray variable '%s' at %L must have "
"deferred shape", sym->name, &sym->declared_at);
/* F2008, C541. */
if (((sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.coarray_comp)

6
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,9 @@
2010-04-06 Tobias Burnus <burnus@net-b.de>
PR fortran/18918
* gfortran.dg/coarray_4.f90: Fix test.
* gfortran.dg/coarray_6.f90: Add more tests.
2010-04-06 Tobias Burnus <burnus@net-b.de>
PR fortran/18918

2
gcc/testsuite/gfortran.dg/coarray_4.f90
View File

@ -48,7 +48,7 @@ subroutine invalid(n)
integer, save :: hf4(5)[n,*] ! { dg-error "cannot have the SAVE attribute" }
integer, allocatable :: a2[*] ! { dg-error "must have deferred shape" }
integer, allocatable :: a3(:)[*] ! { dg-error "deferred shape and non-deferred coshape" }
integer, allocatable :: a3(:)[*] ! { dg-error "must have deferred shape" }
integer, allocatable :: a4[*] ! { dg-error "must have deferred shape" }
end subroutine invalid

26
gcc/testsuite/gfortran.dg/coarray_6.f90
View File

@ -51,6 +51,32 @@ function func() result(func2) ! { dg-error "shall not be a coarray or have a coa
type(t) :: func2
end function func
subroutine invalid()
type t
integer, allocatable :: a[:]
end type t
type t2
type(t), allocatable :: b ! { dg-error "nonpointer, nonallocatable scalar" }
end type t2
type t3
type(t), pointer :: c ! { dg-error "nonpointer, nonallocatable scalar" }
end type t3
type t4
type(t) :: d(4) ! { dg-error "nonpointer, nonallocatable scalar" }
end type t4
end subroutine invalid
subroutine valid(a)
integer :: a(:)[4,-1:6,4:*]
type t
integer, allocatable :: a[:]
end type t
type t2
type(t) :: b
end type t2
type(t2), save :: xt2[*]
end subroutine valid
program main
integer :: A[*] ! Valid, implicit SAVE attribute
end program main