1! { dg-do run }
2
3function f1 ()
4  use omp_lib
5  real :: f1
6  logical :: l
7  f1 = 6.5
8  l = .false.
9!$omp parallel firstprivate (f1) num_threads (2) reduction (.or.:l)
10  l = f1 .ne. 6.5
11  if (omp_get_thread_num () .eq. 0) f1 = 8.5
12  if (omp_get_thread_num () .eq. 1) f1 = 14.5
13!$omp barrier
14  l = l .or. (omp_get_thread_num () .eq. 0 .and. f1 .ne. 8.5)
15  l = l .or. (omp_get_thread_num () .eq. 1 .and. f1 .ne. 14.5)
16!$omp end parallel
17  if (l) call abort
18  f1 = -2.5
19end function f1
20function f2 ()
21  use omp_lib
22  real :: f2, e2
23  logical :: l
24entry e2 ()
25  f2 = 6.5
26  l = .false.
27!$omp parallel firstprivate (e2) num_threads (2) reduction (.or.:l)
28  l = e2 .ne. 6.5
29  if (omp_get_thread_num () .eq. 0) e2 = 8.5
30  if (omp_get_thread_num () .eq. 1) e2 = 14.5
31!$omp barrier
32  l = l .or. (omp_get_thread_num () .eq. 0 .and. e2 .ne. 8.5)
33  l = l .or. (omp_get_thread_num () .eq. 1 .and. e2 .ne. 14.5)
34!$omp end parallel
35  if (l) call abort
36  e2 = 7.5
37end function f2
38function f3 ()
39  use omp_lib
40  real :: f3, e3
41  logical :: l
42entry e3 ()
43  f3 = 6.5
44  l = .false.
45!$omp parallel firstprivate (f3, e3) num_threads (2) reduction (.or.:l)
46  l = e3 .ne. 6.5
47  l = l .or. f3 .ne. 6.5
48  if (omp_get_thread_num () .eq. 0) e3 = 8.5
49  if (omp_get_thread_num () .eq. 1) e3 = 14.5
50  f3 = e3 - 4.5
51!$omp barrier
52  l = l .or. (omp_get_thread_num () .eq. 0 .and. e3 .ne. 8.5)
53  l = l .or. (omp_get_thread_num () .eq. 1 .and. e3 .ne. 14.5)
54  l = l .or. f3 .ne. e3 - 4.5
55!$omp end parallel
56  if (l) call abort
57  e3 = 0.5
58end function f3
59function f4 () result (r4)
60  use omp_lib
61  real :: r4, s4
62  logical :: l
63entry e4 () result (s4)
64  r4 = 6.5
65  l = .false.
66!$omp parallel firstprivate (r4, s4) num_threads (2) reduction (.or.:l)
67  l = s4 .ne. 6.5
68  l = l .or. r4 .ne. 6.5
69  if (omp_get_thread_num () .eq. 0) s4 = 8.5
70  if (omp_get_thread_num () .eq. 1) s4 = 14.5
71  r4 = s4 - 4.5
72!$omp barrier
73  l = l .or. (omp_get_thread_num () .eq. 0 .and. s4 .ne. 8.5)
74  l = l .or. (omp_get_thread_num () .eq. 1 .and. s4 .ne. 14.5)
75  l = l .or. r4 .ne. s4 - 4.5
76!$omp end parallel
77  if (l) call abort
78  s4 = -0.5
79end function f4
80function f5 (is_f5)
81  use omp_lib
82  real :: f5
83  integer :: e5
84  logical :: l, is_f5
85entry e5 (is_f5)
86  if (is_f5) then
87    f5 = 6.5
88  else
89    e5 = 8
90  end if
91  l = .false.
92!$omp parallel firstprivate (f5, e5) shared (is_f5) num_threads (2) &
93!$omp reduction (.or.:l)
94  if (.not. is_f5) l = l .or. e5 .ne. 8
95  if (is_f5) l = l .or. f5 .ne. 6.5
96  if (omp_get_thread_num () .eq. 0) e5 = 8
97  if (omp_get_thread_num () .eq. 1) e5 = 14
98  f5 = e5 - 4.5
99!$omp barrier
100  l = l .or. (omp_get_thread_num () .eq. 0 .and. e5 .ne. 8)
101  l = l .or. (omp_get_thread_num () .eq. 1 .and. e5 .ne. 14)
102  l = l .or. f5 .ne. e5 - 4.5
103!$omp end parallel
104  if (l) call abort
105  if (is_f5) f5 = -2.5
106  if (.not. is_f5) e5 = 8
107end function f5
108
109  real :: f1, f2, e2, f3, e3, f4, e4, f5
110  integer :: e5
111  if (f1 () .ne. -2.5) call abort
112  if (f2 () .ne. 7.5) call abort
113  if (e2 () .ne. 7.5) call abort
114  if (f3 () .ne. 0.5) call abort
115  if (e3 () .ne. 0.5) call abort
116  if (f4 () .ne. -0.5) call abort
117  if (e4 () .ne. -0.5) call abort
118  if (f5 (.true.) .ne. -2.5) call abort
119  if (e5 (.false.) .ne. 8) call abort
120end
121