re PR fortran/43178 (Pointless resetting to NULL for local ALLOCATABLEs)

2010-04-06  Tobias Burnus  <burnus@net-b.de>

        PR fortran/43178
        * trans-array.c (gfc_conv_expr_descriptor): Update
        gfc_trans_scalar_assign call.
        (has_default_initializer): New function.
        (gfc_trans_deferred_array): Nullify less often.
        * trans-expr.c (gfc_conv_subref_array_arg,
        gfc_trans_subcomponent_assign): Update call to
        gfc_trans_scalar_assign.
        (gfc_trans_scalar_assign): Add parameter and pass it on.
        (gfc_trans_assignment_1): Optionally, do not dealloc before
        assignment.
        * trans-openmp.c (gfc_trans_omp_array_reduction): Update
        call to gfc_trans_scalar_assign.
        * trans-decl.c (gfc_get_symbol_decl): Do not always apply
        initializer to static variables.
        (gfc_init_default_dt): Add dealloc parameter and pass it on.
        * trans-stmt.c (forall_make_variable_temp,
        generate_loop_for_temp_to_lhs, generate_loop_for_rhs_to_temp,
        gfc_trans_forall_1, gfc_trans_where_assign, gfc_trans_where_3
        gfc_trans_allocate): Update gfc_trans_assignment call.
        * trans.h (gfc_trans_scalar_assign, gfc_init_default_dt,
        gfc_init_default_dt, gfc_trans_assignment): Add bool dealloc
        parameter to prototype.

2010-04-06  Tobias Burnus  <burnus@net-b.de>

        PR fortran/43178
        * gfortran.dg/alloc_comp_basics_1.f90: Update
        * scan-tree-dump-times.
        * gfortran.dg/alloc_comp_constructor_1.f90: Ditto.
        * gfortran.dg/auto_dealloc_1.f90: Ditto.

From-SVN: r157993

1 files changed, 31 insertions, 8 deletions

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index df2846e..75516ce 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -5214,7 +5214,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
 
       lse.string_length = rse.string_length;
       tmp = gfc_trans_scalar_assign (&lse, &rse, expr->ts, true,
-				     expr->expr_type == EXPR_VARIABLE);
+				     expr->expr_type == EXPR_VARIABLE, true);
       gfc_add_expr_to_block (&block, tmp);
 
       /* Finish the copying loops.  */
@@ -6176,6 +6176,25 @@ gfc_copy_only_alloc_comp (gfc_symbol * der_type, tree decl, tree dest, int rank)
 }
 
 
+/* Check for default initializer; sym->value is not enough as it is also
+   set for EXPR_NULL of allocatables.  */
+
+static bool
+has_default_initializer (gfc_symbol *der)
+{
+  gfc_component *c;
+
+  gcc_assert (der->attr.flavor == FL_DERIVED);
+  for (c = der->components; c; c = c->next)
+    if ((c->ts.type != BT_DERIVED && c->initializer)
+        || (c->ts.type == BT_DERIVED
+            && (!c->attr.pointer && has_default_initializer (c->ts.u.derived))))
+      break;
+
+  return c != NULL;
+}
+
+
 /* NULLIFY an allocatable/pointer array on function entry, free it on exit.
    Do likewise, recursively if necessary, with the allocatable components of
    derived types.  */
@@ -6236,17 +6255,21 @@ gfc_trans_deferred_array (gfc_symbol * sym, tree body)
 
   /* Get the descriptor type.  */
   type = TREE_TYPE (sym->backend_decl);
-    
+
   if (sym_has_alloc_comp && !(sym->attr.pointer || sym->attr.allocatable))
     {
-      if (!sym->attr.save)
+      if (!sym->attr.save
+	  && !(TREE_STATIC (sym->backend_decl) && sym->attr.is_main_program))
 	{
-	  rank = sym->as ? sym->as->rank : 0;
-	  tmp = gfc_nullify_alloc_comp (sym->ts.u.derived, descriptor, rank);
-	  gfc_add_expr_to_block (&fnblock, tmp);
-	  if (sym->value)
+	  if (sym->value == NULL || !has_default_initializer (sym->ts.u.derived))
+	    {
+	      rank = sym->as ? sym->as->rank : 0;
+	      tmp = gfc_nullify_alloc_comp (sym->ts.u.derived, descriptor, rank);
+	      gfc_add_expr_to_block (&fnblock, tmp);
+	    }
+	  else
 	    {
-	      tmp = gfc_init_default_dt (sym, NULL);
+	      tmp = gfc_init_default_dt (sym, NULL, false);
 	      gfc_add_expr_to_block (&fnblock, tmp);
 	    }
 	}