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 #include <algorithm>
13
14 namespace Fortran::semantics {
15
16 // Use when clause falls under 'struct OmpClause' in 'parse-tree.h'.
17 #define CHECK_SIMPLE_CLAUSE(X, Y) \
18 void OmpStructureChecker::Enter(const parser::OmpClause::X &) { \
19 CheckAllowed(llvm::omp::Clause::Y); \
20 }
21
22 #define CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(X, Y) \
23 void OmpStructureChecker::Enter(const parser::OmpClause::X &c) { \
24 CheckAllowed(llvm::omp::Clause::Y); \
25 RequiresConstantPositiveParameter(llvm::omp::Clause::Y, c.v); \
26 }
27
28 #define CHECK_REQ_SCALAR_INT_CLAUSE(X, Y) \
29 void OmpStructureChecker::Enter(const parser::OmpClause::X &c) { \
30 CheckAllowed(llvm::omp::Clause::Y); \
31 RequiresPositiveParameter(llvm::omp::Clause::Y, c.v); \
32 }
33
34 // Use when clause don't falls under 'struct OmpClause' in 'parse-tree.h'.
35 #define CHECK_SIMPLE_PARSER_CLAUSE(X, Y) \
36 void OmpStructureChecker::Enter(const parser::X &) { \
37 CheckAllowed(llvm::omp::Y); \
38 }
39
40 // 'OmpWorkshareBlockChecker' is used to check the validity of the assignment
41 // statements and the expressions enclosed in an OpenMP Workshare construct
42 class OmpWorkshareBlockChecker {
43 public:
OmpWorkshareBlockChecker(SemanticsContext & context,parser::CharBlock source)44 OmpWorkshareBlockChecker(SemanticsContext &context, parser::CharBlock source)
45 : context_{context}, source_{source} {}
46
Pre(const T &)47 template <typename T> bool Pre(const T &) { return true; }
Post(const T &)48 template <typename T> void Post(const T &) {}
49
Pre(const parser::AssignmentStmt & assignment)50 bool Pre(const parser::AssignmentStmt &assignment) {
51 const auto &var{std::get<parser::Variable>(assignment.t)};
52 const auto &expr{std::get<parser::Expr>(assignment.t)};
53 const auto *lhs{GetExpr(var)};
54 const auto *rhs{GetExpr(expr)};
55 if (lhs && rhs) {
56 Tristate isDefined{semantics::IsDefinedAssignment(
57 lhs->GetType(), lhs->Rank(), rhs->GetType(), rhs->Rank())};
58 if (isDefined == Tristate::Yes) {
59 context_.Say(expr.source,
60 "Defined assignment statement is not "
61 "allowed in a WORKSHARE construct"_err_en_US);
62 }
63 }
64 return true;
65 }
66
Pre(const parser::Expr & expr)67 bool Pre(const parser::Expr &expr) {
68 if (const auto *e{GetExpr(expr)}) {
69 for (const Symbol &symbol : evaluate::CollectSymbols(*e)) {
70 const Symbol &root{GetAssociationRoot(symbol)};
71 if (IsFunction(root) &&
72 !(root.attrs().test(Attr::ELEMENTAL) ||
73 root.attrs().test(Attr::INTRINSIC))) {
74 context_.Say(expr.source,
75 "User defined non-ELEMENTAL function "
76 "'%s' is not allowed in a WORKSHARE construct"_err_en_US,
77 root.name());
78 }
79 }
80 }
81 return false;
82 }
83
84 private:
85 SemanticsContext &context_;
86 parser::CharBlock source_;
87 };
88
89 class OmpCycleChecker {
90 public:
OmpCycleChecker(SemanticsContext & context,std::int64_t cycleLevel)91 OmpCycleChecker(SemanticsContext &context, std::int64_t cycleLevel)
92 : context_{context}, cycleLevel_{cycleLevel} {}
93
Pre(const T &)94 template <typename T> bool Pre(const T &) { return true; }
Post(const T &)95 template <typename T> void Post(const T &) {}
96
Pre(const parser::DoConstruct & dc)97 bool Pre(const parser::DoConstruct &dc) {
98 cycleLevel_--;
99 const auto &labelName{std::get<0>(std::get<0>(dc.t).statement.t)};
100 if (labelName) {
101 labelNamesandLevels_.emplace(labelName.value().ToString(), cycleLevel_);
102 }
103 return true;
104 }
105
Pre(const parser::CycleStmt & cyclestmt)106 bool Pre(const parser::CycleStmt &cyclestmt) {
107 std::map<std::string, std::int64_t>::iterator it;
108 bool err{false};
109 if (cyclestmt.v) {
110 it = labelNamesandLevels_.find(cyclestmt.v->source.ToString());
111 err = (it != labelNamesandLevels_.end() && it->second > 0);
112 }
113 if (cycleLevel_ > 0 || err) {
114 context_.Say(*cycleSource_,
115 "CYCLE statement to non-innermost associated loop of an OpenMP DO construct"_err_en_US);
116 }
117 return true;
118 }
119
Pre(const parser::Statement<parser::ActionStmt> & actionstmt)120 bool Pre(const parser::Statement<parser::ActionStmt> &actionstmt) {
121 cycleSource_ = &actionstmt.source;
122 return true;
123 }
124
125 private:
126 SemanticsContext &context_;
127 const parser::CharBlock *cycleSource_;
128 std::int64_t cycleLevel_;
129 std::map<std::string, std::int64_t> labelNamesandLevels_;
130 };
131
IsCloselyNestedRegion(const OmpDirectiveSet & set)132 bool OmpStructureChecker::IsCloselyNestedRegion(const OmpDirectiveSet &set) {
133 // Definition of close nesting:
134 //
135 // `A region nested inside another region with no parallel region nested
136 // between them`
137 //
138 // Examples:
139 // non-parallel construct 1
140 // non-parallel construct 2
141 // parallel construct
142 // construct 3
143 // In the above example, construct 3 is NOT closely nested inside construct 1
144 // or 2
145 //
146 // non-parallel construct 1
147 // non-parallel construct 2
148 // construct 3
149 // In the above example, construct 3 is closely nested inside BOTH construct 1
150 // and 2
151 //
152 // Algorithm:
153 // Starting from the parent context, Check in a bottom-up fashion, each level
154 // of the context stack. If we have a match for one of the (supplied)
155 // violating directives, `close nesting` is satisfied. If no match is there in
156 // the entire stack, `close nesting` is not satisfied. If at any level, a
157 // `parallel` region is found, `close nesting` is not satisfied.
158
159 if (CurrentDirectiveIsNested()) {
160 int index = dirContext_.size() - 2;
161 while (index != -1) {
162 if (set.test(dirContext_[index].directive)) {
163 return true;
164 } else if (llvm::omp::parallelSet.test(dirContext_[index].directive)) {
165 return false;
166 }
167 index--;
168 }
169 }
170 return false;
171 }
172
HasInvalidWorksharingNesting(const parser::CharBlock & source,const OmpDirectiveSet & set)173 bool OmpStructureChecker::HasInvalidWorksharingNesting(
174 const parser::CharBlock &source, const OmpDirectiveSet &set) {
175 // set contains all the invalid closely nested directives
176 // for the given directive (`source` here)
177 if (IsCloselyNestedRegion(set)) {
178 context_.Say(source,
179 "A worksharing region may not be closely nested inside a "
180 "worksharing, explicit task, taskloop, critical, ordered, atomic, or "
181 "master region"_err_en_US);
182 return true;
183 }
184 return false;
185 }
186
HasInvalidDistributeNesting(const parser::OpenMPLoopConstruct & x)187 void OmpStructureChecker::HasInvalidDistributeNesting(
188 const parser::OpenMPLoopConstruct &x) {
189 bool violation{false};
190
191 OmpDirectiveSet distributeSet{llvm::omp::Directive::OMPD_distribute,
192 llvm::omp::Directive::OMPD_distribute_parallel_do,
193 llvm::omp::Directive::OMPD_distribute_parallel_do_simd,
194 llvm::omp::Directive::OMPD_distribute_parallel_for,
195 llvm::omp::Directive::OMPD_distribute_parallel_for_simd,
196 llvm::omp::Directive::OMPD_distribute_simd};
197
198 const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
199 const auto &beginDir{std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
200 if (distributeSet.test(beginDir.v)) {
201 // `distribute` region has to be nested
202 if (!CurrentDirectiveIsNested()) {
203 violation = true;
204 } else {
205 // `distribute` region has to be strictly nested inside `teams`
206 if (!llvm::omp::teamSet.test(GetContextParent().directive)) {
207 violation = true;
208 }
209 }
210 }
211 if (violation) {
212 context_.Say(beginDir.source,
213 "`DISTRIBUTE` region has to be strictly nested inside `TEAMS` region."_err_en_US);
214 }
215 }
216
HasInvalidTeamsNesting(const llvm::omp::Directive & dir,const parser::CharBlock & source)217 void OmpStructureChecker::HasInvalidTeamsNesting(
218 const llvm::omp::Directive &dir, const parser::CharBlock &source) {
219 OmpDirectiveSet allowedSet{llvm::omp::Directive::OMPD_parallel,
220 llvm::omp::Directive::OMPD_parallel_do,
221 llvm::omp::Directive::OMPD_parallel_do_simd,
222 llvm::omp::Directive::OMPD_parallel_for,
223 llvm::omp::Directive::OMPD_parallel_for_simd,
224 llvm::omp::Directive::OMPD_parallel_master,
225 llvm::omp::Directive::OMPD_parallel_master_taskloop,
226 llvm::omp::Directive::OMPD_parallel_master_taskloop_simd,
227 llvm::omp::Directive::OMPD_parallel_sections,
228 llvm::omp::Directive::OMPD_parallel_workshare,
229 llvm::omp::Directive::OMPD_distribute,
230 llvm::omp::Directive::OMPD_distribute_parallel_do,
231 llvm::omp::Directive::OMPD_distribute_parallel_do_simd,
232 llvm::omp::Directive::OMPD_distribute_parallel_for,
233 llvm::omp::Directive::OMPD_distribute_parallel_for_simd,
234 llvm::omp::Directive::OMPD_distribute_simd};
235
236 if (!allowedSet.test(dir)) {
237 context_.Say(source,
238 "Only `DISTRIBUTE` or `PARALLEL` regions are allowed to be strictly nested inside `TEAMS` region."_err_en_US);
239 }
240 }
241
CheckPredefinedAllocatorRestriction(const parser::CharBlock & source,const parser::Name & name)242 void OmpStructureChecker::CheckPredefinedAllocatorRestriction(
243 const parser::CharBlock &source, const parser::Name &name) {
244 if (const auto *symbol{name.symbol}) {
245 const auto *commonBlock{FindCommonBlockContaining(*symbol)};
246 const auto &scope{context_.FindScope(symbol->name())};
247 const Scope &containingScope{GetProgramUnitContaining(scope)};
248 if (!isPredefinedAllocator &&
249 (IsSave(*symbol) || commonBlock ||
250 containingScope.kind() == Scope::Kind::Module)) {
251 context_.Say(source,
252 "If list items within the ALLOCATE directive have the "
253 "SAVE attribute, are a common block name, or are "
254 "declared in the scope of a module, then only "
255 "predefined memory allocator parameters can be used "
256 "in the allocator clause"_err_en_US);
257 }
258 }
259 }
260
CheckPredefinedAllocatorRestriction(const parser::CharBlock & source,const parser::OmpObjectList & ompObjectList)261 void OmpStructureChecker::CheckPredefinedAllocatorRestriction(
262 const parser::CharBlock &source,
263 const parser::OmpObjectList &ompObjectList) {
264 for (const auto &ompObject : ompObjectList.v) {
265 std::visit(
266 common::visitors{
267 [&](const parser::Designator &designator) {
268 if (const auto *dataRef{
269 std::get_if<parser::DataRef>(&designator.u)}) {
270 if (const auto *name{std::get_if<parser::Name>(&dataRef->u)}) {
271 CheckPredefinedAllocatorRestriction(source, *name);
272 }
273 }
274 },
275 [&](const parser::Name &name) {
276 CheckPredefinedAllocatorRestriction(source, name);
277 },
278 },
279 ompObject.u);
280 }
281 }
282
Enter(const parser::OpenMPConstruct & x)283 void OmpStructureChecker::Enter(const parser::OpenMPConstruct &x) {
284 // Simd Construct with Ordered Construct Nesting check
285 // We cannot use CurrentDirectiveIsNested() here because
286 // PushContextAndClauseSets() has not been called yet, it is
287 // called individually for each construct. Therefore a
288 // dirContext_ size `1` means the current construct is nested
289 if (dirContext_.size() >= 1) {
290 if (GetDirectiveNest(SIMDNest) > 0) {
291 CheckSIMDNest(x);
292 }
293 if (GetDirectiveNest(TargetNest) > 0) {
294 CheckTargetNest(x);
295 }
296 }
297 }
298
Enter(const parser::OpenMPLoopConstruct & x)299 void OmpStructureChecker::Enter(const parser::OpenMPLoopConstruct &x) {
300 const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
301 const auto &beginDir{std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
302
303 // check matching, End directive is optional
304 if (const auto &endLoopDir{
305 std::get<std::optional<parser::OmpEndLoopDirective>>(x.t)}) {
306 const auto &endDir{
307 std::get<parser::OmpLoopDirective>(endLoopDir.value().t)};
308
309 CheckMatching<parser::OmpLoopDirective>(beginDir, endDir);
310 }
311
312 PushContextAndClauseSets(beginDir.source, beginDir.v);
313 if (llvm::omp::simdSet.test(GetContext().directive)) {
314 EnterDirectiveNest(SIMDNest);
315 }
316
317 if (beginDir.v == llvm::omp::Directive::OMPD_do) {
318 // 2.7.1 do-clause -> private-clause |
319 // firstprivate-clause |
320 // lastprivate-clause |
321 // linear-clause |
322 // reduction-clause |
323 // schedule-clause |
324 // collapse-clause |
325 // ordered-clause
326
327 // nesting check
328 HasInvalidWorksharingNesting(
329 beginDir.source, llvm::omp::nestedWorkshareErrSet);
330 }
331 SetLoopInfo(x);
332
333 if (const auto &doConstruct{
334 std::get<std::optional<parser::DoConstruct>>(x.t)}) {
335 const auto &doBlock{std::get<parser::Block>(doConstruct->t)};
336 CheckNoBranching(doBlock, beginDir.v, beginDir.source);
337 }
338 CheckDoWhile(x);
339 CheckLoopItrVariableIsInt(x);
340 CheckCycleConstraints(x);
341 HasInvalidDistributeNesting(x);
342 if (CurrentDirectiveIsNested() &&
343 llvm::omp::teamSet.test(GetContextParent().directive)) {
344 HasInvalidTeamsNesting(beginDir.v, beginDir.source);
345 }
346 if ((beginDir.v == llvm::omp::Directive::OMPD_distribute_parallel_do_simd) ||
347 (beginDir.v == llvm::omp::Directive::OMPD_distribute_simd)) {
348 CheckDistLinear(x);
349 }
350 }
GetLoopIndex(const parser::DoConstruct * x)351 const parser::Name OmpStructureChecker::GetLoopIndex(
352 const parser::DoConstruct *x) {
353 using Bounds = parser::LoopControl::Bounds;
354 return std::get<Bounds>(x->GetLoopControl()->u).name.thing;
355 }
SetLoopInfo(const parser::OpenMPLoopConstruct & x)356 void OmpStructureChecker::SetLoopInfo(const parser::OpenMPLoopConstruct &x) {
357 if (const auto &loopConstruct{
358 std::get<std::optional<parser::DoConstruct>>(x.t)}) {
359 const parser::DoConstruct *loop{&*loopConstruct};
360 if (loop && loop->IsDoNormal()) {
361 const parser::Name &itrVal{GetLoopIndex(loop)};
362 SetLoopIv(itrVal.symbol);
363 }
364 }
365 }
CheckDoWhile(const parser::OpenMPLoopConstruct & x)366 void OmpStructureChecker::CheckDoWhile(const parser::OpenMPLoopConstruct &x) {
367 const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
368 const auto &beginDir{std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
369 if (beginDir.v == llvm::omp::Directive::OMPD_do) {
370 if (const auto &doConstruct{
371 std::get<std::optional<parser::DoConstruct>>(x.t)}) {
372 if (doConstruct.value().IsDoWhile()) {
373 const auto &doStmt{std::get<parser::Statement<parser::NonLabelDoStmt>>(
374 doConstruct.value().t)};
375 context_.Say(doStmt.source,
376 "The DO loop cannot be a DO WHILE with DO directive."_err_en_US);
377 }
378 }
379 }
380 }
381
CheckLoopItrVariableIsInt(const parser::OpenMPLoopConstruct & x)382 void OmpStructureChecker::CheckLoopItrVariableIsInt(
383 const parser::OpenMPLoopConstruct &x) {
384 if (const auto &loopConstruct{
385 std::get<std::optional<parser::DoConstruct>>(x.t)}) {
386
387 for (const parser::DoConstruct *loop{&*loopConstruct}; loop;) {
388 if (loop->IsDoNormal()) {
389 const parser::Name &itrVal{GetLoopIndex(loop)};
390 if (itrVal.symbol) {
391 const auto *type{itrVal.symbol->GetType()};
392 if (!type->IsNumeric(TypeCategory::Integer)) {
393 context_.Say(itrVal.source,
394 "The DO loop iteration"
395 " variable must be of the type integer."_err_en_US,
396 itrVal.ToString());
397 }
398 }
399 }
400 // Get the next DoConstruct if block is not empty.
401 const auto &block{std::get<parser::Block>(loop->t)};
402 const auto it{block.begin()};
403 loop = it != block.end() ? parser::Unwrap<parser::DoConstruct>(*it)
404 : nullptr;
405 }
406 }
407 }
408
CheckSIMDNest(const parser::OpenMPConstruct & c)409 void OmpStructureChecker::CheckSIMDNest(const parser::OpenMPConstruct &c) {
410 // Check the following:
411 // The only OpenMP constructs that can be encountered during execution of
412 // a simd region are the `atomic` construct, the `loop` construct, the `simd`
413 // construct and the `ordered` construct with the `simd` clause.
414 // TODO: Expand the check to include `LOOP` construct as well when it is
415 // supported.
416
417 // Check if the parent context has the SIMD clause
418 // Please note that we use GetContext() instead of GetContextParent()
419 // because PushContextAndClauseSets() has not been called on the
420 // current context yet.
421 // TODO: Check for declare simd regions.
422 bool eligibleSIMD{false};
423 std::visit(Fortran::common::visitors{
424 // Allow `!$OMP ORDERED SIMD`
425 [&](const parser::OpenMPBlockConstruct &c) {
426 const auto &beginBlockDir{
427 std::get<parser::OmpBeginBlockDirective>(c.t)};
428 const auto &beginDir{
429 std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
430 if (beginDir.v == llvm::omp::Directive::OMPD_ordered) {
431 const auto &clauses{
432 std::get<parser::OmpClauseList>(beginBlockDir.t)};
433 for (const auto &clause : clauses.v) {
434 if (std::get_if<parser::OmpClause::Simd>(&clause.u)) {
435 eligibleSIMD = true;
436 break;
437 }
438 }
439 }
440 },
441 [&](const parser::OpenMPSimpleStandaloneConstruct &c) {
442 const auto &dir{
443 std::get<parser::OmpSimpleStandaloneDirective>(c.t)};
444 if (dir.v == llvm::omp::Directive::OMPD_ordered) {
445 const auto &clauses{std::get<parser::OmpClauseList>(c.t)};
446 for (const auto &clause : clauses.v) {
447 if (std::get_if<parser::OmpClause::Simd>(&clause.u)) {
448 eligibleSIMD = true;
449 break;
450 }
451 }
452 }
453 },
454 // Allowing SIMD construct
455 [&](const parser::OpenMPLoopConstruct &c) {
456 const auto &beginLoopDir{
457 std::get<parser::OmpBeginLoopDirective>(c.t)};
458 const auto &beginDir{
459 std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
460 if ((beginDir.v == llvm::omp::Directive::OMPD_simd) ||
461 (beginDir.v == llvm::omp::Directive::OMPD_do_simd)) {
462 eligibleSIMD = true;
463 }
464 },
465 [&](const parser::OpenMPAtomicConstruct &c) {
466 // Allow `!$OMP ATOMIC`
467 eligibleSIMD = true;
468 },
469 [&](const auto &c) {},
470 },
471 c.u);
472 if (!eligibleSIMD) {
473 context_.Say(parser::FindSourceLocation(c),
474 "The only OpenMP constructs that can be encountered during execution "
475 "of a 'SIMD'"
476 " region are the `ATOMIC` construct, the `LOOP` construct, the `SIMD`"
477 " construct and the `ORDERED` construct with the `SIMD` clause."_err_en_US);
478 }
479 }
480
CheckTargetNest(const parser::OpenMPConstruct & c)481 void OmpStructureChecker::CheckTargetNest(const parser::OpenMPConstruct &c) {
482 // 2.12.5 Target Construct Restriction
483 bool eligibleTarget{true};
484 llvm::omp::Directive ineligibleTargetDir;
485 std::visit(
486 common::visitors{
487 [&](const parser::OpenMPBlockConstruct &c) {
488 const auto &beginBlockDir{
489 std::get<parser::OmpBeginBlockDirective>(c.t)};
490 const auto &beginDir{
491 std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
492 if (beginDir.v == llvm::omp::Directive::OMPD_target_data) {
493 eligibleTarget = false;
494 ineligibleTargetDir = beginDir.v;
495 }
496 },
497 [&](const parser::OpenMPStandaloneConstruct &c) {
498 std::visit(
499 common::visitors{
500 [&](const parser::OpenMPSimpleStandaloneConstruct &c) {
501 const auto &dir{
502 std::get<parser::OmpSimpleStandaloneDirective>(c.t)};
503 if (dir.v == llvm::omp::Directive::OMPD_target_update ||
504 dir.v ==
505 llvm::omp::Directive::OMPD_target_enter_data ||
506 dir.v ==
507 llvm::omp::Directive::OMPD_target_exit_data) {
508 eligibleTarget = false;
509 ineligibleTargetDir = dir.v;
510 }
511 },
512 [&](const auto &c) {},
513 },
514 c.u);
515 },
516 [&](const auto &c) {},
517 },
518 c.u);
519 if (!eligibleTarget) {
520 context_.Say(parser::FindSourceLocation(c),
521 "If %s directive is nested inside TARGET region, the behaviour "
522 "is unspecified"_en_US,
523 parser::ToUpperCaseLetters(
524 getDirectiveName(ineligibleTargetDir).str()));
525 }
526 }
527
GetOrdCollapseLevel(const parser::OpenMPLoopConstruct & x)528 std::int64_t OmpStructureChecker::GetOrdCollapseLevel(
529 const parser::OpenMPLoopConstruct &x) {
530 const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
531 const auto &clauseList{std::get<parser::OmpClauseList>(beginLoopDir.t)};
532 std::int64_t orderedCollapseLevel{1};
533 std::int64_t orderedLevel{0};
534 std::int64_t collapseLevel{0};
535
536 for (const auto &clause : clauseList.v) {
537 if (const auto *collapseClause{
538 std::get_if<parser::OmpClause::Collapse>(&clause.u)}) {
539 if (const auto v{GetIntValue(collapseClause->v)}) {
540 collapseLevel = *v;
541 }
542 }
543 if (const auto *orderedClause{
544 std::get_if<parser::OmpClause::Ordered>(&clause.u)}) {
545 if (const auto v{GetIntValue(orderedClause->v)}) {
546 orderedLevel = *v;
547 }
548 }
549 }
550 if (orderedLevel >= collapseLevel) {
551 orderedCollapseLevel = orderedLevel;
552 } else {
553 orderedCollapseLevel = collapseLevel;
554 }
555 return orderedCollapseLevel;
556 }
557
CheckCycleConstraints(const parser::OpenMPLoopConstruct & x)558 void OmpStructureChecker::CheckCycleConstraints(
559 const parser::OpenMPLoopConstruct &x) {
560 std::int64_t ordCollapseLevel{GetOrdCollapseLevel(x)};
561 OmpCycleChecker ompCycleChecker{context_, ordCollapseLevel};
562 parser::Walk(x, ompCycleChecker);
563 }
564
CheckDistLinear(const parser::OpenMPLoopConstruct & x)565 void OmpStructureChecker::CheckDistLinear(
566 const parser::OpenMPLoopConstruct &x) {
567
568 const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
569 const auto &clauses{std::get<parser::OmpClauseList>(beginLoopDir.t)};
570
571 semantics::UnorderedSymbolSet indexVars;
572
573 // Collect symbols of all the variables from linear clauses
574 for (const auto &clause : clauses.v) {
575 if (const auto *linearClause{
576 std::get_if<parser::OmpClause::Linear>(&clause.u)}) {
577
578 std::list<parser::Name> values;
579 // Get the variant type
580 if (std::holds_alternative<parser::OmpLinearClause::WithModifier>(
581 linearClause->v.u)) {
582 const auto &withM{
583 std::get<parser::OmpLinearClause::WithModifier>(linearClause->v.u)};
584 values = withM.names;
585 } else {
586 const auto &withOutM{std::get<parser::OmpLinearClause::WithoutModifier>(
587 linearClause->v.u)};
588 values = withOutM.names;
589 }
590 for (auto const &v : values) {
591 indexVars.insert(*(v.symbol));
592 }
593 }
594 }
595
596 if (!indexVars.empty()) {
597 // Get collapse level, if given, to find which loops are "associated."
598 std::int64_t collapseVal{GetOrdCollapseLevel(x)};
599 // Include the top loop if no collapse is specified
600 if (collapseVal == 0) {
601 collapseVal = 1;
602 }
603
604 // Match the loop index variables with the collected symbols from linear
605 // clauses.
606 if (const auto &loopConstruct{
607 std::get<std::optional<parser::DoConstruct>>(x.t)}) {
608 for (const parser::DoConstruct *loop{&*loopConstruct}; loop;) {
609 if (loop->IsDoNormal()) {
610 const parser::Name &itrVal{GetLoopIndex(loop)};
611 if (itrVal.symbol) {
612 // Remove the symbol from the collcted set
613 indexVars.erase(*(itrVal.symbol));
614 }
615 collapseVal--;
616 if (collapseVal == 0) {
617 break;
618 }
619 }
620 // Get the next DoConstruct if block is not empty.
621 const auto &block{std::get<parser::Block>(loop->t)};
622 const auto it{block.begin()};
623 loop = it != block.end() ? parser::Unwrap<parser::DoConstruct>(*it)
624 : nullptr;
625 }
626 }
627
628 // Show error for the remaining variables
629 for (auto var : indexVars) {
630 const Symbol &root{GetAssociationRoot(var)};
631 context_.Say(parser::FindSourceLocation(x),
632 "Variable '%s' not allowed in `LINEAR` clause, only loop iterator can be specified in `LINEAR` clause of a construct combined with `DISTRIBUTE`"_err_en_US,
633 root.name());
634 }
635 }
636 }
637
Leave(const parser::OpenMPLoopConstruct &)638 void OmpStructureChecker::Leave(const parser::OpenMPLoopConstruct &) {
639 if (llvm::omp::simdSet.test(GetContext().directive)) {
640 ExitDirectiveNest(SIMDNest);
641 }
642 dirContext_.pop_back();
643 }
644
Enter(const parser::OmpEndLoopDirective & x)645 void OmpStructureChecker::Enter(const parser::OmpEndLoopDirective &x) {
646 const auto &dir{std::get<parser::OmpLoopDirective>(x.t)};
647 ResetPartialContext(dir.source);
648 switch (dir.v) {
649 // 2.7.1 end-do -> END DO [nowait-clause]
650 // 2.8.3 end-do-simd -> END DO SIMD [nowait-clause]
651 case llvm::omp::Directive::OMPD_do:
652 case llvm::omp::Directive::OMPD_do_simd:
653 SetClauseSets(dir.v);
654 break;
655 default:
656 // no clauses are allowed
657 break;
658 }
659 }
660
Enter(const parser::OpenMPBlockConstruct & x)661 void OmpStructureChecker::Enter(const parser::OpenMPBlockConstruct &x) {
662 const auto &beginBlockDir{std::get<parser::OmpBeginBlockDirective>(x.t)};
663 const auto &endBlockDir{std::get<parser::OmpEndBlockDirective>(x.t)};
664 const auto &beginDir{std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
665 const auto &endDir{std::get<parser::OmpBlockDirective>(endBlockDir.t)};
666 const parser::Block &block{std::get<parser::Block>(x.t)};
667
668 CheckMatching<parser::OmpBlockDirective>(beginDir, endDir);
669
670 PushContextAndClauseSets(beginDir.source, beginDir.v);
671 if (GetContext().directive == llvm::omp::Directive::OMPD_target) {
672 EnterDirectiveNest(TargetNest);
673 }
674
675 if (CurrentDirectiveIsNested()) {
676 CheckIfDoOrderedClause(beginDir);
677 if (llvm::omp::teamSet.test(GetContextParent().directive)) {
678 HasInvalidTeamsNesting(beginDir.v, beginDir.source);
679 }
680 if (GetContext().directive == llvm::omp::Directive::OMPD_master) {
681 CheckMasterNesting(x);
682 }
683 // A teams region can only be strictly nested within the implicit parallel
684 // region or a target region.
685 if (GetContext().directive == llvm::omp::Directive::OMPD_teams &&
686 GetContextParent().directive != llvm::omp::Directive::OMPD_target) {
687 context_.Say(parser::FindSourceLocation(x),
688 "%s region can only be strictly nested within the implicit parallel "
689 "region or TARGET region"_err_en_US,
690 ContextDirectiveAsFortran());
691 }
692 // If a teams construct is nested within a target construct, that target
693 // construct must contain no statements, declarations or directives outside
694 // of the teams construct.
695 if (GetContext().directive == llvm::omp::Directive::OMPD_teams &&
696 GetContextParent().directive == llvm::omp::Directive::OMPD_target &&
697 !GetDirectiveNest(TargetBlockOnlyTeams)) {
698 context_.Say(GetContextParent().directiveSource,
699 "TARGET construct with nested TEAMS region contains statements or "
700 "directives outside of the TEAMS construct"_err_en_US);
701 }
702 }
703
704 CheckNoBranching(block, beginDir.v, beginDir.source);
705
706 switch (beginDir.v) {
707 case llvm::omp::Directive::OMPD_target:
708 if (CheckTargetBlockOnlyTeams(block)) {
709 EnterDirectiveNest(TargetBlockOnlyTeams);
710 }
711 break;
712 case llvm::omp::OMPD_workshare:
713 case llvm::omp::OMPD_parallel_workshare:
714 CheckWorkshareBlockStmts(block, beginDir.source);
715 HasInvalidWorksharingNesting(
716 beginDir.source, llvm::omp::nestedWorkshareErrSet);
717 break;
718 case llvm::omp::Directive::OMPD_single:
719 // TODO: This check needs to be extended while implementing nesting of
720 // regions checks.
721 HasInvalidWorksharingNesting(
722 beginDir.source, llvm::omp::nestedWorkshareErrSet);
723 break;
724 default:
725 break;
726 }
727 }
728
CheckMasterNesting(const parser::OpenMPBlockConstruct & x)729 void OmpStructureChecker::CheckMasterNesting(
730 const parser::OpenMPBlockConstruct &x) {
731 // A MASTER region may not be `closely nested` inside a worksharing, loop,
732 // task, taskloop, or atomic region.
733 // TODO: Expand the check to include `LOOP` construct as well when it is
734 // supported.
735 if (IsCloselyNestedRegion(llvm::omp::nestedMasterErrSet)) {
736 context_.Say(parser::FindSourceLocation(x),
737 "`MASTER` region may not be closely nested inside of `WORKSHARING`, "
738 "`LOOP`, `TASK`, `TASKLOOP`,"
739 " or `ATOMIC` region."_err_en_US);
740 }
741 }
742
CheckIfDoOrderedClause(const parser::OmpBlockDirective & blkDirective)743 void OmpStructureChecker::CheckIfDoOrderedClause(
744 const parser::OmpBlockDirective &blkDirective) {
745 if (blkDirective.v == llvm::omp::OMPD_ordered) {
746 // Loops
747 if (llvm::omp::doSet.test(GetContextParent().directive) &&
748 !FindClauseParent(llvm::omp::Clause::OMPC_ordered)) {
749 context_.Say(blkDirective.source,
750 "The ORDERED clause must be present on the loop"
751 " construct if any ORDERED region ever binds"
752 " to a loop region arising from the loop construct."_err_en_US);
753 }
754 // Other disallowed nestings, these directives do not support
755 // ordered clause in them, so no need to check
756 else if (IsCloselyNestedRegion(llvm::omp::nestedOrderedErrSet)) {
757 context_.Say(blkDirective.source,
758 "`ORDERED` region may not be closely nested inside of "
759 "`CRITICAL`, `ORDERED`, explicit `TASK` or `TASKLOOP` region."_err_en_US);
760 }
761 }
762 }
763
Leave(const parser::OpenMPBlockConstruct &)764 void OmpStructureChecker::Leave(const parser::OpenMPBlockConstruct &) {
765 if (GetDirectiveNest(TargetBlockOnlyTeams)) {
766 ExitDirectiveNest(TargetBlockOnlyTeams);
767 }
768 if (GetContext().directive == llvm::omp::Directive::OMPD_target) {
769 ExitDirectiveNest(TargetNest);
770 }
771 dirContext_.pop_back();
772 }
773
ChecksOnOrderedAsBlock()774 void OmpStructureChecker::ChecksOnOrderedAsBlock() {
775 if (FindClause(llvm::omp::Clause::OMPC_depend)) {
776 context_.Say(GetContext().clauseSource,
777 "DEPEND(*) clauses are not allowed when ORDERED construct is a block"
778 " construct with an ORDERED region"_err_en_US);
779 }
780 }
781
Leave(const parser::OmpBeginBlockDirective &)782 void OmpStructureChecker::Leave(const parser::OmpBeginBlockDirective &) {
783 switch (GetContext().directive) {
784 case llvm::omp::Directive::OMPD_ordered:
785 // [5.1] 2.19.9 Ordered Construct Restriction
786 ChecksOnOrderedAsBlock();
787 break;
788 default:
789 break;
790 }
791 }
792
Enter(const parser::OpenMPSectionsConstruct & x)793 void OmpStructureChecker::Enter(const parser::OpenMPSectionsConstruct &x) {
794 const auto &beginSectionsDir{
795 std::get<parser::OmpBeginSectionsDirective>(x.t)};
796 const auto &endSectionsDir{std::get<parser::OmpEndSectionsDirective>(x.t)};
797 const auto &beginDir{
798 std::get<parser::OmpSectionsDirective>(beginSectionsDir.t)};
799 const auto &endDir{std::get<parser::OmpSectionsDirective>(endSectionsDir.t)};
800 CheckMatching<parser::OmpSectionsDirective>(beginDir, endDir);
801
802 PushContextAndClauseSets(beginDir.source, beginDir.v);
803 const auto §ionBlocks{std::get<parser::OmpSectionBlocks>(x.t)};
804 for (const auto &block : sectionBlocks.v) {
805 CheckNoBranching(block, beginDir.v, beginDir.source);
806 }
807 HasInvalidWorksharingNesting(
808 beginDir.source, llvm::omp::nestedWorkshareErrSet);
809 }
810
Leave(const parser::OpenMPSectionsConstruct &)811 void OmpStructureChecker::Leave(const parser::OpenMPSectionsConstruct &) {
812 dirContext_.pop_back();
813 }
814
Enter(const parser::OmpEndSectionsDirective & x)815 void OmpStructureChecker::Enter(const parser::OmpEndSectionsDirective &x) {
816 const auto &dir{std::get<parser::OmpSectionsDirective>(x.t)};
817 ResetPartialContext(dir.source);
818 switch (dir.v) {
819 // 2.7.2 end-sections -> END SECTIONS [nowait-clause]
820 case llvm::omp::Directive::OMPD_sections:
821 PushContextAndClauseSets(
822 dir.source, llvm::omp::Directive::OMPD_end_sections);
823 break;
824 default:
825 // no clauses are allowed
826 break;
827 }
828 }
829
830 // TODO: Verify the popping of dirContext requirement after nowait
831 // implementation, as there is an implicit barrier at the end of the worksharing
832 // constructs unless a nowait clause is specified. Only OMPD_end_sections is
833 // popped becuase it is pushed while entering the EndSectionsDirective.
Leave(const parser::OmpEndSectionsDirective & x)834 void OmpStructureChecker::Leave(const parser::OmpEndSectionsDirective &x) {
835 if (GetContext().directive == llvm::omp::Directive::OMPD_end_sections) {
836 dirContext_.pop_back();
837 }
838 }
839
Enter(const parser::OpenMPThreadprivate & c)840 void OmpStructureChecker::Enter(const parser::OpenMPThreadprivate &c) {
841 const auto &dir{std::get<parser::Verbatim>(c.t)};
842 PushContextAndClauseSets(
843 dir.source, llvm::omp::Directive::OMPD_threadprivate);
844 }
845
Leave(const parser::OpenMPThreadprivate & c)846 void OmpStructureChecker::Leave(const parser::OpenMPThreadprivate &c) {
847 const auto &dir{std::get<parser::Verbatim>(c.t)};
848 const auto &objectList{std::get<parser::OmpObjectList>(c.t)};
849 CheckIsVarPartOfAnotherVar(dir.source, objectList);
850 dirContext_.pop_back();
851 }
852
Enter(const parser::OpenMPDeclareSimdConstruct & x)853 void OmpStructureChecker::Enter(const parser::OpenMPDeclareSimdConstruct &x) {
854 const auto &dir{std::get<parser::Verbatim>(x.t)};
855 PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_declare_simd);
856 }
857
Leave(const parser::OpenMPDeclareSimdConstruct &)858 void OmpStructureChecker::Leave(const parser::OpenMPDeclareSimdConstruct &) {
859 dirContext_.pop_back();
860 }
861
Enter(const parser::OpenMPDeclarativeAllocate & x)862 void OmpStructureChecker::Enter(const parser::OpenMPDeclarativeAllocate &x) {
863 isPredefinedAllocator = true;
864 const auto &dir{std::get<parser::Verbatim>(x.t)};
865 const auto &objectList{std::get<parser::OmpObjectList>(x.t)};
866 PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_allocate);
867 CheckIsVarPartOfAnotherVar(dir.source, objectList);
868 }
869
Leave(const parser::OpenMPDeclarativeAllocate & x)870 void OmpStructureChecker::Leave(const parser::OpenMPDeclarativeAllocate &x) {
871 const auto &dir{std::get<parser::Verbatim>(x.t)};
872 const auto &objectList{std::get<parser::OmpObjectList>(x.t)};
873 CheckPredefinedAllocatorRestriction(dir.source, objectList);
874 dirContext_.pop_back();
875 }
876
Enter(const parser::OmpClause::Allocator & x)877 void OmpStructureChecker::Enter(const parser::OmpClause::Allocator &x) {
878 CheckAllowed(llvm::omp::Clause::OMPC_allocator);
879 // Note: Predefined allocators are stored in ScalarExpr as numbers
880 // whereas custom allocators are stored as strings, so if the ScalarExpr
881 // actually has an int value, then it must be a predefined allocator
882 isPredefinedAllocator = GetIntValue(x.v).has_value();
883 RequiresPositiveParameter(llvm::omp::Clause::OMPC_allocator, x.v);
884 }
885
Enter(const parser::OpenMPDeclareTargetConstruct & x)886 void OmpStructureChecker::Enter(const parser::OpenMPDeclareTargetConstruct &x) {
887 const auto &dir{std::get<parser::Verbatim>(x.t)};
888 PushContext(dir.source, llvm::omp::Directive::OMPD_declare_target);
889 const auto &spec{std::get<parser::OmpDeclareTargetSpecifier>(x.t)};
890 if (std::holds_alternative<parser::OmpDeclareTargetWithClause>(spec.u)) {
891 SetClauseSets(llvm::omp::Directive::OMPD_declare_target);
892 }
893 }
894
Leave(const parser::OpenMPDeclareTargetConstruct &)895 void OmpStructureChecker::Leave(const parser::OpenMPDeclareTargetConstruct &) {
896 dirContext_.pop_back();
897 }
898
Enter(const parser::OpenMPExecutableAllocate & x)899 void OmpStructureChecker::Enter(const parser::OpenMPExecutableAllocate &x) {
900 isPredefinedAllocator = true;
901 const auto &dir{std::get<parser::Verbatim>(x.t)};
902 const auto &objectList{std::get<std::optional<parser::OmpObjectList>>(x.t)};
903 PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_allocate);
904 if (objectList) {
905 CheckIsVarPartOfAnotherVar(dir.source, *objectList);
906 }
907 }
908
Leave(const parser::OpenMPExecutableAllocate & x)909 void OmpStructureChecker::Leave(const parser::OpenMPExecutableAllocate &x) {
910 const auto &dir{std::get<parser::Verbatim>(x.t)};
911 const auto &objectList{std::get<std::optional<parser::OmpObjectList>>(x.t)};
912 if (objectList)
913 CheckPredefinedAllocatorRestriction(dir.source, *objectList);
914 dirContext_.pop_back();
915 }
916
CheckBarrierNesting(const parser::OpenMPSimpleStandaloneConstruct & x)917 void OmpStructureChecker::CheckBarrierNesting(
918 const parser::OpenMPSimpleStandaloneConstruct &x) {
919 // A barrier region may not be `closely nested` inside a worksharing, loop,
920 // task, taskloop, critical, ordered, atomic, or master region.
921 // TODO: Expand the check to include `LOOP` construct as well when it is
922 // supported.
923 if (GetContext().directive == llvm::omp::Directive::OMPD_barrier) {
924 if (IsCloselyNestedRegion(llvm::omp::nestedBarrierErrSet)) {
925 context_.Say(parser::FindSourceLocation(x),
926 "`BARRIER` region may not be closely nested inside of `WORKSHARING`, "
927 "`LOOP`, `TASK`, `TASKLOOP`,"
928 "`CRITICAL`, `ORDERED`, `ATOMIC` or `MASTER` region."_err_en_US);
929 }
930 }
931 }
932
ChecksOnOrderedAsStandalone()933 void OmpStructureChecker::ChecksOnOrderedAsStandalone() {
934 if (FindClause(llvm::omp::Clause::OMPC_threads) ||
935 FindClause(llvm::omp::Clause::OMPC_simd)) {
936 context_.Say(GetContext().clauseSource,
937 "THREADS, SIMD clauses are not allowed when ORDERED construct is a "
938 "standalone construct with no ORDERED region"_err_en_US);
939 }
940
941 bool isSinkPresent{false};
942 int dependSourceCount{0};
943 auto clauseAll = FindClauses(llvm::omp::Clause::OMPC_depend);
944 for (auto itr = clauseAll.first; itr != clauseAll.second; ++itr) {
945 const auto &dependClause{
946 std::get<parser::OmpClause::Depend>(itr->second->u)};
947 if (std::get_if<parser::OmpDependClause::Source>(&dependClause.v.u)) {
948 dependSourceCount++;
949 if (isSinkPresent) {
950 context_.Say(itr->second->source,
951 "DEPEND(SOURCE) is not allowed when DEPEND(SINK: vec) is present "
952 "on ORDERED directive"_err_en_US);
953 }
954 if (dependSourceCount > 1) {
955 context_.Say(itr->second->source,
956 "At most one DEPEND(SOURCE) clause can appear on the ORDERED "
957 "directive"_err_en_US);
958 }
959 } else if (std::get_if<parser::OmpDependClause::Sink>(&dependClause.v.u)) {
960 isSinkPresent = true;
961 if (dependSourceCount > 0) {
962 context_.Say(itr->second->source,
963 "DEPEND(SINK: vec) is not allowed when DEPEND(SOURCE) is present "
964 "on ORDERED directive"_err_en_US);
965 }
966 } else {
967 context_.Say(itr->second->source,
968 "Only DEPEND(SOURCE) or DEPEND(SINK: vec) are allowed when ORDERED "
969 "construct is a standalone construct with no ORDERED "
970 "region"_err_en_US);
971 }
972 }
973 }
974
Enter(const parser::OpenMPSimpleStandaloneConstruct & x)975 void OmpStructureChecker::Enter(
976 const parser::OpenMPSimpleStandaloneConstruct &x) {
977 const auto &dir{std::get<parser::OmpSimpleStandaloneDirective>(x.t)};
978 PushContextAndClauseSets(dir.source, dir.v);
979 CheckBarrierNesting(x);
980 }
981
Leave(const parser::OpenMPSimpleStandaloneConstruct &)982 void OmpStructureChecker::Leave(
983 const parser::OpenMPSimpleStandaloneConstruct &) {
984 switch (GetContext().directive) {
985 case llvm::omp::Directive::OMPD_ordered:
986 // [5.1] 2.19.9 Ordered Construct Restriction
987 ChecksOnOrderedAsStandalone();
988 break;
989 default:
990 break;
991 }
992 dirContext_.pop_back();
993 }
994
Enter(const parser::OpenMPFlushConstruct & x)995 void OmpStructureChecker::Enter(const parser::OpenMPFlushConstruct &x) {
996 const auto &dir{std::get<parser::Verbatim>(x.t)};
997 PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_flush);
998 }
999
Leave(const parser::OpenMPFlushConstruct & x)1000 void OmpStructureChecker::Leave(const parser::OpenMPFlushConstruct &x) {
1001 if (FindClause(llvm::omp::Clause::OMPC_acquire) ||
1002 FindClause(llvm::omp::Clause::OMPC_release) ||
1003 FindClause(llvm::omp::Clause::OMPC_acq_rel)) {
1004 if (const auto &flushList{
1005 std::get<std::optional<parser::OmpObjectList>>(x.t)}) {
1006 context_.Say(parser::FindSourceLocation(flushList),
1007 "If memory-order-clause is RELEASE, ACQUIRE, or ACQ_REL, list items "
1008 "must not be specified on the FLUSH directive"_err_en_US);
1009 }
1010 }
1011 dirContext_.pop_back();
1012 }
1013
Enter(const parser::OpenMPCancelConstruct & x)1014 void OmpStructureChecker::Enter(const parser::OpenMPCancelConstruct &x) {
1015 const auto &dir{std::get<parser::Verbatim>(x.t)};
1016 const auto &type{std::get<parser::OmpCancelType>(x.t)};
1017 PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_cancel);
1018 CheckCancellationNest(dir.source, type.v);
1019 }
1020
Leave(const parser::OpenMPCancelConstruct &)1021 void OmpStructureChecker::Leave(const parser::OpenMPCancelConstruct &) {
1022 dirContext_.pop_back();
1023 }
1024
Enter(const parser::OpenMPCriticalConstruct & x)1025 void OmpStructureChecker::Enter(const parser::OpenMPCriticalConstruct &x) {
1026 const auto &dir{std::get<parser::OmpCriticalDirective>(x.t)};
1027 PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_critical);
1028 const auto &block{std::get<parser::Block>(x.t)};
1029 CheckNoBranching(block, llvm::omp::Directive::OMPD_critical, dir.source);
1030 }
1031
Leave(const parser::OpenMPCriticalConstruct &)1032 void OmpStructureChecker::Leave(const parser::OpenMPCriticalConstruct &) {
1033 dirContext_.pop_back();
1034 }
1035
Enter(const parser::OpenMPCancellationPointConstruct & x)1036 void OmpStructureChecker::Enter(
1037 const parser::OpenMPCancellationPointConstruct &x) {
1038 const auto &dir{std::get<parser::Verbatim>(x.t)};
1039 const auto &type{std::get<parser::OmpCancelType>(x.t)};
1040 PushContextAndClauseSets(
1041 dir.source, llvm::omp::Directive::OMPD_cancellation_point);
1042 CheckCancellationNest(dir.source, type.v);
1043 }
1044
Leave(const parser::OpenMPCancellationPointConstruct &)1045 void OmpStructureChecker::Leave(
1046 const parser::OpenMPCancellationPointConstruct &) {
1047 dirContext_.pop_back();
1048 }
1049
CheckCancellationNest(const parser::CharBlock & source,const parser::OmpCancelType::Type & type)1050 void OmpStructureChecker::CheckCancellationNest(
1051 const parser::CharBlock &source, const parser::OmpCancelType::Type &type) {
1052 if (CurrentDirectiveIsNested()) {
1053 // If construct-type-clause is taskgroup, the cancellation construct must be
1054 // closely nested inside a task or a taskloop construct and the cancellation
1055 // region must be closely nested inside a taskgroup region. If
1056 // construct-type-clause is sections, the cancellation construct must be
1057 // closely nested inside a sections or section construct. Otherwise, the
1058 // cancellation construct must be closely nested inside an OpenMP construct
1059 // that matches the type specified in construct-type-clause of the
1060 // cancellation construct.
1061
1062 OmpDirectiveSet allowedTaskgroupSet{
1063 llvm::omp::Directive::OMPD_task, llvm::omp::Directive::OMPD_taskloop};
1064 OmpDirectiveSet allowedSectionsSet{llvm::omp::Directive::OMPD_sections,
1065 llvm::omp::Directive::OMPD_parallel_sections};
1066 OmpDirectiveSet allowedDoSet{llvm::omp::Directive::OMPD_do,
1067 llvm::omp::Directive::OMPD_distribute_parallel_do,
1068 llvm::omp::Directive::OMPD_parallel_do,
1069 llvm::omp::Directive::OMPD_target_parallel_do,
1070 llvm::omp::Directive::OMPD_target_teams_distribute_parallel_do,
1071 llvm::omp::Directive::OMPD_teams_distribute_parallel_do};
1072 OmpDirectiveSet allowedParallelSet{llvm::omp::Directive::OMPD_parallel,
1073 llvm::omp::Directive::OMPD_target_parallel};
1074
1075 bool eligibleCancellation{false};
1076 switch (type) {
1077 case parser::OmpCancelType::Type::Taskgroup:
1078 if (allowedTaskgroupSet.test(GetContextParent().directive)) {
1079 eligibleCancellation = true;
1080 if (dirContext_.size() >= 3) {
1081 // Check if the cancellation region is closely nested inside a
1082 // taskgroup region when there are more than two levels of directives
1083 // in the directive context stack.
1084 if (GetContextParent().directive == llvm::omp::Directive::OMPD_task ||
1085 FindClauseParent(llvm::omp::Clause::OMPC_nogroup)) {
1086 for (int i = dirContext_.size() - 3; i >= 0; i--) {
1087 if (dirContext_[i].directive ==
1088 llvm::omp::Directive::OMPD_taskgroup) {
1089 break;
1090 }
1091 if (allowedParallelSet.test(dirContext_[i].directive)) {
1092 eligibleCancellation = false;
1093 break;
1094 }
1095 }
1096 }
1097 }
1098 }
1099 if (!eligibleCancellation) {
1100 context_.Say(source,
1101 "With %s clause, %s construct must be closely nested inside TASK "
1102 "or TASKLOOP construct and %s region must be closely nested inside "
1103 "TASKGROUP region"_err_en_US,
1104 parser::ToUpperCaseLetters(
1105 parser::OmpCancelType::EnumToString(type)),
1106 ContextDirectiveAsFortran(), ContextDirectiveAsFortran());
1107 }
1108 return;
1109 case parser::OmpCancelType::Type::Sections:
1110 if (allowedSectionsSet.test(GetContextParent().directive)) {
1111 eligibleCancellation = true;
1112 }
1113 break;
1114 case Fortran::parser::OmpCancelType::Type::Do:
1115 if (allowedDoSet.test(GetContextParent().directive)) {
1116 eligibleCancellation = true;
1117 }
1118 break;
1119 case parser::OmpCancelType::Type::Parallel:
1120 if (allowedParallelSet.test(GetContextParent().directive)) {
1121 eligibleCancellation = true;
1122 }
1123 break;
1124 }
1125 if (!eligibleCancellation) {
1126 context_.Say(source,
1127 "With %s clause, %s construct cannot be closely nested inside %s "
1128 "construct"_err_en_US,
1129 parser::ToUpperCaseLetters(parser::OmpCancelType::EnumToString(type)),
1130 ContextDirectiveAsFortran(),
1131 parser::ToUpperCaseLetters(
1132 getDirectiveName(GetContextParent().directive).str()));
1133 }
1134 } else {
1135 // The cancellation directive cannot be orphaned.
1136 switch (type) {
1137 case parser::OmpCancelType::Type::Taskgroup:
1138 context_.Say(source,
1139 "%s %s directive is not closely nested inside "
1140 "TASK or TASKLOOP"_err_en_US,
1141 ContextDirectiveAsFortran(),
1142 parser::ToUpperCaseLetters(
1143 parser::OmpCancelType::EnumToString(type)));
1144 break;
1145 case parser::OmpCancelType::Type::Sections:
1146 context_.Say(source,
1147 "%s %s directive is not closely nested inside "
1148 "SECTION or SECTIONS"_err_en_US,
1149 ContextDirectiveAsFortran(),
1150 parser::ToUpperCaseLetters(
1151 parser::OmpCancelType::EnumToString(type)));
1152 break;
1153 case Fortran::parser::OmpCancelType::Type::Do:
1154 context_.Say(source,
1155 "%s %s directive is not closely nested inside "
1156 "the construct that matches the DO clause type"_err_en_US,
1157 ContextDirectiveAsFortran(),
1158 parser::ToUpperCaseLetters(
1159 parser::OmpCancelType::EnumToString(type)));
1160 break;
1161 case parser::OmpCancelType::Type::Parallel:
1162 context_.Say(source,
1163 "%s %s directive is not closely nested inside "
1164 "the construct that matches the PARALLEL clause type"_err_en_US,
1165 ContextDirectiveAsFortran(),
1166 parser::ToUpperCaseLetters(
1167 parser::OmpCancelType::EnumToString(type)));
1168 break;
1169 }
1170 }
1171 }
1172
Enter(const parser::OmpEndBlockDirective & x)1173 void OmpStructureChecker::Enter(const parser::OmpEndBlockDirective &x) {
1174 const auto &dir{std::get<parser::OmpBlockDirective>(x.t)};
1175 ResetPartialContext(dir.source);
1176 switch (dir.v) {
1177 // 2.7.3 end-single-clause -> copyprivate-clause |
1178 // nowait-clause
1179 case llvm::omp::Directive::OMPD_single:
1180 PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_end_single);
1181 break;
1182 // 2.7.4 end-workshare -> END WORKSHARE [nowait-clause]
1183 case llvm::omp::Directive::OMPD_workshare:
1184 PushContextAndClauseSets(
1185 dir.source, llvm::omp::Directive::OMPD_end_workshare);
1186 break;
1187 default:
1188 // no clauses are allowed
1189 break;
1190 }
1191 }
1192
1193 // TODO: Verify the popping of dirContext requirement after nowait
1194 // implementation, as there is an implicit barrier at the end of the worksharing
1195 // constructs unless a nowait clause is specified. Only OMPD_end_single and
1196 // end_workshareare popped as they are pushed while entering the
1197 // EndBlockDirective.
Leave(const parser::OmpEndBlockDirective & x)1198 void OmpStructureChecker::Leave(const parser::OmpEndBlockDirective &x) {
1199 if ((GetContext().directive == llvm::omp::Directive::OMPD_end_single) ||
1200 (GetContext().directive == llvm::omp::Directive::OMPD_end_workshare)) {
1201 dirContext_.pop_back();
1202 }
1203 }
1204
Enter(const parser::OpenMPAtomicConstruct & x)1205 void OmpStructureChecker::Enter(const parser::OpenMPAtomicConstruct &x) {
1206 std::visit(
1207 common::visitors{
1208 [&](const auto &someAtomicConstruct) {
1209 const auto &dir{std::get<parser::Verbatim>(someAtomicConstruct.t)};
1210 PushContextAndClauseSets(
1211 dir.source, llvm::omp::Directive::OMPD_atomic);
1212 },
1213 },
1214 x.u);
1215 }
1216
Leave(const parser::OpenMPAtomicConstruct &)1217 void OmpStructureChecker::Leave(const parser::OpenMPAtomicConstruct &) {
1218 dirContext_.pop_back();
1219 }
1220
1221 // Clauses
1222 // Mainly categorized as
1223 // 1. Checks on 'OmpClauseList' from 'parse-tree.h'.
1224 // 2. Checks on clauses which fall under 'struct OmpClause' from parse-tree.h.
1225 // 3. Checks on clauses which are not in 'struct OmpClause' from parse-tree.h.
1226
Leave(const parser::OmpClauseList &)1227 void OmpStructureChecker::Leave(const parser::OmpClauseList &) {
1228 // 2.7.1 Loop Construct Restriction
1229 if (llvm::omp::doSet.test(GetContext().directive)) {
1230 if (auto *clause{FindClause(llvm::omp::Clause::OMPC_schedule)}) {
1231 // only one schedule clause is allowed
1232 const auto &schedClause{std::get<parser::OmpClause::Schedule>(clause->u)};
1233 if (ScheduleModifierHasType(schedClause.v,
1234 parser::OmpScheduleModifierType::ModType::Nonmonotonic)) {
1235 if (FindClause(llvm::omp::Clause::OMPC_ordered)) {
1236 context_.Say(clause->source,
1237 "The NONMONOTONIC modifier cannot be specified "
1238 "if an ORDERED clause is specified"_err_en_US);
1239 }
1240 if (ScheduleModifierHasType(schedClause.v,
1241 parser::OmpScheduleModifierType::ModType::Monotonic)) {
1242 context_.Say(clause->source,
1243 "The MONOTONIC and NONMONOTONIC modifiers "
1244 "cannot be both specified"_err_en_US);
1245 }
1246 }
1247 }
1248
1249 if (auto *clause{FindClause(llvm::omp::Clause::OMPC_ordered)}) {
1250 // only one ordered clause is allowed
1251 const auto &orderedClause{
1252 std::get<parser::OmpClause::Ordered>(clause->u)};
1253
1254 if (orderedClause.v) {
1255 CheckNotAllowedIfClause(
1256 llvm::omp::Clause::OMPC_ordered, {llvm::omp::Clause::OMPC_linear});
1257
1258 if (auto *clause2{FindClause(llvm::omp::Clause::OMPC_collapse)}) {
1259 const auto &collapseClause{
1260 std::get<parser::OmpClause::Collapse>(clause2->u)};
1261 // ordered and collapse both have parameters
1262 if (const auto orderedValue{GetIntValue(orderedClause.v)}) {
1263 if (const auto collapseValue{GetIntValue(collapseClause.v)}) {
1264 if (*orderedValue > 0 && *orderedValue < *collapseValue) {
1265 context_.Say(clause->source,
1266 "The parameter of the ORDERED clause must be "
1267 "greater than or equal to "
1268 "the parameter of the COLLAPSE clause"_err_en_US);
1269 }
1270 }
1271 }
1272 }
1273 }
1274
1275 // TODO: ordered region binding check (requires nesting implementation)
1276 }
1277 } // doSet
1278
1279 // 2.8.1 Simd Construct Restriction
1280 if (llvm::omp::simdSet.test(GetContext().directive)) {
1281 if (auto *clause{FindClause(llvm::omp::Clause::OMPC_simdlen)}) {
1282 if (auto *clause2{FindClause(llvm::omp::Clause::OMPC_safelen)}) {
1283 const auto &simdlenClause{
1284 std::get<parser::OmpClause::Simdlen>(clause->u)};
1285 const auto &safelenClause{
1286 std::get<parser::OmpClause::Safelen>(clause2->u)};
1287 // simdlen and safelen both have parameters
1288 if (const auto simdlenValue{GetIntValue(simdlenClause.v)}) {
1289 if (const auto safelenValue{GetIntValue(safelenClause.v)}) {
1290 if (*safelenValue > 0 && *simdlenValue > *safelenValue) {
1291 context_.Say(clause->source,
1292 "The parameter of the SIMDLEN clause must be less than or "
1293 "equal to the parameter of the SAFELEN clause"_err_en_US);
1294 }
1295 }
1296 }
1297 }
1298 }
1299 // A list-item cannot appear in more than one aligned clause
1300 semantics::UnorderedSymbolSet alignedVars;
1301 auto clauseAll = FindClauses(llvm::omp::Clause::OMPC_aligned);
1302 for (auto itr = clauseAll.first; itr != clauseAll.second; ++itr) {
1303 const auto &alignedClause{
1304 std::get<parser::OmpClause::Aligned>(itr->second->u)};
1305 const auto &alignedNameList{
1306 std::get<std::list<parser::Name>>(alignedClause.v.t)};
1307 for (auto const &var : alignedNameList) {
1308 if (alignedVars.count(*(var.symbol)) == 1) {
1309 context_.Say(itr->second->source,
1310 "List item '%s' present at multiple ALIGNED clauses"_err_en_US,
1311 var.ToString());
1312 break;
1313 }
1314 alignedVars.insert(*(var.symbol));
1315 }
1316 }
1317 } // SIMD
1318
1319 // 2.7.3 Single Construct Restriction
1320 if (GetContext().directive == llvm::omp::Directive::OMPD_end_single) {
1321 CheckNotAllowedIfClause(
1322 llvm::omp::Clause::OMPC_copyprivate, {llvm::omp::Clause::OMPC_nowait});
1323 }
1324
1325 CheckRequireAtLeastOneOf();
1326 }
1327
Enter(const parser::OmpClause & x)1328 void OmpStructureChecker::Enter(const parser::OmpClause &x) {
1329 SetContextClause(x);
1330 }
1331
1332 // Following clauses do not have a separate node in parse-tree.h.
CHECK_SIMPLE_CLAUSE(AcqRel,OMPC_acq_rel)1333 CHECK_SIMPLE_CLAUSE(AcqRel, OMPC_acq_rel)
1334 CHECK_SIMPLE_CLAUSE(Acquire, OMPC_acquire)
1335 CHECK_SIMPLE_CLAUSE(AtomicDefaultMemOrder, OMPC_atomic_default_mem_order)
1336 CHECK_SIMPLE_CLAUSE(Affinity, OMPC_affinity)
1337 CHECK_SIMPLE_CLAUSE(Allocate, OMPC_allocate)
1338 CHECK_SIMPLE_CLAUSE(Capture, OMPC_capture)
1339 CHECK_SIMPLE_CLAUSE(Copyin, OMPC_copyin)
1340 CHECK_SIMPLE_CLAUSE(Default, OMPC_default)
1341 CHECK_SIMPLE_CLAUSE(Depobj, OMPC_depobj)
1342 CHECK_SIMPLE_CLAUSE(Destroy, OMPC_destroy)
1343 CHECK_SIMPLE_CLAUSE(Detach, OMPC_detach)
1344 CHECK_SIMPLE_CLAUSE(Device, OMPC_device)
1345 CHECK_SIMPLE_CLAUSE(DeviceType, OMPC_device_type)
1346 CHECK_SIMPLE_CLAUSE(DistSchedule, OMPC_dist_schedule)
1347 CHECK_SIMPLE_CLAUSE(DynamicAllocators, OMPC_dynamic_allocators)
1348 CHECK_SIMPLE_CLAUSE(Exclusive, OMPC_exclusive)
1349 CHECK_SIMPLE_CLAUSE(Final, OMPC_final)
1350 CHECK_SIMPLE_CLAUSE(Flush, OMPC_flush)
1351 CHECK_SIMPLE_CLAUSE(From, OMPC_from)
1352 CHECK_SIMPLE_CLAUSE(Full, OMPC_full)
1353 CHECK_SIMPLE_CLAUSE(Hint, OMPC_hint)
1354 CHECK_SIMPLE_CLAUSE(InReduction, OMPC_in_reduction)
1355 CHECK_SIMPLE_CLAUSE(Inclusive, OMPC_inclusive)
1356 CHECK_SIMPLE_CLAUSE(Match, OMPC_match)
1357 CHECK_SIMPLE_CLAUSE(Nontemporal, OMPC_nontemporal)
1358 CHECK_SIMPLE_CLAUSE(Order, OMPC_order)
1359 CHECK_SIMPLE_CLAUSE(Read, OMPC_read)
1360 CHECK_SIMPLE_CLAUSE(ReverseOffload, OMPC_reverse_offload)
1361 CHECK_SIMPLE_CLAUSE(Threadprivate, OMPC_threadprivate)
1362 CHECK_SIMPLE_CLAUSE(Threads, OMPC_threads)
1363 CHECK_SIMPLE_CLAUSE(Inbranch, OMPC_inbranch)
1364 CHECK_SIMPLE_CLAUSE(IsDevicePtr, OMPC_is_device_ptr)
1365 CHECK_SIMPLE_CLAUSE(Link, OMPC_link)
1366 CHECK_SIMPLE_CLAUSE(Mergeable, OMPC_mergeable)
1367 CHECK_SIMPLE_CLAUSE(Nogroup, OMPC_nogroup)
1368 CHECK_SIMPLE_CLAUSE(Notinbranch, OMPC_notinbranch)
1369 CHECK_SIMPLE_CLAUSE(Nowait, OMPC_nowait)
1370 CHECK_SIMPLE_CLAUSE(Partial, OMPC_partial)
1371 CHECK_SIMPLE_CLAUSE(ProcBind, OMPC_proc_bind)
1372 CHECK_SIMPLE_CLAUSE(Release, OMPC_release)
1373 CHECK_SIMPLE_CLAUSE(Relaxed, OMPC_relaxed)
1374 CHECK_SIMPLE_CLAUSE(SeqCst, OMPC_seq_cst)
1375 CHECK_SIMPLE_CLAUSE(Simd, OMPC_simd)
1376 CHECK_SIMPLE_CLAUSE(Sizes, OMPC_sizes)
1377 CHECK_SIMPLE_CLAUSE(TaskReduction, OMPC_task_reduction)
1378 CHECK_SIMPLE_CLAUSE(To, OMPC_to)
1379 CHECK_SIMPLE_CLAUSE(UnifiedAddress, OMPC_unified_address)
1380 CHECK_SIMPLE_CLAUSE(UnifiedSharedMemory, OMPC_unified_shared_memory)
1381 CHECK_SIMPLE_CLAUSE(Uniform, OMPC_uniform)
1382 CHECK_SIMPLE_CLAUSE(Unknown, OMPC_unknown)
1383 CHECK_SIMPLE_CLAUSE(Untied, OMPC_untied)
1384 CHECK_SIMPLE_CLAUSE(UseDevicePtr, OMPC_use_device_ptr)
1385 CHECK_SIMPLE_CLAUSE(UsesAllocators, OMPC_uses_allocators)
1386 CHECK_SIMPLE_CLAUSE(Update, OMPC_update)
1387 CHECK_SIMPLE_CLAUSE(UseDeviceAddr, OMPC_use_device_addr)
1388 CHECK_SIMPLE_CLAUSE(Write, OMPC_write)
1389 CHECK_SIMPLE_CLAUSE(Init, OMPC_init)
1390 CHECK_SIMPLE_CLAUSE(Use, OMPC_use)
1391 CHECK_SIMPLE_CLAUSE(Novariants, OMPC_novariants)
1392 CHECK_SIMPLE_CLAUSE(Nocontext, OMPC_nocontext)
1393 CHECK_SIMPLE_CLAUSE(Filter, OMPC_filter)
1394 CHECK_SIMPLE_CLAUSE(When, OMPC_when)
1395
1396 CHECK_REQ_SCALAR_INT_CLAUSE(Grainsize, OMPC_grainsize)
1397 CHECK_REQ_SCALAR_INT_CLAUSE(NumTasks, OMPC_num_tasks)
1398 CHECK_REQ_SCALAR_INT_CLAUSE(NumTeams, OMPC_num_teams)
1399 CHECK_REQ_SCALAR_INT_CLAUSE(NumThreads, OMPC_num_threads)
1400 CHECK_REQ_SCALAR_INT_CLAUSE(Priority, OMPC_priority)
1401 CHECK_REQ_SCALAR_INT_CLAUSE(ThreadLimit, OMPC_thread_limit)
1402
1403 CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(Collapse, OMPC_collapse)
1404 CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(Safelen, OMPC_safelen)
1405 CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(Simdlen, OMPC_simdlen)
1406
1407 // Restrictions specific to each clause are implemented apart from the
1408 // generalized restrictions.
1409 void OmpStructureChecker::Enter(const parser::OmpClause::Reduction &x) {
1410 CheckAllowed(llvm::omp::Clause::OMPC_reduction);
1411 if (CheckReductionOperators(x)) {
1412 CheckReductionTypeList(x);
1413 }
1414 }
CheckReductionOperators(const parser::OmpClause::Reduction & x)1415 bool OmpStructureChecker::CheckReductionOperators(
1416 const parser::OmpClause::Reduction &x) {
1417
1418 const auto &definedOp{std::get<0>(x.v.t)};
1419 bool ok = false;
1420 std::visit(
1421 common::visitors{
1422 [&](const parser::DefinedOperator &dOpr) {
1423 const auto &intrinsicOp{
1424 std::get<parser::DefinedOperator::IntrinsicOperator>(dOpr.u)};
1425 ok = CheckIntrinsicOperator(intrinsicOp);
1426 },
1427 [&](const parser::ProcedureDesignator &procD) {
1428 const parser::Name *name{std::get_if<parser::Name>(&procD.u)};
1429 if (name) {
1430 if (name->source == "max" || name->source == "min" ||
1431 name->source == "iand" || name->source == "ior" ||
1432 name->source == "ieor") {
1433 ok = true;
1434 } else {
1435 context_.Say(GetContext().clauseSource,
1436 "Invalid reduction identifier in REDUCTION clause."_err_en_US,
1437 ContextDirectiveAsFortran());
1438 }
1439 }
1440 },
1441 },
1442 definedOp.u);
1443
1444 return ok;
1445 }
CheckIntrinsicOperator(const parser::DefinedOperator::IntrinsicOperator & op)1446 bool OmpStructureChecker::CheckIntrinsicOperator(
1447 const parser::DefinedOperator::IntrinsicOperator &op) {
1448
1449 switch (op) {
1450 case parser::DefinedOperator::IntrinsicOperator::Add:
1451 case parser::DefinedOperator::IntrinsicOperator::Subtract:
1452 case parser::DefinedOperator::IntrinsicOperator::Multiply:
1453 case parser::DefinedOperator::IntrinsicOperator::AND:
1454 case parser::DefinedOperator::IntrinsicOperator::OR:
1455 case parser::DefinedOperator::IntrinsicOperator::EQV:
1456 case parser::DefinedOperator::IntrinsicOperator::NEQV:
1457 return true;
1458 default:
1459 context_.Say(GetContext().clauseSource,
1460 "Invalid reduction operator in REDUCTION clause."_err_en_US,
1461 ContextDirectiveAsFortran());
1462 }
1463 return false;
1464 }
1465
CheckReductionTypeList(const parser::OmpClause::Reduction & x)1466 void OmpStructureChecker::CheckReductionTypeList(
1467 const parser::OmpClause::Reduction &x) {
1468 const auto &ompObjectList{std::get<parser::OmpObjectList>(x.v.t)};
1469 CheckIntentInPointerAndDefinable(
1470 ompObjectList, llvm::omp::Clause::OMPC_reduction);
1471 CheckReductionArraySection(ompObjectList);
1472 CheckMultipleAppearanceAcrossContext(ompObjectList);
1473 }
1474
CheckIntentInPointerAndDefinable(const parser::OmpObjectList & objectList,const llvm::omp::Clause clause)1475 void OmpStructureChecker::CheckIntentInPointerAndDefinable(
1476 const parser::OmpObjectList &objectList, const llvm::omp::Clause clause) {
1477 for (const auto &ompObject : objectList.v) {
1478 if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
1479 if (const auto *symbol{name->symbol}) {
1480 if (IsPointer(symbol->GetUltimate()) &&
1481 IsIntentIn(symbol->GetUltimate())) {
1482 context_.Say(GetContext().clauseSource,
1483 "Pointer '%s' with the INTENT(IN) attribute may not appear "
1484 "in a %s clause"_err_en_US,
1485 symbol->name(),
1486 parser::ToUpperCaseLetters(getClauseName(clause).str()));
1487 }
1488 if (auto msg{
1489 WhyNotModifiable(*symbol, context_.FindScope(name->source))}) {
1490 context_.Say(GetContext().clauseSource,
1491 "Variable '%s' on the %s clause is not definable"_err_en_US,
1492 symbol->name(),
1493 parser::ToUpperCaseLetters(getClauseName(clause).str()));
1494 }
1495 }
1496 }
1497 }
1498 }
1499
CheckReductionArraySection(const parser::OmpObjectList & ompObjectList)1500 void OmpStructureChecker::CheckReductionArraySection(
1501 const parser::OmpObjectList &ompObjectList) {
1502 for (const auto &ompObject : ompObjectList.v) {
1503 if (const auto *dataRef{parser::Unwrap<parser::DataRef>(ompObject)}) {
1504 if (const auto *arrayElement{
1505 parser::Unwrap<parser::ArrayElement>(ompObject)}) {
1506 if (arrayElement) {
1507 CheckArraySection(*arrayElement, GetLastName(*dataRef),
1508 llvm::omp::Clause::OMPC_reduction);
1509 }
1510 }
1511 }
1512 }
1513 }
1514
CheckMultipleAppearanceAcrossContext(const parser::OmpObjectList & redObjectList)1515 void OmpStructureChecker::CheckMultipleAppearanceAcrossContext(
1516 const parser::OmpObjectList &redObjectList) {
1517 // TODO: Verify the assumption here that the immediately enclosing region is
1518 // the parallel region to which the worksharing construct having reduction
1519 // binds to.
1520 if (auto *enclosingContext{GetEnclosingDirContext()}) {
1521 for (auto it : enclosingContext->clauseInfo) {
1522 llvmOmpClause type = it.first;
1523 const auto *clause = it.second;
1524 if (llvm::omp::privateReductionSet.test(type)) {
1525 if (const auto *objList{GetOmpObjectList(*clause)}) {
1526 for (const auto &ompObject : objList->v) {
1527 if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
1528 if (const auto *symbol{name->symbol}) {
1529 for (const auto &redOmpObject : redObjectList.v) {
1530 if (const auto *rname{
1531 parser::Unwrap<parser::Name>(redOmpObject)}) {
1532 if (const auto *rsymbol{rname->symbol}) {
1533 if (rsymbol->name() == symbol->name()) {
1534 context_.Say(GetContext().clauseSource,
1535 "%s variable '%s' is %s in outer context must"
1536 " be shared in the parallel regions to which any"
1537 " of the worksharing regions arising from the "
1538 "worksharing"
1539 " construct bind."_err_en_US,
1540 parser::ToUpperCaseLetters(
1541 getClauseName(llvm::omp::Clause::OMPC_reduction)
1542 .str()),
1543 symbol->name(),
1544 parser::ToUpperCaseLetters(
1545 getClauseName(type).str()));
1546 }
1547 }
1548 }
1549 }
1550 }
1551 }
1552 }
1553 }
1554 }
1555 }
1556 }
1557 }
1558
Enter(const parser::OmpClause::Ordered & x)1559 void OmpStructureChecker::Enter(const parser::OmpClause::Ordered &x) {
1560 CheckAllowed(llvm::omp::Clause::OMPC_ordered);
1561 // the parameter of ordered clause is optional
1562 if (const auto &expr{x.v}) {
1563 RequiresConstantPositiveParameter(llvm::omp::Clause::OMPC_ordered, *expr);
1564 // 2.8.3 Loop SIMD Construct Restriction
1565 if (llvm::omp::doSimdSet.test(GetContext().directive)) {
1566 context_.Say(GetContext().clauseSource,
1567 "No ORDERED clause with a parameter can be specified "
1568 "on the %s directive"_err_en_US,
1569 ContextDirectiveAsFortran());
1570 }
1571 }
1572 }
1573
Enter(const parser::OmpClause::Shared & x)1574 void OmpStructureChecker::Enter(const parser::OmpClause::Shared &x) {
1575 CheckAllowed(llvm::omp::Clause::OMPC_shared);
1576 CheckIsVarPartOfAnotherVar(GetContext().clauseSource, x.v);
1577 }
Enter(const parser::OmpClause::Private & x)1578 void OmpStructureChecker::Enter(const parser::OmpClause::Private &x) {
1579 CheckAllowed(llvm::omp::Clause::OMPC_private);
1580 CheckIsVarPartOfAnotherVar(GetContext().clauseSource, x.v);
1581 CheckIntentInPointer(x.v, llvm::omp::Clause::OMPC_private);
1582 }
1583
IsDataRefTypeParamInquiry(const parser::DataRef * dataRef)1584 bool OmpStructureChecker::IsDataRefTypeParamInquiry(
1585 const parser::DataRef *dataRef) {
1586 bool dataRefIsTypeParamInquiry{false};
1587 if (const auto *structComp{
1588 parser::Unwrap<parser::StructureComponent>(dataRef)}) {
1589 if (const auto *compSymbol{structComp->component.symbol}) {
1590 if (const auto *compSymbolMiscDetails{
1591 std::get_if<MiscDetails>(&compSymbol->details())}) {
1592 const auto detailsKind = compSymbolMiscDetails->kind();
1593 dataRefIsTypeParamInquiry =
1594 (detailsKind == MiscDetails::Kind::KindParamInquiry ||
1595 detailsKind == MiscDetails::Kind::LenParamInquiry);
1596 } else if (compSymbol->has<TypeParamDetails>()) {
1597 dataRefIsTypeParamInquiry = true;
1598 }
1599 }
1600 }
1601 return dataRefIsTypeParamInquiry;
1602 }
1603
CheckIsVarPartOfAnotherVar(const parser::CharBlock & source,const parser::OmpObjectList & objList)1604 void OmpStructureChecker::CheckIsVarPartOfAnotherVar(
1605 const parser::CharBlock &source, const parser::OmpObjectList &objList) {
1606 OmpDirectiveSet nonPartialVarSet{llvm::omp::Directive::OMPD_allocate,
1607 llvm::omp::Directive::OMPD_threadprivate};
1608 for (const auto &ompObject : objList.v) {
1609 std::visit(
1610 common::visitors{
1611 [&](const parser::Designator &designator) {
1612 if (const auto *dataRef{
1613 std::get_if<parser::DataRef>(&designator.u)}) {
1614 if (IsDataRefTypeParamInquiry(dataRef)) {
1615 context_.Say(source,
1616 "A type parameter inquiry cannot appear on the %s "
1617 "directive"_err_en_US,
1618 ContextDirectiveAsFortran());
1619 } else if (parser::Unwrap<parser::StructureComponent>(
1620 ompObject) ||
1621 parser::Unwrap<parser::ArrayElement>(ompObject)) {
1622 if (nonPartialVarSet.test(GetContext().directive)) {
1623 context_.Say(source,
1624 "A variable that is part of another variable (as an "
1625 "array or structure element) cannot appear on the %s "
1626 "directive"_err_en_US,
1627 ContextDirectiveAsFortran());
1628 } else {
1629 context_.Say(source,
1630 "A variable that is part of another variable (as an "
1631 "array or structure element) cannot appear in a "
1632 "PRIVATE or SHARED clause"_err_en_US);
1633 }
1634 }
1635 }
1636 },
1637 [&](const parser::Name &name) {},
1638 },
1639 ompObject.u);
1640 }
1641 }
1642
Enter(const parser::OmpClause::Firstprivate & x)1643 void OmpStructureChecker::Enter(const parser::OmpClause::Firstprivate &x) {
1644 CheckAllowed(llvm::omp::Clause::OMPC_firstprivate);
1645 CheckIsLoopIvPartOfClause(llvmOmpClause::OMPC_firstprivate, x.v);
1646
1647 SymbolSourceMap currSymbols;
1648 GetSymbolsInObjectList(x.v, currSymbols);
1649
1650 DirectivesClauseTriple dirClauseTriple;
1651 // Check firstprivate variables in worksharing constructs
1652 dirClauseTriple.emplace(llvm::omp::Directive::OMPD_do,
1653 std::make_pair(
1654 llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet));
1655 dirClauseTriple.emplace(llvm::omp::Directive::OMPD_sections,
1656 std::make_pair(
1657 llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet));
1658 dirClauseTriple.emplace(llvm::omp::Directive::OMPD_single,
1659 std::make_pair(
1660 llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet));
1661 // Check firstprivate variables in distribute construct
1662 dirClauseTriple.emplace(llvm::omp::Directive::OMPD_distribute,
1663 std::make_pair(
1664 llvm::omp::Directive::OMPD_teams, llvm::omp::privateReductionSet));
1665 dirClauseTriple.emplace(llvm::omp::Directive::OMPD_distribute,
1666 std::make_pair(llvm::omp::Directive::OMPD_target_teams,
1667 llvm::omp::privateReductionSet));
1668 // Check firstprivate variables in task and taskloop constructs
1669 dirClauseTriple.emplace(llvm::omp::Directive::OMPD_task,
1670 std::make_pair(llvm::omp::Directive::OMPD_parallel,
1671 OmpClauseSet{llvm::omp::Clause::OMPC_reduction}));
1672 dirClauseTriple.emplace(llvm::omp::Directive::OMPD_taskloop,
1673 std::make_pair(llvm::omp::Directive::OMPD_parallel,
1674 OmpClauseSet{llvm::omp::Clause::OMPC_reduction}));
1675
1676 CheckPrivateSymbolsInOuterCxt(
1677 currSymbols, dirClauseTriple, llvm::omp::Clause::OMPC_firstprivate);
1678 }
1679
CheckIsLoopIvPartOfClause(llvmOmpClause clause,const parser::OmpObjectList & ompObjectList)1680 void OmpStructureChecker::CheckIsLoopIvPartOfClause(
1681 llvmOmpClause clause, const parser::OmpObjectList &ompObjectList) {
1682 for (const auto &ompObject : ompObjectList.v) {
1683 if (const parser::Name * name{parser::Unwrap<parser::Name>(ompObject)}) {
1684 if (name->symbol == GetContext().loopIV) {
1685 context_.Say(name->source,
1686 "DO iteration variable %s is not allowed in %s clause."_err_en_US,
1687 name->ToString(),
1688 parser::ToUpperCaseLetters(getClauseName(clause).str()));
1689 }
1690 }
1691 }
1692 }
1693 // Following clauses have a seperate node in parse-tree.h.
1694 // Atomic-clause
CHECK_SIMPLE_PARSER_CLAUSE(OmpAtomicRead,OMPC_read)1695 CHECK_SIMPLE_PARSER_CLAUSE(OmpAtomicRead, OMPC_read)
1696 CHECK_SIMPLE_PARSER_CLAUSE(OmpAtomicWrite, OMPC_write)
1697 CHECK_SIMPLE_PARSER_CLAUSE(OmpAtomicUpdate, OMPC_update)
1698 CHECK_SIMPLE_PARSER_CLAUSE(OmpAtomicCapture, OMPC_capture)
1699
1700 void OmpStructureChecker::Leave(const parser::OmpAtomicRead &) {
1701 CheckNotAllowedIfClause(llvm::omp::Clause::OMPC_read,
1702 {llvm::omp::Clause::OMPC_release, llvm::omp::Clause::OMPC_acq_rel});
1703 }
Leave(const parser::OmpAtomicWrite &)1704 void OmpStructureChecker::Leave(const parser::OmpAtomicWrite &) {
1705 CheckNotAllowedIfClause(llvm::omp::Clause::OMPC_write,
1706 {llvm::omp::Clause::OMPC_acquire, llvm::omp::Clause::OMPC_acq_rel});
1707 }
Leave(const parser::OmpAtomicUpdate &)1708 void OmpStructureChecker::Leave(const parser::OmpAtomicUpdate &) {
1709 CheckNotAllowedIfClause(llvm::omp::Clause::OMPC_update,
1710 {llvm::omp::Clause::OMPC_acquire, llvm::omp::Clause::OMPC_acq_rel});
1711 }
1712 // OmpAtomic node represents atomic directive without atomic-clause.
1713 // atomic-clause - READ,WRITE,UPDATE,CAPTURE.
Leave(const parser::OmpAtomic &)1714 void OmpStructureChecker::Leave(const parser::OmpAtomic &) {
1715 if (const auto *clause{FindClause(llvm::omp::Clause::OMPC_acquire)}) {
1716 context_.Say(clause->source,
1717 "Clause ACQUIRE is not allowed on the ATOMIC directive"_err_en_US);
1718 }
1719 if (const auto *clause{FindClause(llvm::omp::Clause::OMPC_acq_rel)}) {
1720 context_.Say(clause->source,
1721 "Clause ACQ_REL is not allowed on the ATOMIC directive"_err_en_US);
1722 }
1723 }
1724 // Restrictions specific to each clause are implemented apart from the
1725 // generalized restrictions.
Enter(const parser::OmpClause::Aligned & x)1726 void OmpStructureChecker::Enter(const parser::OmpClause::Aligned &x) {
1727 CheckAllowed(llvm::omp::Clause::OMPC_aligned);
1728
1729 if (const auto &expr{
1730 std::get<std::optional<parser::ScalarIntConstantExpr>>(x.v.t)}) {
1731 RequiresConstantPositiveParameter(llvm::omp::Clause::OMPC_aligned, *expr);
1732 }
1733 // 2.8.1 TODO: list-item attribute check
1734 }
Enter(const parser::OmpClause::Defaultmap & x)1735 void OmpStructureChecker::Enter(const parser::OmpClause::Defaultmap &x) {
1736 CheckAllowed(llvm::omp::Clause::OMPC_defaultmap);
1737 using VariableCategory = parser::OmpDefaultmapClause::VariableCategory;
1738 if (!std::get<std::optional<VariableCategory>>(x.v.t)) {
1739 context_.Say(GetContext().clauseSource,
1740 "The argument TOFROM:SCALAR must be specified on the DEFAULTMAP "
1741 "clause"_err_en_US);
1742 }
1743 }
Enter(const parser::OmpClause::If & x)1744 void OmpStructureChecker::Enter(const parser::OmpClause::If &x) {
1745 CheckAllowed(llvm::omp::Clause::OMPC_if);
1746 using dirNameModifier = parser::OmpIfClause::DirectiveNameModifier;
1747 static std::unordered_map<dirNameModifier, OmpDirectiveSet>
1748 dirNameModifierMap{{dirNameModifier::Parallel, llvm::omp::parallelSet},
1749 {dirNameModifier::Target, llvm::omp::targetSet},
1750 {dirNameModifier::TargetEnterData,
1751 {llvm::omp::Directive::OMPD_target_enter_data}},
1752 {dirNameModifier::TargetExitData,
1753 {llvm::omp::Directive::OMPD_target_exit_data}},
1754 {dirNameModifier::TargetData,
1755 {llvm::omp::Directive::OMPD_target_data}},
1756 {dirNameModifier::TargetUpdate,
1757 {llvm::omp::Directive::OMPD_target_update}},
1758 {dirNameModifier::Task, {llvm::omp::Directive::OMPD_task}},
1759 {dirNameModifier::Taskloop, llvm::omp::taskloopSet}};
1760 if (const auto &directiveName{
1761 std::get<std::optional<dirNameModifier>>(x.v.t)}) {
1762 auto search{dirNameModifierMap.find(*directiveName)};
1763 if (search == dirNameModifierMap.end() ||
1764 !search->second.test(GetContext().directive)) {
1765 context_
1766 .Say(GetContext().clauseSource,
1767 "Unmatched directive name modifier %s on the IF clause"_err_en_US,
1768 parser::ToUpperCaseLetters(
1769 parser::OmpIfClause::EnumToString(*directiveName)))
1770 .Attach(
1771 GetContext().directiveSource, "Cannot apply to directive"_en_US);
1772 }
1773 }
1774 }
1775
Enter(const parser::OmpClause::Linear & x)1776 void OmpStructureChecker::Enter(const parser::OmpClause::Linear &x) {
1777 CheckAllowed(llvm::omp::Clause::OMPC_linear);
1778
1779 // 2.7 Loop Construct Restriction
1780 if ((llvm::omp::doSet | llvm::omp::simdSet).test(GetContext().directive)) {
1781 if (std::holds_alternative<parser::OmpLinearClause::WithModifier>(x.v.u)) {
1782 context_.Say(GetContext().clauseSource,
1783 "A modifier may not be specified in a LINEAR clause "
1784 "on the %s directive"_err_en_US,
1785 ContextDirectiveAsFortran());
1786 }
1787 }
1788 }
1789
CheckAllowedMapTypes(const parser::OmpMapType::Type & type,const std::list<parser::OmpMapType::Type> & allowedMapTypeList)1790 void OmpStructureChecker::CheckAllowedMapTypes(
1791 const parser::OmpMapType::Type &type,
1792 const std::list<parser::OmpMapType::Type> &allowedMapTypeList) {
1793 const auto found{std::find(
1794 std::begin(allowedMapTypeList), std::end(allowedMapTypeList), type)};
1795 if (found == std::end(allowedMapTypeList)) {
1796 std::string commaSeperatedMapTypes;
1797 llvm::interleave(
1798 allowedMapTypeList.begin(), allowedMapTypeList.end(),
1799 [&](const parser::OmpMapType::Type &mapType) {
1800 commaSeperatedMapTypes.append(parser::ToUpperCaseLetters(
1801 parser::OmpMapType::EnumToString(mapType)));
1802 },
1803 [&] { commaSeperatedMapTypes.append(", "); });
1804 context_.Say(GetContext().clauseSource,
1805 "Only the %s map types are permitted "
1806 "for MAP clauses on the %s directive"_err_en_US,
1807 commaSeperatedMapTypes, ContextDirectiveAsFortran());
1808 }
1809 }
1810
Enter(const parser::OmpClause::Map & x)1811 void OmpStructureChecker::Enter(const parser::OmpClause::Map &x) {
1812 CheckAllowed(llvm::omp::Clause::OMPC_map);
1813
1814 if (const auto &maptype{std::get<std::optional<parser::OmpMapType>>(x.v.t)}) {
1815 using Type = parser::OmpMapType::Type;
1816 const Type &type{std::get<Type>(maptype->t)};
1817 switch (GetContext().directive) {
1818 case llvm::omp::Directive::OMPD_target:
1819 case llvm::omp::Directive::OMPD_target_teams:
1820 case llvm::omp::Directive::OMPD_target_teams_distribute:
1821 case llvm::omp::Directive::OMPD_target_teams_distribute_simd:
1822 case llvm::omp::Directive::OMPD_target_teams_distribute_parallel_do:
1823 case llvm::omp::Directive::OMPD_target_teams_distribute_parallel_do_simd:
1824 case llvm::omp::Directive::OMPD_target_data:
1825 CheckAllowedMapTypes(
1826 type, {Type::To, Type::From, Type::Tofrom, Type::Alloc});
1827 break;
1828 case llvm::omp::Directive::OMPD_target_enter_data:
1829 CheckAllowedMapTypes(type, {Type::To, Type::Alloc});
1830 break;
1831 case llvm::omp::Directive::OMPD_target_exit_data:
1832 CheckAllowedMapTypes(type, {Type::From, Type::Release, Type::Delete});
1833 break;
1834 default:
1835 break;
1836 }
1837 }
1838 }
1839
ScheduleModifierHasType(const parser::OmpScheduleClause & x,const parser::OmpScheduleModifierType::ModType & type)1840 bool OmpStructureChecker::ScheduleModifierHasType(
1841 const parser::OmpScheduleClause &x,
1842 const parser::OmpScheduleModifierType::ModType &type) {
1843 const auto &modifier{
1844 std::get<std::optional<parser::OmpScheduleModifier>>(x.t)};
1845 if (modifier) {
1846 const auto &modType1{
1847 std::get<parser::OmpScheduleModifier::Modifier1>(modifier->t)};
1848 const auto &modType2{
1849 std::get<std::optional<parser::OmpScheduleModifier::Modifier2>>(
1850 modifier->t)};
1851 if (modType1.v.v == type || (modType2 && modType2->v.v == type)) {
1852 return true;
1853 }
1854 }
1855 return false;
1856 }
Enter(const parser::OmpClause::Schedule & x)1857 void OmpStructureChecker::Enter(const parser::OmpClause::Schedule &x) {
1858 CheckAllowed(llvm::omp::Clause::OMPC_schedule);
1859 const parser::OmpScheduleClause &scheduleClause = x.v;
1860
1861 // 2.7 Loop Construct Restriction
1862 if (llvm::omp::doSet.test(GetContext().directive)) {
1863 const auto &kind{std::get<1>(scheduleClause.t)};
1864 const auto &chunk{std::get<2>(scheduleClause.t)};
1865 if (chunk) {
1866 if (kind == parser::OmpScheduleClause::ScheduleType::Runtime ||
1867 kind == parser::OmpScheduleClause::ScheduleType::Auto) {
1868 context_.Say(GetContext().clauseSource,
1869 "When SCHEDULE clause has %s specified, "
1870 "it must not have chunk size specified"_err_en_US,
1871 parser::ToUpperCaseLetters(
1872 parser::OmpScheduleClause::EnumToString(kind)));
1873 }
1874 if (const auto &chunkExpr{std::get<std::optional<parser::ScalarIntExpr>>(
1875 scheduleClause.t)}) {
1876 RequiresPositiveParameter(
1877 llvm::omp::Clause::OMPC_schedule, *chunkExpr, "chunk size");
1878 }
1879 }
1880
1881 if (ScheduleModifierHasType(scheduleClause,
1882 parser::OmpScheduleModifierType::ModType::Nonmonotonic)) {
1883 if (kind != parser::OmpScheduleClause::ScheduleType::Dynamic &&
1884 kind != parser::OmpScheduleClause::ScheduleType::Guided) {
1885 context_.Say(GetContext().clauseSource,
1886 "The NONMONOTONIC modifier can only be specified with "
1887 "SCHEDULE(DYNAMIC) or SCHEDULE(GUIDED)"_err_en_US);
1888 }
1889 }
1890 }
1891 }
1892
Enter(const parser::OmpClause::Depend & x)1893 void OmpStructureChecker::Enter(const parser::OmpClause::Depend &x) {
1894 CheckAllowed(llvm::omp::Clause::OMPC_depend);
1895 if (const auto *inOut{std::get_if<parser::OmpDependClause::InOut>(&x.v.u)}) {
1896 const auto &designators{std::get<std::list<parser::Designator>>(inOut->t)};
1897 for (const auto &ele : designators) {
1898 if (const auto *dataRef{std::get_if<parser::DataRef>(&ele.u)}) {
1899 CheckDependList(*dataRef);
1900 if (const auto *arr{
1901 std::get_if<common::Indirection<parser::ArrayElement>>(
1902 &dataRef->u)}) {
1903 CheckArraySection(arr->value(), GetLastName(*dataRef),
1904 llvm::omp::Clause::OMPC_depend);
1905 }
1906 }
1907 }
1908 }
1909 }
1910
Enter(const parser::OmpClause::Copyprivate & x)1911 void OmpStructureChecker::Enter(const parser::OmpClause::Copyprivate &x) {
1912 CheckAllowed(llvm::omp::Clause::OMPC_copyprivate);
1913 CheckIntentInPointer(x.v, llvm::omp::Clause::OMPC_copyprivate);
1914 }
1915
Enter(const parser::OmpClause::Lastprivate & x)1916 void OmpStructureChecker::Enter(const parser::OmpClause::Lastprivate &x) {
1917 CheckAllowed(llvm::omp::Clause::OMPC_lastprivate);
1918
1919 DirectivesClauseTriple dirClauseTriple;
1920 SymbolSourceMap currSymbols;
1921 GetSymbolsInObjectList(x.v, currSymbols);
1922 CheckDefinableObjects(currSymbols, GetClauseKindForParserClass(x));
1923
1924 // Check lastprivate variables in worksharing constructs
1925 dirClauseTriple.emplace(llvm::omp::Directive::OMPD_do,
1926 std::make_pair(
1927 llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet));
1928 dirClauseTriple.emplace(llvm::omp::Directive::OMPD_sections,
1929 std::make_pair(
1930 llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet));
1931
1932 CheckPrivateSymbolsInOuterCxt(
1933 currSymbols, dirClauseTriple, GetClauseKindForParserClass(x));
1934 }
1935
getClauseName(llvm::omp::Clause clause)1936 llvm::StringRef OmpStructureChecker::getClauseName(llvm::omp::Clause clause) {
1937 return llvm::omp::getOpenMPClauseName(clause);
1938 }
1939
getDirectiveName(llvm::omp::Directive directive)1940 llvm::StringRef OmpStructureChecker::getDirectiveName(
1941 llvm::omp::Directive directive) {
1942 return llvm::omp::getOpenMPDirectiveName(directive);
1943 }
1944
CheckDependList(const parser::DataRef & d)1945 void OmpStructureChecker::CheckDependList(const parser::DataRef &d) {
1946 std::visit(
1947 common::visitors{
1948 [&](const common::Indirection<parser::ArrayElement> &elem) {
1949 // Check if the base element is valid on Depend Clause
1950 CheckDependList(elem.value().base);
1951 },
1952 [&](const common::Indirection<parser::StructureComponent> &) {
1953 context_.Say(GetContext().clauseSource,
1954 "A variable that is part of another variable "
1955 "(such as an element of a structure) but is not an array "
1956 "element or an array section cannot appear in a DEPEND "
1957 "clause"_err_en_US);
1958 },
1959 [&](const common::Indirection<parser::CoindexedNamedObject> &) {
1960 context_.Say(GetContext().clauseSource,
1961 "Coarrays are not supported in DEPEND clause"_err_en_US);
1962 },
1963 [&](const parser::Name &) { return; },
1964 },
1965 d.u);
1966 }
1967
1968 // Called from both Reduction and Depend clause.
CheckArraySection(const parser::ArrayElement & arrayElement,const parser::Name & name,const llvm::omp::Clause clause)1969 void OmpStructureChecker::CheckArraySection(
1970 const parser::ArrayElement &arrayElement, const parser::Name &name,
1971 const llvm::omp::Clause clause) {
1972 if (!arrayElement.subscripts.empty()) {
1973 for (const auto &subscript : arrayElement.subscripts) {
1974 if (const auto *triplet{
1975 std::get_if<parser::SubscriptTriplet>(&subscript.u)}) {
1976 if (std::get<0>(triplet->t) && std::get<1>(triplet->t)) {
1977 const auto &lower{std::get<0>(triplet->t)};
1978 const auto &upper{std::get<1>(triplet->t)};
1979 if (lower && upper) {
1980 const auto lval{GetIntValue(lower)};
1981 const auto uval{GetIntValue(upper)};
1982 if (lval && uval && *uval < *lval) {
1983 context_.Say(GetContext().clauseSource,
1984 "'%s' in %s clause"
1985 " is a zero size array section"_err_en_US,
1986 name.ToString(),
1987 parser::ToUpperCaseLetters(getClauseName(clause).str()));
1988 break;
1989 } else if (std::get<2>(triplet->t)) {
1990 const auto &strideExpr{std::get<2>(triplet->t)};
1991 if (strideExpr) {
1992 if (clause == llvm::omp::Clause::OMPC_depend) {
1993 context_.Say(GetContext().clauseSource,
1994 "Stride should not be specified for array section in "
1995 "DEPEND "
1996 "clause"_err_en_US);
1997 }
1998 const auto stride{GetIntValue(strideExpr)};
1999 if ((stride && stride != 1)) {
2000 context_.Say(GetContext().clauseSource,
2001 "A list item that appears in a REDUCTION clause"
2002 " should have a contiguous storage array section."_err_en_US,
2003 ContextDirectiveAsFortran());
2004 break;
2005 }
2006 }
2007 }
2008 }
2009 }
2010 }
2011 }
2012 }
2013 }
2014
CheckIntentInPointer(const parser::OmpObjectList & objectList,const llvm::omp::Clause clause)2015 void OmpStructureChecker::CheckIntentInPointer(
2016 const parser::OmpObjectList &objectList, const llvm::omp::Clause clause) {
2017 SymbolSourceMap symbols;
2018 GetSymbolsInObjectList(objectList, symbols);
2019 for (auto it{symbols.begin()}; it != symbols.end(); ++it) {
2020 const auto *symbol{it->first};
2021 const auto source{it->second};
2022 if (IsPointer(*symbol) && IsIntentIn(*symbol)) {
2023 context_.Say(source,
2024 "Pointer '%s' with the INTENT(IN) attribute may not appear "
2025 "in a %s clause"_err_en_US,
2026 symbol->name(),
2027 parser::ToUpperCaseLetters(getClauseName(clause).str()));
2028 }
2029 }
2030 }
2031
GetSymbolsInObjectList(const parser::OmpObjectList & objectList,SymbolSourceMap & symbols)2032 void OmpStructureChecker::GetSymbolsInObjectList(
2033 const parser::OmpObjectList &objectList, SymbolSourceMap &symbols) {
2034 for (const auto &ompObject : objectList.v) {
2035 if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
2036 if (const auto *symbol{name->symbol}) {
2037 if (const auto *commonBlockDetails{
2038 symbol->detailsIf<CommonBlockDetails>()}) {
2039 for (const auto &object : commonBlockDetails->objects()) {
2040 symbols.emplace(&object->GetUltimate(), name->source);
2041 }
2042 } else {
2043 symbols.emplace(&symbol->GetUltimate(), name->source);
2044 }
2045 }
2046 }
2047 }
2048 }
2049
CheckDefinableObjects(SymbolSourceMap & symbols,const llvm::omp::Clause clause)2050 void OmpStructureChecker::CheckDefinableObjects(
2051 SymbolSourceMap &symbols, const llvm::omp::Clause clause) {
2052 for (auto it{symbols.begin()}; it != symbols.end(); ++it) {
2053 const auto *symbol{it->first};
2054 const auto source{it->second};
2055 if (auto msg{WhyNotModifiable(*symbol, context_.FindScope(source))}) {
2056 context_
2057 .Say(source,
2058 "Variable '%s' on the %s clause is not definable"_err_en_US,
2059 symbol->name(),
2060 parser::ToUpperCaseLetters(getClauseName(clause).str()))
2061 .Attach(source, std::move(*msg), symbol->name());
2062 }
2063 }
2064 }
2065
CheckPrivateSymbolsInOuterCxt(SymbolSourceMap & currSymbols,DirectivesClauseTriple & dirClauseTriple,const llvm::omp::Clause currClause)2066 void OmpStructureChecker::CheckPrivateSymbolsInOuterCxt(
2067 SymbolSourceMap &currSymbols, DirectivesClauseTriple &dirClauseTriple,
2068 const llvm::omp::Clause currClause) {
2069 SymbolSourceMap enclosingSymbols;
2070 auto range{dirClauseTriple.equal_range(GetContext().directive)};
2071 for (auto dirIter{range.first}; dirIter != range.second; ++dirIter) {
2072 auto enclosingDir{dirIter->second.first};
2073 auto enclosingClauseSet{dirIter->second.second};
2074 if (auto *enclosingContext{GetEnclosingContextWithDir(enclosingDir)}) {
2075 for (auto it{enclosingContext->clauseInfo.begin()};
2076 it != enclosingContext->clauseInfo.end(); ++it) {
2077 if (enclosingClauseSet.test(it->first)) {
2078 if (const auto *ompObjectList{GetOmpObjectList(*it->second)}) {
2079 GetSymbolsInObjectList(*ompObjectList, enclosingSymbols);
2080 }
2081 }
2082 }
2083
2084 // Check if the symbols in current context are private in outer context
2085 for (auto iter{currSymbols.begin()}; iter != currSymbols.end(); ++iter) {
2086 const auto *symbol{iter->first};
2087 const auto source{iter->second};
2088 if (enclosingSymbols.find(symbol) != enclosingSymbols.end()) {
2089 context_.Say(source,
2090 "%s variable '%s' is PRIVATE in outer context"_err_en_US,
2091 parser::ToUpperCaseLetters(getClauseName(currClause).str()),
2092 symbol->name());
2093 }
2094 }
2095 }
2096 }
2097 }
2098
CheckTargetBlockOnlyTeams(const parser::Block & block)2099 bool OmpStructureChecker::CheckTargetBlockOnlyTeams(
2100 const parser::Block &block) {
2101 bool nestedTeams{false};
2102 auto it{block.begin()};
2103
2104 if (const auto *ompConstruct{parser::Unwrap<parser::OpenMPConstruct>(*it)}) {
2105 if (const auto *ompBlockConstruct{
2106 std::get_if<parser::OpenMPBlockConstruct>(&ompConstruct->u)}) {
2107 const auto &beginBlockDir{
2108 std::get<parser::OmpBeginBlockDirective>(ompBlockConstruct->t)};
2109 const auto &beginDir{
2110 std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
2111 if (beginDir.v == llvm::omp::Directive::OMPD_teams) {
2112 nestedTeams = true;
2113 }
2114 }
2115 }
2116
2117 if (nestedTeams && ++it == block.end()) {
2118 return true;
2119 }
2120 return false;
2121 }
2122
CheckWorkshareBlockStmts(const parser::Block & block,parser::CharBlock source)2123 void OmpStructureChecker::CheckWorkshareBlockStmts(
2124 const parser::Block &block, parser::CharBlock source) {
2125 OmpWorkshareBlockChecker ompWorkshareBlockChecker{context_, source};
2126
2127 for (auto it{block.begin()}; it != block.end(); ++it) {
2128 if (parser::Unwrap<parser::AssignmentStmt>(*it) ||
2129 parser::Unwrap<parser::ForallStmt>(*it) ||
2130 parser::Unwrap<parser::ForallConstruct>(*it) ||
2131 parser::Unwrap<parser::WhereStmt>(*it) ||
2132 parser::Unwrap<parser::WhereConstruct>(*it)) {
2133 parser::Walk(*it, ompWorkshareBlockChecker);
2134 } else if (const auto *ompConstruct{
2135 parser::Unwrap<parser::OpenMPConstruct>(*it)}) {
2136 if (const auto *ompAtomicConstruct{
2137 std::get_if<parser::OpenMPAtomicConstruct>(&ompConstruct->u)}) {
2138 // Check if assignment statements in the enclosing OpenMP Atomic
2139 // construct are allowed in the Workshare construct
2140 parser::Walk(*ompAtomicConstruct, ompWorkshareBlockChecker);
2141 } else if (const auto *ompCriticalConstruct{
2142 std::get_if<parser::OpenMPCriticalConstruct>(
2143 &ompConstruct->u)}) {
2144 // All the restrictions on the Workshare construct apply to the
2145 // statements in the enclosing critical constructs
2146 const auto &criticalBlock{
2147 std::get<parser::Block>(ompCriticalConstruct->t)};
2148 CheckWorkshareBlockStmts(criticalBlock, source);
2149 } else {
2150 // Check if OpenMP constructs enclosed in the Workshare construct are
2151 // 'Parallel' constructs
2152 auto currentDir{llvm::omp::Directive::OMPD_unknown};
2153 const OmpDirectiveSet parallelDirSet{
2154 llvm::omp::Directive::OMPD_parallel,
2155 llvm::omp::Directive::OMPD_parallel_do,
2156 llvm::omp::Directive::OMPD_parallel_sections,
2157 llvm::omp::Directive::OMPD_parallel_workshare,
2158 llvm::omp::Directive::OMPD_parallel_do_simd};
2159
2160 if (const auto *ompBlockConstruct{
2161 std::get_if<parser::OpenMPBlockConstruct>(&ompConstruct->u)}) {
2162 const auto &beginBlockDir{
2163 std::get<parser::OmpBeginBlockDirective>(ompBlockConstruct->t)};
2164 const auto &beginDir{
2165 std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
2166 currentDir = beginDir.v;
2167 } else if (const auto *ompLoopConstruct{
2168 std::get_if<parser::OpenMPLoopConstruct>(
2169 &ompConstruct->u)}) {
2170 const auto &beginLoopDir{
2171 std::get<parser::OmpBeginLoopDirective>(ompLoopConstruct->t)};
2172 const auto &beginDir{
2173 std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
2174 currentDir = beginDir.v;
2175 } else if (const auto *ompSectionsConstruct{
2176 std::get_if<parser::OpenMPSectionsConstruct>(
2177 &ompConstruct->u)}) {
2178 const auto &beginSectionsDir{
2179 std::get<parser::OmpBeginSectionsDirective>(
2180 ompSectionsConstruct->t)};
2181 const auto &beginDir{
2182 std::get<parser::OmpSectionsDirective>(beginSectionsDir.t)};
2183 currentDir = beginDir.v;
2184 }
2185
2186 if (!parallelDirSet.test(currentDir)) {
2187 context_.Say(source,
2188 "OpenMP constructs enclosed in WORKSHARE construct may consist "
2189 "of ATOMIC, CRITICAL or PARALLEL constructs only"_err_en_US);
2190 }
2191 }
2192 } else {
2193 context_.Say(source,
2194 "The structured block in a WORKSHARE construct may consist of only "
2195 "SCALAR or ARRAY assignments, FORALL or WHERE statements, "
2196 "FORALL, WHERE, ATOMIC, CRITICAL or PARALLEL constructs"_err_en_US);
2197 }
2198 }
2199 }
2200
GetOmpObjectList(const parser::OmpClause & clause)2201 const parser::OmpObjectList *OmpStructureChecker::GetOmpObjectList(
2202 const parser::OmpClause &clause) {
2203
2204 // Clauses with OmpObjectList as its data member
2205 using MemberObjectListClauses = std::tuple<parser::OmpClause::Copyprivate,
2206 parser::OmpClause::Copyin, parser::OmpClause::Firstprivate,
2207 parser::OmpClause::From, parser::OmpClause::Lastprivate,
2208 parser::OmpClause::Link, parser::OmpClause::Private,
2209 parser::OmpClause::Shared, parser::OmpClause::To>;
2210
2211 // Clauses with OmpObjectList in the tuple
2212 using TupleObjectListClauses = std::tuple<parser::OmpClause::Allocate,
2213 parser::OmpClause::Map, parser::OmpClause::Reduction>;
2214
2215 // TODO:: Generate the tuples using TableGen.
2216 // Handle other constructs with OmpObjectList such as OpenMPThreadprivate.
2217 return std::visit(
2218 common::visitors{
2219 [&](const auto &x) -> const parser::OmpObjectList * {
2220 using Ty = std::decay_t<decltype(x)>;
2221 if constexpr (common::HasMember<Ty, MemberObjectListClauses>) {
2222 return &x.v;
2223 } else if constexpr (common::HasMember<Ty,
2224 TupleObjectListClauses>) {
2225 return &(std::get<parser::OmpObjectList>(x.v.t));
2226 } else {
2227 return nullptr;
2228 }
2229 },
2230 },
2231 clause.u);
2232 }
2233
2234 } // namespace Fortran::semantics
2235