diff options
author | Andre Vehreschild <vehre@gmx.de> | 2015-06-23 11:07:22 +0200 |
---|---|---|
committer | Andre Vehreschild <vehre@gcc.gnu.org> | 2015-06-23 11:07:22 +0200 |
commit | 76540ac3e39cd58b0b0084f1f1b4fd0ea3c122b1 (patch) | |
tree | 9c5390ba13cb036568b057572fb5b757c5d0bdb1 /gcc/fortran/parse.c | |
parent | bcd119b7a308c3e89af4fbdaa30d45a146194235 (diff) | |
download | gcc-76540ac3e39cd58b0b0084f1f1b4fd0ea3c122b1.zip gcc-76540ac3e39cd58b0b0084f1f1b4fd0ea3c122b1.tar.gz gcc-76540ac3e39cd58b0b0084f1f1b4fd0ea3c122b1.tar.bz2 |
re PR fortran/64674 ([OOP] ICE in ASSOCIATE with class array)
gcc/fortran/ChangeLog:
2015-06-23 Andre Vehreschild <vehre@gmx.de>
PR fortran/64674
* parse.c (parse_associate): Figure the rank and as of a
class array in an associate early.
* primary.c (gfc_match_varspec): Prevent setting the
dimension attribute on the sym for classes.
* resolve.c (resolve_variable): Correct the component
ref's type for associated variables. Add a full array ref
when class array's are associated.
(resolve_assoc_var): Correct the type of the symbol,
when in the associate the expression's rank becomes scalar.
* trans-expr.c (gfc_conv_variable): Indirect ref needed for
allocatable associated objects.
gcc/testsuite/ChangeLog:
2015-06-23 Andre Vehreschild <vehre@gmx.de>
PR fortran/64674
* gfortran.dg/associate_18.f08: New test.
From-SVN: r224827
Diffstat (limited to 'gcc/fortran/parse.c')
-rw-r--r-- | gcc/fortran/parse.c | 80 |
1 files changed, 80 insertions, 0 deletions
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 56c6782..c707142 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -3958,6 +3958,8 @@ parse_associate (void) for (a = new_st.ext.block.assoc; a; a = a->next) { gfc_symbol* sym; + gfc_ref *ref; + gfc_array_ref *array_ref; if (gfc_get_sym_tree (a->name, NULL, &a->st, false)) gcc_unreachable (); @@ -3974,6 +3976,84 @@ parse_associate (void) for parsing component references on the associate-name in case of association to a derived-type. */ sym->ts = a->target->ts; + + /* Check if the target expression is array valued. This can not always + be done by looking at target.rank, because that might not have been + set yet. Therefore traverse the chain of refs, looking for the last + array ref and evaluate that. */ + array_ref = NULL; + for (ref = a->target->ref; ref; ref = ref->next) + if (ref->type == REF_ARRAY) + array_ref = &ref->u.ar; + if (array_ref || a->target->rank) + { + gfc_array_spec *as; + int dim, rank = 0; + if (array_ref) + { + /* Count the dimension, that have a non-scalar extend. */ + for (dim = 0; dim < array_ref->dimen; ++dim) + if (array_ref->dimen_type[dim] != DIMEN_ELEMENT + && !(array_ref->dimen_type[dim] == DIMEN_UNKNOWN + && array_ref->end[dim] == NULL + && array_ref->start[dim] != NULL)) + ++rank; + } + else + rank = a->target->rank; + /* When the rank is greater than zero then sym will be an array. */ + if (sym->ts.type == BT_CLASS) + { + if ((!CLASS_DATA (sym)->as && rank != 0) + || (CLASS_DATA (sym)->as + && CLASS_DATA (sym)->as->rank != rank)) + { + /* Don't just (re-)set the attr and as in the sym.ts, + because this modifies the target's attr and as. Copy the + data and do a build_class_symbol. */ + symbol_attribute attr = CLASS_DATA (a->target)->attr; + int corank = gfc_get_corank (a->target); + gfc_typespec type; + + if (rank || corank) + { + as = gfc_get_array_spec (); + as->type = AS_DEFERRED; + as->rank = rank; + as->corank = corank; + attr.dimension = rank ? 1 : 0; + attr.codimension = corank ? 1 : 0; + } + else + { + as = NULL; + attr.dimension = attr.codimension = 0; + } + attr.class_ok = 0; + type = CLASS_DATA (sym)->ts; + if (!gfc_build_class_symbol (&type, + &attr, &as)) + gcc_unreachable (); + sym->ts = type; + sym->ts.type = BT_CLASS; + sym->attr.class_ok = 1; + } + else + sym->attr.class_ok = 1; + } + else if ((!sym->as && rank != 0) + || (sym->as && sym->as->rank != rank)) + { + as = gfc_get_array_spec (); + as->type = AS_DEFERRED; + as->rank = rank; + as->corank = gfc_get_corank (a->target); + sym->as = as; + sym->attr.dimension = 1; + if (as->corank) + sym->attr.codimension = 1; + } + } } accept_statement (ST_ASSOCIATE); |