[Bug fortran/55037] [4.8 Regression] [OOP] ICE with local allocatable variable of abstract type

["janus at gcc dot gnu.org" <gcc-bugzilla at gcc dot gnu dot org>]

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