1module my_omp_mod
2 use iso_c_binding, only: c_loc
3 implicit none
4 integer :: v
5 interface
6   integer function omp_get_thread_num () bind(C)
7   end
8   integer function omp_get_num_threads () bind(C)
9   end
10   integer function omp_get_cancellation () bind(C)
11   end
12   integer function omp_target_is_present (ptr, device_num) bind(C)
13     use iso_c_binding, only: c_ptr
14     type(c_ptr), value :: ptr
15     integer :: device_num
16   end
17  end interface
18contains
19  subroutine foo ()
20  end
21end
22
23subroutine f1 (a, b)
24  use my_omp_mod
25  implicit none
26  integer :: a(:), b(:,:)
27  target :: a
28  integer i, j
29  !$omp simd order(concurrent)
30  do i = 1, 64
31    !$omp parallel		! { dg-error "OpenMP constructs other than 'ordered simd', 'simd', 'loop' or 'atomic' may not be nested inside 'simd' region" }
32    call foo ()
33    !$omp end parallel
34  end do
35  !$omp end simd
36  !$omp simd order(concurrent)
37  do i = 1, 64
38    !$omp simd
39    do j = 1, 64
40      b(j, i) = i + j
41    end do
42  end do
43  !$omp simd order(concurrent)
44  do i = 1, 64
45      !$omp critical		! { dg-error "OpenMP constructs other than 'ordered simd', 'simd', 'loop' or 'atomic' may not be nested inside 'simd' region" }
46      call foo ()
47      !$omp end critical
48  end do
49  !$omp simd order(concurrent)
50  do i = 1, 64
51    !$omp ordered simd		! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
52    call foo ()
53    !$omp end ordered
54  end do
55  !$omp simd order(concurrent)
56  do i = 1, 64
57    !$omp atomic		! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
58    v = v + 1
59  end do
60  !$omp simd order(concurrent)
61  do i = 1, 64
62    !$omp atomic read		! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause"  }
63    a(i) = v
64  end do
65  !$omp simd order(concurrent)
66  do i = 1, 64
67      !$omp atomic write	! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
68      v = a(i)
69  end do
70  !$omp simd order(concurrent)
71  do i = 1, 64
72    a(i) = a(i) + omp_get_thread_num ()  ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_thread_num\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
73  end do
74  !$omp simd order(concurrent)
75  do i = 1, 64
76    a(i) = a(i) + omp_get_num_threads ()  ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_num_threads\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
77  end do
78  !$omp simd order(concurrent)
79  do i = 1, 64
80    a(i) = a(i) + omp_target_is_present (c_loc(a(i)), 0)  ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_target_is_present\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
81  end do
82  !$omp simd order(concurrent)
83  do i = 1, 64
84    a(i) = a(i) + omp_get_cancellation ()  ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_cancellation\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
85  end do
86end
87
88subroutine f2 (a, b)
89  use my_omp_mod
90  implicit none
91  integer a(:), b(:,:)
92  target :: a
93  integer i, j
94  !$omp do simd order(concurrent)
95  do i = 1, 64
96    !$omp parallel		! { dg-error "OpenMP constructs other than 'ordered simd', 'simd', 'loop' or 'atomic' may not be nested inside 'simd' region" }
97    call foo ()
98    !$omp end parallel
99  end do
100  !$omp do simd order(concurrent)
101  do i = 1, 64
102    !$omp simd
103    do j = 1, 64
104      b (j, i) = i + j
105    end do
106  end do
107  !$omp do simd order(concurrent)
108  do i = 1, 64
109    !$omp critical		! { dg-error "OpenMP constructs other than 'ordered simd', 'simd', 'loop' or 'atomic' may not be nested inside 'simd' region" }
110    call foo ()
111    !$omp end critical
112  end do
113  !$omp do simd order(concurrent)
114  do i = 1, 64
115    !$omp ordered simd		! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
116    call foo ()
117    !$omp end ordered
118  end do
119  !$omp do simd order(concurrent)
120  do i = 1, 64
121    !$omp atomic		! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
122    v = v + 1
123  end do
124  !$omp do simd order(concurrent)
125  do i = 1, 64
126    !$omp atomic read		! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
127    a(i) = v
128  end do
129  !$omp do simd order(concurrent)
130  do i = 1, 64
131    !$omp atomic write		! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
132    v = a(i)
133  end do
134  !$omp do simd order(concurrent)
135  do i = 1, 64
136    a(i) = a(i) + omp_get_thread_num ()  ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_thread_num\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
137  end do
138  !$omp do simd order(concurrent)
139  do i = 1, 64
140    a(i) = a(i) + omp_get_num_threads ()  ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_num_threads\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
141  end do
142  !$omp do simd order(concurrent)
143  do i = 1, 64
144    a(i) = a(i) + omp_target_is_present (c_loc(a(i)), 0)  ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_target_is_present\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
145  end do
146  !$omp do simd order(concurrent)
147  do i = 1, 64
148    a(i) = a(i) + omp_get_cancellation ()  ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_cancellation\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
149  end do
150end
151
152subroutine f3 (a, b)
153  use my_omp_mod
154  implicit none
155  integer :: a(:), b(:,:)
156  target :: a
157  integer i, j
158  !$omp do order(concurrent)
159  do i = 1, 64
160    !$omp parallel
161    call foo ()
162    !$omp end parallel
163  end do
164  !$omp do order(concurrent)
165  do i = 1, 64
166    !$omp simd
167    do j = 1, 64
168      b(j, i) = i + j
169    end do
170  end do
171  !$omp do order(concurrent)
172  do i = 1, 64
173    !$omp critical		! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
174    call foo ()
175    !$omp end critical
176  end do
177  !$omp do order(concurrent)
178  do i = 1, 64
179    !$omp ordered simd		! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
180    call foo ()
181    !$omp end ordered
182  end do
183  !$omp do order(concurrent)
184  do i = 1, 64
185    !$omp atomic		! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
186    v = v + 1
187  end do
188  !$omp do order(concurrent)
189  do i = 1, 64
190    !$omp atomic read		! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
191    a(i) = v
192  end do
193  !$omp do order(concurrent)
194  do i = 1, 64
195    !$omp atomic write		! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
196    v = a(i)
197  end do
198  !$omp do order(concurrent)
199  do i = 1, 64
200    !$omp task			! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
201    a(i) = a(i) + 1
202    !$omp end task
203  end do
204  !$omp do order(concurrent)
205  do i = 1, 64
206    !$omp taskloop		! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
207    do j = 1, 64
208      b(j, i) = i + j
209    end do
210  end do
211  !$omp do order(concurrent)
212  do i = 1, 64
213    a(i) = a(i) + omp_get_thread_num ()  ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_thread_num\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
214  end do
215  !$omp do order(concurrent)
216  do i = 1, 64
217    a(i) = a(i) + omp_get_num_threads ()  ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_num_threads\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
218  end do
219  !$omp do order(concurrent)
220  do i = 1, 64
221    a(i) = a(i) + omp_target_is_present (c_loc(a(i)), 0)  ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_target_is_present\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
222  end do
223  !$omp do order(concurrent)
224  do i = 1, 64
225    a(i) = a(i) + omp_get_cancellation ()  ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_cancellation\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
226  end do
227end
228