re PR fortran/48462 (realloc on assignment: matmul Segmentation Fault with Allocatable Array)

2011-04-18  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/48462
	* trans-expr.c (fcncall_realloc_result): Renamed version of
	realloc_lhs_bounds_for_intrinsic_call that does not touch the
	descriptor bounds anymore but makes a temporary descriptor to
	hold the result.
	(gfc_trans_arrayfunc_assign): Modify the reference to above
	renamed function.

2011-04-18  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/48462
	* gfortran.dg/realloc_on_assign_7.f03: New test.

From-SVN: r172636

1 files changed, 23 insertions, 40 deletions

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index dc9168a..92a0fe9 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -5528,55 +5528,38 @@ realloc_lhs_loop_for_fcn_call (gfc_se *se, locus *where, gfc_ss **ss,
 }
 
 
+/* For Assignment to a reallocatable lhs from intrinsic functions,
+   replace the se.expr (ie. the result) with a temporary descriptor.
+   Null the data field so that the library allocates space for the
+   result. Free the data of the original descriptor after the function,
+   in case it appears in an argument expression and transfer the
+   result to the original descriptor.  */
+
 static void
-realloc_lhs_bounds_for_intrinsic_call (gfc_se *se, int rank)
+fcncall_realloc_result (gfc_se *se)
 {
   tree desc;
+  tree res_desc;
   tree tmp;
-  tree offset;
-  int n;
 
-  /* Use the allocation done by the library.  */
+  /* Use the allocation done by the library.  Substitute the lhs
+     descriptor with a copy, whose data field is nulled.*/
   desc = build_fold_indirect_ref_loc (input_location, se->expr);
+  res_desc = gfc_evaluate_now (desc, &se->pre);
+  gfc_conv_descriptor_data_set (&se->pre, res_desc, null_pointer_node);
+  se->expr = gfc_build_addr_expr (TREE_TYPE (se->expr), res_desc);
+
+  /* Free the lhs after the function call and copy the result data to
+     it.  */
   tmp = gfc_conv_descriptor_data_get (desc);
   tmp = gfc_call_free (fold_convert (pvoid_type_node, tmp));
-  gfc_add_expr_to_block (&se->pre, tmp);
-  gfc_conv_descriptor_data_set (&se->pre, desc, null_pointer_node);
+  gfc_add_expr_to_block (&se->post, tmp);
+  tmp = gfc_conv_descriptor_data_get (res_desc);
+  gfc_conv_descriptor_data_set (&se->post, desc, tmp);
+
   /* Unallocated, the descriptor does not have a dtype.  */
   tmp = gfc_conv_descriptor_dtype (desc);
-  gfc_add_modify (&se->pre, tmp, gfc_get_dtype (TREE_TYPE (desc)));
-
-  offset = gfc_index_zero_node;
-  tmp = gfc_index_one_node;
-  /* Now reset the bounds from zero based to unity based.  */
-  for (n = 0 ; n < rank; n++)
-    {
-      /* Accumulate the offset.  */
-      offset = fold_build2_loc (input_location, MINUS_EXPR,
-				gfc_array_index_type,
-				offset, tmp);
-      /* Now do the bounds.  */
-      gfc_conv_descriptor_offset_set (&se->post, desc, tmp);
-      tmp = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[n]);
-      tmp = fold_build2_loc (input_location, PLUS_EXPR,
-			     gfc_array_index_type,
-			     tmp, gfc_index_one_node);
-      gfc_conv_descriptor_lbound_set (&se->post, desc,
-				      gfc_rank_cst[n],
-				      gfc_index_one_node);
-      gfc_conv_descriptor_ubound_set (&se->post, desc,
-				      gfc_rank_cst[n], tmp);
-
-      /* The extent for the next contribution to offset.  */
-      tmp = fold_build2_loc (input_location, MINUS_EXPR,
-			     gfc_array_index_type,
-			     gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[n]),
-			     gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[n]));
-      tmp = fold_build2_loc (input_location, PLUS_EXPR,
-			     gfc_array_index_type,
-			     tmp, gfc_index_one_node);
-    }
-  gfc_conv_descriptor_offset_set (&se->post, desc, offset);
+  gfc_add_modify (&se->post, tmp, gfc_get_dtype (TREE_TYPE (desc)));
 }
 
 
@@ -5646,7 +5629,7 @@ gfc_trans_arrayfunc_assign (gfc_expr * expr1, gfc_expr * expr2)
 	  ss->is_alloc_lhs = 1;
 	}
       else
-	realloc_lhs_bounds_for_intrinsic_call (&se, expr1->rank);
+	fcncall_realloc_result (&se);
     }
 
   gfc_conv_function_expr (&se, expr2);