Patchwork [Fortran] Auxiliary functions/fixes for FINAL

login
register
mail settings
Submitter Tobias Burnus
Date Dec. 3, 2012, 3:54 p.m.
Message ID <50BCCB4F.7000100@net-b.de>
Download mbox | patch
Permalink /patch/203387/
State New
Headers show

Comments

Tobias Burnus - Dec. 3, 2012, 3:54 p.m.
Dear all,

this patch adds some auxiliary functions for FINAL - and it fixes some 
issues which mainly occur with FINAL.

Build and regtested on x86-64-gnu-linux.
OK for the trunk?

Tobias
Paul Richard Thomas - Dec. 3, 2012, 9:04 p.m.
OK for trunk.

I think that Janus approved the other patch that we talked about last
night, did he not?

Spent evening fixing unlimited polymorphic bugs - all of them
associated with character targets!

Cheers

Paul

On 3 December 2012 16:54, Tobias Burnus <burnus@net-b.de> wrote:
> Dear all,
>
> this patch adds some auxiliary functions for FINAL - and it fixes some
> issues which mainly occur with FINAL.
>
> Build and regtested on x86-64-gnu-linux.
> OK for the trunk?
>
> Tobias

Patch

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.

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.  */
 
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 4942c1c..bf767b2 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2951,6 +2951,7 @@  void gfc_add_class_array_ref (gfc_expr *);
 #define gfc_add_hash_component(e)     gfc_add_component_ref(e,"_hash")
 #define gfc_add_size_component(e)     gfc_add_component_ref(e,"_size")
 #define gfc_add_def_init_component(e) gfc_add_component_ref(e,"_def_init")
+#define gfc_add_final_component(e)    gfc_add_component_ref(e,"_final")
 bool gfc_is_class_array_ref (gfc_expr *, bool *);
 bool gfc_is_class_scalar_expr (gfc_expr *);
 bool gfc_is_class_container_ref (gfc_expr *e);
@@ -2967,6 +2968,7 @@  gfc_typebound_proc* gfc_find_typebound_intrinsic_op (gfc_symbol*, gfc_try*,
 						     gfc_intrinsic_op, bool,
 						     locus*);
 gfc_symtree* gfc_get_tbp_symtree (gfc_symtree**, const char*);
+bool gfc_is_finalizable (gfc_symbol *, gfc_expr **);
 
 #define CLASS_DATA(sym) sym->ts.u.derived->components
 
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index 89c45b7..16ea97b 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -2597,7 +2597,7 @@  mio_component (gfc_component *c, int vtype)
     c->attr.class_ok = 1;
   c->attr.access = MIO_NAME (gfc_access) (c->attr.access, access_types); 
 
-  if (!vtype)
+  if (!vtype || strcmp (c->name, "_final") == 0)
     mio_expr (&c->initializer);
 
   if (c->attr.proc_pointer)
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 7d434dd..69646de 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -12814,6 +12814,10 @@  resolve_fl_derived0 (gfc_symbol *sym)
   /* Add derived type to the derived type list.  */
   add_dt_to_dt_list (sym);
 
+  /* Check if the type is finalizable. This is done in order to ensure that the
+     finalization wrapper is generated early enough.  */
+  gfc_is_finalizable (sym, NULL);
+
   return SUCCESS;
 }
 
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index d6410d3..42f6e0c 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -95,6 +95,7 @@  conv_scalar_to_descriptor (gfc_se *se, tree scalar, symbol_attribute attr)
 #define VTABLE_EXTENDS_FIELD 2
 #define VTABLE_DEF_INIT_FIELD 3
 #define VTABLE_COPY_FIELD 4
+#define VTABLE_FINAL_FIELD 5
 
 
 tree
@@ -180,6 +181,13 @@  gfc_vtable_copy_get (tree decl)
 }
 
 
+tree
+gfc_vtable_final_get (tree decl)
+{
+  return gfc_vtable_field_get (decl, VTABLE_FINAL_FIELD);
+}
+
+
 #undef CLASS_DATA_FIELD
 #undef CLASS_VPTR_FIELD
 #undef VTABLE_HASH_FIELD
@@ -187,6 +195,7 @@  gfc_vtable_copy_get (tree decl)
 #undef VTABLE_EXTENDS_FIELD
 #undef VTABLE_DEF_INIT_FIELD
 #undef VTABLE_COPY_FIELD
+#undef VTABLE_FINAL_FIELD
 
 
 /* Obtain the vptr of the last class reference in an expression.  */
@@ -1510,7 +1519,7 @@  conv_parent_component_references (gfc_se * se, gfc_ref * ref)
   dt = ref->u.c.sym;
   c = ref->u.c.component;
 
-  /* Return if the component is not in the parent type.  */
+  /* Return if the component is in the parent type.  */
   for (cmp = dt->components; cmp; cmp = cmp->next)
     if (strcmp (c->name, cmp->name) == 0)
       return;
@@ -1714,6 +1723,9 @@  gfc_conv_variable (gfc_se * se, gfc_expr * expr)
 	    conv_parent_component_references (se, ref);
 
 	  gfc_conv_component_ref (se, ref);
+	  if (!ref->next && ref->u.c.sym->attr.codimension
+	      && se->want_pointer && se->descriptor_only)
+	    return;
 
 	  break;
 
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index e9eb307..504a9f3 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -7321,7 +7321,7 @@  conv_intrinsic_move_alloc (gfc_code *code)
 
       /* Deallocate "to".  */
       tmp = gfc_deallocate_scalar_with_status (to_se.expr, NULL_TREE, true,
-					       to_expr2, to_expr->ts);
+					       to_expr, to_expr->ts);
       gfc_add_expr_to_block (&block, tmp);
 
       /* Assign (_data) pointers.  */
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 954dcd3..1779575 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -348,6 +348,7 @@  tree gfc_vtable_size_get (tree);
 tree gfc_vtable_extends_get (tree);
 tree gfc_vtable_def_init_get (tree);
 tree gfc_vtable_copy_get (tree);
+tree gfc_vtable_final_get (tree);
 tree gfc_get_vptr_from_expr (tree);
 tree gfc_get_class_array_ref (tree, tree);
 tree gfc_copy_class_to_class (tree, tree, tree);