1! RUN: %S/test_errors.sh %s %t %flang -fopenmp
2! REQUIRES: shell
3
4program main
5  implicit none
6  integer :: N
7  integer :: i
8  real(8) :: a(256), b(256)
9  N = 256
10
11  !ERROR: `DISTRIBUTE` region has to be strictly nested inside `TEAMS` region.
12  !$omp distribute simd
13  do i = 1, N
14     a(i) = 3.14
15  enddo
16  !$omp end distribute simd
17
18  !$omp target parallel device(0)
19  do i = 1, N
20     a(i) = 3.14
21  enddo
22  !$omp end target parallel
23
24  !ERROR: At most one DEVICE clause can appear on the TARGET PARALLEL directive
25  !$omp target parallel device(0) device(1)
26  do i = 1, N
27     a(i) = 3.14
28  enddo
29  !$omp end target parallel
30
31  !$omp target parallel defaultmap(tofrom:scalar)
32  do i = 1, N
33     a(i) = 3.14
34  enddo
35  !$omp end target parallel
36
37  !ERROR: The argument TOFROM:SCALAR must be specified on the DEFAULTMAP clause
38  !$omp target parallel defaultmap(tofrom)
39  do i = 1, N
40     a(i) = 3.14
41  enddo
42  !$omp end target parallel
43
44  !ERROR: At most one DEFAULTMAP clause can appear on the TARGET PARALLEL directive
45  !$omp target parallel defaultmap(tofrom:scalar) defaultmap(tofrom:scalar)
46  do i = 1, N
47     a(i) = 3.14
48  enddo
49  !$omp end target parallel
50
51  !$omp target parallel map(tofrom:a)
52  do i = 1, N
53     a(i) = 3.14
54  enddo
55  !$omp end target parallel
56
57  !ERROR: COPYIN clause is not allowed on the TARGET PARALLEL directive
58  !ERROR: Non-THREADPRIVATE object 'a' in COPYIN clause
59  !$omp target parallel copyin(a)
60  do i = 1, N
61     a(i) = 3.14
62  enddo
63  !$omp end target parallel
64
65  !$omp target parallel do device(0)
66  do i = 1, N
67     a(i) = 3.14
68  enddo
69  !$omp end target parallel do
70
71  !ERROR: At most one DEVICE clause can appear on the TARGET PARALLEL DO directive
72  !$omp target parallel do device(0) device(1)
73  do i = 1, N
74     a(i) = 3.14
75  enddo
76  !$omp end target parallel do
77
78  !$omp target parallel do defaultmap(tofrom:scalar)
79  do i = 1, N
80     a(i) = 3.14
81  enddo
82  !$omp end target parallel do
83
84  !ERROR: The argument TOFROM:SCALAR must be specified on the DEFAULTMAP clause
85  !$omp target parallel do defaultmap(tofrom)
86  do i = 1, N
87     a(i) = 3.14
88  enddo
89  !$omp end target parallel do
90
91  !ERROR: At most one DEFAULTMAP clause can appear on the TARGET PARALLEL DO directive
92  !$omp target parallel do defaultmap(tofrom:scalar) defaultmap(tofrom:scalar)
93  do i = 1, N
94     a(i) = 3.14
95  enddo
96  !$omp end target parallel do
97
98  !$omp target parallel do map(tofrom:a)
99  do i = 1, N
100     a(i) = 3.14
101  enddo
102  !$omp end target parallel do
103
104  !ERROR: Non-THREADPRIVATE object 'a' in COPYIN clause
105  !$omp target parallel do copyin(a)
106  do i = 1, N
107     a(i) = 3.14
108  enddo
109  !$omp end target parallel do
110
111  !$omp target teams map(a)
112  do i = 1, N
113     a(i) = 3.14
114  enddo
115  !$omp end target teams
116
117  !$omp target teams device(0)
118  do i = 1, N
119     a(i) = 3.14
120  enddo
121  !$omp end target teams
122
123  !ERROR: At most one DEVICE clause can appear on the TARGET TEAMS directive
124  !$omp target teams device(0) device(1)
125  do i = 1, N
126     a(i) = 3.14
127  enddo
128  !$omp end target teams
129
130  !ERROR: SCHEDULE clause is not allowed on the TARGET TEAMS directive
131  !$omp target teams schedule(static)
132  do i = 1, N
133     a(i) = 3.14
134  enddo
135  !$omp end target teams
136
137  !$omp target teams defaultmap(tofrom:scalar)
138  do i = 1, N
139     a(i) = 3.14
140  enddo
141  !$omp end target teams
142
143  !ERROR: The argument TOFROM:SCALAR must be specified on the DEFAULTMAP clause
144  !$omp target teams defaultmap(tofrom)
145  do i = 1, N
146     a(i) = 3.14
147  enddo
148  !$omp end target teams
149
150  !ERROR: At most one DEFAULTMAP clause can appear on the TARGET TEAMS directive
151  !$omp target teams defaultmap(tofrom:scalar) defaultmap(tofrom:scalar)
152  do i = 1, N
153     a(i) = 3.14
154  enddo
155  !$omp end target teams
156
157  !$omp target teams num_teams(3) thread_limit(10) default(shared) private(i) shared(a)
158  do i = 1, N
159     a(i) = 3.14
160  enddo
161  !$omp end target teams
162
163  !ERROR: At most one NUM_TEAMS clause can appear on the TARGET TEAMS directive
164  !$omp target teams num_teams(2) num_teams(3)
165  do i = 1, N
166     a(i) = 3.14
167  enddo
168  !$omp end target teams
169
170  !ERROR: The parameter of the NUM_TEAMS clause must be a positive integer expression
171  !$omp target teams num_teams(-1)
172  do i = 1, N
173     a(i) = 3.14
174  enddo
175  !$omp end target teams
176
177  !ERROR: At most one THREAD_LIMIT clause can appear on the TARGET TEAMS directive
178  !$omp target teams thread_limit(2) thread_limit(3)
179  do i = 1, N
180     a(i) = 3.14
181  enddo
182  !$omp end target teams
183
184  !ERROR: The parameter of the THREAD_LIMIT clause must be a positive integer expression
185  !$omp target teams thread_limit(-1)
186  do i = 1, N
187     a(i) = 3.14
188  enddo
189  !$omp end target teams
190
191  !ERROR: At most one DEFAULT clause can appear on the TARGET TEAMS directive
192  !$omp target teams default(shared) default(private)
193  do i = 1, N
194     a(i) = 3.14
195  enddo
196  !$omp end target teams
197
198  !$omp target teams num_teams(2) defaultmap(tofrom:scalar)
199  do i = 1, N
200      a(i) = 3.14
201  enddo
202  !$omp end target teams
203
204  !$omp target teams map(tofrom:a)
205  do i = 1, N
206     a(i) = 3.14
207  enddo
208  !$omp end target teams
209
210  !ERROR: Only the TO, FROM, TOFROM, ALLOC map types are permitted for MAP clauses on the TARGET TEAMS directive
211  !$omp target teams map(delete:a)
212  do i = 1, N
213     a(i) = 3.14
214  enddo
215  !$omp end target teams
216
217
218  !$omp target teams distribute map(a)
219  do i = 1, N
220     a(i) = 3.14
221  enddo
222  !$omp end target teams distribute
223
224  !$omp target teams distribute device(0)
225  do i = 1, N
226     a(i) = 3.14
227  enddo
228  !$omp end target teams distribute
229
230  !ERROR: At most one DEVICE clause can appear on the TARGET TEAMS DISTRIBUTE directive
231  !$omp target teams distribute device(0) device(1)
232  do i = 1, N
233     a(i) = 3.14
234  enddo
235  !$omp end target teams distribute
236
237  !$omp target teams distribute defaultmap(tofrom:scalar)
238  do i = 1, N
239     a(i) = 3.14
240  enddo
241  !$omp end target teams distribute
242
243  !ERROR: The argument TOFROM:SCALAR must be specified on the DEFAULTMAP clause
244  !$omp target teams distribute defaultmap(tofrom)
245  do i = 1, N
246     a(i) = 3.14
247  enddo
248  !$omp end target teams distribute
249
250  !ERROR: At most one DEFAULTMAP clause can appear on the TARGET TEAMS DISTRIBUTE directive
251  !$omp target teams distribute defaultmap(tofrom:scalar) defaultmap(tofrom:scalar)
252  do i = 1, N
253     a(i) = 3.14
254  enddo
255  !$omp end target teams distribute
256
257  !$omp target teams distribute num_teams(3) thread_limit(10) default(shared) private(i) shared(a)
258  do i = 1, N
259     a(i) = 3.14
260  enddo
261  !$omp end target teams distribute
262
263  !ERROR: At most one NUM_TEAMS clause can appear on the TARGET TEAMS DISTRIBUTE directive
264  !$omp target teams distribute num_teams(2) num_teams(3)
265  do i = 1, N
266     a(i) = 3.14
267  enddo
268  !$omp end target teams distribute
269
270  !ERROR: The parameter of the NUM_TEAMS clause must be a positive integer expression
271  !$omp target teams distribute num_teams(-1)
272  do i = 1, N
273     a(i) = 3.14
274  enddo
275  !$omp end target teams distribute
276
277  !ERROR: At most one THREAD_LIMIT clause can appear on the TARGET TEAMS DISTRIBUTE directive
278  !$omp target teams distribute thread_limit(2) thread_limit(3)
279  do i = 1, N
280     a(i) = 3.14
281  enddo
282  !$omp end target teams distribute
283
284  !ERROR: The parameter of the THREAD_LIMIT clause must be a positive integer expression
285  !$omp target teams distribute thread_limit(-1)
286  do i = 1, N
287     a(i) = 3.14
288  enddo
289  !$omp end target teams distribute
290
291  !ERROR: At most one DEFAULT clause can appear on the TARGET TEAMS DISTRIBUTE directive
292  !$omp target teams distribute default(shared) default(private)
293  do i = 1, N
294     a(i) = 3.14
295  enddo
296  !$omp end target teams distribute
297
298  !$omp target teams distribute num_teams(2) defaultmap(tofrom:scalar)
299  do i = 1, N
300      a(i) = 3.14
301  enddo
302  !$omp end target teams distribute
303
304  !$omp target teams distribute map(tofrom:a)
305  do i = 1, N
306     a(i) = 3.14
307  enddo
308  !$omp end target teams distribute
309
310  !ERROR: Only the TO, FROM, TOFROM, ALLOC map types are permitted for MAP clauses on the TARGET TEAMS DISTRIBUTE directive
311  !$omp target teams distribute map(delete:a)
312  do i = 1, N
313     a(i) = 3.14
314  enddo
315  !$omp end target teams distribute
316
317  !$omp target teams distribute parallel do device(0)
318  do i = 1, N
319     a(i) = 3.14
320  enddo
321  !$omp end target teams distribute parallel do
322
323  !ERROR: At most one DEVICE clause can appear on the TARGET TEAMS DISTRIBUTE PARALLEL DO directive
324  !$omp target teams distribute parallel do device(0) device(1)
325  do i = 1, N
326     a(i) = 3.14
327  enddo
328  !$omp end target teams distribute parallel do
329
330  !$omp target teams distribute parallel do defaultmap(tofrom:scalar)
331  do i = 1, N
332     a(i) = 3.14
333  enddo
334  !$omp end target teams distribute parallel do
335
336  !ERROR: The argument TOFROM:SCALAR must be specified on the DEFAULTMAP clause
337  !$omp target teams distribute parallel do defaultmap(tofrom)
338  do i = 1, N
339     a(i) = 3.14
340  enddo
341  !$omp end target teams distribute parallel do
342
343  !ERROR: At most one DEFAULTMAP clause can appear on the TARGET TEAMS DISTRIBUTE PARALLEL DO directive
344  !$omp target teams distribute parallel do defaultmap(tofrom:scalar) defaultmap(tofrom:scalar)
345  do i = 1, N
346     a(i) = 3.14
347  enddo
348  !$omp end target teams distribute parallel do
349
350  !$omp target teams distribute parallel do num_teams(3) thread_limit(10) default(shared) private(i) shared(a)
351  do i = 1, N
352     a(i) = 3.14
353  enddo
354  !$omp end target teams distribute parallel do
355
356  !ERROR: At most one NUM_TEAMS clause can appear on the TARGET TEAMS DISTRIBUTE PARALLEL DO directive
357  !$omp target teams distribute parallel do num_teams(2) num_teams(3)
358  do i = 1, N
359     a(i) = 3.14
360  enddo
361  !$omp end target teams distribute parallel do
362
363  !ERROR: The parameter of the NUM_TEAMS clause must be a positive integer expression
364  !$omp target teams distribute parallel do num_teams(-1)
365  do i = 1, N
366     a(i) = 3.14
367  enddo
368  !$omp end target teams distribute parallel do
369
370  !ERROR: At most one THREAD_LIMIT clause can appear on the TARGET TEAMS DISTRIBUTE PARALLEL DO directive
371  !$omp target teams distribute parallel do thread_limit(2) thread_limit(3)
372  do i = 1, N
373     a(i) = 3.14
374  enddo
375  !$omp end target teams distribute parallel do
376
377  !ERROR: The parameter of the THREAD_LIMIT clause must be a positive integer expression
378  !$omp target teams distribute parallel do thread_limit(-1)
379  do i = 1, N
380     a(i) = 3.14
381  enddo
382  !$omp end target teams distribute parallel do
383
384  !ERROR: At most one DEFAULT clause can appear on the TARGET TEAMS DISTRIBUTE PARALLEL DO directive
385  !$omp target teams distribute parallel do default(shared) default(private)
386  do i = 1, N
387     a(i) = 3.14
388  enddo
389  !$omp end target teams distribute parallel do
390
391  !$omp target teams distribute parallel do num_teams(2) defaultmap(tofrom:scalar)
392  do i = 1, N
393      a(i) = 3.14
394  enddo
395  !$omp end target teams distribute parallel do
396
397  !$omp target teams distribute parallel do map(tofrom:a)
398  do i = 1, N
399     a(i) = 3.14
400  enddo
401  !$omp end target teams distribute parallel do
402
403  !ERROR: Only the TO, FROM, TOFROM, ALLOC map types are permitted for MAP clauses on the TARGET TEAMS DISTRIBUTE PARALLEL DO directive
404  !$omp target teams distribute parallel do map(delete:a)
405  do i = 1, N
406     a(i) = 3.14
407  enddo
408  !$omp end target teams distribute parallel do
409
410
411  !$omp target teams distribute parallel do simd map(a)
412  do i = 1, N
413     a(i) = 3.14
414  enddo
415  !$omp end target teams distribute parallel do simd
416
417  !$omp target teams distribute parallel do simd device(0)
418  do i = 1, N
419     a(i) = 3.14
420  enddo
421  !$omp end target teams distribute parallel do simd
422
423  !ERROR: At most one DEVICE clause can appear on the TARGET TEAMS DISTRIBUTE PARALLEL DO SIMD directive
424  !$omp target teams distribute parallel do simd device(0) device(1)
425  do i = 1, N
426     a(i) = 3.14
427  enddo
428  !$omp end target teams distribute parallel do simd
429
430  !$omp target teams distribute parallel do simd defaultmap(tofrom:scalar)
431  do i = 1, N
432     a(i) = 3.14
433  enddo
434  !$omp end target teams distribute parallel do simd
435
436  !ERROR: The argument TOFROM:SCALAR must be specified on the DEFAULTMAP clause
437  !$omp target teams distribute parallel do simd defaultmap(tofrom)
438  do i = 1, N
439     a(i) = 3.14
440  enddo
441  !$omp end target teams distribute parallel do simd
442
443  !ERROR: At most one DEFAULTMAP clause can appear on the TARGET TEAMS DISTRIBUTE PARALLEL DO SIMD directive
444  !$omp target teams distribute parallel do simd defaultmap(tofrom:scalar) defaultmap(tofrom:scalar)
445  do i = 1, N
446     a(i) = 3.14
447  enddo
448  !$omp end target teams distribute parallel do simd
449
450  !$omp target teams distribute parallel do simd num_teams(3) thread_limit(10) default(shared) private(i) shared(a)
451  do i = 1, N
452     a(i) = 3.14
453  enddo
454  !$omp end target teams distribute parallel do simd
455
456  !ERROR: At most one NUM_TEAMS clause can appear on the TARGET TEAMS DISTRIBUTE PARALLEL DO SIMD directive
457  !$omp target teams distribute parallel do simd num_teams(2) num_teams(3)
458  do i = 1, N
459     a(i) = 3.14
460  enddo
461  !$omp end target teams distribute parallel do simd
462
463  !ERROR: The parameter of the NUM_TEAMS clause must be a positive integer expression
464  !$omp target teams distribute parallel do simd num_teams(-1)
465  do i = 1, N
466     a(i) = 3.14
467  enddo
468  !$omp end target teams distribute parallel do simd
469
470  !ERROR: At most one THREAD_LIMIT clause can appear on the TARGET TEAMS DISTRIBUTE PARALLEL DO SIMD directive
471  !$omp target teams distribute parallel do simd thread_limit(2) thread_limit(3)
472  do i = 1, N
473     a(i) = 3.14
474  enddo
475  !$omp end target teams distribute parallel do simd
476
477  !ERROR: The parameter of the THREAD_LIMIT clause must be a positive integer expression
478  !$omp target teams distribute parallel do simd thread_limit(-1)
479  do i = 1, N
480     a(i) = 3.14
481  enddo
482  !$omp end target teams distribute parallel do simd
483
484  !ERROR: At most one DEFAULT clause can appear on the TARGET TEAMS DISTRIBUTE PARALLEL DO SIMD directive
485  !$omp target teams distribute parallel do simd default(shared) default(private)
486  do i = 1, N
487     a(i) = 3.14
488  enddo
489  !$omp end target teams distribute parallel do simd
490
491  !$omp target teams distribute parallel do simd num_teams(2) defaultmap(tofrom:scalar)
492  do i = 1, N
493      a(i) = 3.14
494  enddo
495  !$omp end target teams distribute parallel do simd
496
497  !$omp target teams distribute parallel do simd map(tofrom:a)
498  do i = 1, N
499     a(i) = 3.14
500  enddo
501  !$omp end target teams distribute parallel do simd
502
503  !ERROR: Only the TO, FROM, TOFROM, ALLOC map types are permitted for MAP clauses on the TARGET TEAMS DISTRIBUTE PARALLEL DO SIMD directive
504  !$omp target teams distribute parallel do simd map(delete:a)
505  do i = 1, N
506     a(i) = 3.14
507  enddo
508  !$omp end target teams distribute parallel do simd
509
510
511end program main
512
513