[Patch, Fortran] Enable the generation of the FINALization wrapper function

[Tobias Burnus <burnus at net-b dot de>]

Pre-remark: This patch does *not* enable finalization or polymorphic 
deallocation.

* * *

Dear all,

The attached patch is a bit boring and invasive, but it paves the way to 
FINAL support.

Changes of technical kind:

* Changed ABI for CLASS's virtual table (due to _final) - and, hence, it 
bumps the .mod version
* The finalization wrapper is now generated (this should not but might 
lead to ICEs)
* It also causes that the virtual table is now more often generated

New feature:

_copy no longer deallocates the "dst" argument. Doing so lead to bogus 
finalization with ALLOCATE (exposed with the pending FINAL patch). As a 
sideeffect, memset could be removed and CALLOC could be replased by 
MALLOC (minute performance advantage). In order to keep the deallocation 
in gfc_trans_class_array_init_assign, there is now a call to the 
finalization wrapper.

Next steps:
* Add end-of-scope/intent(out) deallocation for polymorphic arrays
* Enable FINAL parsing
* Stepwise enabling for polymorphic deallocation/finalization
* Fix issues with ELEMENTAL(+optional) with intent(out)
* Fix some issues related to intrinsic assignment
* Fix fallout of any of those items

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

Tobias

2013-05-22  Tobias Burnus  <burnus@net-b.de>

	* class.c (finalize_component): Fix coarray array refs.
	(gfc_find_derived_vtab): _copy's dst is now intent(inout).
	Enable finalization-wrapper generation.
	* module.c (MOD_VERSION): Bump.
	(gfc_dump_module, gfc_use_module): Remove empty line in .mod.
	* trans-array.c (gfc_conv_descriptor_token): Accept nonrestricted
	void pointer.
	(gfc_array_allocate, structure_alloc_comps): Don't nullify for
	BT_CLASS allocations.
	* trans-stmt.c (gfc_trans_allocate): Ditto.
	* trans-expr.c (gfc_trans_class_array_init_assign): Call _final
	before _copy.
	
2013-05-22  Tobias Burnus  <burnus@net-b.de>

	* gfortran.dg/auto_dealloc_2.f90: Update _free count in the dump.
	* gfortran.dg/class_19.f03: Ditto.

diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c
index 349f494..c41b95a 100644
--- a/gcc/fortran/class.c
+++ b/gcc/fortran/class.c
@@ -832,17 +832,18 @@ finalize_component (gfc_expr *expr, gfc_symbol *derived, gfc_component *comp,
   ref->u.c.component = comp;
   e->ts = comp->ts;
 
-  if (comp->attr.dimension
+  if (comp->attr.dimension || comp->attr.codimension
       || (comp->ts.type == BT_CLASS && CLASS_DATA (comp)
-	  && CLASS_DATA (comp)->attr.dimension))
+	  && (CLASS_DATA (comp)->attr.dimension
+	      || CLASS_DATA (comp)->attr.codimension)))
     {
       ref->next = gfc_get_ref ();
       ref->next->type = REF_ARRAY;
-      ref->next->u.ar.type = AR_FULL;
       ref->next->u.ar.dimen = 0;
       ref->next->u.ar.as = comp->ts.type == BT_CLASS ? CLASS_DATA (comp)->as
 							: comp->as;
       e->rank = ref->next->u.ar.as->rank;
+      ref->next->u.ar.type = e->rank ? AR_FULL : AR_ELEMENT;
     }
 
   /* Call DEALLOCATE (comp, stat=ignore).  */
@@ -2363,7 +2364,7 @@ gfc_find_derived_vtab (gfc_symbol *derived)
 		  dst->attr.flavor = FL_VARIABLE;
 		  dst->attr.dummy = 1;
 		  dst->attr.artificial = 1;
-		  dst->attr.intent = INTENT_OUT;
+		  dst->attr.intent = INTENT_INOUT;
 		  gfc_set_sym_referenced (dst);
 		  copy->formal->next = gfc_get_formal_arglist ();
 		  copy->formal->next->sym = dst;
@@ -2382,9 +2383,6 @@ gfc_find_derived_vtab (gfc_symbol *derived)
 		 components and the calls to finalization subroutines.
 		 Note: The actual wrapper function can only be generated
 		 at resolution time.  */
