xref: /llvm-project/flang/test/Semantics/OpenMP/device-constructs.f90 (revision 4c4a4134d5c0a0f9476b157862d378a7e571e9f0)
1! RUN: %python %S/../test_errors.py %s %flang -fopenmp -fopenmp-version=51
2! Check OpenMP clause validity for the following directives:
3!     2.10 Device constructs
4program main
5   use iso_c_binding
6
7  real(8) :: arrayA(256), arrayB(256)
8  integer :: N
9  type(c_ptr) :: cptr
10
11  arrayA = 1.414
12  arrayB = 3.14
13  N = 256
14
15  !$omp target map(arrayA)
16  do i = 1, N
17     a = 3.14
18  enddo
19  !$omp end target
20
21  !$omp target device(0)
22  do i = 1, N
23     a = 3.14
24  enddo
25  !$omp end target
26
27  !ERROR: At most one DEVICE clause can appear on the TARGET directive
28  !$omp target device(0) device(1)
29  do i = 1, N
30     a = 3.14
31  enddo
32  !$omp end target
33
34  !ERROR: SCHEDULE clause is not allowed on the TARGET directive
35  !$omp target schedule(static)
36  do i = 1, N
37     a = 3.14
38  enddo
39  !$omp end target
40
41  !$omp target defaultmap(tofrom:scalar)
42  do i = 1, N
43     a = 3.14
44  enddo
45  !$omp end target
46
47  !$omp target defaultmap(tofrom)
48  do i = 1, N
49     a = 3.14
50  enddo
51  !$omp end target
52
53  !ERROR: At most one DEFAULTMAP clause can appear on the TARGET directive
54  !$omp target defaultmap(tofrom:scalar) defaultmap(tofrom:scalar)
55  do i = 1, N
56     a = 3.14
57  enddo
58  !$omp end target
59
60  !$omp target thread_limit(4)
61  do i = 1, N
62     a = 3.14
63  enddo
64  !$omp end target
65
66  !ERROR: At most one THREAD_LIMIT clause can appear on the TARGET directive
67  !$omp target thread_limit(4) thread_limit(8)
68  do i = 1, N
69     a = 3.14
70  enddo
71  !$omp end target
72
73  !$omp teams num_teams(3) thread_limit(10) default(shared) private(i) shared(a)
74  do i = 1, N
75     a = 3.14
76  enddo
77  !$omp end teams
78
79  !ERROR: At most one NUM_TEAMS clause can appear on the TEAMS directive
80  !$omp teams num_teams(2) num_teams(3)
81  do i = 1, N
82     a = 3.14
83  enddo
84  !$omp end teams
85
86  !ERROR: The parameter of the NUM_TEAMS clause must be a positive integer expression
87  !$omp teams num_teams(-1)
88  do i = 1, N
89     a = 3.14
90  enddo
91  !$omp end teams
92
93  !ERROR: At most one THREAD_LIMIT clause can appear on the TEAMS directive
94  !$omp teams thread_limit(2) thread_limit(3)
95  do i = 1, N
96     a = 3.14
97  enddo
98  !$omp end teams
99
100  !ERROR: The parameter of the THREAD_LIMIT clause must be a positive integer expression
101  !$omp teams thread_limit(-1)
102  do i = 1, N
103     a = 3.14
104  enddo
105  !$omp end teams
106
107  !ERROR: At most one DEFAULT clause can appear on the TEAMS directive
108  !$omp teams default(shared) default(private)
109  do i = 1, N
110     a = 3.14
111  enddo
112  !$omp end teams
113
114  !$omp target teams num_teams(2) defaultmap(tofrom:scalar)
115  do i = 1, N
116      a = 3.14
117  enddo
118  !$omp end target teams
119
120  !$omp target map(tofrom:a)
121  do i = 1, N
122     a = 3.14
123  enddo
124  !$omp end target
125
126  !ERROR: Only the TO, FROM, TOFROM, ALLOC map types are permitted for MAP clauses on the TARGET directive
127  !$omp target map(delete:a)
128  do i = 1, N
129     a = 3.14
130  enddo
131  !$omp end target
132
133  !$omp target data device(0) map(to:a)
134  do i = 1, N
135    a = 3.14
136  enddo
137  !$omp end target data
138
139  !$omp target data device(0) use_device_addr(cptr)
140   cptr = c_null_ptr
141  !$omp end target data
142
143  !$omp target data device(0) use_device_addr(cptr)
144   cptr = c_null_ptr
145  !$omp end target data
146
147  !ERROR: At least one of MAP, USE_DEVICE_ADDR, USE_DEVICE_PTR clause must appear on the TARGET DATA directive
148  !$omp target data device(0)
149  do i = 1, N
150     a = 3.14
151  enddo
152  !$omp end target data
153
154  !ERROR: The device expression of the DEVICE clause must be a positive integer expression
155  !$omp target enter data map(alloc:A) device(-2)
156
157  !ERROR: The device expression of the DEVICE clause must be a positive integer expression
158  !$omp target exit data map(delete:A) device(-2)
159
160  !ERROR: At most one IF clause can appear on the TARGET ENTER DATA directive
161  !$omp target enter data map(to:a) if(.true.) if(.false.)
162
163  !ERROR: Only the TO, ALLOC map types are permitted for MAP clauses on the TARGET ENTER DATA directive
164  !$omp target enter data map(from:a)
165
166  !$omp target exit data map(delete:a)
167
168  !ERROR: At most one DEVICE clause can appear on the TARGET EXIT DATA directive
169  !$omp target exit data map(from:a) device(0) device(1)
170
171  !ERROR: Only the FROM, RELEASE, DELETE map types are permitted for MAP clauses on the TARGET EXIT DATA directive
172  !$omp target exit data map(to:a)
173
174  !$omp target update if(.true.) device(1) to(a) from(b) depend(inout:c) nowait
175
176  !ERROR: At most one IF clause can appear on the TARGET UPDATE directive
177  !$omp target update to(a) if(.true.) if(.false.)
178
179  !ERROR: At most one DEVICE clause can appear on the TARGET UPDATE directive
180  !$omp target update device(0) device(1) from(b)
181
182  !$omp target
183  !ERROR: `DISTRIBUTE` region has to be strictly nested inside `TEAMS` region.
184  !$omp distribute
185  do i = 1, N
186     a = 3.14
187  enddo
188  !$omp end distribute
189  !$omp end target
190
191  !$omp target
192  !$omp teams
193  !$omp distribute
194  do i = 1, N
195     a = 3.14
196  enddo
197  !$omp end distribute
198  !$omp end teams
199  !$omp end target
200
201  !$omp target
202  !ERROR: `DISTRIBUTE` region has to be strictly nested inside `TEAMS` region.
203  !ERROR: At most one COLLAPSE clause can appear on the DISTRIBUTE directive
204  !$omp distribute collapse(2) collapse(3)
205  do i = 1, N
206     do j = 1, N
207        do k = 1, N
208           a = 3.14
209        enddo
210     enddo
211  enddo
212  !$omp end distribute
213  !$omp end target
214
215  !$omp target
216  !$omp teams
217  !ERROR: At most one COLLAPSE clause can appear on the DISTRIBUTE directive
218  !$omp distribute collapse(2) collapse(3)
219  do i = 1, N
220     do j = 1, N
221        do k = 1, N
222           a = 3.14
223        enddo
224     enddo
225  enddo
226  !$omp end distribute
227  !$omp end teams
228  !$omp end target
229
230  !$omp target
231  !ERROR: `DISTRIBUTE` region has to be strictly nested inside `TEAMS` region.
232  !$omp distribute dist_schedule(static, 2)
233  do i = 1, N
234     a = 3.14
235  enddo
236  !$omp end distribute
237  !$omp end target
238
239  !$omp target
240  !$omp teams
241  !$omp distribute dist_schedule(static, 2)
242  do i = 1, N
243     a = 3.14
244  enddo
245  !$omp end distribute
246  !$omp end teams
247  !$omp end target
248
249  !$omp target
250  !ERROR: `DISTRIBUTE` region has to be strictly nested inside `TEAMS` region.
251  !ERROR: At most one DIST_SCHEDULE clause can appear on the DISTRIBUTE directive
252  !$omp distribute dist_schedule(static, 2) dist_schedule(static, 3)
253  do i = 1, N
254     a = 3.14
255  enddo
256  !$omp end distribute
257  !$omp end target
258
259  !$omp target
260  !$omp teams
261  !ERROR: At most one DIST_SCHEDULE clause can appear on the DISTRIBUTE directive
262  !$omp distribute dist_schedule(static, 2) dist_schedule(static, 3)
263  do i = 1, N
264     a = 3.14
265  enddo
266  !$omp end distribute
267  !$omp end teams
268  !$omp end target
269
270end program main
271