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)) stop 1
15  call omp_unset_lock (lck)
16  if (.not. omp_test_lock (lck)) stop 2
17  if (omp_test_lock (lck)) stop 3
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) stop 4
23  call omp_set_nest_lock (nlck)
24  if (omp_test_nest_lock (nlck) .ne. 3) stop 5
25  call omp_unset_nest_lock (nlck)
26  call omp_unset_nest_lock (nlck)
27  if (omp_test_nest_lock (nlck) .ne. 2) stop 6
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 ()) stop 7
34  call omp_set_dynamic (.false.)
35  if (omp_get_dynamic ()) stop 8
36
37  call omp_set_nested (.true.)
38  if (.not. omp_get_nested ()) stop 9
39  call omp_set_nested (.false.)
40  if (omp_get_nested ()) stop 10
41
42  call omp_set_num_threads (5)
43  if (omp_get_num_threads () .ne. 1) stop 11
44  if (omp_get_max_threads () .ne. 5) stop 12
45  if (omp_get_thread_num () .ne. 0) stop 13
46  call omp_set_num_threads (3)
47  if (omp_get_num_threads () .ne. 1) stop 14
48  if (omp_get_max_threads () .ne. 3) stop 15
49  if (omp_get_thread_num () .ne. 0) stop 16
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) stop 17
60
61  if (omp_get_num_procs () .le. 0) stop 18
62  if (omp_in_parallel ()) stop 19
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  if (l) stop 20
70
71  e = omp_get_wtime ()
72  if (d .gt. e) stop 21
73  d = omp_get_wtick ()
74  ! Negative precision is definitely wrong,
75  ! bigger than 1s clock resolution is also strange
76  if (d .le. 0 .or. d .gt. 1.) stop 22
77end
78