re PR fortran/37336 ([F03] Finish derived-type finalization)

2012-12-03  Tobias Burnus  <burnus@net-b.de>
            Janus Weil  <janus@gcc.gnu.org>

        PR fortran/37336
        * class.c (gfc_is_finalizable): New function.
        * gfortran.h (gfc_is_finalizable): Its prototype.
        * module.c (mio_component): Read initializer for vtype's _final.
        * resolve.c (resolve_fl_derived0): Call gfc_is_finalizable.
        * trans-expr.c (gfc_vtable_final_get): New function.
        (conv_parent_component_references): Fix comment.
        (gfc_conv_variable): Fix for scalar coarray components.
        * trans-intrinsic.c (conv_intrinsic_move_alloc): For BT_CLASS,
        pass the BT_CLASS type and not the declared type to
        gfc_deallocate_scalar_with_status.
        * trans.h (gfc_vtable_final_get): New prototype.


Co-Authored-By: Janus Weil <janus@gcc.gnu.org>

From-SVN: r194104

1 files changed, 42 insertions, 0 deletions

diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c
index 1271300..8a8a54a 100644
--- a/gcc/fortran/class.c
+++ b/gcc/fortran/class.c
@@ -2013,6 +2013,48 @@ cleanup:
 }
 
 
+/* Check if a derived type is finalizable. That is the case if it
+   (1) has a FINAL subroutine or
+   (2) has a nonpointer nonallocatable component of finalizable type.
+   If it is finalizable, return an expression containing the
+   finalization wrapper.  */
+
+bool
+gfc_is_finalizable (gfc_symbol *derived, gfc_expr **final_expr)
+{
+  gfc_symbol *vtab;
+  gfc_component *c;
+
+  /* (1) Check for FINAL subroutines.  */
+  if (derived->f2k_derived && derived->f2k_derived->finalizers)
+    goto yes;
+
+  /* (2) Check for components of finalizable type.  */
+  for (c = derived->components; c; c = c->next)
+    if (c->ts.type == BT_DERIVED
+	&& !c->attr.pointer && !c->attr.proc_pointer && !c->attr.allocatable
+	&& gfc_is_finalizable (c->ts.u.derived, NULL))
+      goto yes;
+
+  return false;
+
+yes:
+  /* Make sure vtab is generated.  */
+  vtab = gfc_find_derived_vtab (derived);
+  if (final_expr)
+    {
+      /* Return finalizer expression.  */
+      gfc_component *final;
+      final = vtab->ts.u.derived->components->next->next->next->next->next;
+      gcc_assert (strcmp (final->name, "_final") == 0);
+      gcc_assert (final->initializer
+		  && final->initializer->expr_type != EXPR_NULL);
+      *final_expr = final->initializer;
+    }
+  return true;
+}
+
+
 /* General worker function to find either a type-bound procedure or a
    type-bound user operator.  */