re PR fortran/54350 (FAIL: gfortran.dg/realloc_on_assign_*.f90 -O (internal…

re PR fortran/54350 (FAIL: gfortran.dg/realloc_on_assign_*.f90  -O  (internal compiler error) at r190586)

2012-08-24  Tobias Burnus  <burnus@net-b.de>

        PR fortran/54350
        * trans-array.c (free_ss_info): Free data.array.subscript.
        (gfc_free_ss): No longer free data.array.subscript.
        (walk_coarray): New function, moved from trans-intrinsic.c
        (gfc_conv_expr_descriptor): Walk array descriptor instead
        of taking passed "ss".
        (get_array_ctor_all_strlen, gfc_add_loop_ss_code,
        gfc_conv_array_parameter): Update call and cleanup ss handling.
        * trans-array.h (gfc_conv_expr_descriptor,
        gfc_conv_array_parameter): Update prototype.
        * trans-expr.c (gfc_conv_derived_to_class,
        conv_isocbinding_procedure, gfc_conv_procedure_call,
        gfc_trans_alloc_subarray_assign, gfc_trans_subcomponent_assign,
        gfc_trans_pointer_assignment, gfc_trans_arrayfunc_assign): Update
        call to gfc_conv_expr_descriptor and gfc_conv_array_parameter,
        and clean up.
        * trans-intrinsic.c (walk_coarray): Moved to trans-array.c
        (trans_this_image, trans_image_index, gfc_conv_intrinsic_rank
        gfc_conv_intrinsic_bound, gfc_conv_intrinsic_cobound,
        gfc_conv_intrinsic_len, gfc_conv_intrinsic_size,
        gfc_conv_intrinsic_sizeof, gfc_conv_intrinsic_storage_size,
        gfc_conv_intrinsic_transfer, gfc_conv_allocated,
        gfc_conv_associated, gfc_conv_intrinsic_loc,
        conv_intrinsic_move_alloc): Update calls.
        * trans-io.c (gfc_convert_array_to_string, set_internal_unit,
        gfc_trans_transfer): Ditto.
        * trans-stmt.c (gfc_conv_elemental_dependencies,
        gfc_trans_sync, trans_associate_var,
        gfc_trans_pointer_assign_need_temp): Ditto.

From-SVN: r190641

gcc/fortran/ChangeLog

+2012-08-23  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/54350
+	* trans-array.c (free_ss_info): Free data.array.subscript.
+	(gfc_free_ss): No longer free data.array.subscript.
+	(walk_coarray): New function, moved from trans-intrinsic.c
+	(gfc_conv_expr_descriptor): Walk array descriptor instead
+	of taking passed "ss".
+	(get_array_ctor_all_strlen, gfc_add_loop_ss_code,
+	gfc_conv_array_parameter): Update call and cleanup ss handling.
+	* trans-array.h (gfc_conv_expr_descriptor,
+	gfc_conv_array_parameter): Update prototype.
+	* trans-expr.c (gfc_conv_derived_to_class,
+	conv_isocbinding_procedure, gfc_conv_procedure_call,
+	gfc_trans_alloc_subarray_assign, gfc_trans_subcomponent_assign,
+	gfc_trans_pointer_assignment, gfc_trans_arrayfunc_assign): Update
+	call to gfc_conv_expr_descriptor and gfc_conv_array_parameter, and
+	clean up.
+	* trans-intrinsic.c (walk_coarray): Moved to trans-array.c
+	(trans_this_image, trans_image_index, gfc_conv_intrinsic_rank
+	gfc_conv_intrinsic_bound, gfc_conv_intrinsic_cobound,
+	gfc_conv_intrinsic_len, gfc_conv_intrinsic_size,
+	gfc_conv_intrinsic_sizeof, gfc_conv_intrinsic_storage_size,
+	gfc_conv_intrinsic_transfer, gfc_conv_allocated,
+	gfc_conv_associated, gfc_conv_intrinsic_loc,
+	conv_intrinsic_move_alloc): Update calls.
+	* trans-io.c (gfc_convert_array_to_string, set_internal_unit,
+	gfc_trans_transfer): Ditto.
+	* trans-stmt.c (gfc_conv_elemental_dependencies,
+	gfc_trans_sync, trans_associate_var,
+	gfc_trans_pointer_assign_need_temp): Ditto.
+
 2012-08-23  Jakub Jelinek  <jakub@redhat.com>
 
 	* trans-decl.c (trans_function_start, generate_coarray_init,

gcc/fortran/trans-array.c

@@ -510,40 +510,36 @@ gfc_free_ss_chain (gfc_ss * ss)
 static void
 free_ss_info (gfc_ss_info *ss_info)
 {
+  int n;
+
   ss_info->refcount--;
   if (ss_info->refcount > 0)
     return;
 
   gcc_assert (ss_info->refcount == 0);
-  free (ss_info);
-}
-
-
-/* Free a SS.  */
-
-void
-gfc_free_ss (gfc_ss * ss)
-{
-  gfc_ss_info *ss_info;
-  int n;
-
-  ss_info = ss->info;
 
   switch (ss_info->type)
     {
     case GFC_SS_SECTION:
-      for (n = 0; n < ss->dimen; n++)
-	{
-	  if (ss_info->data.array.subscript[ss->dim[n]])
-	    gfc_free_ss_chain (ss_info->data.array.subscript[ss->dim[n]]);
-	}
+      for (n = 0; n < GFC_MAX_DIMENSIONS; n++)
+	if (ss_info->data.array.subscript[n])
+	  gfc_free_ss_chain (ss_info->data.array.subscript[n]);
       break;
 
     default:
       break;
     }
 
-  free_ss_info (ss_info);
+  free (ss_info);
+}
+
+
+/* Free a SS.  */
+
+void
+gfc_free_ss (gfc_ss * ss)
+{
+  free_ss_info (ss->info);
   free (ss);
 }
 
@@ -1805,7 +1801,6 @@ static void
 get_array_ctor_all_strlen (stmtblock_t *block, gfc_expr *e, tree *len)
 {
   gfc_se se;
-  gfc_ss *ss;
 
   /* Don't bother if we already know the length is a constant.  */
   if (*len && INTEGER_CST_P (*len))
@@ -1821,15 +1816,14 @@ get_array_ctor_all_strlen (stmtblock_t *block, gfc_expr *e, tree *len)
   else
     {
       /* Otherwise, be brutal even if inefficient.  */
-      ss = gfc_walk_expr (e);
       gfc_init_se (&se, NULL);
 
       /* No function call, in case of side effects.  */
       se.no_function_call = 1;
-      if (ss == gfc_ss_terminator)
+      if (e->rank == 0)
 	gfc_conv_expr (&se, e);
       else
-	gfc_conv_expr_descriptor (&se, e, ss);
+	gfc_conv_expr_descriptor (&se, e);
 
       /* Fix the value.  */
       *len = gfc_evaluate_now (se.string_length, &se.pre);
@@ -2527,7 +2521,7 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
 	case GFC_SS_VECTOR:
 	  /* Get the vector's descriptor and store it in SS.  */
 	  gfc_init_se (&se, NULL);
-	  gfc_conv_expr_descriptor (&se, expr, gfc_walk_expr (expr));
+	  gfc_conv_expr_descriptor (&se, expr);
 	  gfc_add_block_to_block (&outer_loop->pre, &se.pre);
 	  gfc_add_block_to_block (&outer_loop->post, &se.post);
 	  info->descriptor = se.expr;
@@ -6328,6 +6322,44 @@ transposed_dims (gfc_ss *ss)
   return false;
 }
 
+
+/* Convert the last ref of a scalar coarray from an AR_ELEMENT to an
+   AR_FULL, suitable for the scalarizer.  */
+
+static gfc_ss *
+walk_coarray (gfc_expr *e)
+{
+  gfc_ss *ss;
+
+  gcc_assert (gfc_get_corank (e) > 0);
+
+  ss = gfc_walk_expr (e);
+
+  /* Fix scalar coarray.  */
+  if (ss == gfc_ss_terminator)
+    {
+      gfc_ref *ref;
+
+      ref = e->ref;
+      while (ref)
+	{
+	  if (ref->type == REF_ARRAY
+	      && ref->u.ar.codimen > 0)
+	    break;
+
+	  ref = ref->next;
+	}
+
+      gcc_assert (ref != NULL);
+      if (ref->u.ar.type == AR_ELEMENT)
+	ref->u.ar.type = AR_SECTION;
+      ss = gfc_reverse_ss (gfc_walk_array_ref (ss, e, ref));
+    }
+
+  return ss;
+}
+
+
 /* Convert an array for passing as an actual argument.  Expressions and
    vector subscripts are evaluated and stored in a temporary, which is then
    passed.  For whole arrays the descriptor is passed.  For array sections
@@ -6358,8 +6390,9 @@ transposed_dims (gfc_ss *ss)
    function call.  */
 
 void
-gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
+gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
 {
+  gfc_ss *ss;
   gfc_ss_type ss_type;
   gfc_ss_info *ss_info;
   gfc_loopinfo loop;
@@ -6375,6 +6408,11 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
   bool subref_array_target = false;
   gfc_expr *arg, *ss_expr;
 
+  if (se->want_coarray)
+    ss = walk_coarray (expr);
+  else
+    ss = gfc_walk_expr (expr);
+
   gcc_assert (ss != NULL);
   gcc_assert (ss != gfc_ss_terminator);
 
@@ -6382,6 +6420,16 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
   ss_type = ss_info->type;
   ss_expr = ss_info->expr;
 
+  /* Special case: TRANSPOSE which needs no temporary.  */
+  while (expr->expr_type == EXPR_FUNCTION && expr->value.function.isym
+      && NULL != (arg = gfc_get_noncopying_intrinsic_argument (expr)))
+    {
+      /* This is a call to transpose which has already been handled by the
+	 scalarizer, so that we just need to get its argument's descriptor.  */
+      gcc_assert (expr->value.function.isym->id == GFC_ISYM_TRANSPOSE);
+      expr = expr->value.function.actual->expr;
+    }
+
   /* Special case things we know we can pass easily.  */
   switch (expr->expr_type)
     {
@@ -6411,7 +6459,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
 	  /* Create a new descriptor if the array doesn't have one.  */
 	  full = 0;
 	}
-      else if (info->ref->u.ar.type == AR_FULL)
+      else if (info->ref->u.ar.type == AR_FULL || se->descriptor_only)
 	full = 1;
       else if (se->direct_byref)
 	full = 0;
@@ -6443,24 +6491,12 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
 	  if (expr->ts.type == BT_CHARACTER)
 	    se->string_length = gfc_get_expr_charlen (expr);
 
+	  gfc_free_ss_chain (ss);
 	  return;
 	}
       break;
       
     case EXPR_FUNCTION:
-
-      /* We don't need to copy data in some cases.  */
-      arg = gfc_get_noncopying_intrinsic_argument (expr);
-      if (arg)
-	{
-	  /* This is a call to transpose...  */
-	  gcc_assert (expr->value.function.isym->id == GFC_ISYM_TRANSPOSE);
-	  /* ... which has already been handled by the scalarizer, so
-	     that we just need to get its argument's descriptor.  */
-	  gfc_conv_expr_descriptor (se, expr->value.function.actual->expr, ss);
-	  return;
-	}
-
       /* A transformational function return value will be a temporary
 	 array descriptor.  We still need to go through the scalarizer
 	 to create the descriptor.  Elemental functions are handled as
@@ -6477,6 +6513,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
 	    gcc_assert (se->ss == ss);
 	  se->expr = gfc_build_addr_expr (NULL_TREE, se->expr);
 	  gfc_conv_expr (se, expr);
+	  gfc_free_ss_chain (ss);
 	  return;
 	}
 
@@ -6896,7 +6933,7 @@ array_parameter_size (tree desc, gfc_expr *expr, tree *size)
 /* TODO: Optimize passing g77 arrays.  */
 
 void
-gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, bool g77,
+gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77,
 			  const gfc_symbol *fsym, const char *proc_name,
 			  tree *size)
 {
@@ -6967,7 +7004,7 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, bool g77,
 
       if (sym->ts.type == BT_DERIVED || sym->ts.type == BT_CLASS)
 	{
-	  gfc_conv_expr_descriptor (se, expr, ss);
+	  gfc_conv_expr_descriptor (se, expr);
 	  se->expr = gfc_conv_array_data (se->expr);
 	  return;
 	}
@@ -6993,7 +7030,7 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, bool g77,
         {
 	  if (sym->attr.dummy || sym->attr.result)
 	    {
-	      gfc_conv_expr_descriptor (se, expr, ss);
+	      gfc_conv_expr_descriptor (se, expr);
 	      tmp = se->expr;
 	    }
 	  if (size)
@@ -7037,7 +7074,7 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, bool g77,
 
   if (no_pack || array_constructor || good_allocatable || ultimate_alloc_comp)
     {
-      gfc_conv_expr_descriptor (se, expr, ss);
+      gfc_conv_expr_descriptor (se, expr);
       if (expr->ts.type == BT_CHARACTER)
 	se->string_length = expr->ts.u.cl->backend_decl;
       if (size)
@@ -7049,7 +7086,7 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, bool g77,
   if (this_array_result)
     {
       /* Result of the enclosing function.  */
-      gfc_conv_expr_descriptor (se, expr, ss);
+      gfc_conv_expr_descriptor (se, expr);
       if (size)
 	array_parameter_size (se->expr, expr, size);
       se->expr = gfc_build_addr_expr (NULL_TREE, se->expr);
@@ -7065,7 +7102,7 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, bool g77,
     {
       /* Every other type of array.  */
       se->want_pointer = 1;
-      gfc_conv_expr_descriptor (se, expr, ss);
+      gfc_conv_expr_descriptor (se, expr);
       if (size)
 	array_parameter_size (build_fold_indirect_ref_loc (input_location,
 						       se->expr),

gcc/fortran/trans-array.h

@@ -131,9 +131,9 @@ void gfc_conv_tmp_array_ref (gfc_se * se);
 void gfc_conv_tmp_ref (gfc_se *);
 
 /* Evaluate an array expression.  */
-void gfc_conv_expr_descriptor (gfc_se *, gfc_expr *, gfc_ss *);
+void gfc_conv_expr_descriptor (gfc_se *, gfc_expr *);
 /* Convert an array for passing as an actual function parameter.  */
-void gfc_conv_array_parameter (gfc_se *, gfc_expr *, gfc_ss *, bool,
+void gfc_conv_array_parameter (gfc_se *, gfc_expr *, bool,
 			       const gfc_symbol *, const char *, tree *);
 /* Evaluate and transpose a matrix expression.  */
 void gfc_conv_array_transpose (gfc_se *, gfc_expr *);

gcc/fortran/trans-expr.c

@@ -304,7 +304,7 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e,
       else
 	{
 	  parmse->ss = ss;
-	  gfc_conv_expr_descriptor (parmse, e, ss);
+	  gfc_conv_expr_descriptor (parmse, e);
 
 	  if (e->rank != class_ts.u.derived->components->as->rank)
 	    class_array_data_assign (&parmse->pre, ctree, parmse->expr, true);
@@ -533,8 +533,8 @@ gfc_copy_class_to_class (tree from, tree to, tree nelems)
       loop.to[0] = nelems;
       gfc_trans_scalarizing_loops (&loop, &loopbody);
       gfc_add_block_to_block (&body, &loop.pre);
-      gfc_cleanup_loop (&loop);
       tmp = gfc_finish_block (&body);
+      gfc_cleanup_loop (&loop);
     }
   else
     {
@@ -3385,8 +3385,7 @@ conv_isocbinding_procedure (gfc_se * se, gfc_symbol * sym,
 			    gfc_actual_arglist * arg)
 {
   gfc_symbol *fsym;
-  gfc_ss *argss;
-    
+
   if (sym->intmod_sym_id == ISOCBINDING_LOC)
     {
       if (arg->expr->rank == 0)
@@ -3404,9 +3403,7 @@ conv_isocbinding_procedure (gfc_se * se, gfc_symbol * sym,
 	    && fsym->as->type != AS_ASSUMED_SHAPE;
 	  f = f || !sym->attr.always_explicit;
       
-	  argss = gfc_walk_expr (arg->expr);
-	  gfc_conv_array_parameter (se, arg->expr, argss, f,
-				    NULL, NULL, NULL);
+	  gfc_conv_array_parameter (se, arg->expr, f, NULL, NULL, NULL);
 	}
 
       /* TODO -- the following two lines shouldn't be necessary, but if
@@ -3434,7 +3431,7 @@ conv_isocbinding_procedure (gfc_se * se, gfc_symbol * sym,
       gfc_se cptrse;
       gfc_se fptrse;
       gfc_se shapese;
-      gfc_ss *ss, *shape_ss;
+      gfc_ss *shape_ss;
       tree desc, dim, tmp, stride, offset;
       stmtblock_t body, block;
       gfc_loopinfo loop;
@@ -3469,10 +3466,8 @@ conv_isocbinding_procedure (gfc_se * se, gfc_symbol * sym,
       gfc_start_block (&block);
 
       /* Get the descriptor of the Fortran pointer.  */
-      ss = gfc_walk_expr (arg->next->expr);
-      gcc_assert (ss != gfc_ss_terminator);
       fptrse.descriptor_only = 1;
-      gfc_conv_expr_descriptor (&fptrse, arg->next->expr, ss);
+      gfc_conv_expr_descriptor (&fptrse, arg->next->expr);
       gfc_add_block_to_block (&block, &fptrse.pre);
       desc = fptrse.expr;
 
@@ -3534,7 +3529,6 @@ conv_isocbinding_procedure (gfc_se * se, gfc_symbol * sym,
       gfc_add_block_to_block (&block, &loop.post);
       gfc_add_block_to_block (&block, &fptrse.post);
       gfc_cleanup_loop (&loop);
-      gfc_free_ss (ss);
 
       gfc_add_modify (&block, offset, 
 		      fold_build1_loc (input_location, NEGATE_EXPR,
@@ -3615,7 +3609,6 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
   tree tmp;
   tree fntype;
   gfc_se parmse;
-  gfc_ss *argss;
   gfc_array_info *info;
   int byref;
   int parm_kind;
@@ -3818,11 +3811,20 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 	}
       else
 	{
-	  /* A scalar or transformational function.  */
-	  gfc_init_se (&parmse, NULL);
+	  bool scalar;
+	  gfc_ss *argss;
+
+	  /* Check whether the expression is a scalar or not; we cannot use
+	     e->rank as it can be nonzero for functions arguments.  */
 	  argss = gfc_walk_expr (e);
+	  scalar = argss == gfc_ss_terminator;
+	  if (!scalar)
+	    gfc_free_ss_chain (argss);
 
-	  if (argss == gfc_ss_terminator)
+	  /* A scalar or transformational function.  */
+	  gfc_init_se (&parmse, NULL);
+          
+	  if (scalar)
 	    {
 	      if (e->expr_type == EXPR_VARIABLE
 		    && e->symtree->n.sym->attr.cray_pointee
@@ -3977,7 +3979,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 	    {
 	      /* Pass a class array.  */
 	      gfc_init_se (&parmse, se);
-	      gfc_conv_expr_descriptor (&parmse, e, argss);
+	      gfc_conv_expr_descriptor (&parmse, e);
 	      /* The conversion does not repackage the reference to a class
 	         array - _data descriptor.  */
 	      gfc_conv_class_to_class (&parmse, e, fsym->ts, false);
@@ -4060,8 +4062,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 				fsym ? fsym->attr.intent : INTENT_INOUT,
 				fsym && fsym->attr.pointer);
 	      else
-	        gfc_conv_array_parameter (&parmse, e, argss, f, fsym,
-					  sym->name, NULL);
+	        gfc_conv_array_parameter (&parmse, e, f, fsym, sym->name, NULL);
 
 	      /* If an ALLOCATABLE dummy argument has INTENT(OUT) and is 
 		 allocated on entry, it must be deallocated.  */
@@ -5355,7 +5356,6 @@ gfc_trans_alloc_subarray_assign (tree dest, gfc_component * cm,
 				 gfc_expr * expr)
 {
   gfc_se se;
-  gfc_ss *rss;
   stmtblock_t block;
   tree offset;
   int n;
@@ -5368,9 +5368,8 @@ gfc_trans_alloc_subarray_assign (tree dest, gfc_component * cm,
   gfc_init_se (&se, NULL);
 
   /* Get the descriptor for the expressions.  */ 
-  rss = gfc_walk_expr (expr);
   se.want_pointer = 0;
-  gfc_conv_expr_descriptor (&se, expr, rss);
+  gfc_conv_expr_descriptor (&se, expr);
   gfc_add_block_to_block (&block, &se.pre);
   gfc_add_modify (&block, dest, se.expr);
 
@@ -5501,7 +5500,6 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, gfc_expr * expr)
 {
   gfc_se se;
   gfc_se lse;
-  gfc_ss *rss;
   stmtblock_t block;
   tree tmp;
 
@@ -5518,10 +5516,9 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, gfc_expr * expr)
 	    gfc_conv_descriptor_data_set (&block, dest, null_pointer_node);
 	  else
 	    {
-	      rss = gfc_walk_expr (expr);
 	      se.direct_byref = 1;
 	      se.expr = dest;
-	      gfc_conv_expr_descriptor (&se, expr, rss);
+	      gfc_conv_expr_descriptor (&se, expr);
 	      gfc_add_block_to_block (&block, &se.pre);
 	      gfc_add_block_to_block (&block, &se.post);
 	    }
@@ -5966,25 +5963,29 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2)
 {
   gfc_se lse;
   gfc_se rse;
-  gfc_ss *lss;
-  gfc_ss *rss;
   stmtblock_t block;
   tree desc;
   tree tmp;
   tree decl;
+  bool scalar;
+  gfc_ss *ss;
 
   gfc_start_block (&block);
 
   gfc_init_se (&lse, NULL);
 
-  lss = gfc_walk_expr (expr1);
-  rss = gfc_walk_expr (expr2);
-  if (lss == gfc_ss_terminator)
+  /* Check whether the expression is a scalar or not; we cannot use
+     expr1->rank as it can be nonzero for proc pointers.  */
+  ss = gfc_walk_expr (expr1);
+  scalar = ss == gfc_ss_terminator;
+  if (!scalar)
+    gfc_free_ss_chain (ss);
+ 
+  if (scalar)
     {
       /* Scalar pointers.  */
       lse.want_pointer = 1;
       gfc_conv_expr (&lse, expr1);
-      gcc_assert (rss == gfc_ss_terminator);
       gfc_init_se (&rse, NULL);
       rse.want_pointer = 1;
       gfc_conv_expr (&rse, expr2);
@@ -6048,13 +6049,12 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2)
       for (remap = expr1->ref; remap; remap = remap->next)
 	if (!remap->next && remap->type == REF_ARRAY
 	    && remap->u.ar.type == AR_SECTION)
-	  {  
-	    remap->u.ar.type = AR_FULL;
-	    break;
-	  }
+	  break;
       rank_remap = (remap && remap->u.ar.end[0]);
 
-      gfc_conv_expr_descriptor (&lse, expr1, lss);
+      if (remap)
+	lse.descriptor_only = 1;
+      gfc_conv_expr_descriptor (&lse, expr1);
       strlen_lhs = lse.string_length;
       desc = lse.expr;
 
@@ -6070,14 +6070,14 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2)
 	  gfc_init_se (&rse, NULL);
 	  rse.direct_byref = 1;
 	  rse.byref_noassign = 1;
-	  gfc_conv_expr_descriptor (&rse, expr2, rss);
+	  gfc_conv_expr_descriptor (&rse, expr2);
 	  strlen_rhs = rse.string_length;
 	}
       else if (expr2->expr_type == EXPR_VARIABLE)
 	{
 	  /* Assign directly to the LHS's descriptor.  */
 	  lse.direct_byref = 1;
-	  gfc_conv_expr_descriptor (&lse, expr2, rss);
+	  gfc_conv_expr_descriptor (&lse, expr2);
 	  strlen_rhs = lse.string_length;
 
 	  /* If this is a subreference array pointer assignment, use the rhs
@@ -6103,7 +6103,7 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2)
 
 	  lse.expr = tmp;
 	  lse.direct_byref = 1;
-	  gfc_conv_expr_descriptor (&lse, expr2, rss);
+	  gfc_conv_expr_descriptor (&lse, expr2);
 	  strlen_rhs = lse.string_length;
 	  gfc_add_modify (&lse.pre, desc, tmp);
 	}
@@ -6715,7 +6715,7 @@ static tree
 gfc_trans_arrayfunc_assign (gfc_expr * expr1, gfc_expr * expr2)
 {
   gfc_se se;
-  gfc_ss *ss;
+  gfc_ss *ss = NULL;
   gfc_component *comp = NULL;
   gfc_loopinfo loop;
 
@@ -6730,13 +6730,11 @@ gfc_trans_arrayfunc_assign (gfc_expr * expr1, gfc_expr * expr2)
 	      || (!comp && gfc_return_by_reference (expr2->value.function.esym)
 		  && expr2->value.function.esym->result->attr.dimension));
 
-  ss = gfc_walk_expr (expr1);
-  gcc_assert (ss != gfc_ss_terminator);
   gfc_init_se (&se, NULL);
   gfc_start_block (&se.pre);
   se.want_pointer = 1;
 
-  gfc_conv_array_parameter (&se, expr1, ss, false, NULL, NULL, NULL);
+  gfc_conv_array_parameter (&se, expr1, false, NULL, NULL, NULL);
 
   if (expr1->ts.type == BT_DERIVED
 	&& expr1->ts.u.derived->attr.alloc_comp)
@@ -6770,8 +6768,10 @@ gfc_trans_arrayfunc_assign (gfc_expr * expr1, gfc_expr * expr2)
 
       if (!expr2->value.function.isym)
 	{
+	  ss = gfc_walk_expr (expr1);
+	  gcc_assert (ss != gfc_ss_terminator);
+
 	  realloc_lhs_loop_for_fcn_call (&se, &expr1->where, &ss, &loop);
-	  gfc_cleanup_loop (&loop);
 	  ss->is_alloc_lhs = 1;
 	}
       else
@@ -6780,7 +6780,6 @@ gfc_trans_arrayfunc_assign (gfc_expr * expr1, gfc_expr * expr2)
 
   gfc_conv_function_expr (&se, expr2);
   gfc_add_block_to_block (&se.pre, &se.post);
-  gfc_free_ss (se.ss);
 
   return gfc_finish_block (&se.pre);
 }

gcc/fortran/trans-io.c

@@ -664,7 +664,7 @@ gfc_convert_array_to_string (gfc_se * se, gfc_expr * e)
       return;
     }
 
-  gfc_conv_array_parameter (se, e, gfc_walk_expr (e), true, NULL, NULL, &size);
+  gfc_conv_array_parameter (se, e, true, NULL, NULL, &size);
   se->string_length = fold_convert (gfc_charlen_type_node, size);
 }
 
@@ -780,8 +780,6 @@ set_internal_unit (stmtblock_t * block, stmtblock_t * post_block,
   /* Character array.  */
   else if (e->rank > 0)
     {
-      se.ss = gfc_walk_expr (e);
-
       if (is_subref_array (e))
 	{
 	  /* Use a temporary for components of arrays of derived types
@@ -796,7 +794,7 @@ set_internal_unit (stmtblock_t * block, stmtblock_t * post_block,
       else
 	{
 	  /* Return the data pointer and rank from the descriptor.  */
-	  gfc_conv_expr_descriptor (&se, e, se.ss);
+	  gfc_conv_expr_descriptor (&se, e);
 	  tmp = gfc_conv_descriptor_data_get (se.expr);
 	  se.expr = gfc_build_addr_expr (pchar_type_node, se.expr);
 	}
@@ -2236,12 +2234,10 @@ gfc_trans_transfer (gfc_code * code)
   gfc_init_block (&body);
 
   expr = code->expr1;
-  ss = gfc_walk_expr (expr);
-
   ref = NULL;
   gfc_init_se (&se, NULL);
 
-  if (ss == gfc_ss_terminator)
+  if (expr->rank == 0)
     {
       /* Transfer a scalar value.  */
       gfc_conv_expr_reference (&se, expr);
@@ -2281,15 +2277,16 @@ gfc_trans_transfer (gfc_code * code)
 	  else
 	    {
 	      /* Get the descriptor.  */
-	      gfc_conv_expr_descriptor (&se, expr, ss);
+	      gfc_conv_expr_descriptor (&se, expr);
 	      tmp = gfc_build_addr_expr (NULL_TREE, se.expr);
 	    }
 
 	  transfer_array_desc (&se, &expr->ts, tmp);
 	  goto finish_block_label;
 	}
-      
+
       /* Initialize the scalarizer.  */
+      ss = gfc_walk_expr (expr);
       gfc_init_loopinfo (&loop);
       gfc_add_ss_to_loop (&loop, ss);
 

gcc/fortran/trans-stmt.c

@@ -274,7 +274,7 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse,
 	  /* Obtain the argument descriptor for unpacking.  */
 	  gfc_init_se (&parmse, NULL);
 	  parmse.want_pointer = 1;
-	  gfc_conv_expr_descriptor (&parmse, e, gfc_walk_expr (e));
+	  gfc_conv_expr_descriptor (&parmse, e);
 	  gfc_add_block_to_block (&se->pre, &parmse.pre);
 
 	  /* If we've got INTENT(INOUT) or a derived type with INTENT(OUT),
@@ -864,9 +864,7 @@ gfc_trans_sync (gfc_code *code, gfc_exec_op type)
 			     "implemented for image-set at %L",
 			     gfc_c_int_kind, &code->expr1->where);
 
-	  gfc_conv_array_parameter (&se, code->expr1,
-				    gfc_walk_expr (code->expr1), true, NULL,
-				    NULL, &len);
+	  gfc_conv_array_parameter (&se, code->expr1, true, NULL, NULL, &len);
 	  images = se.expr;
 
 	  tmp = gfc_typenode_for_spec (&code->expr1->ts);
@@ -1160,7 +1158,6 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
       && (sym->as->type == AS_DEFERRED || sym->assoc->variable))
     {
       gfc_se se;
-      gfc_ss *ss;
       tree desc;
 
       desc = sym->backend_decl;
@@ -1168,13 +1165,12 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
       /* If association is to an expression, evaluate it and create temporary.
 	 Otherwise, get descriptor of target for pointer assignment.  */
       gfc_init_se (&se, NULL);
-      ss = gfc_walk_expr (e);
       if (sym->assoc->variable)
 	{
 	  se.direct_byref = 1;
 	  se.expr = desc;
 	}
-      gfc_conv_expr_descriptor (&se, e, ss);
+      gfc_conv_expr_descriptor (&se, e);
 
       /* If we didn't already do the pointer assignment, set associate-name
 	 descriptor to the one generated for the temporary.  */
@@ -1229,7 +1225,7 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
       if (sym->ts.type == BT_CLASS && CLASS_DATA (sym)->attr.dimension)
 	{
 	  /* For a class array we need a descriptor for the selector.  */
-	  gfc_conv_expr_descriptor (&se, e, gfc_walk_expr (e));
+	  gfc_conv_expr_descriptor (&se, e);
 
 	  /* Obtain a temporary class container for the result.  */ 
 	  gfc_conv_class_to_class (&se, e, sym->ts, false);
@@ -3502,8 +3498,7 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2,
       gfc_init_se (&lse, NULL);
       lse.expr = gfc_build_array_ref (tmp1, count, NULL);
       lse.direct_byref = 1;
-      rss = gfc_walk_expr (expr2);
-      gfc_conv_expr_descriptor (&lse, expr2, rss);
+      gfc_conv_expr_descriptor (&lse, expr2);
 
       gfc_add_block_to_block (&body, &lse.pre);
       gfc_add_block_to_block (&body, &lse.post);
@@ -3524,9 +3519,8 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2,
       gfc_add_modify (block, count, gfc_index_zero_node);
 
       parm = gfc_build_array_ref (tmp1, count, NULL);
-      lss = gfc_walk_expr (expr1);
       gfc_init_se (&lse, NULL);
-      gfc_conv_expr_descriptor (&lse, expr1, lss);
+      gfc_conv_expr_descriptor (&lse, expr1);
       gfc_add_modify (&lse.pre, lse.expr, parm);
       gfc_start_block (&body);
       gfc_add_block_to_block (&body, &lse.pre);