-	    /* FIXME: Enable ABI-breaking "_final" generation.  */
-	    if (0)
-	    {
 	      if (!gfc_add_component (vtype, "_final", &c))
 		goto cleanup;
 	      c->attr.proc_pointer = 1;
@@ -2392,7 +2390,6 @@ gfc_find_derived_vtab (gfc_symbol *derived)
 	      c->tb = XCNEW (gfc_typebound_proc);
 	      c->tb->ppc = 1;
 	      generate_finalization_wrapper (derived, ns, tname, c);
-	    }
 
 	      /* Add procedure pointers for type-bound procedures.  */
 	      if (!derived->attr.unlimited_polymorphic)
@@ -2651,7 +2648,7 @@ gfc_find_intrinsic_vtab (gfc_typespec *ts)
 	      dst->ts.kind = ts->kind;
 	      dst->attr.flavor = FL_VARIABLE;
 	      dst->attr.dummy = 1;
-	      dst->attr.intent = INTENT_OUT;
+	      dst->attr.intent = INTENT_INOUT;
 	      gfc_set_sym_referenced (dst);
 	      copy->formal->next = gfc_get_formal_arglist ();
 	      copy->formal->next->sym = dst;
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index e6a4cd7..9486b28 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -80,10 +80,8 @@ along with GCC; see the file COPYING3.  If not see
 #define MODULE_EXTENSION ".mod"
 
 /* Don't put any single quote (') in MOD_VERSION, if you want it to be
-   recognized.  
-   TODO: When the version is bumped, remove the extra empty line at
-   the beginning of module files.  */
-#define MOD_VERSION "10"
+   recognized.  */
+#define MOD_VERSION "11"
 
 
 /* Structure that describes a position within a module file.  */
@@ -5571,7 +5569,7 @@ gfc_dump_module (const char *name, int dump_flag)
      FIXME: For backwards compatibility with the old uncompressed
      module format, write an extra empty line. When the module version
      is bumped, this can be removed.  */
-  gzprintf (module_fp, "GFORTRAN module version '%s' created from %s\n\n",
+  gzprintf (module_fp, "GFORTRAN module version '%s' created from %s\n",
 	    MOD_VERSION, gfc_source_file);
 
 
@@ -6364,10 +6362,10 @@ gfc_use_module (gfc_use_list *module)
   read_module_to_tmpbuf ();
   gzclose (module_fp);
 
-  /* Skip the first two lines of the module, after checking that this is
+  /* Skip the first line of the module, after checking that this is
      a gfortran module file.  */
   line = 0;
-  while (line < 2)
+  while (line < 1)
     {
       c = module_char ();
       if (c == EOF)
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 6cb85d4..be3a5a0 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -300,7 +300,11 @@ gfc_conv_descriptor_token (tree desc)
   gcc_assert (GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ALLOCATABLE);
   gcc_assert (gfc_option.coarray == GFC_FCOARRAY_LIB);
   field = gfc_advance_chain (TYPE_FIELDS (type), CAF_TOKEN_FIELD);
-  gcc_assert (field != NULL_TREE && TREE_TYPE (field) == prvoid_type_node);
+
+  /* Should be a restricted pointer - except in the finalization wrapper.  */
+  gcc_assert (field != NULL_TREE
+	      && (TREE_TYPE (field) == prvoid_type_node
+		  || TREE_TYPE (field) == pvoid_type_node));
 
   return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field),
 			  desc, field, NULL_TREE);
@@ -5222,18 +5226,6 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg,
 
   gfc_add_expr_to_block (&se->pre, tmp);
 
-  if (expr->ts.type == BT_CLASS)
-    {
-      tmp = build_int_cst (unsigned_char_type_node, 0);
-      /* With class objects, it is best to play safe and null the
-	 memory because we cannot know if dynamic types have allocatable
-	 components or not.  */
-      tmp = build_call_expr_loc (input_location,
-				 builtin_decl_explicit (BUILT_IN_MEMSET),
-				 3, pointer, tmp,  size);
-      gfc_add_expr_to_block (&se->pre, tmp);
-    }
-
   /* Update the array descriptors. */
   if (dimension)
     gfc_conv_descriptor_offset_set (&set_descriptor_block, se->expr, offset);
