libgomp/testsuite/libgomp.fortran/omp_atomic2.f90

   1 ! { dg-do run }
   2 ! { dg-options "-std=legacy" }
   3
   4   real, dimension (20) :: r
   5   integer, dimension (20) :: d
   6   integer :: i, j, k, n
   7   integer (kind = 2) :: a, b, c
   8
   9   do 10 i = 1, 20
  10     r(i) = i
  11 10  d(i) = 21 - i
  12
  13   n = 20
  14   call foo (r, d, n)
  15
  16   if (n .ne. 22) STOP 1
  17   if (any (r .ne. 33)) STOP 2
  18
  19   i = 1
  20   j = 18
  21   k = 23
  22 !$omp atomic
  23   i = min (i, j, k, n)
  24   if (i .ne. 1) STOP 3
  25 !$omp atomic
  26   i = max (j, n, k, i)
  27   if (i .ne. 23) STOP 4
  28
  29   a = 1
  30   b = 18
  31   c = 23
  32 !$omp atomic
  33   a = min (a, b, c)
  34   if (a .ne. 1) STOP 5
  35 !$omp atomic
  36   a = max (a, b, c)
  37   if (a .ne. 23) STOP 6
  38
  39 contains
  40   function bar (i)
  41     real bar
  42     integer i
  43     bar = 12.0 + i
  44   end function bar
  45
  46   subroutine foo (x, y, n)
  47     integer i, y (*), n
  48     real x (*)
  49     do i = 1, n
  50 !$omp atomic
  51       x(y(i)) = x(y(i)) + bar (i)
  52     end do
  53 !$omp atomic
  54     n = n + 2
  55   end subroutine foo
  56 end