1! { dg-do run }
2!
3! PR fortran/51250
4! Wrong loop shape for SUM when arguments are library-allocated arrays.
5!
6! Original testcase provided by Harald Anlauf <anlauf@gmx.de>
7
8program gfcbug115
9  implicit none
10  integer :: n_obstype = 2
11  integer :: nboxes = 1
12  integer :: nprocs = 1
13  integer :: nbox, j
14  integer, allocatable :: nbx(:,:), pes(:)
15
16  allocate (pes(nboxes))
17  allocate (nbx(n_obstype,nboxes))
18  nbx(:,:) = 1
19  do j = 1, nboxes
20     pes(j) = modulo (j-1, nprocs)
21  end do
22  if (any(nbx /= 1)) STOP 1
23  do j = 0, nprocs-1
24     if (.not. all(spread (pes==j,dim=1,ncopies=n_obstype))) STOP 2
25     ! The two following tests used to fail
26     if (any(shape(sum(nbx,dim=2,mask=spread (pes==j,dim=1,ncopies=n_obstype))) &
27             /= (/ 2 /))) STOP 3
28     if (any(sum (nbx,dim=2,mask=spread (pes==j,dim=1,ncopies=n_obstype)) &
29             /= (/ 1, 1 /))) STOP 4
30  end do
31end program gfcbug115
32