[Patch, Fortran, OOP, Regression] PR 60234: ICE in generate_finalization_wrapper at fortran/class.c:1883

Janus Weil janus@gcc.gnu.org
Thu Feb 20 21:52:00 GMT 2014


Hi all,

attached is a patch for an ICE-on-valid regression related to finalization.

What the patch does is to defer the building of the vtabs to a later
stage. Previously this was done only for some rare cases, now we do it
basically for all vtabs. This is necessary with finalization, since
building the vtab also implies building the finalization wrapper, for
which it is necessary that the finalizers have been resolved.

Deferring the building of the vtab means that we have to leave blank
the type of the class container's _vtab component at first. This is
then later fixed up in 'gfc_add_component_ref'.

I think in general it's a good strategy for the complete OOP
implementation to defer the building of the front-end structures
(class containers, vtabs, etc) as much as possible. Ultimately it
would be best to generate all the structures only at translation stage
(I think Paul at some point already started preparations for a
trans-class.c). However, this is a major effort and clearly can not be
tackled before the next stage 1.

Anyway, the patch regtests cleanly on x86_64-unknown-linux-gnu. Ok for trunk?

Cheers,
Janus



2014-02-20  Janus Weil  <janus@gcc.gnu.org>

    PR fortran/60234
    * gfortran.h (gfc_build_class_symbol): Removed argument.
    * class.c (gfc_add_component_ref): Fix up missing vtype if necessary.
    (gfc_build_class_symbol): Remove argument 'delayed_vtab'. vtab is always
    delayed now, except for unlimited polymorphics.
    (comp_is_finalizable): Procedure pointer components are not finalizable.
    * decl. (build_sym, build_struct, attr_decl1): Removed argument of
    'gfc_build_class_symbol'.
    * match.c (copy_ts_from_selector_to_associate, select_type_set_tmp):
    Ditto.
    * symbol.c (gfc_set_default_type): Ditto.


2014-02-20  Janus Weil  <janus@gcc.gnu.org>

    PR fortran/60234
    * gfortran.dg/finalize_23.f90: New.
-------------- next part --------------
Index: gcc/fortran/class.c
===================================================================
--- gcc/fortran/class.c	(revision 207846)
+++ gcc/fortran/class.c	(working copy)
@@ -218,6 +218,14 @@ gfc_add_component_ref (gfc_expr *e, const char *na
 	break;
       tail = &((*tail)->next);
     }
+  if (derived->components->next->ts.type == BT_DERIVED &&
+      derived->components->next->ts.u.derived == NULL)
+    {
+      /* Fix up missing vtype.  */
+      gfc_symbol *vtab = gfc_find_derived_vtab (derived->components->ts.u.derived);
+      gcc_assert (vtab);
+      derived->components->next->ts.u.derived = vtab->ts.u.derived;
+    }
   if (*tail != NULL && strcmp (name, "_data") == 0)
     next = *tail;
   (*tail) = gfc_get_ref();
@@ -543,7 +551,7 @@ gfc_intrinsic_hash_value (gfc_typespec *ts)
 
 bool
 gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr,
-			gfc_array_spec **as, bool delayed_vtab)
+			gfc_array_spec **as)
 {
   char name[GFC_MAX_SYMBOL_LEN+1], tname[GFC_MAX_SYMBOL_LEN+1];
   gfc_symbol *fclass;
@@ -637,16 +645,17 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_a
       if (!gfc_add_component (fclass, "_vptr", &c))
 	return false;
       c->ts.type = BT_DERIVED;
-      if (delayed_vtab
-	  || (ts->u.derived->f2k_derived
-	      && ts->u.derived->f2k_derived->finalizers))
-	c->ts.u.derived = NULL;
-      else
+
+      if (ts->u.derived->attr.unlimited_polymorphic)
 	{
 	  vtab = gfc_find_derived_vtab (ts->u.derived);
 	  gcc_assert (vtab);
 	  c->ts.u.derived = vtab->ts.u.derived;
 	}
+      else
+	/* Build vtab later.  */
+	c->ts.u.derived = NULL;
+
       c->attr.access = ACCESS_PRIVATE;
       c->attr.pointer = 1;
     }
