gcc/testsuite/gfortran.dg/forall_4.f90

   1 ! { dg-do run }
   2 ! Tests the fix for PR25072, in which mask expressions
   3 ! that start with an internal or intrinsic function
   4 ! reference would give a syntax error.
   5 !
   6 ! The fix for PR28119 is tested as well; here, the forall
   7 ! statement could not be followed by another statement on
   8 ! the same line.
   9 !
  10 ! Contributed by Paul Thomas  <pault@gcc.gnu.org>
  11 !
  12 module foo
  13   integer, parameter :: n = 4
  14 contains
  15   pure logical function foot (i)
  16     integer, intent(in) :: i
  17     foot = (i == 2) .or. (i == 3)
  18   end function foot
  19 end module foo
  20
  21   use foo
  22   integer :: i, a(n)
  23   logical :: s(n)
  24   s = (/(foot (i), i=1, n)/)
  25
  26 ! Check that non-mask case is still OK and the fix for PR28119
  27   a = 0
  28   forall (i=1:n) a(i) = i ; if (any (a .ne. (/1,2,3,4/))) call abort ()
  29
  30 ! Now a mask using a function with an explicit interface
  31 ! via use association.
  32   a = 0
  33   forall (i=1:n, foot (i)) a(i) = i
  34   if (any (a .ne. (/0,2,3,0/))) call abort ()
  35
  36 ! Now an array variable mask
  37   a = 0
  38   forall (i=1:n, .not. s(i)) a(i) = i
  39   if (any (a .ne. (/1,0,0,4/))) call abort ()
  40
  41 ! This was the PR - an internal function mask
  42   a = 0
  43   forall (i=1:n, t (i)) a(i) = i
  44   if (any (a .ne. (/0,2,0,4/))) call abort ()
  45
  46 ! Check that an expression is OK - this also gave a syntax
  47 ! error
  48   a = 0
  49   forall (i=1:n, mod (i, 2) == 0) a(i) = i
  50   if (any (a .ne. (/0,2,0,4/))) call abort ()
  51
  52 ! And that an expression that used to work is OK
  53   a = 0
  54   forall (i=1:n, s (i) .or. t(i)) a(i) = w (i)
  55   if (any (a .ne. (/0,3,2,1/))) call abort ()
  56
  57 contains
  58   pure logical function t(i)
  59     integer, intent(in) :: i
  60     t = (mod (i, 2) == 0)
  61   end function t
  62   pure integer function w(i)
  63     integer, intent(in) :: i
  64     w = 5 - i
  65   end function w
  66 end
  67 ! { dg-final { cleanup-modules "foo" } }