diff options
| author | Tobias Burnus <burnus@net-b.de> | 2010-04-06 20:23:56 +0200 |
|---|---|---|
| committer | Tobias Burnus <burnus@gcc.gnu.org> | 2010-04-06 20:23:56 +0200 |
| commit | 178f9aa17efb04fe73f447763c9cab64166b1041 (patch) | |
| tree | 09851507edcb4905b8c3426e51a826c7aa3fb49c /gcc/fortran/array.c | |
| parent | d079b87fab5e8de93c897940b750286d31d5d003 (diff) | |
| download | gcc-178f9aa17efb04fe73f447763c9cab64166b1041.tar.gz | |
re PR fortran/18918 (Eventually support Fortran 2008's coarrays [co-arrays])
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
Diffstat (limited to 'gcc/fortran/array.c')
| -rw-r--r-- | gcc/fortran/array.c | 46 |
1 files changed, 10 insertions, 36 deletions
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++) { |