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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 0f7db3a441441fada1903a76246d27e7cb491300..e5b8d31e8b4c313db7deb291791c5360425da451 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+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

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 1582833a0541d636cf887a589fa6f5d5ef470fc3..3dde29837cbf0d2d46bb3b1fc0c25b1e6bed3f7c 100644 (file)
--- a/gcc/fortran/trans-expr.c
+++ b/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);

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 5eaa00da46af22d04c32b644c9fb7b50c23ec878..a4599ca9e56a70e03c6a18f04d004c27e740ca94 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+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

diff --git a/gcc/testsuite/gfortran.dg/realloc_on_assign_7.f03 b/gcc/testsuite/gfortran.dg/realloc_on_assign_7.f03
index ca9a2d943e91201c481db0c4ea225aa37e74a5c7..f871d273942b3d9284f7daea0892d99685ecc51e 100644 (file)
--- a/gcc/testsuite/gfortran.dg/realloc_on_assign_7.f03
+++ b/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
+