Hello,
this patch fixes a regression introduced by my recent inline sum change(s).
This change:
http://gcc.gnu.org/viewcvs?view=revision&revision=180895
inserts a loop in gfc_trans_create_temp_array from:
if (size == NULL_TREE)
for (n = 0; n < ss->loop->dimen; n++)
to:
if (size == NULL_TREE)
for (s = ss; s; s = s->parent)
for (n = 0; n < s->loop->dimen; n++)
That is we take care of array dimensions scattered in more than one loop.
As a result of this, usages of 'ss' (before the patch the only one loop's
array info, and after it the innermost loop's one) have to be replaced with
usages of 's' (the current loop's one).
One of them was forgotten, resulting in loops with library-allocated arrays
geting the wrong shape (that from the innermost loop).
This patch fixes it.
Regression tested on x86_64-unknown-linux-gnu. OK for trunk?
Mikael
2011-11-24 Mikael Morin <[email protected]>
PR fortran/51250
PR fortran/43829
* trans-array.c (gfc_trans_create_temp_array): Get dimension from
the right gfc_ss struct.
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 2fb2d34..ee8f896 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -1087,7 +1087,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss,
for (s = ss; s; s = s->parent)
for (n = 0; n < s->loop->dimen; n++)
{
- dim = get_scalarizer_dim_for_array_dim (ss, ss->dim[n]);
+ dim = get_scalarizer_dim_for_array_dim (ss, s->dim[n]);
/* For a callee allocated array express the loop bounds in terms
of the descriptor fields. */
2011-11-24 Mikael Morin <[email protected]>
PR fortran/51250
PR fortran/43829
* gfortran.dg/inline_sum_3.f90: New test.
! { dg-do run }
!
! PR fortran/51250
! Wrong loop shape for SUM when arguments are library-allocated arrays.
!
! Original testcase provided by Harald Anlauf <[email protected]>
program gfcbug115
implicit none
integer :: n_obstype = 2
integer :: nboxes = 1
integer :: nprocs = 1
integer :: nbox, j
integer, allocatable :: nbx(:,:), pes(:)
allocate (pes(nboxes))
allocate (nbx(n_obstype,nboxes))
nbx(:,:) = 1
do j = 1, nboxes
pes(j) = modulo (j-1, nprocs)
end do
if (any(nbx /= 1)) call abort
do j = 0, nprocs-1
if (.not. all(spread (pes==j,dim=1,ncopies=n_obstype))) call abort
! The two following tests used to fail
if (any(shape(sum(nbx,dim=2,mask=spread (pes==j,dim=1,ncopies=n_obstype))) &
/= (/ 2 /))) call abort
if (any(sum (nbx,dim=2,mask=spread (pes==j,dim=1,ncopies=n_obstype)) &
/= (/ 1, 1 /))) call abort
end do
end program gfcbug115
