aboutsummaryrefslogtreecommitdiffstats
path: root/gcc-4.9/gcc/fortran/resolve.c
diff options
context:
space:
mode:
Diffstat (limited to 'gcc-4.9/gcc/fortran/resolve.c')
-rw-r--r--gcc-4.9/gcc/fortran/resolve.c42
1 files changed, 36 insertions, 6 deletions
diff --git a/gcc-4.9/gcc/fortran/resolve.c b/gcc-4.9/gcc/fortran/resolve.c
index 6e23e570b..38755fef6 100644
--- a/gcc-4.9/gcc/fortran/resolve.c
+++ b/gcc-4.9/gcc/fortran/resolve.c
@@ -11200,15 +11200,36 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag)
the requirements of the standard for procedures used as finalizers. */
static bool
-gfc_resolve_finalizers (gfc_symbol* derived)
+gfc_resolve_finalizers (gfc_symbol* derived, bool *finalizable)
{
gfc_finalizer* list;
gfc_finalizer** prev_link; /* For removing wrong entries from the list. */
bool result = true;
bool seen_scalar = false;
+ gfc_symbol *vtab;
+ gfc_component *c;
+ /* Return early when not finalizable. Additionally, ensure that derived-type
+ components have a their finalizables resolved. */
if (!derived->f2k_derived || !derived->f2k_derived->finalizers)
- return true;
+ {
+ bool has_final = false;
+ for (c = derived->components; c; c = c->next)
+ if (c->ts.type == BT_DERIVED
+ && !c->attr.pointer && !c->attr.proc_pointer && !c->attr.allocatable)
+ {
+ bool has_final2 = false;
+ if (!gfc_resolve_finalizers (c->ts.u.derived, &has_final))
+ return false; /* Error. */
+ has_final = has_final || has_final2;
+ }
+ if (!has_final)
+ {
+ if (finalizable)
+ *finalizable = false;
+ return true;
+ }
+ }
/* Walk over the list of finalizer-procedures, check them, and if any one
does not fit in with the standard's definition, print an error and remove
@@ -11330,12 +11351,15 @@ gfc_resolve_finalizers (gfc_symbol* derived)
/* Remove wrong nodes immediately from the list so we don't risk any
troubles in the future when they might fail later expectations. */
error:
- result = false;
i = list;
*prev_link = list->next;
gfc_free_finalizer (i);
+ result = false;
}
+ if (result == false)
+ return false;
+
/* Warn if we haven't seen a scalar finalizer procedure (but we know there
were nodes in the list, must have been for arrays. It is surely a good
idea to have a scalar version there if there's something to finalize. */
@@ -11344,8 +11368,14 @@ error:
" defined at %L, suggest also scalar one",
derived->name, &derived->declared_at);
- gfc_find_derived_vtab (derived);
- return result;
+ vtab = gfc_find_derived_vtab (derived);
+ c = vtab->ts.u.derived->components->next->next->next->next->next;
+ gfc_set_sym_referenced (c->initializer->symtree->n.sym);
+
+ if (finalizable)
+ *finalizable = true;
+
+ return true;
}
@@ -12513,7 +12543,7 @@ resolve_fl_derived (gfc_symbol *sym)
return false;
/* Resolve the finalizer procedures. */
- if (!gfc_resolve_finalizers (sym))
+ if (!gfc_resolve_finalizers (sym, NULL))
return false;
if (sym->attr.is_class && sym->ts.u.derived == NULL)