trans-expr.c (gfc_conv_procedure_call): Handle temporaries for arguments to elemental calls.

	* trans-expr.c (gfc_conv_procedure_call): Handle temporaries for
	arguments to elemental calls.
	* trans-stmt.c (replace_ss): New function.
	(gfc_conv_elemental_dependencies): Remove temporary loop handling.
	Create a new ss for the temporary and replace the original one with it.
	Remove fake array references. Recalculate all offsets.

From-SVN: r180906

gcc/fortran/ChangeLog

 2011-11-04  Mikael Morin  <mikael@gcc.gnu.org>
 
+	* trans-expr.c (gfc_conv_procedure_call): Handle temporaries for
+	arguments to elemental calls.
+	* trans-stmt.c (replace_ss): New function.
+	(gfc_conv_elemental_dependencies): Remove temporary loop handling.
+	Create a new ss for the temporary and replace the original one with it.
+	Remove fake array references. Recalculate all offsets.
+
+2011-11-04  Mikael Morin  <mikael@gcc.gnu.org>
+
 	* trans-array.h (gfc_free_ss, gfc_set_delta): New prototypes.
 	* trans-array.c (gfc_free_ss): Remove forward declaration.
 	Make non-static.

gcc/fortran/trans-expr.c

@@ -2997,8 +2997,19 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 	{
 	  /* An elemental function inside a scalarized loop.  */
 	  gfc_init_se (&parmse, se);
-	  gfc_conv_expr_reference (&parmse, e);
 	  parm_kind = ELEMENTAL;
+
+	  if (se->ss->dimen > 0
+	      && se->ss->info->data.array.ref == NULL)
+	    {
+	      gfc_conv_tmp_array_ref (&parmse);
+	      if (e->ts.type == BT_CHARACTER)
+		gfc_conv_string_parameter (&parmse);
+	      else
+		parmse.expr = gfc_build_addr_expr (NULL_TREE, parmse.expr);
+	    }
+	  else
+	    gfc_conv_expr_reference (&parmse, e);
 	}
       else
 	{

gcc/fortran/trans-stmt.c

@@ -178,6 +178,41 @@ gfc_trans_entry (gfc_code * code)
 }
 
 
+/* Replace a gfc_ss structure by another both in the gfc_se struct
+   and the gfc_loopinfo struct.  This is used in gfc_conv_elemental_dependencies
+   to replace a variable ss by the corresponding temporary.  */
+
+static void
+replace_ss (gfc_se *se, gfc_ss *old_ss, gfc_ss *new_ss)
+{
+  gfc_ss **sess, **loopss;
+
+  /* The old_ss is a ss for a single variable.  */
+  gcc_assert (old_ss->info->type == GFC_SS_SECTION);
+
+  for (sess = &(se->ss); *sess != gfc_ss_terminator; sess = &((*sess)->next))
+    if (*sess == old_ss)
+      break;
+  gcc_assert (*sess != gfc_ss_terminator);
+
+  *sess = new_ss;
+  new_ss->next = old_ss->next;
+
+
+  for (loopss = &(se->loop->ss); *loopss != gfc_ss_terminator;
+       loopss = &((*loopss)->loop_chain))
+    if (*loopss == old_ss)
+      break;
+  gcc_assert (*loopss != gfc_ss_terminator);
+
+  *loopss = new_ss;
+  new_ss->loop_chain = old_ss->loop_chain;
+  new_ss->loop = old_ss->loop;
+
+  gfc_free_ss (old_ss);
+}
+
+
 /* Check for dependencies between INTENT(IN) and INTENT(OUT) arguments of
    elemental subroutines.  Make temporaries for output arguments if any such
    dependencies are found.  Output arguments are chosen because internal_unpack
@@ -190,15 +225,10 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse,
   gfc_actual_arglist *arg0;
   gfc_expr *e;
   gfc_formal_arglist *formal;
-  gfc_loopinfo tmp_loop;
   gfc_se parmse;
   gfc_ss *ss;
-  gfc_array_info *info;
   gfc_symbol *fsym;
-  gfc_ref *ref;
-  int n;
   tree data;
-  tree offset;
   tree size;
   tree tmp;
 
@@ -217,14 +247,9 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse,
 	continue;
 
       /* Obtain the info structure for the current argument.  */ 
-      info = NULL;
       for (ss = loopse->ss; ss && ss != gfc_ss_terminator; ss = ss->next)
