gcc/testsuite/gfortran.fortran-torture/execute/where_1.f90

   1 ! Program to test WHERE inside FORALL
   2 program where_1
   3    integer :: A(5,5)
   4
   5    A(1,:) = (/1,0,0,0,0/)
   6    A(2,:) = (/2,1,1,1,0/)
   7    A(3,:) = (/1,2,2,0,2/)
   8    A(4,:) = (/2,1,0,2,3/)
   9    A(5,:) = (/1,0,0,0,0/)
  10
  11    ! Where inside FORALL.
  12    ! WHERE masks must be evaluated before executing the assignments
  13    forall (I=1:5)
  14       where (A(I,:) .EQ. 0)
  15          A(:,I) = I
  16       elsewhere (A(I,:) >2)
  17          A(I,:) = 6
  18       endwhere
  19    end forall
  20
  21    if (any (A .ne. reshape ((/1, 1, 1, 1, 1, 0, 1, 2, 1, 2, 0, 1, 2, 3, 0, &
  22       0, 1, 4, 2, 0, 0, 5, 6, 6, 5/), (/5, 5/)))) call abort
  23
  24    ! Where inside DO
  25    A(1,:) = (/1,0,0,0,0/)
  26    A(2,:) = (/2,1,1,1,0/)
  27    A(3,:) = (/1,2,2,0,2/)
  28    A(4,:) = (/2,1,0,2,3/)
  29    A(5,:) = (/1,0,0,0,0/)
  30
  31    do I=1,5
  32       where (A(I,:) .EQ. 0)
  33          A(:,I) = I
  34       elsewhere (A(I,:) >2)
  35          A(I,:) = 6
  36       endwhere
  37    enddo
  38
  39    if (any (A .ne. reshape ((/1, 1, 1, 1, 1, 0, 1, 2, 1, 2, 0, 1, 2, 6, 0, &
  40       0, 1, 0, 2, 0, 0, 0, 5, 5, 5/), (/5, 5/)))) call abort
  41 end