@@ -7699,6 +7691,10 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
 		{
 		  nelems = gfc_conv_descriptor_size (src_data,
 						     CLASS_DATA (c)->as->rank);
+		  size = fold_build2_loc (input_location, MULT_EXPR,
+					  size_type_node, size,
+					  fold_convert (size_type_node,
+							nelems));
 		  src_data = gfc_conv_descriptor_data_get (src_data);
 		  dst_data = gfc_conv_descriptor_data_get (dst_data);
 		}
@@ -7707,11 +7703,8 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
 
 	      gfc_init_block (&tmpblock);
 
-	      /* We need to use CALLOC as _copy might try to free allocatable
-		 components of the destination.  */
-	      ftn_tree = builtin_decl_explicit (BUILT_IN_CALLOC);
-              tmp = build_call_expr_loc (input_location, ftn_tree, 2, nelems,
-					 size);
+	      ftn_tree = builtin_decl_explicit (BUILT_IN_MALLOC);
+	      tmp = build_call_expr_loc (input_location, ftn_tree, 1, size);
 	      gfc_add_modify (&tmpblock, dst_data,
 			      fold_convert (TREE_TYPE (dst_data), tmp));
 
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index de851a2..f8d99fd 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -835,10 +835,24 @@ static tree
 gfc_trans_class_array_init_assign (gfc_expr *rhs, gfc_expr *lhs, gfc_expr *obj)
 {
   gfc_actual_arglist *actual;
+  gfc_expr *final_expr;
+  gfc_expr *vptr_size;
   gfc_expr *ppc;
   gfc_code *ppc_code;
   tree res;
 
+  final_expr = gfc_copy_expr (obj);
+  gfc_add_vptr_component (final_expr);
+  gfc_add_component_ref (final_expr, "_final");
+
+  vptr_size = gfc_copy_expr (obj);
+  gfc_add_vptr_component (vptr_size);
+  gfc_add_component_ref (vptr_size, "_size");
+
+  gfc_build_final_call (obj->ts, final_expr, obj, false, vptr_size);
+  gfc_free_expr (final_expr);
+  gfc_free_expr (vptr_size);
+
   actual = gfc_get_actual_arglist ();
   actual->expr = gfc_copy_expr (rhs);
   actual->next = gfc_get_actual_arglist ();
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 1b65f2c..6c5f557 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -5071,16 +5071,6 @@ gfc_trans_allocate (gfc_code * code)
 	      tmp = gfc_nullify_alloc_comp (expr->ts.u.derived, tmp, 0);
 	      gfc_add_expr_to_block (&se.pre, tmp);
 	    }
-	  else if (al->expr->ts.type == BT_CLASS)
-	    {
-	      /* With class objects, it is best to play safe and null the
-		 memory because we cannot know if dynamic types have allocatable
-		 components or not.  */
-	      tmp = build_call_expr_loc (input_location,
-					 builtin_decl_explicit (BUILT_IN_MEMSET),
-					 3, se.expr, integer_zero_node,  memsz);
-	      gfc_add_expr_to_block (&se.pre, tmp);
-	    }
 	}
 
       gfc_add_block_to_block (&block, &se.pre);
diff --git a/gcc/testsuite/gfortran.dg/auto_dealloc_2.f90 b/gcc/testsuite/gfortran.dg/auto_dealloc_2.f90
index e607b6a..d261973 100644
--- a/gcc/testsuite/gfortran.dg/auto_dealloc_2.f90
+++ b/gcc/testsuite/gfortran.dg/auto_dealloc_2.f90
@@ -25,5 +25,5 @@ contains
 
 end program 
 
-! { dg-final { scan-tree-dump-times "__builtin_free" 3 "original" } }
+! { dg-final { scan-tree-dump-times "__builtin_free" 5 "original" } }
 ! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/class_19.f03 b/gcc/testsuite/gfortran.dg/class_19.f03
index 63b8e06..6dcd99c 100644
--- a/gcc/testsuite/gfortran.dg/class_19.f03
+++ b/gcc/testsuite/gfortran.dg/class_19.f03
@@ -39,5 +39,5 @@ program main
 
 end program main
 
-! { dg-final { scan-tree-dump-times "__builtin_free" 11 "original" } }
+! { dg-final { scan-tree-dump-times "__builtin_free" 15 "original" } }
 ! { dg-final { cleanup-tree-dump "original" } }