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