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 <ja...@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 <ja...@gcc.gnu.org>
PR fortran/60234
* gfortran.dg/finalize_23.f90: New.
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)
! { dg-do compile }
!
! PR 60234: [4.9 Regression] [OOP] ICE in generate_finalization_wrapper at fortran/class.c:1883
!
! Contribued by Antony Lewis <ant...@cosmologist.info>
module ObjectLists
implicit none
Type TObjectList
contains
FINAL :: finalize
end Type
Type, extends(TObjectList):: TRealCompareList
end Type
contains
subroutine finalize(L)
Type(TObjectList) :: L
end subroutine
integer function CompareReal(this)
Class(TRealCompareList) :: this
end function
end module
! { dg-final { cleanup-modules "ObjectLists" } }
