diff mbox

[Fortran,v1] Restructure initialization of allocatable components

Message ID 20161106171241.36f37d07@vepi2
State New
Headers show

Commit Message

Andre Vehreschild Nov. 6, 2016, 4:12 p.m. UTC
Hi Steve, hi Paul, hi Dominique, hi all,

thanks for the reviews, Steve and Paul, thanks for the heavy testing, Dominique.
Committed as r241885.

Regards,
	Andre
On Sat, 5 Nov 2016 10:46:46 +0100
Paul Richard Thomas <paul.richard.thomas@gmail.com> wrote:

> Dear Andre,

> 

> The patch looks fine to me. OK for trunk.

> 

> Cheers

> 

> Paul

> 

> On 4 November 2016 at 01:57, Steve Kargl

> <sgk@troutmask.apl.washington.edu> wrote:

> > On Thu, Nov 03, 2016 at 02:16:48PM +0100, Andre Vehreschild wrote:  

> >>

> >> Bootstraps and regtests fine on x86_64-linux/F23. Ok for trunk?

> >>

> >> @Dominique: Would you give it a go on your open patch collection? Maybe it

> >> fixes one PR, but I am not very hopeful, because the patch is merely

> >> removing complexity instead of doing new things.

> >>  

> >

> > Andre,

> >

> > I did not see anything that looked dubious.  I think

> > it is OK to commit, but you may want to see if Paul

> > has any comment.

> >

> > --

> > Steve  

> 

> 

> 



-- 
Andre Vehreschild * Email: vehre ad gmx dot de
diff mbox

Patch

Index: gcc/fortran/ChangeLog
===================================================================
--- gcc/fortran/ChangeLog	(Revision 241884)
+++ gcc/fortran/ChangeLog	(Arbeitskopie)
@@ -1,3 +1,26 @@ 
+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.
+
 2016-11-06  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
 	PR fortran/78221
Index: gcc/fortran/expr.c
===================================================================
--- gcc/fortran/expr.c	(Revision 241884)
+++ gcc/fortran/expr.c	(Arbeitskopie)
@@ -4131,6 +4131,26 @@ 
 }
 
 
+/* Check whether an expression is a structure constructor and whether it has
+   other values than NULL.  */
+
+bool
+is_non_empty_structure_constructor (gfc_expr * e)
+{
+  if (e->expr_type != EXPR_STRUCTURE)
+    return false;
+
+  gfc_constructor *cons = gfc_constructor_first (e->value.constructor);
+  while (cons)
+    {
+      if (!cons->expr || cons->expr->expr_type != EXPR_NULL)
+	return true;
+      cons = gfc_constructor_next (cons);
+    }
+  return false;
+}
+
+
 /* Check for default initializer; sym->value is not enough
    as it is also set for EXPR_NULL of allocatables.  */
 
@@ -4145,7 +4165,9 @@ 
       {
         if (!c->attr.pointer && !c->attr.proc_pointer
 	     && !(c->attr.allocatable && der == c->ts.u.derived)
-	     && gfc_has_default_initializer (c->ts.u.derived))
+	     && ((c->initializer
+		  && is_non_empty_structure_constructor (c->initializer))
+		 || gfc_has_default_initializer (c->ts.u.derived)))
 	  return true;
 	if (c->attr.pointer && c->initializer)
 	  return true;
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(Revision 241884)
+++ gcc/fortran/resolve.c	(Arbeitskopie)
@@ -7048,36 +7048,7 @@ 
   return true;
 }
 
-static void
-cond_init (gfc_code *code, gfc_expr *e, int pointer, gfc_expr *init_e)
-{
-  gfc_code *block;
-  gfc_expr *cond;
-  gfc_code *init_st;
-  gfc_expr *e_to_init = gfc_expr_to_initialize (e);
 
-  cond = pointer
-    ? gfc_build_intrinsic_call (gfc_current_ns, GFC_ISYM_ASSOCIATED,
-	"associated", code->loc, 2, gfc_copy_expr (e_to_init), NULL)
-    : gfc_build_intrinsic_call (gfc_current_ns, GFC_ISYM_ALLOCATED,
-	"allocated", code->loc, 1, gfc_copy_expr (e_to_init));
-
-  init_st = gfc_get_code (EXEC_INIT_ASSIGN);
-  init_st->loc = code->loc;
-  init_st->expr1 = e_to_init;
-  init_st->expr2 = init_e;
-
-  block = gfc_get_code (EXEC_IF);
-  block->loc = code->loc;
-  block->block = gfc_get_code (EXEC_IF);
-  block->block->loc = code->loc;
-  block->block->expr1 = cond;
-  block->block->next = init_st;
-  block->next = code->next;
-
-  code->next = block;
-}
-
 /* Resolve the expression in an ALLOCATE statement, doing the additional
    checks to see whether the expression is OK or not.  The expression must
    have a trailing array reference that gives the size of the array.  */
@@ -7327,35 +7298,7 @@ 
       /* We have to zero initialize the integer variable.  */
       code->expr3 = gfc_get_int_expr (gfc_default_integer_kind, &e->where, 0);
     }
