This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
Re: [Patch, Fortran] PR 42051,43896: [OOP] ICE in gfc_conv_variable, at fortran/trans-expr.c:551
Please find attached an updated version of the patch that I sent this
morning. It applies to revision 159428.
It fixes pr41539, pr42051_1.f90 and pr43896.f90, up to defined
operators for classes.
I was in the midst of tackling pr41951, when I ground to a halt.
I'll take a further look at it over the weekend.
(Janus, feel free to commit the posted patch. I will modify this one
to suit - thanks, by the way :-) )
Paul
Index: gcc/fortran/interface.c
===================================================================
--- gcc/fortran/interface.c (revision 159428)
+++ gcc/fortran/interface.c (working copy)
@@ -1507,6 +1507,23 @@
if (symbol_rank (formal) == actual->rank)
return 1;
+ if (formal->ts.type == BT_CLASS)
+ {
+ int formal_rank;
+ formal_rank = formal->ts.u.derived->components->as
+ ? formal->ts.u.derived->components->as->rank : 0;
+ if (formal_rank == actual->rank)
+ return 1;
+ else
+ {
+ if (where)
+ gfc_error ("Rank mismatch in argument '%s' at %L (%d and %d)",
+ formal->name, &actual->where, formal_rank,
+ actual->rank);
+ return 0;
+ }
+ }
+
rank_check = where != NULL && !is_elemental && formal->as
&& (formal->as->type == AS_ASSUMED_SHAPE
|| formal->as->type == AS_DEFERRED)
Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c (revision 159428)
+++ gcc/fortran/trans-expr.c (working copy)
@@ -2479,15 +2479,28 @@
/* Set the vptr. */
cmp = gfc_find_component (declared, "$vptr", true, true);
- ctree = fold_build3 (COMPONENT_REF, TREE_TYPE (cmp->backend_decl),
- var, cmp->backend_decl, NULL_TREE);
+
+ /* Remember the vtab corresponds to the derived type not to the
+ class declared type, unless this is an array reference to a
+ class object. */
+ if (((e->expr_type == EXPR_VARIABLE) || (e->expr_type == EXPR_FUNCTION))
+ && e->symtree->n.sym->ts.type == BT_CLASS)
+ {
+ tmp = gfc_get_symbol_decl (e->symtree->n.sym);
+ ctree = fold_build3 (COMPONENT_REF, TREE_TYPE (cmp->backend_decl),
+ tmp, cmp->backend_decl, NULL_TREE);
+ tmp = fold_build3 (COMPONENT_REF, TREE_TYPE (cmp->backend_decl),
+ tmp, cmp->backend_decl, NULL_TREE);
+ }
+ else
+ {
+ ctree = fold_build3 (COMPONENT_REF, TREE_TYPE (cmp->backend_decl),
+ var, cmp->backend_decl, NULL_TREE);
+ vtab = gfc_find_derived_vtab (e->ts.u.derived, true);
+ gcc_assert (vtab);
+ tmp = gfc_build_addr_expr (NULL_TREE, gfc_get_symbol_decl (vtab));
+ }
- /* Remember the vtab corresponds to the derived type
- not to the class declared type. */
- vtab = gfc_find_derived_vtab (e->ts.u.derived, true);
- gcc_assert (vtab);
- gfc_trans_assign_vtab_procs (&parmse->pre, e->ts.u.derived, vtab);
- tmp = gfc_build_addr_expr (NULL_TREE, gfc_get_symbol_decl (vtab));
gfc_add_modify (&parmse->pre, ctree,
fold_convert (TREE_TYPE (ctree), tmp));
@@ -2498,13 +2511,15 @@
ss = gfc_walk_expr (e);
if (ss == gfc_ss_terminator)
{
+ parmse->ss = NULL;
gfc_conv_expr_reference (parmse, e);
tmp = fold_convert (TREE_TYPE (ctree), parmse->expr);
gfc_add_modify (&parmse->pre, ctree, tmp);
}
else
{
- gfc_conv_expr (parmse, e);
+ parmse->ss = ss;
+ gfc_conv_expr_descriptor (parmse, e, ss);
gfc_add_modify (&parmse->pre, ctree, parmse->expr);
}
Index: gcc/fortran/match.c
===================================================================
--- gcc/fortran/match.c (revision 159428)
+++ gcc/fortran/match.c (working copy)
@@ -2679,7 +2679,7 @@
gfc_match_allocate (void)
{
gfc_alloc *head, *tail;
- gfc_expr *stat, *errmsg, *tmp, *source;
+ gfc_expr *stat, *errmsg, *tmp, *source, *e;
gfc_typespec ts;
gfc_symbol *sym;
match m;
@@ -2740,6 +2740,18 @@
goto cleanup;
}
+ /* A class object's array reference changes the expression type to that
+ of the declared type. Change it back to the class type for allocate
+ expressions. */
+ e = tail->expr;
+ if (e->symtree->n.sym->ts.type == BT_CLASS
+ && e->ts.type == BT_DERIVED
+ && e->ref && e->ref->type == REF_COMPONENT
+ && strcmp (e->ref->u.c.component->name, "$data") == 0
+ && (!e->ref->next
+ || (e->ref->next->type == REF_ARRAY && !e->ref->next->next)))
+ e->ts = e->symtree->n.sym->ts;
+
/* The ALLOCATE statement had an optional typespec. Check the
constraints. */
if (ts.type != BT_UNKNOWN)
Index: gcc/fortran/primary.c
===================================================================
--- gcc/fortran/primary.c (revision 159428)
+++ gcc/fortran/primary.c (working copy)
@@ -1725,7 +1725,7 @@
{
char name[GFC_MAX_SYMBOL_LEN + 1];
gfc_ref *substring, *tail;
- gfc_component *component;
+ gfc_component *component = NULL;
gfc_symbol *sym = primary->symtree->n.sym;
match m;
bool unknown;
@@ -1759,6 +1759,16 @@
|| (sym->ts.type == BT_CLASS
&& sym->ts.u.derived->components->attr.dimension))
{
+ if (sym->ts.type == BT_CLASS && gfc_peek_ascii_char () == '(')
+ {
+ component = gfc_find_component (sym->ts.u.derived, "$data",
+ true, true);
+ tail = extend_ref (primary, tail);
+ tail->type = REF_COMPONENT;
+ tail->u.c.component = component;
+ tail->u.c.sym = sym;
+ }
+
/* In EQUIVALENCE, we don't know yet whether we are seeing
an array, character variable or array of character
variables. We'll leave the decision till resolve time. */
@@ -1782,7 +1792,10 @@
}
}
- primary->ts = sym->ts;
+ if (sym->ts.type == BT_CLASS && component)
+ primary->ts = component->ts;
+ else
+ primary->ts = sym->ts;
if (equiv_flag)
return MATCH_YES;
@@ -2765,7 +2778,8 @@
/* If the symbol has a dimension attribute, the expression is a
variable. */
- if (sym->attr.dimension)
+ if (sym->attr.dimension
+ || (sym->ts.type == BT_CLASS && sym->ts.u.derived->components->attr.dimension))
{
if (gfc_add_flavor (&sym->attr, FL_VARIABLE,
sym->name, NULL) == FAILURE)