libgomp/testsuite/libgomp.fortran/omp_parse3.f90

   1 ! { dg-do run }
   2 ! { dg-require-effective-target tls_runtime }
   3 use omp_lib
   4   common /tlsblock/ x, y
   5   integer :: x, y, z
   6   save z
   7 !$omp threadprivate (/tlsblock/, z)
   8
   9   call test_flush
  10   call test_ordered
  11   call test_threadprivate
  12
  13 contains
  14   subroutine test_flush
  15     integer :: i, j
  16     i = 0
  17     j = 0
  18 !$omp parallel num_threads (4)
  19     if (omp_get_thread_num () .eq. 0) i = omp_get_num_threads ()
  20     if (omp_get_thread_num () .eq. 0) j = j + 1
  21 !$omp flush (i, j)
  22 !$omp barrier
  23     if (omp_get_thread_num () .eq. 1) j = j + 2
  24 !$omp flush
  25 !$omp barrier
  26     if (omp_get_thread_num () .eq. 2) j = j + 3
  27 !$omp flush (i)
  28 !$omp flush (j)
  29 !$omp barrier
  30     if (omp_get_thread_num () .eq. 3) j = j + 4
  31 !$omp end parallel
  32   end subroutine test_flush
  33
  34   subroutine test_ordered
  35     integer :: i, j
  36     integer, dimension (100) :: d
  37     d(:) = -1
  38 !$omp parallel do ordered schedule (dynamic) num_threads (4)
  39     do i = 1, 100, 5
  40 !$omp ordered
  41       d(i) = i
  42 !$omp end ordered
  43     end do
  44     j = 1
  45     do 100 i = 1, 100
  46       if (i .eq. j) then
  47         if (d(i) .ne. i) call abort
  48         j = i + 5
  49       else
  50         if (d(i) .ne. -1) call abort
  51       end if
  52 100   d(i) = -1
  53   end subroutine test_ordered
  54
  55   subroutine test_threadprivate
  56     common /tlsblock/ x, y
  57 !$omp threadprivate (/tlsblock/)
  58     integer :: i, j, x, y
  59     logical :: m, n
  60     call omp_set_num_threads (4)
  61     call omp_set_dynamic (.false.)
  62     i = -1
  63     x = 6
  64     y = 7
  65     z = 8
  66     n = .false.
  67     m = .false.
  68 !$omp parallel copyin (/tlsblock/, z) reduction (.or.:m) &
  69 !$omp& num_threads (4)
  70     if (omp_get_thread_num () .eq. 0) i = omp_get_num_threads ()
  71     if (x .ne. 6 .or. y .ne. 7 .or. z .ne. 8) call abort
  72     x = omp_get_thread_num ()
  73     y = omp_get_thread_num () + 1024
  74     z = omp_get_thread_num () + 4096
  75 !$omp end parallel
  76     if (x .ne. 0 .or. y .ne. 1024 .or. z .ne. 4096) call abort
  77 !$omp parallel num_threads (4), private (j) reduction (.or.:n)
  78     if (omp_get_num_threads () .eq. i) then
  79       j = omp_get_thread_num ()
  80       if (x .ne. j .or. y .ne. j + 1024 .or. z .ne. j + 4096) &
  81 &       call abort
  82     end if
  83 !$omp end parallel
  84     m = m .or. n
  85     n = .false.
  86 !$omp parallel num_threads (4), copyin (z) reduction (.or. : n) &
  87 !$omp&private (j)
  88     if (z .ne. 4096) n = .true.
  89     if (omp_get_num_threads () .eq. i) then
  90       j = omp_get_thread_num ()
  91       if (x .ne. j .or. y .ne. j + 1024) call abort
  92     end if
  93 !$omp end parallel
  94     if (m .or. n) call abort
  95   end subroutine test_threadprivate
  96 end