-  else if (!code->expr3)
-    {
-      /* Set up default initializer if needed.  */
-      gfc_typespec ts;
-      gfc_expr *init_e;
 
-      if (gfc_bt_struct (code->ext.alloc.ts.type))
-	ts = code->ext.alloc.ts;
-      else
-	ts = e->ts;
-
-      if (ts.type == BT_CLASS)
-	ts = ts.u.derived->components->ts;
-
-      if (gfc_bt_struct (ts.type) && (init_e = gfc_default_initializer (&ts)))
-	cond_init (code, e, pointer, init_e);
-    }
-  else if (code->expr3->mold && code->expr3->ts.type == BT_DERIVED)
-    {
-      /* Default initialization via MOLD (non-polymorphic).  */
-      gfc_expr *rhs = gfc_default_initializer (&code->expr3->ts);
-      if (rhs != NULL)
-	{
-	  gfc_resolve_expr (rhs);
-	  gfc_free_expr (code->expr3);
-	  code->expr3 = rhs;
-	}
-    }
-
   if (e->ts.type == BT_CLASS && !unlimited && !UNLIMITED_POLY (code->expr3))
     {
       /* Make sure the vtab symbol is present when
@@ -7366,10 +7309,9 @@ 
       else if (code->ext.alloc.ts.type == BT_DERIVED)
 	ts = code->ext.alloc.ts;
 
+      /* Finding the vtab also publishes the type's symbol.  Therefore this
+	 statement is necessary.  */
       gfc_find_derived_vtab (ts.u.derived);
-
-      if (dimension)
-	e = gfc_expr_to_initialize (e);
     }
   else if (unlimited && !UNLIMITED_POLY (code->expr3))
     {
@@ -7383,10 +7325,9 @@ 
 
       gcc_assert (ts);
 
+      /* Finding the vtab also publishes the type's symbol.  Therefore this
+	 statement is necessary.  */
       gfc_find_vtab (ts);
-
-      if (dimension)
-	e = gfc_expr_to_initialize (e);
     }
 
   if (dimension == 0 && codimension == 0)
@@ -7690,6 +7631,22 @@ 
   if (strcmp (fcn, "ALLOCATE") == 0)
     {
       bool arr_alloc_wo_spec = false;
+
+      /* Resolving the expr3 in the loop over all objects to allocate would
+	 execute loop invariant code for each loop item.  Therefore do it just
+	 once here.  */
+      if (code->expr3 && code->expr3->mold
+	  && code->expr3->ts.type == BT_DERIVED)
+	{
+	  /* Default initialization via MOLD (non-polymorphic).  */
+	  gfc_expr *rhs = gfc_default_initializer (&code->expr3->ts);
+	  if (rhs != NULL)
+	    {
+	      gfc_resolve_expr (rhs);
+	      gfc_free_expr (code->expr3);
+	      code->expr3 = rhs;
+	    }
+	}
       for (a = code->ext.alloc.list; a; a = a->next)
 	resolve_allocate_expr (a->expr, code, &arr_alloc_wo_spec);
 
Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c	(Revision 241884)
+++ gcc/fortran/trans-expr.c	(Arbeitskopie)
@@ -10042,7 +10042,7 @@ 
 tree
 gfc_trans_init_assign (gfc_code * code)
 {
-  return gfc_trans_assignment (code->expr1, code->expr2, true, false);
+  return gfc_trans_assignment (code->expr1, code->expr2, true, false, true);
 }
 
 tree
Index: gcc/fortran/trans-array.c
===================================================================
--- gcc/fortran/trans-array.c	(Revision 241884)
+++ gcc/fortran/trans-array.c	(Arbeitskopie)
@@ -5623,14 +5623,6 @@ 
   else
       gfc_add_expr_to_block (&se->pre, set_descriptor);
 
-  if (expr->ts.type == BT_DERIVED && expr->ts.u.derived->attr.alloc_comp
-      && !coarray)
-    {
-      tmp = gfc_nullify_alloc_comp (expr->ts.u.derived, se->expr,
-				    ref->u.ar.as->rank);
-      gfc_add_expr_to_block (&se->pre, tmp);
-    }
-
   return true;
 }
 
Index: gcc/fortran/trans-stmt.c
===================================================================
--- gcc/fortran/trans-stmt.c	(Revision 241884)
+++ gcc/fortran/trans-stmt.c	(Arbeitskopie)
@@ -5450,6 +5450,34 @@ 
 }
 
 
+/* 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
@@ -5456,7 +5484,7 @@ 
 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 @@ 
 				      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 @@ 
 			    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_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
Index: gcc/testsuite/gfortran.dg/allocate_with_source_14.f03
===================================================================
--- gcc/testsuite/gfortran.dg/allocate_with_source_14.f03	(Revision 241884)
+++ gcc/testsuite/gfortran.dg/allocate_with_source_14.f03	(Arbeitskopie)
@@ -210,5 +210,5 @@ 
   call v%free()
   deallocate(av)
 end program
-! { dg-final { scan-tree-dump-times "__builtin_malloc" 23 "original" } }
+! { dg-final { scan-tree-dump-times "__builtin_malloc" 22 "original" } }
 ! { dg-final { scan-tree-dump-times "__builtin_free" 29 "original" } }
Index: gcc/testsuite/ChangeLog
===================================================================
--- gcc/testsuite/ChangeLog	(Revision 241884)
+++ gcc/testsuite/ChangeLog	(Arbeitskopie)
@@ -1,3 +1,8 @@ 
+2016-11-06  Andre Vehreschild  <vehre@gcc.gnu.org>
+
+	* gfortran.dg/allocate_with_source_14.f03: Fixed number mallocs
+	occuring.
+
 2016-11-06  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
 	PR fortran/78221