1 //===-- lib/Semantics/check-omp-structure.cpp -----------------------------===//
2 //
3 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
4 // See https://llvm.org/LICENSE.txt for license information.
5 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
6 //
7 //===----------------------------------------------------------------------===//
8
9 #include "check-omp-structure.h"
10 #include "flang/Parser/parse-tree.h"
11 #include "flang/Semantics/tools.h"
12
13 namespace Fortran::semantics {
14
ContextDirectiveAsFortran()15 std::string OmpStructureChecker::ContextDirectiveAsFortran() {
16 auto dir = llvm::omp::getOpenMPDirectiveName(GetContext().directive).str();
17 std::transform(dir.begin(), dir.end(), dir.begin(),
18 [](unsigned char c) { return std::toupper(c); });
19 return dir;
20 }
21
SayNotMatching(const parser::CharBlock & beginSource,const parser::CharBlock & endSource)22 void OmpStructureChecker::SayNotMatching(
23 const parser::CharBlock &beginSource, const parser::CharBlock &endSource) {
24 context_
25 .Say(endSource, "Unmatched %s directive"_err_en_US,
26 parser::ToUpperCaseLetters(endSource.ToString()))
27 .Attach(beginSource, "Does not match directive"_en_US);
28 }
29
HasInvalidWorksharingNesting(const parser::CharBlock & source,const OmpDirectiveSet & set)30 bool OmpStructureChecker::HasInvalidWorksharingNesting(
31 const parser::CharBlock &source, const OmpDirectiveSet &set) {
32 // set contains all the invalid closely nested directives
33 // for the given directive (`source` here)
34 if (CurrentDirectiveIsNested() && set.test(GetContext().directive)) {
35 context_.Say(source,
36 "A worksharing region may not be closely nested inside a "
37 "worksharing, explicit task, taskloop, critical, ordered, atomic, or "
38 "master region"_err_en_US);
39 return true;
40 }
41 return false;
42 }
43
CheckAllowed(llvm::omp::Clause type)44 void OmpStructureChecker::CheckAllowed(llvm::omp::Clause type) {
45 if (!GetContext().allowedClauses.test(type) &&
46 !GetContext().allowedOnceClauses.test(type) &&
47 !GetContext().allowedExclusiveClauses.test(type)) {
48 context_.Say(GetContext().clauseSource,
49 "%s clause is not allowed on the %s directive"_err_en_US,
50 parser::ToUpperCaseLetters(llvm::omp::getOpenMPClauseName(type).str()),
51 parser::ToUpperCaseLetters(GetContext().directiveSource.ToString()));
52 return;
53 }
54 if ((GetContext().allowedOnceClauses.test(type) ||
55 GetContext().allowedExclusiveClauses.test(type)) &&
56 FindClause(type)) {
57 context_.Say(GetContext().clauseSource,
58 "At most one %s clause can appear on the %s directive"_err_en_US,
59 parser::ToUpperCaseLetters(llvm::omp::getOpenMPClauseName(type).str()),
60 parser::ToUpperCaseLetters(GetContext().directiveSource.ToString()));
61 return;
62 }
63 if (GetContext().allowedExclusiveClauses.test(type)) {
64 std::vector<llvm::omp::Clause> others;
65 GetContext().allowedExclusiveClauses.IterateOverMembers(
66 [&](llvm::omp::Clause o) {
67 if (FindClause(o)) {
68 others.emplace_back(o);
69 }
70 });
71 for (const auto &e : others) {
72 context_.Say(GetContext().clauseSource,
73 "%s and %s are mutually exclusive and may not appear on the "
74 "same %s directive"_err_en_US,
75 parser::ToUpperCaseLetters(
76 llvm::omp::getOpenMPClauseName(type).str()),
77 parser::ToUpperCaseLetters(llvm::omp::getOpenMPClauseName(e).str()),
78 parser::ToUpperCaseLetters(GetContext().directiveSource.ToString()));
79 }
80 if (!others.empty()) {
81 return;
82 }
83 }
84 SetContextClauseInfo(type);
85 }
86
CheckRequired(llvm::omp::Clause c)87 void OmpStructureChecker::CheckRequired(llvm::omp::Clause c) {
88 if (!FindClause(c)) {
89 context_.Say(GetContext().directiveSource,
90 "At least one %s clause must appear on the %s directive"_err_en_US,
91 parser::ToUpperCaseLetters(llvm::omp::getOpenMPClauseName(c).str()),
92 ContextDirectiveAsFortran());
93 }
94 }
95
RequiresConstantPositiveParameter(const llvm::omp::Clause & clause,const parser::ScalarIntConstantExpr & i)96 void OmpStructureChecker::RequiresConstantPositiveParameter(
97 const llvm::omp::Clause &clause, const parser::ScalarIntConstantExpr &i) {
98 if (const auto v{GetIntValue(i)}) {
99 if (*v <= 0) {
100 context_.Say(GetContext().clauseSource,
101 "The parameter of the %s clause must be "
102 "a constant positive integer expression"_err_en_US,
103 parser::ToUpperCaseLetters(
104 llvm::omp::getOpenMPClauseName(clause).str()));
105 }
106 }
107 }
108
RequiresPositiveParameter(const llvm::omp::Clause & clause,const parser::ScalarIntExpr & i)109 void OmpStructureChecker::RequiresPositiveParameter(
110 const llvm::omp::Clause &clause, const parser::ScalarIntExpr &i) {
111 if (const auto v{GetIntValue(i)}) {
112 if (*v <= 0) {
113 context_.Say(GetContext().clauseSource,
114 "The parameter of the %s clause must be "
115 "a positive integer expression"_err_en_US,
116 parser::ToUpperCaseLetters(
117 llvm::omp::getOpenMPClauseName(clause).str()));
118 }
119 }
120 }
121
Enter(const parser::OpenMPConstruct &)122 void OmpStructureChecker::Enter(const parser::OpenMPConstruct &) {
123 // 2.8.1 TODO: Simd Construct with Ordered Construct Nesting check
124 }
125
Enter(const parser::OpenMPLoopConstruct & x)126 void OmpStructureChecker::Enter(const parser::OpenMPLoopConstruct &x) {
127 const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
128 const auto &beginDir{std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
129
130 // check matching, End directive is optional
131 if (const auto &endLoopDir{
132 std::get<std::optional<parser::OmpEndLoopDirective>>(x.t)}) {
133 CheckMatching<parser::OmpLoopDirective>(beginLoopDir, *endLoopDir);
134 }
135
136 if (beginDir.v != llvm::omp::Directive::OMPD_do) {
137 PushContextAndClauseSets(beginDir.source, beginDir.v);
138 } else {
139 // 2.7.1 do-clause -> private-clause |
140 // firstprivate-clause |
141 // lastprivate-clause |
142 // linear-clause |
143 // reduction-clause |
144 // schedule-clause |
145 // collapse-clause |
146 // ordered-clause
147
148 // nesting check
149 HasInvalidWorksharingNesting(beginDir.source,
150 {llvm::omp::Directive::OMPD_do, llvm::omp::Directive::OMPD_sections,
151 llvm::omp::Directive::OMPD_single,
152 llvm::omp::Directive::OMPD_workshare,
153 llvm::omp::Directive::OMPD_task,
154 llvm::omp::Directive::OMPD_taskloop,
155 llvm::omp::Directive::OMPD_critical,
156 llvm::omp::Directive::OMPD_ordered,
157 llvm::omp::Directive::OMPD_atomic,
158 llvm::omp::Directive::OMPD_master});
159 PushContextAndClauseSets(beginDir.source, llvm::omp::Directive::OMPD_do);
160 }
161 }
162
Leave(const parser::OpenMPLoopConstruct &)163 void OmpStructureChecker::Leave(const parser::OpenMPLoopConstruct &) {
164 ompContext_.pop_back();
165 }
166
Enter(const parser::OmpEndLoopDirective & x)167 void OmpStructureChecker::Enter(const parser::OmpEndLoopDirective &x) {
168 const auto &dir{std::get<parser::OmpLoopDirective>(x.t)};
169 ResetPartialContext(dir.source);
170 switch (dir.v) {
171 // 2.7.1 end-do -> END DO [nowait-clause]
172 // 2.8.3 end-do-simd -> END DO SIMD [nowait-clause]
173 case llvm::omp::Directive::OMPD_do:
174 case llvm::omp::Directive::OMPD_do_simd:
175 SetClauseSets(dir.v);
176 break;
177 default:
178 // no clauses are allowed
179 break;
180 }
181 }
182
Enter(const parser::OpenMPBlockConstruct & x)183 void OmpStructureChecker::Enter(const parser::OpenMPBlockConstruct &x) {
184 const auto &beginBlockDir{std::get<parser::OmpBeginBlockDirective>(x.t)};
185 const auto &endBlockDir{std::get<parser::OmpEndBlockDirective>(x.t)};
186 const auto &beginDir{
187 CheckMatching<parser::OmpBlockDirective>(beginBlockDir, endBlockDir)};
188
189 PushContextAndClauseSets(beginDir.source, beginDir.v);
190 }
191
Leave(const parser::OpenMPBlockConstruct &)192 void OmpStructureChecker::Leave(const parser::OpenMPBlockConstruct &) {
193 ompContext_.pop_back();
194 }
195
Enter(const parser::OpenMPSectionsConstruct & x)196 void OmpStructureChecker::Enter(const parser::OpenMPSectionsConstruct &x) {
197 const auto &beginSectionsDir{
198 std::get<parser::OmpBeginSectionsDirective>(x.t)};
199 const auto &endSectionsDir{std::get<parser::OmpEndSectionsDirective>(x.t)};
200 const auto &beginDir{CheckMatching<parser::OmpSectionsDirective>(
201 beginSectionsDir, endSectionsDir)};
202
203 PushContextAndClauseSets(beginDir.source, beginDir.v);
204 }
205
Leave(const parser::OpenMPSectionsConstruct &)206 void OmpStructureChecker::Leave(const parser::OpenMPSectionsConstruct &) {
207 ompContext_.pop_back();
208 }
209
Enter(const parser::OmpEndSectionsDirective & x)210 void OmpStructureChecker::Enter(const parser::OmpEndSectionsDirective &x) {
211 const auto &dir{std::get<parser::OmpSectionsDirective>(x.t)};
212 ResetPartialContext(dir.source);
213 switch (dir.v) {
214 // 2.7.2 end-sections -> END SECTIONS [nowait-clause]
215 case llvm::omp::Directive::OMPD_sections:
216 SetContextDirectiveEnum(llvm::omp::Directive::OMPD_end_sections);
217 SetContextAllowed(OmpClauseSet{llvm::omp::Clause::OMPC_nowait});
218 break;
219 default:
220 // no clauses are allowed
221 break;
222 }
223 }
224
Enter(const parser::OpenMPDeclareSimdConstruct & x)225 void OmpStructureChecker::Enter(const parser::OpenMPDeclareSimdConstruct &x) {
226 const auto &dir{std::get<parser::Verbatim>(x.t)};
227 PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_declare_simd);
228 }
229
Leave(const parser::OpenMPDeclareSimdConstruct &)230 void OmpStructureChecker::Leave(const parser::OpenMPDeclareSimdConstruct &) {
231 ompContext_.pop_back();
232 }
233
Enter(const parser::OpenMPDeclareTargetConstruct & x)234 void OmpStructureChecker::Enter(const parser::OpenMPDeclareTargetConstruct &x) {
235 const auto &dir{std::get<parser::Verbatim>(x.t)};
236 PushContext(dir.source, llvm::omp::Directive::OMPD_declare_target);
237 const auto &spec{std::get<parser::OmpDeclareTargetSpecifier>(x.t)};
238 if (std::holds_alternative<parser::OmpDeclareTargetWithClause>(spec.u)) {
239 SetContextAllowed(
240 OmpClauseSet{llvm::omp::Clause::OMPC_to, llvm::omp::Clause::OMPC_link});
241 }
242 }
243
Leave(const parser::OpenMPDeclareTargetConstruct &)244 void OmpStructureChecker::Leave(const parser::OpenMPDeclareTargetConstruct &) {
245 ompContext_.pop_back();
246 }
247
Enter(const parser::OpenMPSimpleStandaloneConstruct & x)248 void OmpStructureChecker::Enter(
249 const parser::OpenMPSimpleStandaloneConstruct &x) {
250 const auto &dir{std::get<parser::OmpSimpleStandaloneDirective>(x.t)};
251 PushContextAndClauseSets(dir.source, dir.v);
252 }
253
Leave(const parser::OpenMPSimpleStandaloneConstruct &)254 void OmpStructureChecker::Leave(
255 const parser::OpenMPSimpleStandaloneConstruct &) {
256 ompContext_.pop_back();
257 }
258
Enter(const parser::OpenMPFlushConstruct & x)259 void OmpStructureChecker::Enter(const parser::OpenMPFlushConstruct &x) {
260 const auto &dir{std::get<parser::Verbatim>(x.t)};
261 PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_flush);
262 }
263
Leave(const parser::OpenMPFlushConstruct &)264 void OmpStructureChecker::Leave(const parser::OpenMPFlushConstruct &) {
265 ompContext_.pop_back();
266 }
267
Enter(const parser::OpenMPCancelConstruct & x)268 void OmpStructureChecker::Enter(const parser::OpenMPCancelConstruct &x) {
269 const auto &dir{std::get<parser::Verbatim>(x.t)};
270 PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_cancel);
271 }
272
Leave(const parser::OpenMPCancelConstruct &)273 void OmpStructureChecker::Leave(const parser::OpenMPCancelConstruct &) {
274 ompContext_.pop_back();
275 }
276
Enter(const parser::OpenMPCancellationPointConstruct & x)277 void OmpStructureChecker::Enter(
278 const parser::OpenMPCancellationPointConstruct &x) {
279 const auto &dir{std::get<parser::Verbatim>(x.t)};
280 PushContextAndClauseSets(
281 dir.source, llvm::omp::Directive::OMPD_cancellation_point);
282 }
283
Leave(const parser::OpenMPCancellationPointConstruct &)284 void OmpStructureChecker::Leave(
285 const parser::OpenMPCancellationPointConstruct &) {
286 ompContext_.pop_back();
287 }
288
Enter(const parser::OmpEndBlockDirective & x)289 void OmpStructureChecker::Enter(const parser::OmpEndBlockDirective &x) {
290 const auto &dir{std::get<parser::OmpBlockDirective>(x.t)};
291 ResetPartialContext(dir.source);
292 switch (dir.v) {
293 // 2.7.3 end-single-clause -> copyprivate-clause |
294 // nowait-clause
295 case llvm::omp::Directive::OMPD_single: {
296 SetContextDirectiveEnum(llvm::omp::Directive::OMPD_end_single);
297 OmpClauseSet allowed{llvm::omp::Clause::OMPC_copyprivate};
298 SetContextAllowed(allowed);
299 OmpClauseSet allowedOnce{llvm::omp::Clause::OMPC_nowait};
300 SetContextAllowedOnce(allowedOnce);
301 } break;
302 // 2.7.4 end-workshare -> END WORKSHARE [nowait-clause]
303 case llvm::omp::Directive::OMPD_workshare:
304 SetContextDirectiveEnum(llvm::omp::Directive::OMPD_end_workshare);
305 SetContextAllowed(OmpClauseSet{llvm::omp::Clause::OMPC_nowait});
306 break;
307 default:
308 // no clauses are allowed
309 break;
310 }
311 }
312
Leave(const parser::OmpClauseList &)313 void OmpStructureChecker::Leave(const parser::OmpClauseList &) {
314 // 2.7 Loop Construct Restriction
315 if (llvm::omp::doSet.test(GetContext().directive)) {
316 if (auto *clause{FindClause(llvm::omp::Clause::OMPC_schedule)}) {
317 // only one schedule clause is allowed
318 const auto &schedClause{std::get<parser::OmpScheduleClause>(clause->u)};
319 if (ScheduleModifierHasType(schedClause,
320 parser::OmpScheduleModifierType::ModType::Nonmonotonic)) {
321 if (FindClause(llvm::omp::Clause::OMPC_ordered)) {
322 context_.Say(clause->source,
323 "The NONMONOTONIC modifier cannot be specified "
324 "if an ORDERED clause is specified"_err_en_US);
325 }
326 if (ScheduleModifierHasType(schedClause,
327 parser::OmpScheduleModifierType::ModType::Monotonic)) {
328 context_.Say(clause->source,
329 "The MONOTONIC and NONMONOTONIC modifiers "
330 "cannot be both specified"_err_en_US);
331 }
332 }
333 }
334
335 if (auto *clause{FindClause(llvm::omp::Clause::OMPC_ordered)}) {
336 // only one ordered clause is allowed
337 const auto &orderedClause{
338 std::get<parser::OmpClause::Ordered>(clause->u)};
339
340 if (orderedClause.v) {
341 if (FindClause(llvm::omp::Clause::OMPC_linear)) {
342 context_.Say(clause->source,
343 "A loop directive may not have both a LINEAR clause and "
344 "an ORDERED clause with a parameter"_err_en_US);
345 }
346
347 if (auto *clause2{FindClause(llvm::omp::Clause::OMPC_collapse)}) {
348 const auto &collapseClause{
349 std::get<parser::OmpClause::Collapse>(clause2->u)};
350 // ordered and collapse both have parameters
351 if (const auto orderedValue{GetIntValue(orderedClause.v)}) {
352 if (const auto collapseValue{GetIntValue(collapseClause.v)}) {
353 if (*orderedValue > 0 && *orderedValue < *collapseValue) {
354 context_.Say(clause->source,
355 "The parameter of the ORDERED clause must be "
356 "greater than or equal to "
357 "the parameter of the COLLAPSE clause"_err_en_US);
358 }
359 }
360 }
361 }
362 }
363
364 // TODO: ordered region binding check (requires nesting implementation)
365 }
366 } // doSet
367
368 // 2.8.1 Simd Construct Restriction
369 if (llvm::omp::simdSet.test(GetContext().directive)) {
370 if (auto *clause{FindClause(llvm::omp::Clause::OMPC_simdlen)}) {
371 if (auto *clause2{FindClause(llvm::omp::Clause::OMPC_safelen)}) {
372 const auto &simdlenClause{
373 std::get<parser::OmpClause::Simdlen>(clause->u)};
374 const auto &safelenClause{
375 std::get<parser::OmpClause::Safelen>(clause2->u)};
376 // simdlen and safelen both have parameters
377 if (const auto simdlenValue{GetIntValue(simdlenClause.v)}) {
378 if (const auto safelenValue{GetIntValue(safelenClause.v)}) {
379 if (*safelenValue > 0 && *simdlenValue > *safelenValue) {
380 context_.Say(clause->source,
381 "The parameter of the SIMDLEN clause must be less than or "
382 "equal to the parameter of the SAFELEN clause"_err_en_US);
383 }
384 }
385 }
386 }
387 }
388
389 // TODO: A list-item cannot appear in more than one aligned clause
390 } // SIMD
391
392 // 2.7.3 Single Construct Restriction
393 if (GetContext().directive == llvm::omp::Directive::OMPD_end_single) {
394 if (auto *clause{FindClause(llvm::omp::Clause::OMPC_copyprivate)}) {
395 if (FindClause(llvm::omp::Clause::OMPC_nowait)) {
396 context_.Say(clause->source,
397 "The COPYPRIVATE clause must not be used with "
398 "the NOWAIT clause"_err_en_US);
399 }
400 }
401 }
402
403 GetContext().requiredClauses.IterateOverMembers(
404 [this](llvm::omp::Clause c) { CheckRequired(c); });
405 }
406
Enter(const parser::OmpClause & x)407 void OmpStructureChecker::Enter(const parser::OmpClause &x) {
408 SetContextClause(x);
409 }
410
Enter(const parser::OmpNowait &)411 void OmpStructureChecker::Enter(const parser::OmpNowait &) {
412 CheckAllowed(llvm::omp::Clause::OMPC_nowait);
413 }
Enter(const parser::OmpClause::Inbranch &)414 void OmpStructureChecker::Enter(const parser::OmpClause::Inbranch &) {
415 CheckAllowed(llvm::omp::Clause::OMPC_inbranch);
416 }
Enter(const parser::OmpClause::Mergeable &)417 void OmpStructureChecker::Enter(const parser::OmpClause::Mergeable &) {
418 CheckAllowed(llvm::omp::Clause::OMPC_mergeable);
419 }
Enter(const parser::OmpClause::Nogroup &)420 void OmpStructureChecker::Enter(const parser::OmpClause::Nogroup &) {
421 CheckAllowed(llvm::omp::Clause::OMPC_nogroup);
422 }
Enter(const parser::OmpClause::Notinbranch &)423 void OmpStructureChecker::Enter(const parser::OmpClause::Notinbranch &) {
424 CheckAllowed(llvm::omp::Clause::OMPC_notinbranch);
425 }
Enter(const parser::OmpClause::Untied &)426 void OmpStructureChecker::Enter(const parser::OmpClause::Untied &) {
427 CheckAllowed(llvm::omp::Clause::OMPC_untied);
428 }
429
Enter(const parser::OmpClause::Collapse & x)430 void OmpStructureChecker::Enter(const parser::OmpClause::Collapse &x) {
431 CheckAllowed(llvm::omp::Clause::OMPC_collapse);
432 // collapse clause must have a parameter
433 RequiresConstantPositiveParameter(llvm::omp::Clause::OMPC_collapse, x.v);
434 }
435
Enter(const parser::OmpClause::Copyin &)436 void OmpStructureChecker::Enter(const parser::OmpClause::Copyin &) {
437 CheckAllowed(llvm::omp::Clause::OMPC_copyin);
438 }
Enter(const parser::OmpClause::Copyprivate &)439 void OmpStructureChecker::Enter(const parser::OmpClause::Copyprivate &) {
440 CheckAllowed(llvm::omp::Clause::OMPC_copyprivate);
441 }
Enter(const parser::OmpClause::Device &)442 void OmpStructureChecker::Enter(const parser::OmpClause::Device &) {
443 CheckAllowed(llvm::omp::Clause::OMPC_device);
444 }
Enter(const parser::OmpClause::DistSchedule &)445 void OmpStructureChecker::Enter(const parser::OmpClause::DistSchedule &) {
446 CheckAllowed(llvm::omp::Clause::OMPC_dist_schedule);
447 }
Enter(const parser::OmpClause::Final &)448 void OmpStructureChecker::Enter(const parser::OmpClause::Final &) {
449 CheckAllowed(llvm::omp::Clause::OMPC_final);
450 }
Enter(const parser::OmpClause::Firstprivate &)451 void OmpStructureChecker::Enter(const parser::OmpClause::Firstprivate &) {
452 CheckAllowed(llvm::omp::Clause::OMPC_firstprivate);
453 }
Enter(const parser::OmpClause::From &)454 void OmpStructureChecker::Enter(const parser::OmpClause::From &) {
455 CheckAllowed(llvm::omp::Clause::OMPC_from);
456 }
Enter(const parser::OmpClause::Grainsize & x)457 void OmpStructureChecker::Enter(const parser::OmpClause::Grainsize &x) {
458 CheckAllowed(llvm::omp::Clause::OMPC_grainsize);
459 RequiresPositiveParameter(llvm::omp::Clause::OMPC_grainsize, x.v);
460 }
Enter(const parser::OmpClause::Lastprivate &)461 void OmpStructureChecker::Enter(const parser::OmpClause::Lastprivate &) {
462 CheckAllowed(llvm::omp::Clause::OMPC_lastprivate);
463 }
Enter(const parser::OmpClause::NumTasks & x)464 void OmpStructureChecker::Enter(const parser::OmpClause::NumTasks &x) {
465 CheckAllowed(llvm::omp::Clause::OMPC_num_tasks);
466 RequiresPositiveParameter(llvm::omp::Clause::OMPC_num_tasks, x.v);
467 }
Enter(const parser::OmpClause::NumTeams & x)468 void OmpStructureChecker::Enter(const parser::OmpClause::NumTeams &x) {
469 CheckAllowed(llvm::omp::Clause::OMPC_num_teams);
470 RequiresPositiveParameter(llvm::omp::Clause::OMPC_num_teams, x.v);
471 }
Enter(const parser::OmpClause::NumThreads & x)472 void OmpStructureChecker::Enter(const parser::OmpClause::NumThreads &x) {
473 CheckAllowed(llvm::omp::Clause::OMPC_num_threads);
474 RequiresPositiveParameter(llvm::omp::Clause::OMPC_num_threads, x.v);
475 // if parameter is variable, defer to Expression Analysis
476 }
477
Enter(const parser::OmpClause::Ordered & x)478 void OmpStructureChecker::Enter(const parser::OmpClause::Ordered &x) {
479 CheckAllowed(llvm::omp::Clause::OMPC_ordered);
480 // the parameter of ordered clause is optional
481 if (const auto &expr{x.v}) {
482 RequiresConstantPositiveParameter(llvm::omp::Clause::OMPC_ordered, *expr);
483
484 // 2.8.3 Loop SIMD Construct Restriction
485 if (llvm::omp::doSimdSet.test(GetContext().directive)) {
486 context_.Say(GetContext().clauseSource,
487 "No ORDERED clause with a parameter can be specified "
488 "on the %s directive"_err_en_US,
489 ContextDirectiveAsFortran());
490 }
491 }
492 }
Enter(const parser::OmpClause::Priority & x)493 void OmpStructureChecker::Enter(const parser::OmpClause::Priority &x) {
494 CheckAllowed(llvm::omp::Clause::OMPC_priority);
495 RequiresPositiveParameter(llvm::omp::Clause::OMPC_priority, x.v);
496 }
Enter(const parser::OmpClause::Private &)497 void OmpStructureChecker::Enter(const parser::OmpClause::Private &) {
498 CheckAllowed(llvm::omp::Clause::OMPC_private);
499 }
Enter(const parser::OmpClause::Safelen & x)500 void OmpStructureChecker::Enter(const parser::OmpClause::Safelen &x) {
501 CheckAllowed(llvm::omp::Clause::OMPC_safelen);
502 RequiresConstantPositiveParameter(llvm::omp::Clause::OMPC_safelen, x.v);
503 }
Enter(const parser::OmpClause::Shared &)504 void OmpStructureChecker::Enter(const parser::OmpClause::Shared &) {
505 CheckAllowed(llvm::omp::Clause::OMPC_shared);
506 }
Enter(const parser::OmpClause::Simdlen & x)507 void OmpStructureChecker::Enter(const parser::OmpClause::Simdlen &x) {
508 CheckAllowed(llvm::omp::Clause::OMPC_simdlen);
509 RequiresConstantPositiveParameter(llvm::omp::Clause::OMPC_simdlen, x.v);
510 }
Enter(const parser::OmpClause::ThreadLimit & x)511 void OmpStructureChecker::Enter(const parser::OmpClause::ThreadLimit &x) {
512 CheckAllowed(llvm::omp::Clause::OMPC_thread_limit);
513 RequiresPositiveParameter(llvm::omp::Clause::OMPC_thread_limit, x.v);
514 }
Enter(const parser::OmpClause::To &)515 void OmpStructureChecker::Enter(const parser::OmpClause::To &) {
516 CheckAllowed(llvm::omp::Clause::OMPC_to);
517 }
Enter(const parser::OmpClause::Link &)518 void OmpStructureChecker::Enter(const parser::OmpClause::Link &) {
519 CheckAllowed(llvm::omp::Clause::OMPC_link);
520 }
Enter(const parser::OmpClause::Uniform &)521 void OmpStructureChecker::Enter(const parser::OmpClause::Uniform &) {
522 CheckAllowed(llvm::omp::Clause::OMPC_uniform);
523 }
Enter(const parser::OmpClause::UseDevicePtr &)524 void OmpStructureChecker::Enter(const parser::OmpClause::UseDevicePtr &) {
525 CheckAllowed(llvm::omp::Clause::OMPC_use_device_ptr);
526 }
Enter(const parser::OmpClause::IsDevicePtr &)527 void OmpStructureChecker::Enter(const parser::OmpClause::IsDevicePtr &) {
528 CheckAllowed(llvm::omp::Clause::OMPC_is_device_ptr);
529 }
530
Enter(const parser::OmpAlignedClause & x)531 void OmpStructureChecker::Enter(const parser::OmpAlignedClause &x) {
532 CheckAllowed(llvm::omp::Clause::OMPC_aligned);
533
534 if (const auto &expr{
535 std::get<std::optional<parser::ScalarIntConstantExpr>>(x.t)}) {
536 if (const auto v{GetIntValue(*expr)}) {
537 if (*v <= 0) {
538 context_.Say(GetContext().clauseSource,
539 "The ALIGNMENT parameter of the ALIGNED clause must be "
540 "a constant positive integer expression"_err_en_US);
541 }
542 }
543 }
544 // 2.8.1 TODO: list-item attribute check
545 }
Enter(const parser::OmpDefaultClause &)546 void OmpStructureChecker::Enter(const parser::OmpDefaultClause &) {
547 CheckAllowed(llvm::omp::Clause::OMPC_default);
548 }
Enter(const parser::OmpDefaultmapClause & x)549 void OmpStructureChecker::Enter(const parser::OmpDefaultmapClause &x) {
550 CheckAllowed(llvm::omp::Clause::OMPC_defaultmap);
551 using VariableCategory = parser::OmpDefaultmapClause::VariableCategory;
552 if (!std::get<std::optional<VariableCategory>>(x.t)) {
553 context_.Say(GetContext().clauseSource,
554 "The argument TOFROM:SCALAR must be specified on the DEFAULTMAP "
555 "clause"_err_en_US);
556 }
557 }
Enter(const parser::OmpDependClause &)558 void OmpStructureChecker::Enter(const parser::OmpDependClause &) {
559 CheckAllowed(llvm::omp::Clause::OMPC_depend);
560 }
561
Enter(const parser::OmpIfClause & x)562 void OmpStructureChecker::Enter(const parser::OmpIfClause &x) {
563 CheckAllowed(llvm::omp::Clause::OMPC_if);
564
565 using dirNameModifier = parser::OmpIfClause::DirectiveNameModifier;
566 static std::unordered_map<dirNameModifier, OmpDirectiveSet>
567 dirNameModifierMap{{dirNameModifier::Parallel, llvm::omp::parallelSet},
568 {dirNameModifier::Target, llvm::omp::targetSet},
569 {dirNameModifier::TargetEnterData,
570 {llvm::omp::Directive::OMPD_target_enter_data}},
571 {dirNameModifier::TargetExitData,
572 {llvm::omp::Directive::OMPD_target_exit_data}},
573 {dirNameModifier::TargetData,
574 {llvm::omp::Directive::OMPD_target_data}},
575 {dirNameModifier::TargetUpdate,
576 {llvm::omp::Directive::OMPD_target_update}},
577 {dirNameModifier::Task, {llvm::omp::Directive::OMPD_task}},
578 {dirNameModifier::Taskloop, llvm::omp::taskloopSet}};
579 if (const auto &directiveName{
580 std::get<std::optional<dirNameModifier>>(x.t)}) {
581 auto search{dirNameModifierMap.find(*directiveName)};
582 if (search == dirNameModifierMap.end() ||
583 !search->second.test(GetContext().directive)) {
584 context_
585 .Say(GetContext().clauseSource,
586 "Unmatched directive name modifier %s on the IF clause"_err_en_US,
587 parser::ToUpperCaseLetters(
588 parser::OmpIfClause::EnumToString(*directiveName)))
589 .Attach(
590 GetContext().directiveSource, "Cannot apply to directive"_en_US);
591 }
592 }
593 }
594
Enter(const parser::OmpLinearClause & x)595 void OmpStructureChecker::Enter(const parser::OmpLinearClause &x) {
596 CheckAllowed(llvm::omp::Clause::OMPC_linear);
597
598 // 2.7 Loop Construct Restriction
599 if ((llvm::omp::doSet | llvm::omp::simdSet).test(GetContext().directive)) {
600 if (std::holds_alternative<parser::OmpLinearClause::WithModifier>(x.u)) {
601 context_.Say(GetContext().clauseSource,
602 "A modifier may not be specified in a LINEAR clause "
603 "on the %s directive"_err_en_US,
604 ContextDirectiveAsFortran());
605 }
606 }
607 }
Enter(const parser::OmpMapClause & x)608 void OmpStructureChecker::Enter(const parser::OmpMapClause &x) {
609 CheckAllowed(llvm::omp::Clause::OMPC_map);
610 if (const auto &maptype{std::get<std::optional<parser::OmpMapType>>(x.t)}) {
611 using Type = parser::OmpMapType::Type;
612 const Type &type{std::get<Type>(maptype->t)};
613 switch (GetContext().directive) {
614 case llvm::omp::Directive::OMPD_target:
615 case llvm::omp::Directive::OMPD_target_teams:
616 case llvm::omp::Directive::OMPD_target_teams_distribute:
617 case llvm::omp::Directive::OMPD_target_teams_distribute_simd:
618 case llvm::omp::Directive::OMPD_target_teams_distribute_parallel_do:
619 case llvm::omp::Directive::OMPD_target_teams_distribute_parallel_do_simd:
620 case llvm::omp::Directive::OMPD_target_data: {
621 if (type != Type::To && type != Type::From && type != Type::Tofrom &&
622 type != Type::Alloc) {
623 context_.Say(GetContext().clauseSource,
624 "Only the TO, FROM, TOFROM, or ALLOC map types are permitted "
625 "for MAP clauses on the %s directive"_err_en_US,
626 ContextDirectiveAsFortran());
627 }
628 } break;
629 case llvm::omp::Directive::OMPD_target_enter_data: {
630 if (type != Type::To && type != Type::Alloc) {
631 context_.Say(GetContext().clauseSource,
632 "Only the TO or ALLOC map types are permitted "
633 "for MAP clauses on the %s directive"_err_en_US,
634 ContextDirectiveAsFortran());
635 }
636 } break;
637 case llvm::omp::Directive::OMPD_target_exit_data: {
638 if (type != Type::Delete && type != Type::Release && type != Type::From) {
639 context_.Say(GetContext().clauseSource,
640 "Only the FROM, RELEASE, or DELETE map types are permitted "
641 "for MAP clauses on the %s directive"_err_en_US,
642 ContextDirectiveAsFortran());
643 }
644 } break;
645 default:
646 break;
647 }
648 }
649 }
Enter(const parser::OmpProcBindClause &)650 void OmpStructureChecker::Enter(const parser::OmpProcBindClause &) {
651 CheckAllowed(llvm::omp::Clause::OMPC_proc_bind);
652 }
Enter(const parser::OmpReductionClause &)653 void OmpStructureChecker::Enter(const parser::OmpReductionClause &) {
654 CheckAllowed(llvm::omp::Clause::OMPC_reduction);
655 }
656
ScheduleModifierHasType(const parser::OmpScheduleClause & x,const parser::OmpScheduleModifierType::ModType & type)657 bool OmpStructureChecker::ScheduleModifierHasType(
658 const parser::OmpScheduleClause &x,
659 const parser::OmpScheduleModifierType::ModType &type) {
660 const auto &modifier{
661 std::get<std::optional<parser::OmpScheduleModifier>>(x.t)};
662 if (modifier) {
663 const auto &modType1{
664 std::get<parser::OmpScheduleModifier::Modifier1>(modifier->t)};
665 const auto &modType2{
666 std::get<std::optional<parser::OmpScheduleModifier::Modifier2>>(
667 modifier->t)};
668 if (modType1.v.v == type || (modType2 && modType2->v.v == type)) {
669 return true;
670 }
671 }
672 return false;
673 }
Enter(const parser::OmpScheduleClause & x)674 void OmpStructureChecker::Enter(const parser::OmpScheduleClause &x) {
675 CheckAllowed(llvm::omp::Clause::OMPC_schedule);
676
677 // 2.7 Loop Construct Restriction
678 if (llvm::omp::doSet.test(GetContext().directive)) {
679 const auto &kind{std::get<1>(x.t)};
680 const auto &chunk{std::get<2>(x.t)};
681 if (chunk) {
682 if (kind == parser::OmpScheduleClause::ScheduleType::Runtime ||
683 kind == parser::OmpScheduleClause::ScheduleType::Auto) {
684 context_.Say(GetContext().clauseSource,
685 "When SCHEDULE clause has %s specified, "
686 "it must not have chunk size specified"_err_en_US,
687 parser::ToUpperCaseLetters(
688 parser::OmpScheduleClause::EnumToString(kind)));
689 }
690 }
691
692 if (ScheduleModifierHasType(
693 x, parser::OmpScheduleModifierType::ModType::Nonmonotonic)) {
694 if (kind != parser::OmpScheduleClause::ScheduleType::Dynamic &&
695 kind != parser::OmpScheduleClause::ScheduleType::Guided) {
696 context_.Say(GetContext().clauseSource,
697 "The NONMONOTONIC modifier can only be specified with "
698 "SCHEDULE(DYNAMIC) or SCHEDULE(GUIDED)"_err_en_US);
699 }
700 }
701 }
702 }
703 } // namespace Fortran::semantics
704