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 ...