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