aboutsummaryrefslogtreecommitdiff
path: root/gcc/fortran/parse.c
diff options
context:
space:
mode:
authorAndre Vehreschild <vehre@gmx.de>2015-06-23 11:07:22 +0200
committerAndre Vehreschild <vehre@gcc.gnu.org>2015-06-23 11:07:22 +0200
commit76540ac3e39cd58b0b0084f1f1b4fd0ea3c122b1 (patch)
tree9c5390ba13cb036568b057572fb5b757c5d0bdb1 /gcc/fortran/parse.c
parentbcd119b7a308c3e89af4fbdaa30d45a146194235 (diff)
downloadgcc-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.c80
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);