re PR fortran/48746 (Matmul with allocate on assignment)

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

	PR fortran/48746
	* trans-expr.c (fcncall_realloc_result): Set the bounds and the
	offset so that the lbounds are one.
	(gfc_trans_arrayfunc_assign): Add rank to arguments of above.

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

	PR fortran/48746
	* gfortran.dg/realloc_on_assign_7.f03: Test bounds.

From-SVN: r173213

gcc/fortran/ChangeLog

+2011-04-30  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/48746
+	* trans-expr.c (fcncall_realloc_result): Set the bounds and the
+	offset so that the lbounds are one.
+	(gfc_trans_arrayfunc_assign): Add rank to arguments of above.
+
 2011-04-29  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/48462

gcc/fortran/trans-expr.c

@@ -5539,11 +5539,13 @@ realloc_lhs_loop_for_fcn_call (gfc_se *se, locus *where, gfc_ss **ss,
    result to the original descriptor.  */
 
 static void
-fcncall_realloc_result (gfc_se *se)
+fcncall_realloc_result (gfc_se *se, int rank)
 {
   tree desc;
   tree res_desc;
   tree tmp;
+  tree offset;
+  int n;
 
   /* Use the allocation done by the library.  Substitute the lhs
      descriptor with a copy, whose data field is nulled.*/
@@ -5555,13 +5557,44 @@ fcncall_realloc_result (gfc_se *se)
   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.  */
+  /* Free the lhs after the function call and copy the result to
+     the lhs descriptor.  */
   tmp = gfc_conv_descriptor_data_get (desc);
   tmp = gfc_call_free (fold_convert (pvoid_type_node, tmp));
   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);
+  gfc_add_modify (&se->post, desc, res_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);
 }
 
 
@@ -5631,7 +5664,7 @@ gfc_trans_arrayfunc_assign (gfc_expr * expr1, gfc_expr * expr2)
 	  ss->is_alloc_lhs = 1;
 	}
       else
-	fcncall_realloc_result (&se);
+	fcncall_realloc_result (&se, expr1->rank);
     }
 
   gfc_conv_function_expr (&se, expr2);

gcc/testsuite/ChangeLog

+2011-04-30  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/48746
+	* gfortran.dg/realloc_on_assign_7.f03: Test bounds.
+
 2011-04-30  Jakub Jelinek  <jakub@redhat.com>
 
 	PR tree-optimization/48809

gcc/testsuite/gfortran.dg/realloc_on_assign_7.f03

@@ -77,5 +77,8 @@ contains
     call random_number(a)
     call random_number(b)
     tmp = matmul(a,b)
+    if (any (lbound (tmp) .ne. [1,1])) call abort
+    if (any (ubound (tmp) .ne. [10,12])) call abort
   end subroutine
 end program main
+