re PR fortran/45516 ([F08] allocatable compontents of recursive type)

2016-10-25  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/45516
	* class.c (gfc_find_derived_vtab): Detect recursive allocatable
	derived type components. If present, add '_deallocate' field to
	the vtable and build the '__deallocate' function.
	* decl.c (build_struct): Allow recursive allocatable derived
	type components for -std=f2008 or more.
	(gfc_match_data_decl): Accept these derived types.
	* expr.c (gfc_has_default_initializer): Ditto.
	* resolve.c (resolve_component): Make sure that the vtable is
	built for these derived types.
	* trans-array.c(structure_alloc_comps) : Use the '__deallocate'
	function for the automatic deallocation of these types.
	* trans-expr.c : Generate the deallocate accessor.
	* trans.h : Add its prototype.
	* trans-types.c (gfc_get_derived_type): Treat the recursive
	allocatable components in the same way as the corresponding
	pointer components.

2016-10-25  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/45516
	* gfortran.dg/class_2.f03: Set -std=f2003.
	* gfortran.dg/finalize_21.f90: Modify tree-dump.
	* gfortran.dg/recursive_alloc_comp_1.f08: New test.
	* gfortran.dg/recursive_alloc_comp_2.f08: New test.
	* gfortran.dg/recursive_alloc_comp_3.f08: New test.
	* gfortran.dg/recursive_alloc_comp_4.f08: New test.

From-SVN: r241539

1 files changed, 8 insertions, 7 deletions

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index b3acf1d..ed639a7 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -3249,7 +3249,7 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform,
   if (rvalue->is_boz && lvalue->ts.type != BT_INTEGER
       && lvalue->symtree->n.sym->attr.data
       && !gfc_notify_std (GFC_STD_GNU, "BOZ literal at %L used to "
-			  "initialize non-integer variable %qs", 
+			  "initialize non-integer variable %qs",
 			  &rvalue->where, lvalue->symtree->n.sym->name))
     return false;
   else if (rvalue->is_boz && !lvalue->symtree->n.sym->attr.data
@@ -3378,7 +3378,7 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue)
 	    }
 
 	  if (!gfc_notify_std (GFC_STD_F2003, "Bounds specification "
-			       "for %qs in pointer assignment at %L", 
+			       "for %qs in pointer assignment at %L",
 			       lvalue->symtree->n.sym->name, &lvalue->where))
 	    return false;
 
@@ -4144,6 +4144,7 @@ gfc_has_default_initializer (gfc_symbol *der)
     if (gfc_bt_struct (c->ts.type))
       {
         if (!c->attr.pointer && !c->attr.proc_pointer
+	     && !(c->attr.allocatable && der == c->ts.u.derived)
 	     && gfc_has_default_initializer (c->ts.u.derived))
 	  return true;
 	if (c->attr.pointer && c->initializer)
@@ -4196,7 +4197,7 @@ gfc_default_initializer (gfc_typespec *ts)
 }
 
 
-/* Get or generate an expression for a default initializer of a derived type. 
+/* Get or generate an expression for a default initializer of a derived type.
    If -finit-derived is specified, generate default initialization expressions
    for components that lack them when generate is set.  */
 
@@ -5318,13 +5319,13 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj,
 		{
 		  gfc_constructor *c, *n;
 		  gfc_expr *ec, *en;
-		  
+
 		  for (c = gfc_constructor_first (arr->value.constructor);
 		       c != NULL; c = gfc_constructor_next (c))
 		    {
 		      if (c == NULL || c->iterator != NULL)
 			continue;
-		      
+
 		      ec = c->expr;
 
 		      for (n = gfc_constructor_next (c); n != NULL;
@@ -5332,7 +5333,7 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj,
 			{
 			  if (n->iterator != NULL)
 			    continue;
-			  
+
 			  en = n->expr;
 			  if (gfc_dep_compare_expr (ec, en) == 0)
 			    {
@@ -5349,6 +5350,6 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj,
 		    }
 		}
 	    }
-  
+
   return true;
 }