allocate_with_source_14.f03: Fixed number mallocs occuring.

gcc/testsuite/ChangeLog:

2016-11-06  Andre Vehreschild  <vehre@gcc.gnu.org>

	* gfortran.dg/allocate_with_source_14.f03: Fixed number mallocs
	occuring.

gcc/fortran/ChangeLog:

2016-11-06  Andre Vehreschild  <vehre@gcc.gnu.org>

	* expr.c (is_non_empty_structure_constructor): New function to detect
	non-empty structure constructor.
	(gfc_has_default_initializer): Analyse initializers.
	* resolve.c (cond_init): Removed.
	(resolve_allocate_expr): Removed dead code.  Moved invariant code out
	of the loop over all objects to allocate.
	(resolve_allocate_deallocate): Added the invariant code remove from
	resolve_allocate_expr.
	* trans-array.c (gfc_array_allocate): Removed nullify of structure
	components in favour of doing this in gfc_trans_allocate for both
	scalars and arrays in the same place.
	* trans-expr.c (gfc_trans_init_assign): Always using _vptr->copy for
	class objects.
	* trans-stmt.c (allocate_get_initializer): Get the initializer
	expression for object allocated.
	(gfc_trans_allocate): Nullify a derived type only, when no SOURCE=
	or MOLD= is present preventing duplicate work.  Moved the creation
	of the init-expression here to prevent code for conditions that
	can not occur on freshly allocated object, like checking for the need
	to free allocatable components.

From-SVN: r241885

1 files changed, 48 insertions, 9 deletions

diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index c52066f..490b18d 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -5450,13 +5450,41 @@ gfc_trans_exit (gfc_code * code)
 }
 
 
+/* Get the initializer expression for the code and expr of an allocate.
+   When no initializer is needed return NULL.  */
+
+static gfc_expr *
+allocate_get_initializer (gfc_code * code, gfc_expr * expr)
+{
+  if (!gfc_bt_struct (expr->ts.type) && expr->ts.type != BT_CLASS)
+    return NULL;
+
+  /* An explicit type was given in allocate ( T:: object).  */
+  if (code->ext.alloc.ts.type == BT_DERIVED
+      && (code->ext.alloc.ts.u.derived->attr.alloc_comp
+	  || gfc_has_default_initializer (code->ext.alloc.ts.u.derived)))
+    return gfc_default_initializer (&code->ext.alloc.ts);
+
+  if (gfc_bt_struct (expr->ts.type)
+      && (expr->ts.u.derived->attr.alloc_comp
+	  || gfc_has_default_initializer (expr->ts.u.derived)))
+    return gfc_default_initializer (&expr->ts);
+
+  if (expr->ts.type == BT_CLASS
+      && (CLASS_DATA (expr)->ts.u.derived->attr.alloc_comp
+	  || gfc_has_default_initializer (CLASS_DATA (expr)->ts.u.derived)))
+    return gfc_default_initializer (&CLASS_DATA (expr)->ts);
+
+  return NULL;
+}
+
 /* Translate the ALLOCATE statement.  */
 
 tree
 gfc_trans_allocate (gfc_code * code)
 {
   gfc_alloc *al;
-  gfc_expr *expr, *e3rhs = NULL;
+  gfc_expr *expr, *e3rhs = NULL, *init_expr;
   gfc_se se, se_sz;
   tree tmp;
   tree parm;
@@ -6080,14 +6108,6 @@ gfc_trans_allocate (gfc_code * code)
 				      label_finish, expr, 0);
 	  else
 	    gfc_allocate_using_malloc (&se.pre, se.expr, memsz, stat);
-
-	  if (al->expr->ts.type == BT_DERIVED
-	      && expr->ts.u.derived->attr.alloc_comp)
-	    {
-	      tmp = build_fold_indirect_ref_loc (input_location, se.expr);
-	      tmp = gfc_nullify_alloc_comp (expr->ts.u.derived, tmp, 0);
-	      gfc_add_expr_to_block (&se.pre, tmp);
-	    }
 	}
       else
 	{
@@ -6217,6 +6237,8 @@ gfc_trans_allocate (gfc_code * code)
 			    fold_convert (TREE_TYPE (al_len),
 					  integer_zero_node));
 	}
+
+      init_expr = NULL;
       if (code->expr3 && !code->expr3->mold && e3_is != E3_MOLD)
 	{
 	  /* Initialization via SOURCE block (or static default initializer).
@@ -6246,6 +6268,23 @@ gfc_trans_allocate (gfc_code * code)
 	  gfc_free_statements (ini);
 	  gfc_add_expr_to_block (&block, tmp);
 	}
+      else if ((init_expr = allocate_get_initializer (code, expr)))
+	{
+	  /* Use class_init_assign to initialize expr.  */
+	  gfc_code *ini;
+	  int realloc_lhs = flag_realloc_lhs;
+	  ini = gfc_get_code (EXEC_INIT_ASSIGN);
+	  ini->expr1 = gfc_expr_to_initialize (expr);
+	  ini->expr2 = init_expr;
+	  flag_realloc_lhs = 0;
+	  tmp= gfc_trans_init_assign (ini);
+	  flag_realloc_lhs = realloc_lhs;
+	  gfc_free_statements (ini);
+	  /* Init_expr is freeed by above free_statements, just need to null
+	     it here.  */
+	  init_expr = NULL;
+	  gfc_add_expr_to_block (&block, tmp);
+	}
 
       gfc_free_expr (expr);
     } // for-loop