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

Reply via email to