===================================================================
@@ -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
===================================================================
@@ -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;
===================================================================
@@ -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*,
===================================================================
@@ -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
===================================================================
@@ -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)