1! Really test where inside forall with temporary
2program evil_where
3  implicit none
4  type t
5    logical valid
6    integer :: s
7    integer, dimension(:), pointer :: p
8  end type
9  type (t), dimension (5) :: v
10  integer i
11
12  allocate (v(1)%p(2))
13  allocate (v(2)%p(8))
14  v(3)%p => NULL()
15  allocate (v(4)%p(8))
16  allocate (v(5)%p(2))
17
18  v(:)%valid = (/.true., .true., .false., .true., .true./)
19  v(:)%s = (/1, 8, 999, 6, 2/)
20  v(1)%p(:) = (/9, 10/)
21  v(2)%p(:) = (/1, 2, 3, 4, 5, 6, 7, 8/)
22  v(4)%p(:) = (/13, 14, 15, 16, 17, 18, 19, 20/)
23  v(5)%p(:) = (/11, 12/)
24
25  forall (i=1:5,v(i)%valid)
26    where (v(i)%p(1:v(i)%s).gt.4)
27      v(i)%p(1:v(i)%s) = v(6-i)%p(1:v(i)%s)
28    end where
29  end forall
30
31  if (any(v(1)%p(:) .ne. (/11, 10/))) call abort
32  if (any(v(2)%p(:) .ne. (/1, 2, 3, 4, 17, 18, 19, 20/))) call abort
33  if (any(v(4)%p(:) .ne. (/1, 2, 3, 4, 5, 6, 19, 20/))) call abort
34  if (any(v(5)%p(:) .ne. (/9, 10/))) call abort
35
36  v(1)%p(:) = (/9, 10/)
37  v(2)%p(:) = (/1, 2, 3, 4, 5, 6, 7, 8/)
38  v(4)%p(:) = (/13, 14, 15, 16, 17, 18, 19, 20/)
39  v(5)%p(:) = (/11, 12/)
40
41  forall (i=1:5,v(i)%valid)
42    where (v(i)%p(1:v(i)%s).le.4)
43      v(i)%p(1:v(i)%s) = v(6-i)%p(1:v(i)%s)
44    end where
45  end forall
46
47  if (any(v(1)%p(:) .ne. (/9, 10/))) call abort
48  if (any(v(2)%p(:) .ne. (/13, 14, 15, 16, 5, 6, 7, 8/))) call abort
49  if (any(v(4)%p(:) .ne. (/13, 14, 15, 16, 17, 18, 19, 20/))) call abort
50  if (any(v(5)%p(:) .ne. (/11, 12/))) call abort
51
52  ! I should really free the memory I've allocated.
53end program
54