Re: [Patch, fortran, pr65894, v1] [6 Regression] severe regression in gfortran 6.0.0

[Mikael Morin <mikael dot morin at sfr dot fr>]

Le 07/05/2015 11:52, Andre Vehreschild a Ãcrit :
> Hi all,
> 
> my work on pr60322 caused a regression on trunk. This patch fixes it. The
> regression had two causes:
> 1. Not taking the correct attribute for BT_CLASS objects with allocatable
>    components into account (chunk 1), and
> 2. taking the address of an address (chunk 2). When a class or derived typed
>    scalar object is to be returned as a reference and a scalarizer is present,
>    then the address of the address of the object was returned. The former code
>    was meant to return the address of an array element for which taking the
>    address was ok. The patch now prevents taking the additional address when
>    the object is scalar.
> 
Hello,

The "chunk 2" fix should go in gfc_conv_expr, so that
gfc_add_loop_ss_code's "can_be_null_ref" condition matches the one in
gfc_conv_expr.  Both functions work together, if references are
generated in gfc_add_loop_ss_code, they should be used as reference in
gfc_conv_expr.  Same if values are generated.

About the condition of the first chunk, I don't understand what it's
good for.

So I propose the attached patch instead.
It creates a new function to decide between reference and value, so that
gfc_add_loop_ss_code and gfc_conv_expr are kept in sync.
As the new function needs information about the dummy argument, the
dummy symbol is saved to a new field in gfc_ss_info.
And the "chunk 1" condition is reverted to its previous state.
The testcase is yours.

regression tested on x86_64-unknown-linux-gnu.  OK for trunk?

Mikael

Attachment: pr65894_v2.CL
Description: Text document

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index a17f431..fb9cbc4 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -2427,6 +2427,41 @@ set_vector_loop_bounds (gfc_ss * ss)
 }
 
 
+/* Tells whether a scalar argument to an elemental procedure is saved out
+   of a scalarization loop as a value or as a reference.  */
+
+bool
+gfc_scalar_elemental_arg_saved_as_reference (gfc_ss_info * ss_info)
+{
+  if (ss_info->type != GFC_SS_REFERENCE)
+    return false;
+
+  /* If the actual argument can be absent (in other words, it can
+     be a NULL reference), don't try to evaluate it; pass instead
+     the reference directly.  */
+  if (ss_info->can_be_null_ref)
+    return true;
+
+  /* If the expression is of polymorphic type, it's actual size is not known,
+     so we avoid copying it anywhere.  */
+  if (ss_info->data.scalar.dummy_arg
+      && ss_info->data.scalar.dummy_arg->ts.type == BT_CLASS
+      && ss_info->expr->ts.type == BT_CLASS)
+    return true;
+
+  /* If the expression is a data reference of aggregate type,
+     avoid a copy by saving a reference to the content.  */
+  if (ss_info->expr->expr_type == EXPR_VARIABLE
+      && (ss_info->expr->ts.type == BT_DERIVED
+	  || ss_info->expr->ts.type == BT_CLASS))
+    return true;
+
+  /* Otherwise the expression is evaluated to a temporary variable before the
+     scalarization loop.  */
+  return false;
+}
+
+
 /* Add the pre and post chains for all the scalar expressions in a SS chain
    to loop.  This is called after the loop parameters have been calculated,
    but before the actual scalarizing loops.  */
@@ -2495,19 +2530,11 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
 	case GFC_SS_REFERENCE:
 	  /* Scalar argument to elemental procedure.  */
 	  gfc_init_se (&se, NULL);
-	  if (ss_info->can_be_null_ref || (expr->symtree
-			     && (expr->symtree->n.sym->ts.type == BT_DERIVED
-				 || expr->symtree->n.sym->ts.type == BT_CLASS)))
-	    {
-	      /* If the actual argument can be absent (in other words, it can
-		 be a NULL reference), don't try to evaluate it; pass instead
-		 the reference directly.  The reference is also needed when
-		 expr is of type class or derived.  */
-	      gfc_conv_expr_reference (&se, expr);
-	    }
+	  if (gfc_scalar_elemental_arg_saved_as_reference (ss_info))
+	    gfc_conv_expr_reference (&se, expr);
 	  else
 	    {
-	      /* Otherwise, evaluate the argument outside the loop and pass
+	      /* Evaluate the argument outside the loop and pass
 		 a reference to the value.  */
 	      gfc_conv_expr (&se, expr);
 	    }
@@ -9101,7 +9128,8 @@ gfc_walk_elemental_function_args (gfc_ss * ss, gfc_actual_arglist *arg,
 	  gcc_assert (type == GFC_SS_SCALAR || type == GFC_SS_REFERENCE);
 	  newss = gfc_get_scalar_ss (head, arg->expr);
 	  newss->info->type = type;
-
+	  if (dummy_arg)
+	    newss->info->data.scalar.dummy_arg = dummy_arg->sym;
 	}
       else
 	scalar = 0;
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 76bad2a..ad9a292 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -105,6 +105,8 @@ gfc_ss *gfc_get_temp_ss (tree, tree, int);
 /* Allocate a new scalar type ss.  */
 gfc_ss *gfc_get_scalar_ss (gfc_ss *, gfc_expr *);
 
+bool gfc_scalar_elemental_arg_saved_as_reference (gfc_ss_info *);
+
 /* Calculates the lower bound and stride of array sections.  */
 void gfc_conv_ss_startstride (gfc_loopinfo *);
 
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 9c5ce7d..c71037f 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -4735,19 +4735,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 	  gfc_init_se (&parmse, se);
 	  parm_kind = ELEMENTAL;
 
-	  /* For all value functions or polymorphic scalar non-pointer
-	     non-allocatable variables use the expression in e directly.  This
-	     ensures, that initializers of polymorphic entities are correctly
-	     copied.  */
-	  if (fsym && (fsym->attr.value
-		       || (e->expr_type == EXPR_VARIABLE
-			   && fsym->ts.type == BT_DERIVED
-			   && e->ts.type == BT_DERIVED
-			   && !e->ts.u.derived->attr.dimension
-			   && !e->rank
-			   && (!e->symtree
-			       || (!e->symtree->n.sym->attr.allocatable
-				   && !e->symtree->n.sym->attr.pointer)))))
+	  if (fsym && fsym->attr.value)
 	    gfc_conv_expr (&parmse, e);
 	  else
 	    gfc_conv_expr_reference (&parmse, e);
@@ -7310,11 +7298,9 @@ gfc_conv_expr (gfc_se * se, gfc_expr * expr)
 
       ss_info = ss->info;
       /* Substitute a scalar expression evaluated outside the scalarization
-         loop.  */
+	 loop.  */
       se->expr = ss_info->data.scalar.value;
-      /* If the reference can be NULL, the value field contains the reference,
-	 not the value the reference points to (see gfc_add_loop_ss_code).  */
-      if (ss_info->can_be_null_ref)
+      if (gfc_scalar_elemental_arg_saved_as_reference (ss_info))
 	se->expr = build_fold_indirect_ref_loc (input_location, se->expr);
 
       se->string_length = ss_info->string_length;
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index e2a1fea..570b5b8 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -206,6 +206,9 @@ typedef struct gfc_ss_info
     /* If type is GFC_SS_SCALAR or GFC_SS_REFERENCE.  */
     struct
     {
+      /* If the scalar is passed as actual argument to an (elemental) procedure,
+	 this is the symbol of the corresponding dummy argument.  */
+      gfc_symbol *dummy_arg;
       tree value;
     }
     scalar;