xref: /openbsd-src/gnu/gcc/libgomp/testsuite/libgomp.fortran/omp_parse2.f90 (revision 404b540a9034ac75a6199ad1a32d1bbc7a0d4210)
1*404b540aSrobert! { dg-do run }
2*404b540aSrobertuse omp_lib
3*404b540aSrobert  call test_master
4*404b540aSrobert  call test_critical
5*404b540aSrobert  call test_barrier
6*404b540aSrobert  call test_atomic
7*404b540aSrobert
8*404b540aSrobertcontains
9*404b540aSrobert  subroutine test_master
10*404b540aSrobert    logical :: i, j
11*404b540aSrobert    i = .false.
12*404b540aSrobert    j = .false.
13*404b540aSrobert!$omp parallel num_threads (4)
14*404b540aSrobert!$omp master
15*404b540aSrobert    i = .true.
16*404b540aSrobert    j = omp_get_thread_num () .eq. 0
17*404b540aSrobert!$omp endmaster
18*404b540aSrobert!$omp end parallel
19*404b540aSrobert    if (.not. (i .or. j)) call abort
20*404b540aSrobert  end subroutine test_master
21*404b540aSrobert
22*404b540aSrobert  subroutine test_critical_1 (i, j)
23*404b540aSrobert    integer :: i, j
24*404b540aSrobert!$omp critical(critical_foo)
25*404b540aSrobert    i = i + 1
26*404b540aSrobert!$omp end critical (critical_foo)
27*404b540aSrobert!$omp critical
28*404b540aSrobert    j = j + 1
29*404b540aSrobert!$omp end critical
30*404b540aSrobert    end subroutine test_critical_1
31*404b540aSrobert
32*404b540aSrobert  subroutine test_critical
33*404b540aSrobert    integer :: i, j, n
34*404b540aSrobert    n = -1
35*404b540aSrobert    i = 0
36*404b540aSrobert    j = 0
37*404b540aSrobert!$omp parallel num_threads (4)
38*404b540aSrobert    if (omp_get_thread_num () .eq. 0) n = omp_get_num_threads ()
39*404b540aSrobert    call test_critical_1 (i, j)
40*404b540aSrobert    call test_critical_1 (i, j)
41*404b540aSrobert!$omp critical
42*404b540aSrobert    j = j + 1
43*404b540aSrobert!$omp end critical
44*404b540aSrobert!$omp critical (critical_foo)
45*404b540aSrobert    i = i + 1
46*404b540aSrobert!$omp endcritical (critical_foo)
47*404b540aSrobert!$omp end parallel
48*404b540aSrobert    if (n .lt. 1 .or. i .ne. n * 3 .or. j .ne. n * 3) call abort
49*404b540aSrobert  end subroutine test_critical
50*404b540aSrobert
51*404b540aSrobert  subroutine test_barrier
52*404b540aSrobert    integer :: i
53*404b540aSrobert    logical :: j
54*404b540aSrobert    i = 23
55*404b540aSrobert    j = .false.
56*404b540aSrobert!$omp parallel num_threads (4)
57*404b540aSrobert    if (omp_get_thread_num () .eq. 0) i = 5
58*404b540aSrobert!$omp flush (i)
59*404b540aSrobert!$omp barrier
60*404b540aSrobert    if (i .ne. 5) then
61*404b540aSrobert!$omp atomic
62*404b540aSrobert      j = j .or. .true.
63*404b540aSrobert    end if
64*404b540aSrobert!$omp end parallel
65*404b540aSrobert    if (i .ne. 5 .or. j) call abort
66*404b540aSrobert  end subroutine test_barrier
67*404b540aSrobert
68*404b540aSrobert  subroutine test_atomic
69*404b540aSrobert    integer :: a, b, c, d, e, f, g
70*404b540aSrobert    a = 0
71*404b540aSrobert    b = 1
72*404b540aSrobert    c = 0
73*404b540aSrobert    d = 1024
74*404b540aSrobert    e = 1024
75*404b540aSrobert    f = -1
76*404b540aSrobert    g = -1
77*404b540aSrobert!$omp parallel num_threads (8)
78*404b540aSrobert!$omp atomic
79*404b540aSrobert    a = a + 2 + 4
80*404b540aSrobert!$omp atomic
81*404b540aSrobert    b = 3 * b
82*404b540aSrobert!$omp atomic
83*404b540aSrobert    c = 8 - c
84*404b540aSrobert!$omp atomic
85*404b540aSrobert    d = d / 2
86*404b540aSrobert!$omp atomic
87*404b540aSrobert    e = min (e, omp_get_thread_num ())
88*404b540aSrobert!$omp atomic
89*404b540aSrobert    f = max (omp_get_thread_num (), f)
90*404b540aSrobert    if (omp_get_thread_num () .eq. 0) g = omp_get_num_threads ()
91*404b540aSrobert!$omp end parallel
92*404b540aSrobert    if (g .le. 0 .or. g .gt. 8) call abort
93*404b540aSrobert    if (a .ne. 6 * g .or. b .ne. 3 ** g) call abort
94*404b540aSrobert    if (iand (g, 1) .eq. 1) then
95*404b540aSrobert      if (c .ne. 8) call abort
96*404b540aSrobert    else if (c .ne. 0) then
97*404b540aSrobert      call abort
98*404b540aSrobert    end if
99*404b540aSrobert    if (d .ne. 1024 / (2 ** g)) call abort
100*404b540aSrobert    if (e .ne. 0 .or. f .ne. g - 1) call abort
101*404b540aSrobert  end subroutine test_atomic
102*404b540aSrobertend
103