diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index f6cfcfdcce2..b1db67aa40d 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,13 @@ +2010-04-06 Tobias Burnus + + 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 PR fortran/18918 diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c index 4b2ccf643c5..c291ad8ca5c 100644 --- a/gcc/fortran/array.c +++ b/gcc/fortran/array.c @@ -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++) { diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index a2e385d2d31..2bf0ef856d8 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -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. */ diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index b68afba3d66..190148c24ee 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -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. */ diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 55c0d124f51..3ec454e7b73 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -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) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index bcbc8d3df2b..2e035200c5d 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2010-04-06 Tobias Burnus + + PR fortran/18918 + * gfortran.dg/coarray_4.f90: Fix test. + * gfortran.dg/coarray_6.f90: Add more tests. + 2010-04-06 Tobias Burnus PR fortran/18918 diff --git a/gcc/testsuite/gfortran.dg/coarray_4.f90 b/gcc/testsuite/gfortran.dg/coarray_4.f90 index 71fbf98c82d..cb693ea2e04 100644 --- a/gcc/testsuite/gfortran.dg/coarray_4.f90 +++ b/gcc/testsuite/gfortran.dg/coarray_4.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/coarray_6.f90 b/gcc/testsuite/gfortran.dg/coarray_6.f90 index f122fd451f3..b6d8b4952d2 100644 --- a/gcc/testsuite/gfortran.dg/coarray_6.f90 +++ b/gcc/testsuite/gfortran.dg/coarray_6.f90 @@ -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