@@ -790,7 +799,9 @@ has_finalizer_component (gfc_symbol *derived)
 static bool
 comp_is_finalizable (gfc_component *comp)
 {
-  if (comp->attr.allocatable && comp->ts.type != BT_CLASS)
+  if (comp->attr.proc_pointer)
+    return false;
+  else if (comp->attr.allocatable && comp->ts.type != BT_CLASS)
     return true;
   else if (comp->ts.type == BT_DERIVED && !comp->attr.pointer
 	   && (comp->ts.u.derived->attr.alloc_comp
Index: gcc/fortran/decl.c
===================================================================
--- gcc/fortran/decl.c	(revision 207846)
+++ gcc/fortran/decl.c	(working copy)
@@ -1199,7 +1199,7 @@ build_sym (const char *name, gfc_charlen *cl, bool
   sym->attr.implied_index = 0;
 
   if (sym->ts.type == BT_CLASS)
-    return gfc_build_class_symbol (&sym->ts, &sym->attr, &sym->as, false);
+    return gfc_build_class_symbol (&sym->ts, &sym->attr, &sym->as);
 
   return true;
 }
@@ -1656,10 +1656,7 @@ build_struct (const char *name, gfc_charlen *cl, g
 scalar:
   if (c->ts.type == BT_CLASS)
     {
-      bool delayed = (gfc_state_stack->sym == c->ts.u.derived)
-		     || (!c->ts.u.derived->components
-			 && !c->ts.u.derived->attr.zero_comp);
-      bool t2 = gfc_build_class_symbol (&c->ts, &c->attr, &c->as, delayed);
+      bool t2 = gfc_build_class_symbol (&c->ts, &c->attr, &c->as);
 
       if (t)
 	t = t2;
@@ -6340,7 +6337,7 @@ attr_decl1 (void)
     }
 
   if (sym->ts.type == BT_CLASS
-      && !gfc_build_class_symbol (&sym->ts, &sym->attr, &sym->as, false))
+      && !gfc_build_class_symbol (&sym->ts, &sym->attr, &sym->as))
     {
       m = MATCH_ERROR;
       goto cleanup;
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h	(revision 207846)
+++ gcc/fortran/gfortran.h	(working copy)
@@ -2988,7 +2988,7 @@ bool gfc_is_class_container_ref (gfc_expr *e);
 gfc_expr *gfc_class_initializer (gfc_typespec *, gfc_expr *);
 unsigned int gfc_hash_value (gfc_symbol *);
 bool gfc_build_class_symbol (gfc_typespec *, symbol_attribute *,
-				gfc_array_spec **, bool);
+			     gfc_array_spec **);
 gfc_symbol *gfc_find_derived_vtab (gfc_symbol *);
 gfc_symbol *gfc_find_vtab (gfc_typespec *);
 gfc_symtree* gfc_find_typebound_proc (gfc_symbol*, bool*,
Index: gcc/fortran/match.c
===================================================================
--- gcc/fortran/match.c	(revision 207846)
+++ gcc/fortran/match.c	(working copy)
@@ -5148,8 +5148,7 @@ copy_ts_from_selector_to_associate (gfc_expr *asso
       assoc_sym->ts.type = BT_CLASS;
       assoc_sym->ts.u.derived = CLASS_DATA (selector)->ts.u.derived;
       assoc_sym->attr.pointer = 1;
-      gfc_build_class_symbol (&assoc_sym->ts, &assoc_sym->attr,
-			      &assoc_sym->as, false);
+      gfc_build_class_symbol (&assoc_sym->ts, &assoc_sym->attr, &assoc_sym->as);
     }
 }
 
@@ -5273,7 +5272,7 @@ select_type_set_tmp (gfc_typespec *ts)
 
   if (ts->type == BT_CLASS)
     gfc_build_class_symbol (&tmp->n.sym->ts, &tmp->n.sym->attr,
-			    &tmp->n.sym->as, false);
+			    &tmp->n.sym->as);
     }
 
   /* Add an association for it, so the rest of the parser knows it is
Index: gcc/fortran/symbol.c
===================================================================
--- gcc/fortran/symbol.c	(revision 207846)
+++ gcc/fortran/symbol.c	(working copy)
@@ -262,7 +262,7 @@ gfc_set_default_type (gfc_symbol *sym, int error_f
   if (ts->type == BT_CHARACTER && ts->u.cl)
     sym->ts.u.cl = gfc_new_charlen (sym->ns, ts->u.cl);
   else if (ts->type == BT_CLASS
-	   && !gfc_build_class_symbol (&sym->ts, &sym->attr, &sym->as, false))
+	   && !gfc_build_class_symbol (&sym->ts, &sym->attr, &sym->as))
     return false;
 
   if (sym->attr.is_bind_c == 1 && gfc_option.warn_c_binding_type)
-------------- next part --------------
A non-text attachment was scrubbed...
Name: finalize_23.f90
Type: text/x-fortran
Size: 581 bytes
Desc: not available
URL: <http://gcc.gnu.org/pipermail/gcc-patches/attachments/20140220/ade6fffb/attachment.bin>


More information about the Gcc-patches mailing list