http://gcc.gnu.org/bugzilla/show_bug.cgi?id=50981
--- Comment #18 from Mikael Morin <mikael at gcc dot gnu.org> 2012-01-11
23:31:32 UTC ---
(In reply to comment #17)
> I think the proper solution is to remove the trans-stmt.c manual scalarization
> and handle somewhere in trans-{array,expr}.c the array bounds.
>
Some of it might actually be dead code. I don't see where the `temp' variable
is used.
> Stupid attempts fail for various reasons: Changing the BT_CLASS to BT_DERIVED
> in gfc_trans_allocate does not work as one the offsets will no longer be
> class._size (why?). Keeping BT_CLASS but removing the gfc_add_data_component
> > in trans-stmt.c will ICE for dataref - and removing that as well will lead
> to
> valid code with class._size, but without scalarization loop ...
Below is my `stupid' attempt at the not-so-proper solution: it does an
`intelligent' e->ts.type == BT_CLASS in the new conditions in
gfc_conv_procedure_call. It passes gfortran.dg/*elemental* and
gfortran.dg/*class*. But it is admittedly somewhat hackish.
diff --git a/trans-expr.c b/trans-expr.c
index a2268a1..1a24d4b 100644
--- a/trans-expr.c
+++ b/trans-expr.c
@@ -3259,6 +3259,35 @@ conv_isocbinding_procedure (gfc_se * se, gfc_symbol *
sym,
}
+static bool
+needs_class_data_ref (gfc_expr *e)
+{
+ gfc_ref *ref;
+ bool result;
+
+ if (e->expr_type != EXPR_VARIABLE)
+ return false;
+
+ if (e->symtree->n.sym->ts.type == BT_CLASS)
+ result = true;
+
+ for (ref = e->ref; ref; ref = ref->next)
+ {
+ if (ref->type != REF_COMPONENT)
+ {
+ result = false;
+ continue;
+ }
+
+ if (ref->u.c.component->ts.type == BT_CLASS)
+ result = true;
+ else if (!strcmp (ref->u.c.component->name, "_data"))
+ result = false;
+ }
+
+ return result;
+}
+
/* Generate code for a procedure call. Note can return se->post != NULL.
If se->direct_byref is set then se->expr contains the return parameter.
Return nonzero, if the call has alternate specifiers.
@@ -3435,7 +3464,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
else
gfc_conv_expr_reference (&parmse, e);
- if (fsym && fsym->ts.type == BT_DERIVED && e->ts.type == BT_CLASS)
+ if (fsym && fsym->ts.type == BT_DERIVED && needs_class_data_ref (e))
parmse.expr = gfc_class_data_get (parmse.expr);
/* The scalarizer does not repackage the reference to a class
@@ -3514,7 +3543,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
if (fsym && fsym->ts.type == BT_DERIVED
- && e->ts.type == BT_CLASS)
+ && needs_class_data_ref (e))
parmse.expr = gfc_class_data_get (parmse.expr);
/* A class array element needs converting back to be a
