diff options
| author | Paul Thomas <pault@gcc.gnu.org> | 2018-10-15 16:31:15 +0000 |
|---|---|---|
| committer | Paul Thomas <pault@gcc.gnu.org> | 2018-10-15 16:31:15 +0000 |
| commit | e60f68ec460bc5b33a6f75caac9667bf978f37d8 (patch) | |
| tree | 3cdf05c071e53c16a1aa96b96c259221366c7d1e /gcc/fortran/resolve.c | |
| parent | 72551c683ce3ae89835216851473863c6d4ef27f (diff) | |
| download | gcc-e60f68ec460bc5b33a6f75caac9667bf978f37d8.zip gcc-e60f68ec460bc5b33a6f75caac9667bf978f37d8.tar.gz gcc-e60f68ec460bc5b33a6f75caac9667bf978f37d8.tar.bz2 | |
re PR fortran/87566 (ICE with class(*) and select)
2018-10-15 Paul Thomas <pault@gcc.gnu.org>
Tobias Burnus <burnus@gcc.gnu.org>
PR fortran/87566
* resolve.c (resolve_assoc_var): Add missing array spec for
class associate names.
(resolve_select_type): Handle case where last typed component
of the selector has a different type to the expression.
* trans-expr.c (gfc_find_and_cut_at_last_class_ref): Replace
call to gfc_expr_to_initialize with call to gfc_copy_expr.
(gfc_conv_class_to_class): Guard assignment to 'len' field
against case where zero constant is supplied.
2018-10-15 Paul Thomas <pault@gcc.gnu.org>
Tobias Burnus <burnus@gcc.gnu.org>
PR fortran/87566
* gfortran.dg/select_type_44.f90: New test.
* gfortran.dg/associate_42.f90: New test.
Co-Authored-By: Tobias Burnus <burnus@gcc.gnu.org>
From-SVN: r265171
Diffstat (limited to 'gcc/fortran/resolve.c')
| -rw-r--r-- | gcc/fortran/resolve.c | 33 |
1 files changed, 30 insertions, 3 deletions
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 87e65df..56ab595 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -8675,6 +8675,18 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target) if (as->corank != 0) sym->attr.codimension = 1; } + else if (sym->ts.type == BT_CLASS && (!CLASS_DATA (sym)->as || sym->assoc->rankguessed)) + { + if (!CLASS_DATA (sym)->as) + CLASS_DATA (sym)->as = gfc_get_array_spec (); + as = CLASS_DATA (sym)->as; + as->rank = target->rank; + as->type = AS_DEFERRED; + as->corank = gfc_get_corank (target); + CLASS_DATA (sym)->attr.dimension = 1; + if (as->corank != 0) + CLASS_DATA (sym)->attr.codimension = 1; + } } else { @@ -8875,9 +8887,24 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns) if (code->expr2) { - if (code->expr1->symtree->n.sym->attr.untyped) - code->expr1->symtree->n.sym->ts = code->expr2->ts; - selector_type = CLASS_DATA (code->expr2)->ts.u.derived; + gfc_ref *ref2 = NULL; + for (ref = code->expr2->ref; ref != NULL; ref = ref->next) + if (ref->type == REF_COMPONENT + && ref->u.c.component->ts.type == BT_CLASS) + ref2 = ref; + + if (ref2) + { + if (code->expr1->symtree->n.sym->attr.untyped) + code->expr1->symtree->n.sym->ts = ref->u.c.component->ts; + selector_type = CLASS_DATA (ref2->u.c.component)->ts.u.derived; + } + else + { + if (code->expr1->symtree->n.sym->attr.untyped) + code->expr1->symtree->n.sym->ts = code->expr2->ts; + selector_type = CLASS_DATA (code->expr2)->ts.u.derived; + } if (code->expr2->rank && CLASS_DATA (code->expr1)->as) CLASS_DATA (code->expr1)->as->rank = code->expr2->rank; |