[Patch, fortran] PR fortran/51250 bug with sum(,dim,mask)

[Mikael Morin <mikael dot morin at sfr dot fr>]

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

Attachment: pr51250.CL
Description: Text document

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.  */

Attachment: pr51250_tests.CL
Description: Text document

! { dg-do run }
!
! PR fortran/51250
! Wrong loop shape for SUM when arguments are library-allocated arrays.
!
! Original testcase provided by Harald Anlauf <anlauf@gmx.de>

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