2012-01-31 Paul Thomas <pault@gcc.gnu.org>

	PR fortran/52012
	* trans-expr.c (fcncall_realloc_result): Correct calculation of
	result offset.

2012-01-31  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/52012
	* gfortran.dg/realloc_on_assign_10.f90: New test.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@183757 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 3fb70e0c12e63c70c02b422fd33891d4bfd12908..e836c0af382bf1be146a3fb7a86c9e33ddf4728e 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2012-01-31  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/52012
+       * trans-expr.c (fcncall_realloc_result): Correct calculation of
+       result offset.
+
 2012-01-29  Janne Blomqvist  <jb@gcc.gnu.org>
 
        * module.c (pointer_info): Make true_name and module pointers

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 7543149e32c6c01347231f116ab21e52565935e1..657b4f4fd5a974a327380eafe03fbb9b56891147 100644 (file)
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -6310,16 +6310,11 @@ fcncall_realloc_result (gfc_se *se, int rank)
   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.  */
+
+  /* Now reset the bounds from zero based to unity based and set the
+     offset accordingly.  */
   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,
@@ -6330,15 +6325,16 @@ fcncall_realloc_result (gfc_se *se, int rank)
       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);
+      /* Accumulate the offset.  Since all lbounds are unity, offset
+        is just minus the sum of the strides.  */
+      tmp = gfc_conv_descriptor_stride_get (desc, gfc_rank_cst[n]);
+      offset = fold_build2_loc (input_location, MINUS_EXPR,
+                               gfc_array_index_type,
+                               offset, tmp);
+      offset = gfc_evaluate_now (offset, &se->post);
+
     }
+
   gfc_conv_descriptor_offset_set (&se->post, desc, offset);
 }
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 77c86391983371293eaf84cd2cd8e6a3aa13eb53..ae4175f3482736d83666b7b70ba258910eda8be1 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2012-01-31  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/52012
+       * gfortran.dg/realloc_on_assign_10.f90: New test.
+
 2012-01-31  Richard Guenther  <rguenther@suse.de>
 
        PR tree-optimization/51528

diff --git a/gcc/testsuite/gfortran.dg/realloc_on_assign_10.f90 b/gcc/testsuite/gfortran.dg/realloc_on_assign_10.f90
new file mode 100644 (file)
index 0000000..787a56a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/realloc_on_assign_10.f90
@@ -0,0 +1,18 @@
+! { dg-do run }
+! PR52012 - with realloc_lhs active(ie. default condition) the
+! offset was wrongly calculated for a, after assignment.
+!
+! Reported by Reinhold Bader and Tobias Burnus  <burnus@gcc.gnu.org>
+! 
+program gf
+  implicit none
+  real, allocatable :: a(:,:,:)
+  real, parameter :: zero = 0.0, one = 1.0
+  real :: b(3,4,5) = zero
+  b(1,2,3) = one
+  allocate (a(size (b, 3), size (b, 2), size (b, 1)))
+  a = reshape (b, shape (a), order = [3, 2, 1])
+  if (any (a(:, 2, 1) .ne. [zero, zero, one, zero, zero])) call abort
+  if (a(3, 2, 1) /= one) call abort()
+  if (sum (abs (a)) /= one) call abort()
+end program