http://gcc.gnu.org/bugzilla/show_bug.cgi?id=55037
janus at gcc dot gnu.org changed:
What |Removed |Added
----------------------------------------------------------------------------
Status|NEW |ASSIGNED
AssignedTo|unassigned at gcc dot |janus at gcc dot gnu.org
|gnu.org |
--- Comment #4 from janus at gcc dot gnu.org 2012-10-24 10:25:49 UTC ---
(In reply to comment #2)
> Here is a variant which fails with a different ICE:
The problem with comment 2 is that 'gfc_class_data_get' is applied twice (in
trans-expr.c, gfc_conv_procedure_call): Once in line 4188, and once in line
4203.
Here is a patch which fixes both comment 0 and comment 2 and is free of
testsuite regressions:
Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c (revision 192691)
+++ gcc/fortran/trans-expr.c (working copy)
@@ -4180,13 +4180,6 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol *
CLASS_DATA (fsym)->attr.class_pointer
|| CLASS_DATA (fsym)->attr.allocatable);
- if (fsym && (fsym->ts.type == BT_DERIVED
- || fsym->ts.type == BT_ASSUMED)
- && e->ts.type == BT_CLASS
- && !CLASS_DATA (e)->attr.dimension
- && !CLASS_DATA (e)->attr.codimension)
- parmse.expr = gfc_class_data_get (parmse.expr);
-
/* If an ALLOCATABLE dummy argument has INTENT(OUT) and is
allocated on entry, it must be deallocated. */
if (fsym && fsym->attr.intent == INTENT_OUT
@@ -4215,7 +4208,6 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol *
if (fsym->ts.type == BT_CLASS)
{
gfc_symbol *vtab;
- gcc_assert (fsym->ts.u.derived == e->ts.u.derived);
vtab = gfc_find_derived_vtab (fsym->ts.u.derived);
tmp = gfc_get_symbol_decl (vtab);
tmp = gfc_build_addr_expr (NULL_TREE, tmp);
@@ -4240,6 +4232,12 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol *
gfc_add_expr_to_block (&se->pre, tmp);
}
+ else if (fsym && (fsym->ts.type == BT_DERIVED
+ || fsym->ts.type == BT_ASSUMED)
+ && e->ts.type == BT_CLASS
+ && !CLASS_DATA (e)->attr.dimension
+ && !CLASS_DATA (e)->attr.codimension)
+ parmse.expr = gfc_class_data_get (parmse.expr);
/* Wrap scalar variable in a descriptor. We need to convert
the address of a pointer back to the pointer itself before,
Will commit as obvious ...
