1! { dg-do run }
2! { dg-additional-options "-Wno-deprecated-declarations" }
3
4  use omp_lib
5
6  double precision :: d, e
7  logical :: l
8  integer (kind = omp_lock_kind) :: lck
9  integer (kind = omp_nest_lock_kind) :: nlck
10
11  d = omp_get_wtime ()
12
13  call omp_init_lock (lck)
14  call omp_set_lock (lck)
15  if (omp_test_lock (lck)) stop 1
16  call omp_unset_lock (lck)
17  if (.not. omp_test_lock (lck)) stop 2
18  if (omp_test_lock (lck)) stop 3
19  call omp_unset_lock (lck)
20  call omp_destroy_lock (lck)
21
22  call omp_init_nest_lock (nlck)
23  if (omp_test_nest_lock (nlck) .ne. 1) stop 4
24  call omp_set_nest_lock (nlck)
25  if (omp_test_nest_lock (nlck) .ne. 3) stop 5
26  call omp_unset_nest_lock (nlck)
27  call omp_unset_nest_lock (nlck)
28  if (omp_test_nest_lock (nlck) .ne. 2) stop 6
29  call omp_unset_nest_lock (nlck)
30  call omp_unset_nest_lock (nlck)
31  call omp_destroy_nest_lock (nlck)
32
33  call omp_set_dynamic (.true.)
34  if (.not. omp_get_dynamic ()) stop 7
35  call omp_set_dynamic (.false.)
36  if (omp_get_dynamic ()) stop 8
37
38  call omp_set_nested (.true.)
39  if (.not. omp_get_nested ()) stop 9
40  call omp_set_nested (.false.)
41  if (omp_get_nested ()) stop 10
42
43  call omp_set_num_threads (5)
44  if (omp_get_num_threads () .ne. 1) stop 11
45  if (omp_get_max_threads () .ne. 5) stop 12
46  if (omp_get_thread_num () .ne. 0) stop 13
47  call omp_set_num_threads (3)
48  if (omp_get_num_threads () .ne. 1) stop 14
49  if (omp_get_max_threads () .ne. 3) stop 15
50  if (omp_get_thread_num () .ne. 0) stop 16
51  l = .false.
52!$omp parallel reduction (.or.:l)
53  l = omp_get_num_threads () .ne. 3
54  l = l .or. (omp_get_thread_num () .lt. 0)
55  l = l .or. (omp_get_thread_num () .ge. 3)
56!$omp master
57  l = l .or. (omp_get_thread_num () .ne. 0)
58!$omp end master
59!$omp end parallel
60  if (l) stop 17
61
62  if (omp_get_num_procs () .le. 0) stop 18
63  if (omp_in_parallel ()) stop 19
64!$omp parallel reduction (.or.:l)
65  l = .not. omp_in_parallel ()
66!$omp end parallel
67!$omp parallel reduction (.or.:l) if (.true.)
68  l = .not. omp_in_parallel ()
69!$omp end parallel
70  if (l) stop 20
71
72  e = omp_get_wtime ()
73  if (d .gt. e) stop 21
74  d = omp_get_wtick ()
75  ! Negative precision is definitely wrong,
76  ! bigger than 1s clock resolution is also strange
77  if (d .le. 0 .or. d .gt. 1.) stop 22
78end
79