-	{
-	  if (ss->info->expr != e)
-	    continue;
-	  info = &ss->info->data.array;
+	if (ss->info->expr == e)
 	  break;
-	}
 
       /* If there is a dependency, create a temporary and use it
 	 instead of the variable.  */
@@ -237,49 +262,17 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse,
 	{
 	  tree initial, temptype;
 	  stmtblock_t temp_post;
+	  gfc_ss *tmp_ss;
 
-	  /* Make a local loopinfo for the temporary creation, so that
-	     none of the other ss->info's have to be renormalized.  */
-	  gfc_init_loopinfo (&tmp_loop);
-	  tmp_loop.dimen = ss->dimen;
-	  for (n = 0; n < ss->dimen; n++)
-	    {
-	      tmp_loop.to[n] = loopse->loop->to[n];
-	      tmp_loop.from[n] = loopse->loop->from[n];
-	      tmp_loop.order[n] = loopse->loop->order[n];
-	    }
+	  tmp_ss = gfc_get_array_ss (gfc_ss_terminator, NULL, ss->dimen,
+				     GFC_SS_SECTION);
+	  gfc_mark_ss_chain_used (tmp_ss, 1);
+	  tmp_ss->info->expr = ss->info->expr;
+	  replace_ss (loopse, ss, tmp_ss);
 
 	  /* Obtain the argument descriptor for unpacking.  */
 	  gfc_init_se (&parmse, NULL);
 	  parmse.want_pointer = 1;
-
-	  /* The scalarizer introduces some specific peculiarities when
-	     handling elemental subroutines; the stride can be needed up to
-	     the dim_array - 1, rather than dim_loop - 1 to calculate
-	     offsets outside the loop.  For this reason, we make sure that
-	     the descriptor has the dimensionality of the array by converting
-	     trailing elements into ranges with end = start.  */
-	  for (ref = e->ref; ref; ref = ref->next)
-	    if (ref->type == REF_ARRAY && ref->u.ar.type == AR_SECTION)
-	      break;
-
-	  if (ref)
-	    {
-	      bool seen_range = false;
-	      for (n = 0; n < ref->u.ar.dimen; n++)
-		{
-		  if (ref->u.ar.dimen_type[n] == DIMEN_RANGE)
-		    seen_range = true;
-
-		  if (!seen_range
-			|| ref->u.ar.dimen_type[n] != DIMEN_ELEMENT)
-		    continue;
-
-		  ref->u.ar.end[n] = gfc_copy_expr (ref->u.ar.start[n]);
-		  ref->u.ar.dimen_type[n] = DIMEN_RANGE;
-		}
-	    }
-
 	  gfc_conv_expr_descriptor (&parmse, e, gfc_walk_expr (e));
 	  gfc_add_block_to_block (&se->pre, &parmse.pre);
 
@@ -309,28 +302,15 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse,
 	  size = gfc_create_var (gfc_array_index_type, NULL);
 	  data = gfc_create_var (pvoid_type_node, NULL);
 	  gfc_init_block (&temp_post);
-	  ss->loop = &tmp_loop;
-	  tmp = gfc_trans_create_temp_array (&se->pre, &temp_post, ss,
+	  tmp = gfc_trans_create_temp_array (&se->pre, &temp_post, tmp_ss,
 					     temptype, initial, false, true,
 					     false, &arg->expr->where);
 	  gfc_add_modify (&se->pre, size, tmp);
-	  tmp = fold_convert (pvoid_type_node, info->data);
+	  tmp = fold_convert (pvoid_type_node, tmp_ss->info->data.array.data);
 	  gfc_add_modify (&se->pre, data, tmp);
 
-	  /* Calculate the offset for the temporary.  */
-	  offset = gfc_index_zero_node;
-	  for (n = 0; n < ss->dimen; n++)
-	    {
-	      tmp = gfc_conv_descriptor_stride_get (info->descriptor,
-						    gfc_rank_cst[n]);
-	      tmp = fold_build2_loc (input_location, MULT_EXPR,
-				     gfc_array_index_type,
-				     loopse->loop->from[n], tmp);
-	      offset = fold_build2_loc (input_location, MINUS_EXPR,
-					gfc_array_index_type, offset, tmp);
-	    }
-	  info->offset = gfc_create_var (gfc_array_index_type, NULL);	  
-	  gfc_add_modify (&se->pre, info->offset, offset);
+	  /* Update other ss' delta.  */
+	  gfc_set_delta (loopse->loop);
 
 	  /* Copy the result back using unpack.  */
 	  tmp = build_call_expr_loc (input_location,