[MemProf] Templatize CallStackRadixTreeBuilder (NFC) (#117014)
[llvm-project.git] / flang / lib / Semantics / check-omp-structure.cpp
blob9cac652216fcf2690eba934910ed8c5cd6708531
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 //===----------------------------------------------------------------------===//
9 #include "check-omp-structure.h"
10 #include "definable.h"
11 #include "flang/Evaluate/check-expression.h"
12 #include "flang/Parser/parse-tree.h"
13 #include "flang/Semantics/expression.h"
14 #include "flang/Semantics/tools.h"
15 #include <variant>
17 namespace Fortran::semantics {
19 // Use when clause falls under 'struct OmpClause' in 'parse-tree.h'.
20 #define CHECK_SIMPLE_CLAUSE(X, Y) \
21 void OmpStructureChecker::Enter(const parser::OmpClause::X &) { \
22 CheckAllowedClause(llvm::omp::Clause::Y); \
25 #define CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(X, Y) \
26 void OmpStructureChecker::Enter(const parser::OmpClause::X &c) { \
27 CheckAllowedClause(llvm::omp::Clause::Y); \
28 RequiresConstantPositiveParameter(llvm::omp::Clause::Y, c.v); \
31 #define CHECK_REQ_SCALAR_INT_CLAUSE(X, Y) \
32 void OmpStructureChecker::Enter(const parser::OmpClause::X &c) { \
33 CheckAllowedClause(llvm::omp::Clause::Y); \
34 RequiresPositiveParameter(llvm::omp::Clause::Y, c.v); \
37 // Use when clause don't falls under 'struct OmpClause' in 'parse-tree.h'.
38 #define CHECK_SIMPLE_PARSER_CLAUSE(X, Y) \
39 void OmpStructureChecker::Enter(const parser::X &) { \
40 CheckAllowedClause(llvm::omp::Y); \
43 std::string ThisVersion(unsigned version) {
44 std::string tv{
45 std::to_string(version / 10) + "." + std::to_string(version % 10)};
46 return "OpenMP v" + tv;
49 std::string TryVersion(unsigned version) {
50 return "try -fopenmp-version=" + std::to_string(version);
53 // 'OmpWorkshareBlockChecker' is used to check the validity of the assignment
54 // statements and the expressions enclosed in an OpenMP Workshare construct
55 class OmpWorkshareBlockChecker {
56 public:
57 OmpWorkshareBlockChecker(SemanticsContext &context, parser::CharBlock source)
58 : context_{context}, source_{source} {}
60 template <typename T> bool Pre(const T &) { return true; }
61 template <typename T> void Post(const T &) {}
63 bool Pre(const parser::AssignmentStmt &assignment) {
64 const auto &var{std::get<parser::Variable>(assignment.t)};
65 const auto &expr{std::get<parser::Expr>(assignment.t)};
66 const auto *lhs{GetExpr(context_, var)};
67 const auto *rhs{GetExpr(context_, expr)};
68 if (lhs && rhs) {
69 Tristate isDefined{semantics::IsDefinedAssignment(
70 lhs->GetType(), lhs->Rank(), rhs->GetType(), rhs->Rank())};
71 if (isDefined == Tristate::Yes) {
72 context_.Say(expr.source,
73 "Defined assignment statement is not "
74 "allowed in a WORKSHARE construct"_err_en_US);
77 return true;
80 bool Pre(const parser::Expr &expr) {
81 if (const auto *e{GetExpr(context_, expr)}) {
82 for (const Symbol &symbol : evaluate::CollectSymbols(*e)) {
83 const Symbol &root{GetAssociationRoot(symbol)};
84 if (IsFunction(root)) {
85 std::string attrs{""};
86 if (!IsElementalProcedure(root)) {
87 attrs = " non-ELEMENTAL";
89 if (root.attrs().test(Attr::IMPURE)) {
90 if (attrs != "") {
91 attrs = "," + attrs;
93 attrs = " IMPURE" + attrs;
95 if (attrs != "") {
96 context_.Say(expr.source,
97 "User defined%s function '%s' is not allowed in a "
98 "WORKSHARE construct"_err_en_US,
99 attrs, root.name());
104 return false;
107 private:
108 SemanticsContext &context_;
109 parser::CharBlock source_;
112 class AssociatedLoopChecker {
113 public:
114 AssociatedLoopChecker(SemanticsContext &context, std::int64_t level)
115 : context_{context}, level_{level} {}
117 template <typename T> bool Pre(const T &) { return true; }
118 template <typename T> void Post(const T &) {}
120 bool Pre(const parser::DoConstruct &dc) {
121 level_--;
122 const auto &doStmt{
123 std::get<parser::Statement<parser::NonLabelDoStmt>>(dc.t)};
124 const auto &constructName{
125 std::get<std::optional<parser::Name>>(doStmt.statement.t)};
126 if (constructName) {
127 constructNamesAndLevels_.emplace(
128 constructName.value().ToString(), level_);
130 if (level_ >= 0) {
131 if (dc.IsDoWhile()) {
132 context_.Say(doStmt.source,
133 "The associated loop of a loop-associated directive cannot be a DO WHILE."_err_en_US);
135 if (!dc.GetLoopControl()) {
136 context_.Say(doStmt.source,
137 "The associated loop of a loop-associated directive cannot be a DO without control."_err_en_US);
140 return true;
143 void Post(const parser::DoConstruct &dc) { level_++; }
145 bool Pre(const parser::CycleStmt &cyclestmt) {
146 std::map<std::string, std::int64_t>::iterator it;
147 bool err{false};
148 if (cyclestmt.v) {
149 it = constructNamesAndLevels_.find(cyclestmt.v->source.ToString());
150 err = (it != constructNamesAndLevels_.end() && it->second > 0);
151 } else { // If there is no label then use the level of the last enclosing DO
152 err = level_ > 0;
154 if (err) {
155 context_.Say(*source_,
156 "CYCLE statement to non-innermost associated loop of an OpenMP DO "
157 "construct"_err_en_US);
159 return true;
162 bool Pre(const parser::ExitStmt &exitStmt) {
163 std::map<std::string, std::int64_t>::iterator it;
164 bool err{false};
165 if (exitStmt.v) {
166 it = constructNamesAndLevels_.find(exitStmt.v->source.ToString());
167 err = (it != constructNamesAndLevels_.end() && it->second >= 0);
168 } else { // If there is no label then use the level of the last enclosing DO
169 err = level_ >= 0;
171 if (err) {
172 context_.Say(*source_,
173 "EXIT statement terminates associated loop of an OpenMP DO "
174 "construct"_err_en_US);
176 return true;
179 bool Pre(const parser::Statement<parser::ActionStmt> &actionstmt) {
180 source_ = &actionstmt.source;
181 return true;
184 private:
185 SemanticsContext &context_;
186 const parser::CharBlock *source_;
187 std::int64_t level_;
188 std::map<std::string, std::int64_t> constructNamesAndLevels_;
191 bool OmpStructureChecker::CheckAllowedClause(llvmOmpClause clause) {
192 unsigned version{context_.langOptions().OpenMPVersion};
193 DirectiveContext &dirCtx = GetContext();
194 llvm::omp::Directive dir{dirCtx.directive};
196 if (!llvm::omp::isAllowedClauseForDirective(dir, clause, version)) {
197 unsigned allowedInVersion{[&] {
198 for (unsigned v : {45, 50, 51, 52, 60}) {
199 if (v <= version) {
200 continue;
202 if (llvm::omp::isAllowedClauseForDirective(dir, clause, v)) {
203 return v;
206 return 0u;
207 }()};
209 // Only report it if there is a later version that allows it.
210 // If it's not allowed at all, it will be reported by CheckAllowed.
211 if (allowedInVersion != 0) {
212 auto clauseName{parser::ToUpperCaseLetters(getClauseName(clause).str())};
213 auto dirName{parser::ToUpperCaseLetters(getDirectiveName(dir).str())};
215 context_.Say(dirCtx.clauseSource,
216 "%s clause is not allowed on directive %s in %s, %s"_err_en_US,
217 clauseName, dirName, ThisVersion(version),
218 TryVersion(allowedInVersion));
221 return CheckAllowed(clause);
224 bool OmpStructureChecker::IsVariableListItem(const Symbol &sym) {
225 return evaluate::IsVariable(sym) || sym.attrs().test(Attr::POINTER);
228 bool OmpStructureChecker::IsExtendedListItem(const Symbol &sym) {
229 return IsVariableListItem(sym) || sym.IsSubprogram();
232 bool OmpStructureChecker::IsCloselyNestedRegion(const OmpDirectiveSet &set) {
233 // Definition of close nesting:
235 // `A region nested inside another region with no parallel region nested
236 // between them`
238 // Examples:
239 // non-parallel construct 1
240 // non-parallel construct 2
241 // parallel construct
242 // construct 3
243 // In the above example, construct 3 is NOT closely nested inside construct 1
244 // or 2
246 // non-parallel construct 1
247 // non-parallel construct 2
248 // construct 3
249 // In the above example, construct 3 is closely nested inside BOTH construct 1
250 // and 2
252 // Algorithm:
253 // Starting from the parent context, Check in a bottom-up fashion, each level
254 // of the context stack. If we have a match for one of the (supplied)
255 // violating directives, `close nesting` is satisfied. If no match is there in
256 // the entire stack, `close nesting` is not satisfied. If at any level, a
257 // `parallel` region is found, `close nesting` is not satisfied.
259 if (CurrentDirectiveIsNested()) {
260 int index = dirContext_.size() - 2;
261 while (index != -1) {
262 if (set.test(dirContext_[index].directive)) {
263 return true;
264 } else if (llvm::omp::allParallelSet.test(dirContext_[index].directive)) {
265 return false;
267 index--;
270 return false;
273 namespace {
274 struct ContiguousHelper {
275 ContiguousHelper(SemanticsContext &context)
276 : fctx_(context.foldingContext()) {}
278 template <typename Contained>
279 std::optional<bool> Visit(const common::Indirection<Contained> &x) {
280 return Visit(x.value());
282 template <typename Contained>
283 std::optional<bool> Visit(const common::Reference<Contained> &x) {
284 return Visit(x.get());
286 template <typename T> std::optional<bool> Visit(const evaluate::Expr<T> &x) {
287 return common::visit([&](auto &&s) { return Visit(s); }, x.u);
289 template <typename T>
290 std::optional<bool> Visit(const evaluate::Designator<T> &x) {
291 return common::visit(
292 [this](auto &&s) { return evaluate::IsContiguous(s, fctx_); }, x.u);
294 template <typename T> std::optional<bool> Visit(const T &) {
295 // Everything else.
296 return std::nullopt;
299 private:
300 evaluate::FoldingContext &fctx_;
302 } // namespace
304 std::optional<bool> OmpStructureChecker::IsContiguous(
305 const parser::OmpObject &object) {
306 return common::visit(common::visitors{
307 [&](const parser::Name &x) {
308 // Any member of a common block must be contiguous.
309 return std::optional<bool>{true};
311 [&](const parser::Designator &x) {
312 evaluate::ExpressionAnalyzer ea{context_};
313 if (MaybeExpr maybeExpr{ea.Analyze(x)}) {
314 return ContiguousHelper{context_}.Visit(
315 *maybeExpr);
317 return std::optional<bool>{};
320 object.u);
323 void OmpStructureChecker::CheckMultipleOccurrence(
324 semantics::UnorderedSymbolSet &listVars,
325 const std::list<parser::Name> &nameList, const parser::CharBlock &item,
326 const std::string &clauseName) {
327 for (auto const &var : nameList) {
328 if (llvm::is_contained(listVars, *(var.symbol))) {
329 context_.Say(item,
330 "List item '%s' present at multiple %s clauses"_err_en_US,
331 var.ToString(), clauseName);
333 listVars.insert(*(var.symbol));
337 void OmpStructureChecker::CheckMultListItems() {
338 semantics::UnorderedSymbolSet listVars;
340 // Aligned clause
341 for (auto [_, clause] : FindClauses(llvm::omp::Clause::OMPC_aligned)) {
342 const auto &alignedClause{std::get<parser::OmpClause::Aligned>(clause->u)};
343 const auto &alignedList{std::get<0>(alignedClause.v.t)};
344 std::list<parser::Name> alignedNameList;
345 for (const auto &ompObject : alignedList.v) {
346 if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
347 if (name->symbol) {
348 if (FindCommonBlockContaining(*(name->symbol))) {
349 context_.Say(clause->source,
350 "'%s' is a common block name and can not appear in an "
351 "ALIGNED clause"_err_en_US,
352 name->ToString());
353 } else if (!(IsBuiltinCPtr(*(name->symbol)) ||
354 IsAllocatableOrObjectPointer(
355 &name->symbol->GetUltimate()))) {
356 context_.Say(clause->source,
357 "'%s' in ALIGNED clause must be of type C_PTR, POINTER or "
358 "ALLOCATABLE"_err_en_US,
359 name->ToString());
360 } else {
361 alignedNameList.push_back(*name);
363 } else {
364 // The symbol is null, return early
365 return;
369 CheckMultipleOccurrence(
370 listVars, alignedNameList, clause->source, "ALIGNED");
373 // Nontemporal clause
374 for (auto [_, clause] : FindClauses(llvm::omp::Clause::OMPC_nontemporal)) {
375 const auto &nontempClause{
376 std::get<parser::OmpClause::Nontemporal>(clause->u)};
377 const auto &nontempNameList{nontempClause.v};
378 CheckMultipleOccurrence(
379 listVars, nontempNameList, clause->source, "NONTEMPORAL");
383 bool OmpStructureChecker::HasInvalidWorksharingNesting(
384 const parser::CharBlock &source, const OmpDirectiveSet &set) {
385 // set contains all the invalid closely nested directives
386 // for the given directive (`source` here)
387 if (IsCloselyNestedRegion(set)) {
388 context_.Say(source,
389 "A worksharing region may not be closely nested inside a "
390 "worksharing, explicit task, taskloop, critical, ordered, atomic, or "
391 "master region"_err_en_US);
392 return true;
394 return false;
397 void OmpStructureChecker::HasInvalidDistributeNesting(
398 const parser::OpenMPLoopConstruct &x) {
399 bool violation{false};
400 const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
401 const auto &beginDir{std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
402 if (llvm::omp::topDistributeSet.test(beginDir.v)) {
403 // `distribute` region has to be nested
404 if (!CurrentDirectiveIsNested()) {
405 violation = true;
406 } else {
407 // `distribute` region has to be strictly nested inside `teams`
408 if (!OmpDirectiveSet{llvm::omp::OMPD_teams, llvm::omp::OMPD_target_teams}
409 .test(GetContextParent().directive)) {
410 violation = true;
414 if (violation) {
415 context_.Say(beginDir.source,
416 "`DISTRIBUTE` region has to be strictly nested inside `TEAMS` "
417 "region."_err_en_US);
420 void OmpStructureChecker::HasInvalidLoopBinding(
421 const parser::OpenMPLoopConstruct &x) {
422 const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
423 const auto &beginDir{std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
425 auto teamsBindingChecker = [&](parser::MessageFixedText msg) {
426 const auto &clauseList{std::get<parser::OmpClauseList>(beginLoopDir.t)};
427 for (const auto &clause : clauseList.v) {
428 if (const auto *bindClause{
429 std::get_if<parser::OmpClause::Bind>(&clause.u)}) {
430 if (bindClause->v.v != parser::OmpBindClause::Type::Teams) {
431 context_.Say(beginDir.source, msg);
437 if (llvm::omp::Directive::OMPD_loop == beginDir.v &&
438 CurrentDirectiveIsNested() &&
439 OmpDirectiveSet{llvm::omp::OMPD_teams, llvm::omp::OMPD_target_teams}.test(
440 GetContextParent().directive)) {
441 teamsBindingChecker(
442 "`BIND(TEAMS)` must be specified since the `LOOP` region is "
443 "strictly nested inside a `TEAMS` region."_err_en_US);
446 if (OmpDirectiveSet{
447 llvm::omp::OMPD_teams_loop, llvm::omp::OMPD_target_teams_loop}
448 .test(beginDir.v)) {
449 teamsBindingChecker(
450 "`BIND(TEAMS)` must be specified since the `LOOP` directive is "
451 "combined with a `TEAMS` construct."_err_en_US);
455 void OmpStructureChecker::HasInvalidTeamsNesting(
456 const llvm::omp::Directive &dir, const parser::CharBlock &source) {
457 if (!llvm::omp::nestedTeamsAllowedSet.test(dir)) {
458 context_.Say(source,
459 "Only `DISTRIBUTE`, `PARALLEL`, or `LOOP` regions are allowed to be "
460 "strictly nested inside `TEAMS` region."_err_en_US);
464 void OmpStructureChecker::CheckPredefinedAllocatorRestriction(
465 const parser::CharBlock &source, const parser::Name &name) {
466 if (const auto *symbol{name.symbol}) {
467 const auto *commonBlock{FindCommonBlockContaining(*symbol)};
468 const auto &scope{context_.FindScope(symbol->name())};
469 const Scope &containingScope{GetProgramUnitContaining(scope)};
470 if (!isPredefinedAllocator &&
471 (IsSaved(*symbol) || commonBlock ||
472 containingScope.kind() == Scope::Kind::Module)) {
473 context_.Say(source,
474 "If list items within the %s directive have the "
475 "SAVE attribute, are a common block name, or are "
476 "declared in the scope of a module, then only "
477 "predefined memory allocator parameters can be used "
478 "in the allocator clause"_err_en_US,
479 ContextDirectiveAsFortran());
484 void OmpStructureChecker::CheckPredefinedAllocatorRestriction(
485 const parser::CharBlock &source,
486 const parser::OmpObjectList &ompObjectList) {
487 for (const auto &ompObject : ompObjectList.v) {
488 common::visit(
489 common::visitors{
490 [&](const parser::Designator &designator) {
491 if (const auto *dataRef{
492 std::get_if<parser::DataRef>(&designator.u)}) {
493 if (const auto *name{std::get_if<parser::Name>(&dataRef->u)}) {
494 CheckPredefinedAllocatorRestriction(source, *name);
498 [&](const parser::Name &name) {
499 CheckPredefinedAllocatorRestriction(source, name);
502 ompObject.u);
506 template <class D>
507 void OmpStructureChecker::CheckHintClause(
508 D *leftOmpClauseList, D *rightOmpClauseList) {
509 auto checkForValidHintClause = [&](const D *clauseList) {
510 for (const auto &clause : clauseList->v) {
511 const Fortran::parser::OmpClause *ompClause = nullptr;
512 if constexpr (std::is_same_v<D,
513 const Fortran::parser::OmpAtomicClauseList>) {
514 ompClause = std::get_if<Fortran::parser::OmpClause>(&clause.u);
515 if (!ompClause)
516 continue;
517 } else if constexpr (std::is_same_v<D,
518 const Fortran::parser::OmpClauseList>) {
519 ompClause = &clause;
521 if (const Fortran::parser::OmpClause::Hint *hintClause{
522 std::get_if<Fortran::parser::OmpClause::Hint>(&ompClause->u)}) {
523 std::optional<std::int64_t> hintValue = GetIntValue(hintClause->v);
524 if (hintValue && *hintValue >= 0) {
525 /*`omp_sync_hint_nonspeculative` and `omp_lock_hint_speculative`*/
526 if ((*hintValue & 0xC) == 0xC
527 /*`omp_sync_hint_uncontended` and omp_sync_hint_contended*/
528 || (*hintValue & 0x3) == 0x3)
529 context_.Say(clause.source,
530 "Hint clause value "
531 "is not a valid OpenMP synchronization value"_err_en_US);
532 } else {
533 context_.Say(clause.source,
534 "Hint clause must have non-negative constant "
535 "integer expression"_err_en_US);
541 if (leftOmpClauseList) {
542 checkForValidHintClause(leftOmpClauseList);
544 if (rightOmpClauseList) {
545 checkForValidHintClause(rightOmpClauseList);
549 void OmpStructureChecker::Enter(const parser::OpenMPConstruct &x) {
550 // Simd Construct with Ordered Construct Nesting check
551 // We cannot use CurrentDirectiveIsNested() here because
552 // PushContextAndClauseSets() has not been called yet, it is
553 // called individually for each construct. Therefore a
554 // dirContext_ size `1` means the current construct is nested
555 if (dirContext_.size() >= 1) {
556 if (GetDirectiveNest(SIMDNest) > 0) {
557 CheckSIMDNest(x);
559 if (GetDirectiveNest(TargetNest) > 0) {
560 CheckTargetNest(x);
565 void OmpStructureChecker::Leave(const parser::OpenMPConstruct &) {
566 for (const auto &[sym, source] : deferredNonVariables_) {
567 context_.SayWithDecl(
568 *sym, source, "'%s' must be a variable"_err_en_US, sym->name());
570 deferredNonVariables_.clear();
573 void OmpStructureChecker::Enter(const parser::OpenMPLoopConstruct &x) {
574 loopStack_.push_back(&x);
575 const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
576 const auto &beginDir{std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
578 // check matching, End directive is optional
579 if (const auto &endLoopDir{
580 std::get<std::optional<parser::OmpEndLoopDirective>>(x.t)}) {
581 const auto &endDir{
582 std::get<parser::OmpLoopDirective>(endLoopDir.value().t)};
584 CheckMatching<parser::OmpLoopDirective>(beginDir, endDir);
587 PushContextAndClauseSets(beginDir.source, beginDir.v);
588 if (llvm::omp::allSimdSet.test(GetContext().directive)) {
589 EnterDirectiveNest(SIMDNest);
592 // Combined target loop constructs are target device constructs. Keep track of
593 // whether any such construct has been visited to later check that REQUIRES
594 // directives for target-related options don't appear after them.
595 if (llvm::omp::allTargetSet.test(beginDir.v)) {
596 deviceConstructFound_ = true;
599 if (beginDir.v == llvm::omp::Directive::OMPD_do) {
600 // 2.7.1 do-clause -> private-clause |
601 // firstprivate-clause |
602 // lastprivate-clause |
603 // linear-clause |
604 // reduction-clause |
605 // schedule-clause |
606 // collapse-clause |
607 // ordered-clause
609 // nesting check
610 HasInvalidWorksharingNesting(
611 beginDir.source, llvm::omp::nestedWorkshareErrSet);
613 SetLoopInfo(x);
615 if (const auto &doConstruct{
616 std::get<std::optional<parser::DoConstruct>>(x.t)}) {
617 const auto &doBlock{std::get<parser::Block>(doConstruct->t)};
618 CheckNoBranching(doBlock, beginDir.v, beginDir.source);
620 CheckLoopItrVariableIsInt(x);
621 CheckAssociatedLoopConstraints(x);
622 HasInvalidDistributeNesting(x);
623 HasInvalidLoopBinding(x);
624 if (CurrentDirectiveIsNested() &&
625 llvm::omp::topTeamsSet.test(GetContextParent().directive)) {
626 HasInvalidTeamsNesting(beginDir.v, beginDir.source);
628 if ((beginDir.v == llvm::omp::Directive::OMPD_distribute_parallel_do_simd) ||
629 (beginDir.v == llvm::omp::Directive::OMPD_distribute_simd)) {
630 CheckDistLinear(x);
633 const parser::Name OmpStructureChecker::GetLoopIndex(
634 const parser::DoConstruct *x) {
635 using Bounds = parser::LoopControl::Bounds;
636 return std::get<Bounds>(x->GetLoopControl()->u).name.thing;
638 void OmpStructureChecker::SetLoopInfo(const parser::OpenMPLoopConstruct &x) {
639 if (const auto &loopConstruct{
640 std::get<std::optional<parser::DoConstruct>>(x.t)}) {
641 const parser::DoConstruct *loop{&*loopConstruct};
642 if (loop && loop->IsDoNormal()) {
643 const parser::Name &itrVal{GetLoopIndex(loop)};
644 SetLoopIv(itrVal.symbol);
649 void OmpStructureChecker::CheckIteratorRange(
650 const parser::OmpIteratorSpecifier &x) {
651 // Check:
652 // 1. Whether begin/end are present.
653 // 2. Whether the step value is non-zero.
654 // 3. If the step has a known sign, whether the lower/upper bounds form
655 // a proper interval.
656 const auto &[begin, end, step]{std::get<parser::SubscriptTriplet>(x.t).t};
657 if (!begin || !end) {
658 context_.Say(x.source,
659 "The begin and end expressions in iterator range-specification are "
660 "mandatory"_err_en_US);
662 // [5.2:67:19] In a range-specification, if the step is not specified its
663 // value is implicitly defined to be 1.
664 if (auto stepv{step ? GetIntValue(*step) : std::optional<int64_t>{1}}) {
665 if (*stepv == 0) {
666 context_.Say(
667 x.source, "The step value in the iterator range is 0"_warn_en_US);
668 } else if (begin && end) {
669 std::optional<int64_t> beginv{GetIntValue(*begin)};
670 std::optional<int64_t> endv{GetIntValue(*end)};
671 if (beginv && endv) {
672 if (*stepv > 0 && *beginv > *endv) {
673 context_.Say(x.source,
674 "The begin value is greater than the end value in iterator "
675 "range-specification with a positive step"_warn_en_US);
676 } else if (*stepv < 0 && *beginv < *endv) {
677 context_.Say(x.source,
678 "The begin value is less than the end value in iterator "
679 "range-specification with a negative step"_warn_en_US);
686 void OmpStructureChecker::CheckIteratorModifier(const parser::OmpIterator &x) {
687 // Check if all iterator variables have integer type.
688 for (auto &&iterSpec : x.v) {
689 bool isInteger{true};
690 auto &typeDecl{std::get<parser::TypeDeclarationStmt>(iterSpec.t)};
691 auto &typeSpec{std::get<parser::DeclarationTypeSpec>(typeDecl.t)};
692 if (!std::holds_alternative<parser::IntrinsicTypeSpec>(typeSpec.u)) {
693 isInteger = false;
694 } else {
695 auto &intrinType{std::get<parser::IntrinsicTypeSpec>(typeSpec.u)};
696 if (!std::holds_alternative<parser::IntegerTypeSpec>(intrinType.u)) {
697 isInteger = false;
700 if (!isInteger) {
701 context_.Say(iterSpec.source,
702 "The iterator variable must be of integer type"_err_en_US);
704 CheckIteratorRange(iterSpec);
708 void OmpStructureChecker::CheckLoopItrVariableIsInt(
709 const parser::OpenMPLoopConstruct &x) {
710 if (const auto &loopConstruct{
711 std::get<std::optional<parser::DoConstruct>>(x.t)}) {
713 for (const parser::DoConstruct *loop{&*loopConstruct}; loop;) {
714 if (loop->IsDoNormal()) {
715 const parser::Name &itrVal{GetLoopIndex(loop)};
716 if (itrVal.symbol) {
717 const auto *type{itrVal.symbol->GetType()};
718 if (!type->IsNumeric(TypeCategory::Integer)) {
719 context_.Say(itrVal.source,
720 "The DO loop iteration"
721 " variable must be of the type integer."_err_en_US,
722 itrVal.ToString());
726 // Get the next DoConstruct if block is not empty.
727 const auto &block{std::get<parser::Block>(loop->t)};
728 const auto it{block.begin()};
729 loop = it != block.end() ? parser::Unwrap<parser::DoConstruct>(*it)
730 : nullptr;
735 void OmpStructureChecker::CheckSIMDNest(const parser::OpenMPConstruct &c) {
736 // Check the following:
737 // The only OpenMP constructs that can be encountered during execution of
738 // a simd region are the `atomic` construct, the `loop` construct, the `simd`
739 // construct and the `ordered` construct with the `simd` clause.
740 // TODO: Expand the check to include `LOOP` construct as well when it is
741 // supported.
743 // Check if the parent context has the SIMD clause
744 // Please note that we use GetContext() instead of GetContextParent()
745 // because PushContextAndClauseSets() has not been called on the
746 // current context yet.
747 // TODO: Check for declare simd regions.
748 bool eligibleSIMD{false};
749 common::visit(
750 Fortran::common::visitors{
751 // Allow `!$OMP ORDERED SIMD`
752 [&](const parser::OpenMPBlockConstruct &c) {
753 const auto &beginBlockDir{
754 std::get<parser::OmpBeginBlockDirective>(c.t)};
755 const auto &beginDir{
756 std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
757 if (beginDir.v == llvm::omp::Directive::OMPD_ordered) {
758 const auto &clauses{
759 std::get<parser::OmpClauseList>(beginBlockDir.t)};
760 for (const auto &clause : clauses.v) {
761 if (std::get_if<parser::OmpClause::Simd>(&clause.u)) {
762 eligibleSIMD = true;
763 break;
768 [&](const parser::OpenMPStandaloneConstruct &c) {
769 if (const auto &simpleConstruct =
770 std::get_if<parser::OpenMPSimpleStandaloneConstruct>(
771 &c.u)) {
772 const auto &dir{std::get<parser::OmpSimpleStandaloneDirective>(
773 simpleConstruct->t)};
774 if (dir.v == llvm::omp::Directive::OMPD_ordered) {
775 const auto &clauses{
776 std::get<parser::OmpClauseList>(simpleConstruct->t)};
777 for (const auto &clause : clauses.v) {
778 if (std::get_if<parser::OmpClause::Simd>(&clause.u)) {
779 eligibleSIMD = true;
780 break;
783 } else if (dir.v == llvm::omp::Directive::OMPD_scan) {
784 eligibleSIMD = true;
788 // Allowing SIMD construct
789 [&](const parser::OpenMPLoopConstruct &c) {
790 const auto &beginLoopDir{
791 std::get<parser::OmpBeginLoopDirective>(c.t)};
792 const auto &beginDir{
793 std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
794 if ((beginDir.v == llvm::omp::Directive::OMPD_simd) ||
795 (beginDir.v == llvm::omp::Directive::OMPD_do_simd)) {
796 eligibleSIMD = true;
799 [&](const parser::OpenMPAtomicConstruct &c) {
800 // Allow `!$OMP ATOMIC`
801 eligibleSIMD = true;
803 [&](const auto &c) {},
805 c.u);
806 if (!eligibleSIMD) {
807 context_.Say(parser::FindSourceLocation(c),
808 "The only OpenMP constructs that can be encountered during execution "
809 "of a 'SIMD' region are the `ATOMIC` construct, the `LOOP` construct, "
810 "the `SIMD` construct, the `SCAN` construct and the `ORDERED` "
811 "construct with the `SIMD` clause."_err_en_US);
815 void OmpStructureChecker::CheckTargetNest(const parser::OpenMPConstruct &c) {
816 // 2.12.5 Target Construct Restriction
817 bool eligibleTarget{true};
818 llvm::omp::Directive ineligibleTargetDir;
819 common::visit(
820 common::visitors{
821 [&](const parser::OpenMPBlockConstruct &c) {
822 const auto &beginBlockDir{
823 std::get<parser::OmpBeginBlockDirective>(c.t)};
824 const auto &beginDir{
825 std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
826 if (beginDir.v == llvm::omp::Directive::OMPD_target_data) {
827 eligibleTarget = false;
828 ineligibleTargetDir = beginDir.v;
831 [&](const parser::OpenMPStandaloneConstruct &c) {
832 common::visit(
833 common::visitors{
834 [&](const parser::OpenMPSimpleStandaloneConstruct &c) {
835 const auto &dir{
836 std::get<parser::OmpSimpleStandaloneDirective>(c.t)};
837 if (dir.v == llvm::omp::Directive::OMPD_target_update ||
838 dir.v ==
839 llvm::omp::Directive::OMPD_target_enter_data ||
840 dir.v ==
841 llvm::omp::Directive::OMPD_target_exit_data) {
842 eligibleTarget = false;
843 ineligibleTargetDir = dir.v;
846 [&](const auto &c) {},
848 c.u);
850 [&](const auto &c) {},
852 c.u);
853 if (!eligibleTarget) {
854 context_.Warn(common::UsageWarning::Portability,
855 parser::FindSourceLocation(c),
856 "If %s directive is nested inside TARGET region, the behaviour is unspecified"_port_en_US,
857 parser::ToUpperCaseLetters(
858 getDirectiveName(ineligibleTargetDir).str()));
862 std::int64_t OmpStructureChecker::GetOrdCollapseLevel(
863 const parser::OpenMPLoopConstruct &x) {
864 const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
865 const auto &clauseList{std::get<parser::OmpClauseList>(beginLoopDir.t)};
866 std::int64_t orderedCollapseLevel{1};
867 std::int64_t orderedLevel{1};
868 std::int64_t collapseLevel{1};
870 for (const auto &clause : clauseList.v) {
871 if (const auto *collapseClause{
872 std::get_if<parser::OmpClause::Collapse>(&clause.u)}) {
873 if (const auto v{GetIntValue(collapseClause->v)}) {
874 collapseLevel = *v;
877 if (const auto *orderedClause{
878 std::get_if<parser::OmpClause::Ordered>(&clause.u)}) {
879 if (const auto v{GetIntValue(orderedClause->v)}) {
880 orderedLevel = *v;
884 if (orderedLevel >= collapseLevel) {
885 orderedCollapseLevel = orderedLevel;
886 } else {
887 orderedCollapseLevel = collapseLevel;
889 return orderedCollapseLevel;
892 void OmpStructureChecker::CheckAssociatedLoopConstraints(
893 const parser::OpenMPLoopConstruct &x) {
894 std::int64_t ordCollapseLevel{GetOrdCollapseLevel(x)};
895 AssociatedLoopChecker checker{context_, ordCollapseLevel};
896 parser::Walk(x, checker);
899 void OmpStructureChecker::CheckDistLinear(
900 const parser::OpenMPLoopConstruct &x) {
902 const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
903 const auto &clauses{std::get<parser::OmpClauseList>(beginLoopDir.t)};
905 semantics::UnorderedSymbolSet indexVars;
907 // Collect symbols of all the variables from linear clauses
908 for (const auto &clause : clauses.v) {
909 if (const auto *linearClause{
910 std::get_if<parser::OmpClause::Linear>(&clause.u)}) {
912 std::list<parser::Name> values;
913 // Get the variant type
914 if (std::holds_alternative<parser::OmpLinearClause::WithModifier>(
915 linearClause->v.u)) {
916 const auto &withM{
917 std::get<parser::OmpLinearClause::WithModifier>(linearClause->v.u)};
918 values = withM.names;
919 } else {
920 const auto &withOutM{std::get<parser::OmpLinearClause::WithoutModifier>(
921 linearClause->v.u)};
922 values = withOutM.names;
924 for (auto const &v : values) {
925 indexVars.insert(*(v.symbol));
930 if (!indexVars.empty()) {
931 // Get collapse level, if given, to find which loops are "associated."
932 std::int64_t collapseVal{GetOrdCollapseLevel(x)};
933 // Include the top loop if no collapse is specified
934 if (collapseVal == 0) {
935 collapseVal = 1;
938 // Match the loop index variables with the collected symbols from linear
939 // clauses.
940 if (const auto &loopConstruct{
941 std::get<std::optional<parser::DoConstruct>>(x.t)}) {
942 for (const parser::DoConstruct *loop{&*loopConstruct}; loop;) {
943 if (loop->IsDoNormal()) {
944 const parser::Name &itrVal{GetLoopIndex(loop)};
945 if (itrVal.symbol) {
946 // Remove the symbol from the collcted set
947 indexVars.erase(*(itrVal.symbol));
949 collapseVal--;
950 if (collapseVal == 0) {
951 break;
954 // Get the next DoConstruct if block is not empty.
955 const auto &block{std::get<parser::Block>(loop->t)};
956 const auto it{block.begin()};
957 loop = it != block.end() ? parser::Unwrap<parser::DoConstruct>(*it)
958 : nullptr;
962 // Show error for the remaining variables
963 for (auto var : indexVars) {
964 const Symbol &root{GetAssociationRoot(var)};
965 context_.Say(parser::FindSourceLocation(x),
966 "Variable '%s' not allowed in `LINEAR` clause, only loop iterator "
967 "can be specified in `LINEAR` clause of a construct combined with "
968 "`DISTRIBUTE`"_err_en_US,
969 root.name());
974 void OmpStructureChecker::Leave(const parser::OpenMPLoopConstruct &x) {
975 const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
976 const auto &clauseList{std::get<parser::OmpClauseList>(beginLoopDir.t)};
978 // A few semantic checks for InScan reduction are performed below as SCAN
979 // constructs inside LOOP may add the relevant information. Scan reduction is
980 // supported only in loop constructs, so same checks are not applicable to
981 // other directives.
982 for (const auto &clause : clauseList.v) {
983 if (const auto *reductionClause{
984 std::get_if<parser::OmpClause::Reduction>(&clause.u)}) {
985 const auto &maybeModifier{
986 std::get<std::optional<ReductionModifier>>(reductionClause->v.t)};
987 if (maybeModifier && *maybeModifier == ReductionModifier::Inscan) {
988 const auto &objectList{
989 std::get<parser::OmpObjectList>(reductionClause->v.t)};
990 auto checkReductionSymbolInScan = [&](const parser::Name *name) {
991 if (auto &symbol = name->symbol) {
992 if (!symbol->test(Symbol::Flag::OmpInclusiveScan) &&
993 !symbol->test(Symbol::Flag::OmpExclusiveScan)) {
994 context_.Say(name->source,
995 "List item %s must appear in EXCLUSIVE or "
996 "INCLUSIVE clause of an "
997 "enclosed SCAN directive"_err_en_US,
998 name->ToString());
1002 for (const auto &ompObj : objectList.v) {
1003 common::visit(
1004 common::visitors{
1005 [&](const parser::Designator &designator) {
1006 if (const auto *name{semantics::getDesignatorNameIfDataRef(
1007 designator)}) {
1008 checkReductionSymbolInScan(name);
1011 [&](const auto &name) { checkReductionSymbolInScan(&name); },
1013 ompObj.u);
1018 if (llvm::omp::allSimdSet.test(GetContext().directive)) {
1019 ExitDirectiveNest(SIMDNest);
1021 dirContext_.pop_back();
1023 assert(!loopStack_.empty() && "Expecting non-empty loop stack");
1024 #ifndef NDEBUG
1025 const LoopConstruct &top{loopStack_.back()};
1026 auto *loopc{std::get_if<const parser::OpenMPLoopConstruct *>(&top)};
1027 assert(loopc != nullptr && *loopc == &x && "Mismatched loop constructs");
1028 #endif
1029 loopStack_.pop_back();
1032 void OmpStructureChecker::Enter(const parser::OmpEndLoopDirective &x) {
1033 const auto &dir{std::get<parser::OmpLoopDirective>(x.t)};
1034 ResetPartialContext(dir.source);
1035 switch (dir.v) {
1036 // 2.7.1 end-do -> END DO [nowait-clause]
1037 // 2.8.3 end-do-simd -> END DO SIMD [nowait-clause]
1038 case llvm::omp::Directive::OMPD_do:
1039 PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_end_do);
1040 break;
1041 case llvm::omp::Directive::OMPD_do_simd:
1042 PushContextAndClauseSets(
1043 dir.source, llvm::omp::Directive::OMPD_end_do_simd);
1044 break;
1045 default:
1046 // no clauses are allowed
1047 break;
1051 void OmpStructureChecker::Leave(const parser::OmpEndLoopDirective &x) {
1052 if ((GetContext().directive == llvm::omp::Directive::OMPD_end_do) ||
1053 (GetContext().directive == llvm::omp::Directive::OMPD_end_do_simd)) {
1054 dirContext_.pop_back();
1058 void OmpStructureChecker::Enter(const parser::OpenMPBlockConstruct &x) {
1059 const auto &beginBlockDir{std::get<parser::OmpBeginBlockDirective>(x.t)};
1060 const auto &endBlockDir{std::get<parser::OmpEndBlockDirective>(x.t)};
1061 const auto &beginDir{std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
1062 const auto &endDir{std::get<parser::OmpBlockDirective>(endBlockDir.t)};
1063 const parser::Block &block{std::get<parser::Block>(x.t)};
1065 CheckMatching<parser::OmpBlockDirective>(beginDir, endDir);
1067 PushContextAndClauseSets(beginDir.source, beginDir.v);
1068 if (GetContext().directive == llvm::omp::Directive::OMPD_target) {
1069 EnterDirectiveNest(TargetNest);
1072 if (CurrentDirectiveIsNested()) {
1073 if (llvm::omp::topTeamsSet.test(GetContextParent().directive)) {
1074 HasInvalidTeamsNesting(beginDir.v, beginDir.source);
1076 if (GetContext().directive == llvm::omp::Directive::OMPD_master) {
1077 CheckMasterNesting(x);
1079 // A teams region can only be strictly nested within the implicit parallel
1080 // region or a target region.
1081 if (GetContext().directive == llvm::omp::Directive::OMPD_teams &&
1082 GetContextParent().directive != llvm::omp::Directive::OMPD_target) {
1083 context_.Say(parser::FindSourceLocation(x),
1084 "%s region can only be strictly nested within the implicit parallel "
1085 "region or TARGET region"_err_en_US,
1086 ContextDirectiveAsFortran());
1088 // If a teams construct is nested within a target construct, that target
1089 // construct must contain no statements, declarations or directives outside
1090 // of the teams construct.
1091 if (GetContext().directive == llvm::omp::Directive::OMPD_teams &&
1092 GetContextParent().directive == llvm::omp::Directive::OMPD_target &&
1093 !GetDirectiveNest(TargetBlockOnlyTeams)) {
1094 context_.Say(GetContextParent().directiveSource,
1095 "TARGET construct with nested TEAMS region contains statements or "
1096 "directives outside of the TEAMS construct"_err_en_US);
1100 CheckNoBranching(block, beginDir.v, beginDir.source);
1102 // Target block constructs are target device constructs. Keep track of
1103 // whether any such construct has been visited to later check that REQUIRES
1104 // directives for target-related options don't appear after them.
1105 if (llvm::omp::allTargetSet.test(beginDir.v)) {
1106 deviceConstructFound_ = true;
1109 switch (beginDir.v) {
1110 case llvm::omp::Directive::OMPD_target:
1111 if (CheckTargetBlockOnlyTeams(block)) {
1112 EnterDirectiveNest(TargetBlockOnlyTeams);
1114 break;
1115 case llvm::omp::OMPD_workshare:
1116 case llvm::omp::OMPD_parallel_workshare:
1117 CheckWorkshareBlockStmts(block, beginDir.source);
1118 HasInvalidWorksharingNesting(
1119 beginDir.source, llvm::omp::nestedWorkshareErrSet);
1120 break;
1121 case llvm::omp::Directive::OMPD_scope:
1122 case llvm::omp::Directive::OMPD_single:
1123 // TODO: This check needs to be extended while implementing nesting of
1124 // regions checks.
1125 HasInvalidWorksharingNesting(
1126 beginDir.source, llvm::omp::nestedWorkshareErrSet);
1127 break;
1128 default:
1129 break;
1133 void OmpStructureChecker::CheckMasterNesting(
1134 const parser::OpenMPBlockConstruct &x) {
1135 // A MASTER region may not be `closely nested` inside a worksharing, loop,
1136 // task, taskloop, or atomic region.
1137 // TODO: Expand the check to include `LOOP` construct as well when it is
1138 // supported.
1139 if (IsCloselyNestedRegion(llvm::omp::nestedMasterErrSet)) {
1140 context_.Say(parser::FindSourceLocation(x),
1141 "`MASTER` region may not be closely nested inside of `WORKSHARING`, "
1142 "`LOOP`, `TASK`, `TASKLOOP`,"
1143 " or `ATOMIC` region."_err_en_US);
1147 void OmpStructureChecker::Leave(const parser::OpenMPBlockConstruct &) {
1148 if (GetDirectiveNest(TargetBlockOnlyTeams)) {
1149 ExitDirectiveNest(TargetBlockOnlyTeams);
1151 if (GetContext().directive == llvm::omp::Directive::OMPD_target) {
1152 ExitDirectiveNest(TargetNest);
1154 dirContext_.pop_back();
1157 void OmpStructureChecker::ChecksOnOrderedAsBlock() {
1158 if (FindClause(llvm::omp::Clause::OMPC_depend)) {
1159 context_.Say(GetContext().clauseSource,
1160 "DEPEND clauses are not allowed when ORDERED construct is a block construct with an ORDERED region"_err_en_US);
1161 return;
1164 bool isNestedInDo{false};
1165 bool isNestedInDoSIMD{false};
1166 bool isNestedInSIMD{false};
1167 bool noOrderedClause{false};
1168 bool isOrderedClauseWithPara{false};
1169 bool isCloselyNestedRegion{true};
1170 if (CurrentDirectiveIsNested()) {
1171 for (int i = (int)dirContext_.size() - 2; i >= 0; i--) {
1172 if (llvm::omp::nestedOrderedErrSet.test(dirContext_[i].directive)) {
1173 context_.Say(GetContext().directiveSource,
1174 "`ORDERED` region may not be closely nested inside of `CRITICAL`, "
1175 "`ORDERED`, explicit `TASK` or `TASKLOOP` region."_err_en_US);
1176 break;
1177 } else if (llvm::omp::allDoSet.test(dirContext_[i].directive)) {
1178 isNestedInDo = true;
1179 isNestedInDoSIMD =
1180 llvm::omp::allDoSimdSet.test(dirContext_[i].directive);
1181 if (const auto *clause{
1182 FindClause(dirContext_[i], llvm::omp::Clause::OMPC_ordered)}) {
1183 const auto &orderedClause{
1184 std::get<parser::OmpClause::Ordered>(clause->u)};
1185 const auto orderedValue{GetIntValue(orderedClause.v)};
1186 isOrderedClauseWithPara = orderedValue > 0;
1187 } else {
1188 noOrderedClause = true;
1190 break;
1191 } else if (llvm::omp::allSimdSet.test(dirContext_[i].directive)) {
1192 isNestedInSIMD = true;
1193 break;
1194 } else if (llvm::omp::nestedOrderedParallelErrSet.test(
1195 dirContext_[i].directive)) {
1196 isCloselyNestedRegion = false;
1197 break;
1202 if (!isCloselyNestedRegion) {
1203 context_.Say(GetContext().directiveSource,
1204 "An ORDERED directive without the DEPEND clause must be closely nested "
1205 "in a SIMD, worksharing-loop, or worksharing-loop SIMD "
1206 "region"_err_en_US);
1207 } else {
1208 if (CurrentDirectiveIsNested() &&
1209 FindClause(llvm::omp::Clause::OMPC_simd) &&
1210 (!isNestedInDoSIMD && !isNestedInSIMD)) {
1211 context_.Say(GetContext().directiveSource,
1212 "An ORDERED directive with SIMD clause must be closely nested in a "
1213 "SIMD or worksharing-loop SIMD region"_err_en_US);
1215 if (isNestedInDo && (noOrderedClause || isOrderedClauseWithPara)) {
1216 context_.Say(GetContext().directiveSource,
1217 "An ORDERED directive without the DEPEND clause must be closely "
1218 "nested in a worksharing-loop (or worksharing-loop SIMD) region with "
1219 "ORDERED clause without the parameter"_err_en_US);
1224 void OmpStructureChecker::Leave(const parser::OmpBeginBlockDirective &) {
1225 switch (GetContext().directive) {
1226 case llvm::omp::Directive::OMPD_ordered:
1227 // [5.1] 2.19.9 Ordered Construct Restriction
1228 ChecksOnOrderedAsBlock();
1229 break;
1230 default:
1231 break;
1235 void OmpStructureChecker::Enter(const parser::OpenMPSectionsConstruct &x) {
1236 const auto &beginSectionsDir{
1237 std::get<parser::OmpBeginSectionsDirective>(x.t)};
1238 const auto &endSectionsDir{std::get<parser::OmpEndSectionsDirective>(x.t)};
1239 const auto &beginDir{
1240 std::get<parser::OmpSectionsDirective>(beginSectionsDir.t)};
1241 const auto &endDir{std::get<parser::OmpSectionsDirective>(endSectionsDir.t)};
1242 CheckMatching<parser::OmpSectionsDirective>(beginDir, endDir);
1244 PushContextAndClauseSets(beginDir.source, beginDir.v);
1245 const auto &sectionBlocks{std::get<parser::OmpSectionBlocks>(x.t)};
1246 for (const parser::OpenMPConstruct &block : sectionBlocks.v) {
1247 CheckNoBranching(std::get<parser::OpenMPSectionConstruct>(block.u).v,
1248 beginDir.v, beginDir.source);
1250 HasInvalidWorksharingNesting(
1251 beginDir.source, llvm::omp::nestedWorkshareErrSet);
1254 void OmpStructureChecker::Leave(const parser::OpenMPSectionsConstruct &) {
1255 dirContext_.pop_back();
1258 void OmpStructureChecker::Enter(const parser::OmpEndSectionsDirective &x) {
1259 const auto &dir{std::get<parser::OmpSectionsDirective>(x.t)};
1260 ResetPartialContext(dir.source);
1261 switch (dir.v) {
1262 // 2.7.2 end-sections -> END SECTIONS [nowait-clause]
1263 case llvm::omp::Directive::OMPD_sections:
1264 PushContextAndClauseSets(
1265 dir.source, llvm::omp::Directive::OMPD_end_sections);
1266 break;
1267 default:
1268 // no clauses are allowed
1269 break;
1273 // TODO: Verify the popping of dirContext requirement after nowait
1274 // implementation, as there is an implicit barrier at the end of the worksharing
1275 // constructs unless a nowait clause is specified. Only OMPD_end_sections is
1276 // popped becuase it is pushed while entering the EndSectionsDirective.
1277 void OmpStructureChecker::Leave(const parser::OmpEndSectionsDirective &x) {
1278 if (GetContext().directive == llvm::omp::Directive::OMPD_end_sections) {
1279 dirContext_.pop_back();
1283 void OmpStructureChecker::CheckThreadprivateOrDeclareTargetVar(
1284 const parser::OmpObjectList &objList) {
1285 for (const auto &ompObject : objList.v) {
1286 common::visit(
1287 common::visitors{
1288 [&](const parser::Designator &) {
1289 if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
1290 // The symbol is null, return early, CheckSymbolNames
1291 // should have already reported the missing symbol as a
1292 // diagnostic error
1293 if (!name->symbol) {
1294 return;
1297 if (name->symbol->GetUltimate().IsSubprogram()) {
1298 if (GetContext().directive ==
1299 llvm::omp::Directive::OMPD_threadprivate)
1300 context_.Say(name->source,
1301 "The procedure name cannot be in a %s "
1302 "directive"_err_en_US,
1303 ContextDirectiveAsFortran());
1304 // TODO: Check for procedure name in declare target directive.
1305 } else if (name->symbol->attrs().test(Attr::PARAMETER)) {
1306 if (GetContext().directive ==
1307 llvm::omp::Directive::OMPD_threadprivate)
1308 context_.Say(name->source,
1309 "The entity with PARAMETER attribute cannot be in a %s "
1310 "directive"_err_en_US,
1311 ContextDirectiveAsFortran());
1312 else if (GetContext().directive ==
1313 llvm::omp::Directive::OMPD_declare_target)
1314 context_.Warn(common::UsageWarning::OpenMPUsage,
1315 name->source,
1316 "The entity with PARAMETER attribute is used in a %s directive"_warn_en_US,
1317 ContextDirectiveAsFortran());
1318 } else if (FindCommonBlockContaining(*name->symbol)) {
1319 context_.Say(name->source,
1320 "A variable in a %s directive cannot be an element of a "
1321 "common block"_err_en_US,
1322 ContextDirectiveAsFortran());
1323 } else if (FindEquivalenceSet(*name->symbol)) {
1324 context_.Say(name->source,
1325 "A variable in a %s directive cannot appear in an "
1326 "EQUIVALENCE statement"_err_en_US,
1327 ContextDirectiveAsFortran());
1328 } else if (name->symbol->test(Symbol::Flag::OmpThreadprivate) &&
1329 GetContext().directive ==
1330 llvm::omp::Directive::OMPD_declare_target) {
1331 context_.Say(name->source,
1332 "A THREADPRIVATE variable cannot appear in a %s "
1333 "directive"_err_en_US,
1334 ContextDirectiveAsFortran());
1335 } else {
1336 const semantics::Scope &useScope{
1337 context_.FindScope(GetContext().directiveSource)};
1338 const semantics::Scope &curScope =
1339 name->symbol->GetUltimate().owner();
1340 if (!curScope.IsTopLevel()) {
1341 const semantics::Scope &declScope =
1342 GetProgramUnitOrBlockConstructContaining(curScope);
1343 const semantics::Symbol *sym{
1344 declScope.parent().FindSymbol(name->symbol->name())};
1345 if (sym &&
1346 (sym->has<MainProgramDetails>() ||
1347 sym->has<ModuleDetails>())) {
1348 context_.Say(name->source,
1349 "The module name or main program name cannot be in a "
1350 "%s "
1351 "directive"_err_en_US,
1352 ContextDirectiveAsFortran());
1353 } else if (!IsSaved(*name->symbol) &&
1354 declScope.kind() != Scope::Kind::MainProgram &&
1355 declScope.kind() != Scope::Kind::Module) {
1356 context_.Say(name->source,
1357 "A variable that appears in a %s directive must be "
1358 "declared in the scope of a module or have the SAVE "
1359 "attribute, either explicitly or "
1360 "implicitly"_err_en_US,
1361 ContextDirectiveAsFortran());
1362 } else if (useScope != declScope) {
1363 context_.Say(name->source,
1364 "The %s directive and the common block or variable "
1365 "in it must appear in the same declaration section "
1366 "of a scoping unit"_err_en_US,
1367 ContextDirectiveAsFortran());
1373 [&](const parser::Name &) {}, // common block
1375 ompObject.u);
1379 void OmpStructureChecker::Enter(const parser::OpenMPThreadprivate &c) {
1380 const auto &dir{std::get<parser::Verbatim>(c.t)};
1381 PushContextAndClauseSets(
1382 dir.source, llvm::omp::Directive::OMPD_threadprivate);
1385 void OmpStructureChecker::Leave(const parser::OpenMPThreadprivate &c) {
1386 const auto &dir{std::get<parser::Verbatim>(c.t)};
1387 const auto &objectList{std::get<parser::OmpObjectList>(c.t)};
1388 CheckSymbolNames(dir.source, objectList);
1389 CheckIsVarPartOfAnotherVar(dir.source, objectList);
1390 CheckThreadprivateOrDeclareTargetVar(objectList);
1391 dirContext_.pop_back();
1394 void OmpStructureChecker::Enter(const parser::OpenMPDeclareSimdConstruct &x) {
1395 const auto &dir{std::get<parser::Verbatim>(x.t)};
1396 PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_declare_simd);
1399 void OmpStructureChecker::Leave(const parser::OpenMPDeclareSimdConstruct &) {
1400 dirContext_.pop_back();
1403 void OmpStructureChecker::Enter(const parser::OpenMPDepobjConstruct &x) {
1404 const auto &dir{std::get<parser::Verbatim>(x.t)};
1405 PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_depobj);
1407 // [5.2:73:27-28]
1408 // If the destroy clause appears on a depobj construct, destroy-var must
1409 // refer to the same depend object as the depobj argument of the construct.
1410 auto &clause{std::get<parser::OmpClause>(x.t)};
1411 if (clause.Id() == llvm::omp::Clause::OMPC_destroy) {
1412 auto getSymbol{[&](const parser::OmpObject &obj) {
1413 return common::visit(
1414 [&](auto &&s) { return GetLastName(s).symbol; }, obj.u);
1417 auto &wrapper{std::get<parser::OmpClause::Destroy>(clause.u)};
1418 if (const std::optional<parser::OmpDestroyClause> &destroy{wrapper.v}) {
1419 const Symbol *constrSym{getSymbol(std::get<parser::OmpObject>(x.t))};
1420 const Symbol *clauseSym{getSymbol(destroy->v)};
1421 assert(constrSym && "Unresolved depobj construct symbol");
1422 assert(clauseSym && "Unresolved destroy symbol on depobj construct");
1423 if (constrSym != clauseSym) {
1424 context_.Say(x.source,
1425 "The DESTROY clause must refer to the same object as the "
1426 "DEPOBJ construct"_err_en_US);
1432 void OmpStructureChecker::Leave(const parser::OpenMPDepobjConstruct &x) {
1433 dirContext_.pop_back();
1436 void OmpStructureChecker::Enter(const parser::OpenMPRequiresConstruct &x) {
1437 const auto &dir{std::get<parser::Verbatim>(x.t)};
1438 PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_requires);
1441 void OmpStructureChecker::Leave(const parser::OpenMPRequiresConstruct &) {
1442 dirContext_.pop_back();
1445 void OmpStructureChecker::Enter(const parser::OpenMPDeclarativeAllocate &x) {
1446 isPredefinedAllocator = true;
1447 const auto &dir{std::get<parser::Verbatim>(x.t)};
1448 const auto &objectList{std::get<parser::OmpObjectList>(x.t)};
1449 PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_allocate);
1450 CheckIsVarPartOfAnotherVar(dir.source, objectList);
1453 void OmpStructureChecker::Leave(const parser::OpenMPDeclarativeAllocate &x) {
1454 const auto &dir{std::get<parser::Verbatim>(x.t)};
1455 const auto &objectList{std::get<parser::OmpObjectList>(x.t)};
1456 CheckPredefinedAllocatorRestriction(dir.source, objectList);
1457 dirContext_.pop_back();
1460 void OmpStructureChecker::Enter(const parser::OmpClause::Allocator &x) {
1461 CheckAllowedClause(llvm::omp::Clause::OMPC_allocator);
1462 // Note: Predefined allocators are stored in ScalarExpr as numbers
1463 // whereas custom allocators are stored as strings, so if the ScalarExpr
1464 // actually has an int value, then it must be a predefined allocator
1465 isPredefinedAllocator = GetIntValue(x.v).has_value();
1466 RequiresPositiveParameter(llvm::omp::Clause::OMPC_allocator, x.v);
1469 void OmpStructureChecker::Enter(const parser::OmpClause::Allocate &x) {
1470 CheckAllowedClause(llvm::omp::Clause::OMPC_allocate);
1471 if (const auto &modifier{
1472 std::get<std::optional<parser::OmpAllocateClause::AllocateModifier>>(
1473 x.v.t)}) {
1474 common::visit(
1475 common::visitors{
1476 [&](const parser::OmpAllocateClause::AllocateModifier::Allocator
1477 &y) {
1478 RequiresPositiveParameter(llvm::omp::Clause::OMPC_allocate, y.v);
1479 isPredefinedAllocator = GetIntValue(y.v).has_value();
1481 [&](const parser::OmpAllocateClause::AllocateModifier::
1482 ComplexModifier &y) {
1483 const auto &alloc = std::get<
1484 parser::OmpAllocateClause::AllocateModifier::Allocator>(y.t);
1485 const auto &align =
1486 std::get<parser::OmpAllocateClause::AllocateModifier::Align>(
1487 y.t);
1488 RequiresPositiveParameter(
1489 llvm::omp::Clause::OMPC_allocate, alloc.v);
1490 RequiresPositiveParameter(
1491 llvm::omp::Clause::OMPC_allocate, align.v);
1492 isPredefinedAllocator = GetIntValue(alloc.v).has_value();
1494 [&](const parser::OmpAllocateClause::AllocateModifier::Align &y) {
1495 RequiresPositiveParameter(llvm::omp::Clause::OMPC_allocate, y.v);
1498 modifier->u);
1502 void OmpStructureChecker::Enter(const parser::OmpDeclareTargetWithClause &x) {
1503 SetClauseSets(llvm::omp::Directive::OMPD_declare_target);
1506 void OmpStructureChecker::Leave(const parser::OmpDeclareTargetWithClause &x) {
1507 if (x.v.v.size() > 0) {
1508 const parser::OmpClause *enterClause =
1509 FindClause(llvm::omp::Clause::OMPC_enter);
1510 const parser::OmpClause *toClause = FindClause(llvm::omp::Clause::OMPC_to);
1511 const parser::OmpClause *linkClause =
1512 FindClause(llvm::omp::Clause::OMPC_link);
1513 if (!enterClause && !toClause && !linkClause) {
1514 context_.Say(x.source,
1515 "If the DECLARE TARGET directive has a clause, it must contain at least one ENTER clause or LINK clause"_err_en_US);
1517 unsigned version{context_.langOptions().OpenMPVersion};
1518 if (toClause && version >= 52) {
1519 context_.Warn(common::UsageWarning::OpenMPUsage, toClause->source,
1520 "The usage of TO clause on DECLARE TARGET directive has been deprecated. Use ENTER clause instead."_warn_en_US);
1525 void OmpStructureChecker::Enter(const parser::OpenMPDeclareMapperConstruct &x) {
1526 const auto &dir{std::get<parser::Verbatim>(x.t)};
1527 PushContextAndClauseSets(
1528 dir.source, llvm::omp::Directive::OMPD_declare_mapper);
1529 const auto &spec{std::get<parser::OmpDeclareMapperSpecifier>(x.t)};
1530 const auto &type = std::get<parser::TypeSpec>(spec.t);
1531 if (!std::get_if<parser::DerivedTypeSpec>(&type.u)) {
1532 context_.Say(dir.source, "Type is not a derived type"_err_en_US);
1536 void OmpStructureChecker::Leave(const parser::OpenMPDeclareMapperConstruct &) {
1537 dirContext_.pop_back();
1540 void OmpStructureChecker::Enter(const parser::OpenMPDeclareTargetConstruct &x) {
1541 const auto &dir{std::get<parser::Verbatim>(x.t)};
1542 PushContext(dir.source, llvm::omp::Directive::OMPD_declare_target);
1545 void OmpStructureChecker::Enter(const parser::OmpDeclareTargetWithList &x) {
1546 SymbolSourceMap symbols;
1547 GetSymbolsInObjectList(x.v, symbols);
1548 for (auto &[symbol, source] : symbols) {
1549 const GenericDetails *genericDetails = symbol->detailsIf<GenericDetails>();
1550 if (genericDetails) {
1551 context_.Say(source,
1552 "The procedure '%s' in DECLARE TARGET construct cannot be a generic name."_err_en_US,
1553 symbol->name());
1554 genericDetails->specific();
1556 if (IsProcedurePointer(*symbol)) {
1557 context_.Say(source,
1558 "The procedure '%s' in DECLARE TARGET construct cannot be a procedure pointer."_err_en_US,
1559 symbol->name());
1561 const SubprogramDetails *entryDetails =
1562 symbol->detailsIf<SubprogramDetails>();
1563 if (entryDetails && entryDetails->entryScope()) {
1564 context_.Say(source,
1565 "The procedure '%s' in DECLARE TARGET construct cannot be an entry name."_err_en_US,
1566 symbol->name());
1568 if (IsStmtFunction(*symbol)) {
1569 context_.Say(source,
1570 "The procedure '%s' in DECLARE TARGET construct cannot be a statement function."_err_en_US,
1571 symbol->name());
1576 void OmpStructureChecker::CheckSymbolNames(
1577 const parser::CharBlock &source, const parser::OmpObjectList &objList) {
1578 for (const auto &ompObject : objList.v) {
1579 common::visit(
1580 common::visitors{
1581 [&](const parser::Designator &designator) {
1582 if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
1583 if (!name->symbol) {
1584 context_.Say(source,
1585 "The given %s directive clause has an invalid argument"_err_en_US,
1586 ContextDirectiveAsFortran());
1590 [&](const parser::Name &name) {
1591 if (!name.symbol) {
1592 context_.Say(source,
1593 "The given %s directive clause has an invalid argument"_err_en_US,
1594 ContextDirectiveAsFortran());
1598 ompObject.u);
1602 void OmpStructureChecker::Leave(const parser::OpenMPDeclareTargetConstruct &x) {
1603 const auto &dir{std::get<parser::Verbatim>(x.t)};
1604 const auto &spec{std::get<parser::OmpDeclareTargetSpecifier>(x.t)};
1605 // Handle both forms of DECLARE TARGET.
1606 // - Extended list: It behaves as if there was an ENTER/TO clause with the
1607 // list of objects as argument. It accepts no explicit clauses.
1608 // - With clauses.
1609 if (const auto *objectList{parser::Unwrap<parser::OmpObjectList>(spec.u)}) {
1610 deviceConstructFound_ = true;
1611 CheckSymbolNames(dir.source, *objectList);
1612 CheckIsVarPartOfAnotherVar(dir.source, *objectList);
1613 CheckThreadprivateOrDeclareTargetVar(*objectList);
1614 } else if (const auto *clauseList{
1615 parser::Unwrap<parser::OmpClauseList>(spec.u)}) {
1616 bool toClauseFound{false}, deviceTypeClauseFound{false},
1617 enterClauseFound{false};
1618 for (const auto &clause : clauseList->v) {
1619 common::visit(
1620 common::visitors{
1621 [&](const parser::OmpClause::To &toClause) {
1622 toClauseFound = true;
1623 auto &objList{std::get<parser::OmpObjectList>(toClause.v.t)};
1624 CheckSymbolNames(dir.source, objList);
1625 CheckIsVarPartOfAnotherVar(dir.source, objList);
1626 CheckThreadprivateOrDeclareTargetVar(objList);
1628 [&](const parser::OmpClause::Link &linkClause) {
1629 CheckSymbolNames(dir.source, linkClause.v);
1630 CheckIsVarPartOfAnotherVar(dir.source, linkClause.v);
1631 CheckThreadprivateOrDeclareTargetVar(linkClause.v);
1633 [&](const parser::OmpClause::Enter &enterClause) {
1634 enterClauseFound = true;
1635 CheckSymbolNames(dir.source, enterClause.v);
1636 CheckIsVarPartOfAnotherVar(dir.source, enterClause.v);
1637 CheckThreadprivateOrDeclareTargetVar(enterClause.v);
1639 [&](const parser::OmpClause::DeviceType &deviceTypeClause) {
1640 deviceTypeClauseFound = true;
1641 if (deviceTypeClause.v.v !=
1642 parser::OmpDeviceTypeClause::Type::Host) {
1643 // Function / subroutine explicitly marked as runnable by the
1644 // target device.
1645 deviceConstructFound_ = true;
1648 [&](const auto &) {},
1650 clause.u);
1652 if ((toClauseFound || enterClauseFound) && !deviceTypeClauseFound) {
1653 deviceConstructFound_ = true;
1657 dirContext_.pop_back();
1660 void OmpStructureChecker::Enter(const parser::OpenMPExecutableAllocate &x) {
1661 isPredefinedAllocator = true;
1662 const auto &dir{std::get<parser::Verbatim>(x.t)};
1663 const auto &objectList{std::get<std::optional<parser::OmpObjectList>>(x.t)};
1664 PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_allocate);
1665 if (objectList) {
1666 CheckIsVarPartOfAnotherVar(dir.source, *objectList);
1670 void OmpStructureChecker::Leave(const parser::OpenMPExecutableAllocate &x) {
1671 const auto &dir{std::get<parser::Verbatim>(x.t)};
1672 const auto &objectList{std::get<std::optional<parser::OmpObjectList>>(x.t)};
1673 if (objectList)
1674 CheckPredefinedAllocatorRestriction(dir.source, *objectList);
1675 dirContext_.pop_back();
1678 void OmpStructureChecker::Enter(const parser::OpenMPAllocatorsConstruct &x) {
1679 isPredefinedAllocator = true;
1680 const auto &dir{std::get<parser::Verbatim>(x.t)};
1681 PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_allocators);
1682 const auto &clauseList{std::get<parser::OmpClauseList>(x.t)};
1683 for (const auto &clause : clauseList.v) {
1684 if (const auto *allocClause{
1685 parser::Unwrap<parser::OmpClause::Allocate>(clause)}) {
1686 CheckIsVarPartOfAnotherVar(
1687 dir.source, std::get<parser::OmpObjectList>(allocClause->v.t));
1692 void OmpStructureChecker::Leave(const parser::OpenMPAllocatorsConstruct &x) {
1693 const auto &dir{std::get<parser::Verbatim>(x.t)};
1694 const auto &clauseList{std::get<parser::OmpClauseList>(x.t)};
1695 for (const auto &clause : clauseList.v) {
1696 if (const auto *allocClause{
1697 std::get_if<parser::OmpClause::Allocate>(&clause.u)}) {
1698 CheckPredefinedAllocatorRestriction(
1699 dir.source, std::get<parser::OmpObjectList>(allocClause->v.t));
1702 dirContext_.pop_back();
1705 void OmpStructureChecker::CheckScan(
1706 const parser::OpenMPSimpleStandaloneConstruct &x) {
1707 if (std::get<parser::OmpClauseList>(x.t).v.size() != 1) {
1708 context_.Say(x.source,
1709 "Exactly one of EXCLUSIVE or INCLUSIVE clause is expected"_err_en_US);
1711 if (!CurrentDirectiveIsNested() ||
1712 !llvm::omp::scanParentAllowedSet.test(GetContextParent().directive)) {
1713 context_.Say(x.source,
1714 "Orphaned SCAN directives are prohibited; perhaps you forgot "
1715 "to enclose the directive in to a WORKSHARING LOOP, a WORKSHARING "
1716 "LOOP SIMD or a SIMD directive."_err_en_US);
1720 void OmpStructureChecker::CheckBarrierNesting(
1721 const parser::OpenMPSimpleStandaloneConstruct &x) {
1722 // A barrier region may not be `closely nested` inside a worksharing, loop,
1723 // task, taskloop, critical, ordered, atomic, or master region.
1724 // TODO: Expand the check to include `LOOP` construct as well when it is
1725 // supported.
1726 if (IsCloselyNestedRegion(llvm::omp::nestedBarrierErrSet)) {
1727 context_.Say(parser::FindSourceLocation(x),
1728 "`BARRIER` region may not be closely nested inside of `WORKSHARING`, "
1729 "`LOOP`, `TASK`, `TASKLOOP`,"
1730 "`CRITICAL`, `ORDERED`, `ATOMIC` or `MASTER` region."_err_en_US);
1734 void OmpStructureChecker::ChecksOnOrderedAsStandalone() {
1735 if (FindClause(llvm::omp::Clause::OMPC_threads) ||
1736 FindClause(llvm::omp::Clause::OMPC_simd)) {
1737 context_.Say(GetContext().clauseSource,
1738 "THREADS and SIMD clauses are not allowed when ORDERED construct is a standalone construct with no ORDERED region"_err_en_US);
1741 int dependSinkCount{0}, dependSourceCount{0};
1742 bool exclusiveShown{false}, duplicateSourceShown{false};
1744 auto visitDoacross{[&](const parser::OmpDoacross &doa,
1745 const parser::CharBlock &src) {
1746 common::visit(
1747 common::visitors{
1748 [&](const parser::OmpDoacross::Source &) { dependSourceCount++; },
1749 [&](const parser::OmpDoacross::Sink &) { dependSinkCount++; }},
1750 doa.u);
1751 if (!exclusiveShown && dependSinkCount > 0 && dependSourceCount > 0) {
1752 exclusiveShown = true;
1753 context_.Say(src,
1754 "The SINK and SOURCE dependence types are mutually exclusive"_err_en_US);
1756 if (!duplicateSourceShown && dependSourceCount > 1) {
1757 duplicateSourceShown = true;
1758 context_.Say(src,
1759 "At most one SOURCE dependence type can appear on the ORDERED directive"_err_en_US);
1763 // Visit the DEPEND and DOACROSS clauses.
1764 for (auto [_, clause] : FindClauses(llvm::omp::Clause::OMPC_depend)) {
1765 const auto &dependClause{std::get<parser::OmpClause::Depend>(clause->u)};
1766 if (auto *doAcross{std::get_if<parser::OmpDoacross>(&dependClause.v.u)}) {
1767 visitDoacross(*doAcross, clause->source);
1768 } else {
1769 context_.Say(clause->source,
1770 "Only SINK or SOURCE dependence types are allowed when ORDERED construct is a standalone construct with no ORDERED region"_err_en_US);
1773 for (auto [_, clause] : FindClauses(llvm::omp::Clause::OMPC_doacross)) {
1774 auto &doaClause{std::get<parser::OmpClause::Doacross>(clause->u)};
1775 visitDoacross(doaClause.v.v, clause->source);
1778 bool isNestedInDoOrderedWithPara{false};
1779 if (CurrentDirectiveIsNested() &&
1780 llvm::omp::nestedOrderedDoAllowedSet.test(GetContextParent().directive)) {
1781 if (const auto *clause{
1782 FindClause(GetContextParent(), llvm::omp::Clause::OMPC_ordered)}) {
1783 const auto &orderedClause{
1784 std::get<parser::OmpClause::Ordered>(clause->u)};
1785 const auto orderedValue{GetIntValue(orderedClause.v)};
1786 if (orderedValue > 0) {
1787 isNestedInDoOrderedWithPara = true;
1788 CheckOrderedDependClause(orderedValue);
1793 if (FindClause(llvm::omp::Clause::OMPC_depend) &&
1794 !isNestedInDoOrderedWithPara) {
1795 context_.Say(GetContext().clauseSource,
1796 "An ORDERED construct with the DEPEND clause must be closely nested "
1797 "in a worksharing-loop (or parallel worksharing-loop) construct with "
1798 "ORDERED clause with a parameter"_err_en_US);
1802 void OmpStructureChecker::CheckOrderedDependClause(
1803 std::optional<int64_t> orderedValue) {
1804 auto visitDoacross{[&](const parser::OmpDoacross &doa,
1805 const parser::CharBlock &src) {
1806 if (auto *sinkVector{std::get_if<parser::OmpDoacross::Sink>(&doa.u)}) {
1807 int64_t numVar = sinkVector->v.v.size();
1808 if (orderedValue != numVar) {
1809 context_.Say(src,
1810 "The number of variables in the SINK iteration vector does not match the parameter specified in ORDERED clause"_err_en_US);
1814 for (auto [_, clause] : FindClauses(llvm::omp::Clause::OMPC_depend)) {
1815 auto &dependClause{std::get<parser::OmpClause::Depend>(clause->u)};
1816 if (auto *doAcross{std::get_if<parser::OmpDoacross>(&dependClause.v.u)}) {
1817 visitDoacross(*doAcross, clause->source);
1820 for (auto [_, clause] : FindClauses(llvm::omp::Clause::OMPC_doacross)) {
1821 auto &doaClause{std::get<parser::OmpClause::Doacross>(clause->u)};
1822 visitDoacross(doaClause.v.v, clause->source);
1826 void OmpStructureChecker::CheckTargetUpdate() {
1827 const parser::OmpClause *toWrapper{FindClause(llvm::omp::Clause::OMPC_to)};
1828 const parser::OmpClause *fromWrapper{
1829 FindClause(llvm::omp::Clause::OMPC_from)};
1830 if (!toWrapper && !fromWrapper) {
1831 context_.Say(GetContext().directiveSource,
1832 "At least one motion-clause (TO/FROM) must be specified on "
1833 "TARGET UPDATE construct."_err_en_US);
1835 if (toWrapper && fromWrapper) {
1836 SymbolSourceMap toSymbols, fromSymbols;
1837 auto &fromClause{std::get<parser::OmpClause::From>(fromWrapper->u).v};
1838 auto &toClause{std::get<parser::OmpClause::To>(toWrapper->u).v};
1839 GetSymbolsInObjectList(
1840 std::get<parser::OmpObjectList>(fromClause.t), fromSymbols);
1841 GetSymbolsInObjectList(
1842 std::get<parser::OmpObjectList>(toClause.t), toSymbols);
1844 for (auto &[symbol, source] : toSymbols) {
1845 auto fromSymbol{fromSymbols.find(symbol)};
1846 if (fromSymbol != fromSymbols.end()) {
1847 context_.Say(source,
1848 "A list item ('%s') can only appear in a TO or FROM clause, but not in both."_err_en_US,
1849 symbol->name());
1850 context_.Say(source, "'%s' appears in the TO clause."_because_en_US,
1851 symbol->name());
1852 context_.Say(fromSymbol->second,
1853 "'%s' appears in the FROM clause."_because_en_US,
1854 fromSymbol->first->name());
1860 void OmpStructureChecker::CheckTaskDependenceType(
1861 const parser::OmpTaskDependenceType::Value &x) {
1862 // Common checks for task-dependence-type (DEPEND and UPDATE clauses).
1863 unsigned version{context_.langOptions().OpenMPVersion};
1864 unsigned since{0};
1866 switch (x) {
1867 case parser::OmpTaskDependenceType::Value::In:
1868 case parser::OmpTaskDependenceType::Value::Out:
1869 case parser::OmpTaskDependenceType::Value::Inout:
1870 break;
1871 case parser::OmpTaskDependenceType::Value::Mutexinoutset:
1872 case parser::OmpTaskDependenceType::Value::Depobj:
1873 since = 50;
1874 break;
1875 case parser::OmpTaskDependenceType::Value::Inoutset:
1876 since = 52;
1877 break;
1880 if (version < since) {
1881 context_.Say(GetContext().clauseSource,
1882 "%s task dependence type is not supported in %s, %s"_warn_en_US,
1883 parser::ToUpperCaseLetters(
1884 parser::OmpTaskDependenceType::EnumToString(x)),
1885 ThisVersion(version), TryVersion(since));
1889 void OmpStructureChecker::CheckDependenceType(
1890 const parser::OmpDependenceType::Value &x) {
1891 // Common checks for dependence-type (DEPEND and UPDATE clauses).
1892 unsigned version{context_.langOptions().OpenMPVersion};
1893 unsigned deprecatedIn{~0u};
1895 switch (x) {
1896 case parser::OmpDependenceType::Value::Source:
1897 case parser::OmpDependenceType::Value::Sink:
1898 deprecatedIn = 52;
1899 break;
1902 if (version >= deprecatedIn) {
1903 context_.Say(GetContext().clauseSource,
1904 "%s dependence type is deprecated in %s"_warn_en_US,
1905 parser::ToUpperCaseLetters(parser::OmpDependenceType::EnumToString(x)),
1906 ThisVersion(deprecatedIn));
1910 void OmpStructureChecker::Enter(
1911 const parser::OpenMPSimpleStandaloneConstruct &x) {
1912 const auto &dir{std::get<parser::OmpSimpleStandaloneDirective>(x.t)};
1913 PushContextAndClauseSets(dir.source, dir.v);
1914 switch (dir.v) {
1915 case llvm::omp::Directive::OMPD_barrier:
1916 CheckBarrierNesting(x);
1917 break;
1918 case llvm::omp::Directive::OMPD_scan:
1919 CheckScan(x);
1920 break;
1921 default:
1922 break;
1926 void OmpStructureChecker::Leave(
1927 const parser::OpenMPSimpleStandaloneConstruct &x) {
1928 switch (GetContext().directive) {
1929 case llvm::omp::Directive::OMPD_ordered:
1930 // [5.1] 2.19.9 Ordered Construct Restriction
1931 ChecksOnOrderedAsStandalone();
1932 break;
1933 case llvm::omp::Directive::OMPD_target_update:
1934 CheckTargetUpdate();
1935 break;
1936 default:
1937 break;
1939 dirContext_.pop_back();
1942 void OmpStructureChecker::Enter(const parser::OpenMPFlushConstruct &x) {
1943 const auto &dir{std::get<parser::Verbatim>(x.t)};
1944 PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_flush);
1947 void OmpStructureChecker::Leave(const parser::OpenMPFlushConstruct &x) {
1948 if (FindClause(llvm::omp::Clause::OMPC_acquire) ||
1949 FindClause(llvm::omp::Clause::OMPC_release) ||
1950 FindClause(llvm::omp::Clause::OMPC_acq_rel)) {
1951 if (const auto &flushList{
1952 std::get<std::optional<parser::OmpObjectList>>(x.t)}) {
1953 context_.Say(parser::FindSourceLocation(flushList),
1954 "If memory-order-clause is RELEASE, ACQUIRE, or ACQ_REL, list items "
1955 "must not be specified on the FLUSH directive"_err_en_US);
1958 dirContext_.pop_back();
1961 void OmpStructureChecker::Enter(const parser::OpenMPCancelConstruct &x) {
1962 const auto &dir{std::get<parser::Verbatim>(x.t)};
1963 const auto &type{std::get<parser::OmpCancelType>(x.t)};
1964 PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_cancel);
1965 CheckCancellationNest(dir.source, type.v);
1968 void OmpStructureChecker::Leave(const parser::OpenMPCancelConstruct &) {
1969 dirContext_.pop_back();
1972 void OmpStructureChecker::Enter(const parser::OpenMPCriticalConstruct &x) {
1973 const auto &dir{std::get<parser::OmpCriticalDirective>(x.t)};
1974 const auto &endDir{std::get<parser::OmpEndCriticalDirective>(x.t)};
1975 PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_critical);
1976 const auto &block{std::get<parser::Block>(x.t)};
1977 CheckNoBranching(block, llvm::omp::Directive::OMPD_critical, dir.source);
1978 const auto &dirName{std::get<std::optional<parser::Name>>(dir.t)};
1979 const auto &endDirName{std::get<std::optional<parser::Name>>(endDir.t)};
1980 const auto &ompClause{std::get<parser::OmpClauseList>(dir.t)};
1981 if (dirName && endDirName &&
1982 dirName->ToString().compare(endDirName->ToString())) {
1983 context_
1984 .Say(endDirName->source,
1985 parser::MessageFormattedText{
1986 "CRITICAL directive names do not match"_err_en_US})
1987 .Attach(dirName->source, "should be "_en_US);
1988 } else if (dirName && !endDirName) {
1989 context_
1990 .Say(dirName->source,
1991 parser::MessageFormattedText{
1992 "CRITICAL directive names do not match"_err_en_US})
1993 .Attach(dirName->source, "should be NULL"_en_US);
1994 } else if (!dirName && endDirName) {
1995 context_
1996 .Say(endDirName->source,
1997 parser::MessageFormattedText{
1998 "CRITICAL directive names do not match"_err_en_US})
1999 .Attach(endDirName->source, "should be NULL"_en_US);
2001 if (!dirName && !ompClause.source.empty() &&
2002 ompClause.source.NULTerminatedToString() != "hint(omp_sync_hint_none)") {
2003 context_.Say(dir.source,
2004 parser::MessageFormattedText{
2005 "Hint clause other than omp_sync_hint_none cannot be specified for "
2006 "an unnamed CRITICAL directive"_err_en_US});
2008 CheckHintClause<const parser::OmpClauseList>(&ompClause, nullptr);
2011 void OmpStructureChecker::Leave(const parser::OpenMPCriticalConstruct &) {
2012 dirContext_.pop_back();
2015 void OmpStructureChecker::Enter(
2016 const parser::OpenMPCancellationPointConstruct &x) {
2017 const auto &dir{std::get<parser::Verbatim>(x.t)};
2018 const auto &type{std::get<parser::OmpCancelType>(x.t)};
2019 PushContextAndClauseSets(
2020 dir.source, llvm::omp::Directive::OMPD_cancellation_point);
2021 CheckCancellationNest(dir.source, type.v);
2024 void OmpStructureChecker::Leave(
2025 const parser::OpenMPCancellationPointConstruct &) {
2026 dirContext_.pop_back();
2029 void OmpStructureChecker::CheckCancellationNest(
2030 const parser::CharBlock &source, const parser::OmpCancelType::Type &type) {
2031 if (CurrentDirectiveIsNested()) {
2032 // If construct-type-clause is taskgroup, the cancellation construct must be
2033 // closely nested inside a task or a taskloop construct and the cancellation
2034 // region must be closely nested inside a taskgroup region. If
2035 // construct-type-clause is sections, the cancellation construct must be
2036 // closely nested inside a sections or section construct. Otherwise, the
2037 // cancellation construct must be closely nested inside an OpenMP construct
2038 // that matches the type specified in construct-type-clause of the
2039 // cancellation construct.
2040 bool eligibleCancellation{false};
2041 switch (type) {
2042 case parser::OmpCancelType::Type::Taskgroup:
2043 if (llvm::omp::nestedCancelTaskgroupAllowedSet.test(
2044 GetContextParent().directive)) {
2045 eligibleCancellation = true;
2046 if (dirContext_.size() >= 3) {
2047 // Check if the cancellation region is closely nested inside a
2048 // taskgroup region when there are more than two levels of directives
2049 // in the directive context stack.
2050 if (GetContextParent().directive == llvm::omp::Directive::OMPD_task ||
2051 FindClauseParent(llvm::omp::Clause::OMPC_nogroup)) {
2052 for (int i = dirContext_.size() - 3; i >= 0; i--) {
2053 if (dirContext_[i].directive ==
2054 llvm::omp::Directive::OMPD_taskgroup) {
2055 break;
2057 if (llvm::omp::nestedCancelParallelAllowedSet.test(
2058 dirContext_[i].directive)) {
2059 eligibleCancellation = false;
2060 break;
2066 if (!eligibleCancellation) {
2067 context_.Say(source,
2068 "With %s clause, %s construct must be closely nested inside TASK "
2069 "or TASKLOOP construct and %s region must be closely nested inside "
2070 "TASKGROUP region"_err_en_US,
2071 parser::ToUpperCaseLetters(
2072 parser::OmpCancelType::EnumToString(type)),
2073 ContextDirectiveAsFortran(), ContextDirectiveAsFortran());
2075 return;
2076 case parser::OmpCancelType::Type::Sections:
2077 if (llvm::omp::nestedCancelSectionsAllowedSet.test(
2078 GetContextParent().directive)) {
2079 eligibleCancellation = true;
2081 break;
2082 case Fortran::parser::OmpCancelType::Type::Do:
2083 if (llvm::omp::nestedCancelDoAllowedSet.test(
2084 GetContextParent().directive)) {
2085 eligibleCancellation = true;
2087 break;
2088 case parser::OmpCancelType::Type::Parallel:
2089 if (llvm::omp::nestedCancelParallelAllowedSet.test(
2090 GetContextParent().directive)) {
2091 eligibleCancellation = true;
2093 break;
2095 if (!eligibleCancellation) {
2096 context_.Say(source,
2097 "With %s clause, %s construct cannot be closely nested inside %s "
2098 "construct"_err_en_US,
2099 parser::ToUpperCaseLetters(parser::OmpCancelType::EnumToString(type)),
2100 ContextDirectiveAsFortran(),
2101 parser::ToUpperCaseLetters(
2102 getDirectiveName(GetContextParent().directive).str()));
2104 } else {
2105 // The cancellation directive cannot be orphaned.
2106 switch (type) {
2107 case parser::OmpCancelType::Type::Taskgroup:
2108 context_.Say(source,
2109 "%s %s directive is not closely nested inside "
2110 "TASK or TASKLOOP"_err_en_US,
2111 ContextDirectiveAsFortran(),
2112 parser::ToUpperCaseLetters(
2113 parser::OmpCancelType::EnumToString(type)));
2114 break;
2115 case parser::OmpCancelType::Type::Sections:
2116 context_.Say(source,
2117 "%s %s directive is not closely nested inside "
2118 "SECTION or SECTIONS"_err_en_US,
2119 ContextDirectiveAsFortran(),
2120 parser::ToUpperCaseLetters(
2121 parser::OmpCancelType::EnumToString(type)));
2122 break;
2123 case Fortran::parser::OmpCancelType::Type::Do:
2124 context_.Say(source,
2125 "%s %s directive is not closely nested inside "
2126 "the construct that matches the DO clause type"_err_en_US,
2127 ContextDirectiveAsFortran(),
2128 parser::ToUpperCaseLetters(
2129 parser::OmpCancelType::EnumToString(type)));
2130 break;
2131 case parser::OmpCancelType::Type::Parallel:
2132 context_.Say(source,
2133 "%s %s directive is not closely nested inside "
2134 "the construct that matches the PARALLEL clause type"_err_en_US,
2135 ContextDirectiveAsFortran(),
2136 parser::ToUpperCaseLetters(
2137 parser::OmpCancelType::EnumToString(type)));
2138 break;
2143 void OmpStructureChecker::Enter(const parser::OmpEndBlockDirective &x) {
2144 const auto &dir{std::get<parser::OmpBlockDirective>(x.t)};
2145 ResetPartialContext(dir.source);
2146 switch (dir.v) {
2147 case llvm::omp::Directive::OMPD_scope:
2148 PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_end_scope);
2149 break;
2150 // 2.7.3 end-single-clause -> copyprivate-clause |
2151 // nowait-clause
2152 case llvm::omp::Directive::OMPD_single:
2153 PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_end_single);
2154 break;
2155 // 2.7.4 end-workshare -> END WORKSHARE [nowait-clause]
2156 case llvm::omp::Directive::OMPD_workshare:
2157 PushContextAndClauseSets(
2158 dir.source, llvm::omp::Directive::OMPD_end_workshare);
2159 break;
2160 default:
2161 // no clauses are allowed
2162 break;
2166 // TODO: Verify the popping of dirContext requirement after nowait
2167 // implementation, as there is an implicit barrier at the end of the worksharing
2168 // constructs unless a nowait clause is specified. Only OMPD_end_single and
2169 // end_workshareare popped as they are pushed while entering the
2170 // EndBlockDirective.
2171 void OmpStructureChecker::Leave(const parser::OmpEndBlockDirective &x) {
2172 if ((GetContext().directive == llvm::omp::Directive::OMPD_end_scope) ||
2173 (GetContext().directive == llvm::omp::Directive::OMPD_end_single) ||
2174 (GetContext().directive == llvm::omp::Directive::OMPD_end_workshare)) {
2175 dirContext_.pop_back();
2179 inline void OmpStructureChecker::ErrIfAllocatableVariable(
2180 const parser::Variable &var) {
2181 // Err out if the given symbol has
2182 // ALLOCATABLE attribute
2183 if (const auto *e{GetExpr(context_, var)})
2184 for (const Symbol &symbol : evaluate::CollectSymbols(*e))
2185 if (IsAllocatable(symbol)) {
2186 const auto &designator =
2187 std::get<common::Indirection<parser::Designator>>(var.u);
2188 const auto *dataRef =
2189 std::get_if<Fortran::parser::DataRef>(&designator.value().u);
2190 const Fortran::parser::Name *name =
2191 dataRef ? std::get_if<Fortran::parser::Name>(&dataRef->u) : nullptr;
2192 if (name)
2193 context_.Say(name->source,
2194 "%s must not have ALLOCATABLE "
2195 "attribute"_err_en_US,
2196 name->ToString());
2200 inline void OmpStructureChecker::ErrIfLHSAndRHSSymbolsMatch(
2201 const parser::Variable &var, const parser::Expr &expr) {
2202 // Err out if the symbol on the LHS is also used on the RHS of the assignment
2203 // statement
2204 const auto *e{GetExpr(context_, expr)};
2205 const auto *v{GetExpr(context_, var)};
2206 if (e && v) {
2207 auto vSyms{evaluate::GetSymbolVector(*v)};
2208 const Symbol &varSymbol = vSyms.front();
2209 for (const Symbol &symbol : evaluate::GetSymbolVector(*e)) {
2210 if (varSymbol == symbol) {
2211 const Fortran::common::Indirection<Fortran::parser::Designator>
2212 *designator = std::get_if<
2213 Fortran::common::Indirection<Fortran::parser::Designator>>(
2214 &expr.u);
2215 if (designator) {
2216 auto *z{var.typedExpr.get()};
2217 auto *c{expr.typedExpr.get()};
2218 if (z->v == c->v) {
2219 context_.Say(expr.source,
2220 "RHS expression on atomic assignment statement cannot access '%s'"_err_en_US,
2221 var.GetSource());
2223 } else {
2224 context_.Say(expr.source,
2225 "RHS expression on atomic assignment statement cannot access '%s'"_err_en_US,
2226 var.GetSource());
2233 inline void OmpStructureChecker::ErrIfNonScalarAssignmentStmt(
2234 const parser::Variable &var, const parser::Expr &expr) {
2235 // Err out if either the variable on the LHS or the expression on the RHS of
2236 // the assignment statement are non-scalar (i.e. have rank > 0 or is of
2237 // CHARACTER type)
2238 const auto *e{GetExpr(context_, expr)};
2239 const auto *v{GetExpr(context_, var)};
2240 if (e && v) {
2241 if (e->Rank() != 0 ||
2242 (e->GetType().has_value() &&
2243 e->GetType().value().category() == common::TypeCategory::Character))
2244 context_.Say(expr.source,
2245 "Expected scalar expression "
2246 "on the RHS of atomic assignment "
2247 "statement"_err_en_US);
2248 if (v->Rank() != 0 ||
2249 (v->GetType().has_value() &&
2250 v->GetType()->category() == common::TypeCategory::Character))
2251 context_.Say(var.GetSource(),
2252 "Expected scalar variable "
2253 "on the LHS of atomic assignment "
2254 "statement"_err_en_US);
2258 template <typename T, typename D>
2259 bool OmpStructureChecker::IsOperatorValid(const T &node, const D &variable) {
2260 using AllowedBinaryOperators =
2261 std::variant<parser::Expr::Add, parser::Expr::Multiply,
2262 parser::Expr::Subtract, parser::Expr::Divide, parser::Expr::AND,
2263 parser::Expr::OR, parser::Expr::EQV, parser::Expr::NEQV>;
2264 using BinaryOperators = std::variant<parser::Expr::Add,
2265 parser::Expr::Multiply, parser::Expr::Subtract, parser::Expr::Divide,
2266 parser::Expr::AND, parser::Expr::OR, parser::Expr::EQV,
2267 parser::Expr::NEQV, parser::Expr::Power, parser::Expr::Concat,
2268 parser::Expr::LT, parser::Expr::LE, parser::Expr::EQ, parser::Expr::NE,
2269 parser::Expr::GE, parser::Expr::GT>;
2271 if constexpr (common::HasMember<T, BinaryOperators>) {
2272 const auto &variableName{variable.GetSource().ToString()};
2273 const auto &exprLeft{std::get<0>(node.t)};
2274 const auto &exprRight{std::get<1>(node.t)};
2275 if ((exprLeft.value().source.ToString() != variableName) &&
2276 (exprRight.value().source.ToString() != variableName)) {
2277 context_.Say(variable.GetSource(),
2278 "Atomic update statement should be of form "
2279 "`%s = %s operator expr` OR `%s = expr operator %s`"_err_en_US,
2280 variableName, variableName, variableName, variableName);
2282 return common::HasMember<T, AllowedBinaryOperators>;
2284 return false;
2287 void OmpStructureChecker::CheckAtomicCaptureStmt(
2288 const parser::AssignmentStmt &assignmentStmt) {
2289 const auto &var{std::get<parser::Variable>(assignmentStmt.t)};
2290 const auto &expr{std::get<parser::Expr>(assignmentStmt.t)};
2291 common::visit(
2292 common::visitors{
2293 [&](const common::Indirection<parser::Designator> &designator) {
2294 const auto *dataRef =
2295 std::get_if<Fortran::parser::DataRef>(&designator.value().u);
2296 const auto *name = dataRef
2297 ? std::get_if<Fortran::parser::Name>(&dataRef->u)
2298 : nullptr;
2299 if (name && IsAllocatable(*name->symbol))
2300 context_.Say(name->source,
2301 "%s must not have ALLOCATABLE "
2302 "attribute"_err_en_US,
2303 name->ToString());
2305 [&](const auto &) {
2306 // Anything other than a `parser::Designator` is not allowed
2307 context_.Say(expr.source,
2308 "Expected scalar variable "
2309 "of intrinsic type on RHS of atomic "
2310 "assignment statement"_err_en_US);
2312 expr.u);
2313 ErrIfLHSAndRHSSymbolsMatch(var, expr);
2314 ErrIfNonScalarAssignmentStmt(var, expr);
2317 void OmpStructureChecker::CheckAtomicWriteStmt(
2318 const parser::AssignmentStmt &assignmentStmt) {
2319 const auto &var{std::get<parser::Variable>(assignmentStmt.t)};
2320 const auto &expr{std::get<parser::Expr>(assignmentStmt.t)};
2321 ErrIfAllocatableVariable(var);
2322 ErrIfLHSAndRHSSymbolsMatch(var, expr);
2323 ErrIfNonScalarAssignmentStmt(var, expr);
2326 void OmpStructureChecker::CheckAtomicUpdateStmt(
2327 const parser::AssignmentStmt &assignment) {
2328 const auto &expr{std::get<parser::Expr>(assignment.t)};
2329 const auto &var{std::get<parser::Variable>(assignment.t)};
2330 bool isIntrinsicProcedure{false};
2331 bool isValidOperator{false};
2332 common::visit(
2333 common::visitors{
2334 [&](const common::Indirection<parser::FunctionReference> &x) {
2335 isIntrinsicProcedure = true;
2336 const auto &procedureDesignator{
2337 std::get<parser::ProcedureDesignator>(x.value().v.t)};
2338 const parser::Name *name{
2339 std::get_if<parser::Name>(&procedureDesignator.u)};
2340 if (name &&
2341 !(name->source == "max" || name->source == "min" ||
2342 name->source == "iand" || name->source == "ior" ||
2343 name->source == "ieor")) {
2344 context_.Say(expr.source,
2345 "Invalid intrinsic procedure name in "
2346 "OpenMP ATOMIC (UPDATE) statement"_err_en_US);
2349 [&](const auto &x) {
2350 if (!IsOperatorValid(x, var)) {
2351 context_.Say(expr.source,
2352 "Invalid or missing operator in atomic update "
2353 "statement"_err_en_US);
2354 } else
2355 isValidOperator = true;
2358 expr.u);
2359 if (const auto *e{GetExpr(context_, expr)}) {
2360 const auto *v{GetExpr(context_, var)};
2361 if (e->Rank() != 0 ||
2362 (e->GetType().has_value() &&
2363 e->GetType().value().category() == common::TypeCategory::Character))
2364 context_.Say(expr.source,
2365 "Expected scalar expression "
2366 "on the RHS of atomic update assignment "
2367 "statement"_err_en_US);
2368 if (v->Rank() != 0 ||
2369 (v->GetType().has_value() &&
2370 v->GetType()->category() == common::TypeCategory::Character))
2371 context_.Say(var.GetSource(),
2372 "Expected scalar variable "
2373 "on the LHS of atomic update assignment "
2374 "statement"_err_en_US);
2375 auto vSyms{evaluate::GetSymbolVector(*v)};
2376 const Symbol &varSymbol = vSyms.front();
2377 int numOfSymbolMatches{0};
2378 SymbolVector exprSymbols{evaluate::GetSymbolVector(*e)};
2379 for (const Symbol &symbol : exprSymbols) {
2380 if (varSymbol == symbol) {
2381 numOfSymbolMatches++;
2384 if (isIntrinsicProcedure) {
2385 std::string varName = var.GetSource().ToString();
2386 if (numOfSymbolMatches != 1)
2387 context_.Say(expr.source,
2388 "Intrinsic procedure"
2389 " arguments in atomic update statement"
2390 " must have exactly one occurence of '%s'"_err_en_US,
2391 varName);
2392 else if (varSymbol != exprSymbols.front() &&
2393 varSymbol != exprSymbols.back())
2394 context_.Say(expr.source,
2395 "Atomic update statement "
2396 "should be of the form `%s = intrinsic_procedure(%s, expr_list)` "
2397 "OR `%s = intrinsic_procedure(expr_list, %s)`"_err_en_US,
2398 varName, varName, varName, varName);
2399 } else if (isValidOperator) {
2400 if (numOfSymbolMatches != 1)
2401 context_.Say(expr.source,
2402 "Exactly one occurence of '%s' "
2403 "expected on the RHS of atomic update assignment statement"_err_en_US,
2404 var.GetSource().ToString());
2408 ErrIfAllocatableVariable(var);
2411 // TODO: Allow cond-update-stmt once compare clause is supported.
2412 void OmpStructureChecker::CheckAtomicCaptureConstruct(
2413 const parser::OmpAtomicCapture &atomicCaptureConstruct) {
2414 const Fortran::parser::AssignmentStmt &stmt1 =
2415 std::get<Fortran::parser::OmpAtomicCapture::Stmt1>(
2416 atomicCaptureConstruct.t)
2417 .v.statement;
2418 const auto &stmt1Var{std::get<Fortran::parser::Variable>(stmt1.t)};
2419 const auto &stmt1Expr{std::get<Fortran::parser::Expr>(stmt1.t)};
2421 const Fortran::parser::AssignmentStmt &stmt2 =
2422 std::get<Fortran::parser::OmpAtomicCapture::Stmt2>(
2423 atomicCaptureConstruct.t)
2424 .v.statement;
2425 const auto &stmt2Var{std::get<Fortran::parser::Variable>(stmt2.t)};
2426 const auto &stmt2Expr{std::get<Fortran::parser::Expr>(stmt2.t)};
2428 if (Fortran::semantics::checkForSingleVariableOnRHS(stmt1)) {
2429 CheckAtomicCaptureStmt(stmt1);
2430 if (Fortran::semantics::checkForSymbolMatch(stmt2)) {
2431 // ATOMIC CAPTURE construct is of the form [capture-stmt, update-stmt]
2432 CheckAtomicUpdateStmt(stmt2);
2433 } else {
2434 // ATOMIC CAPTURE construct is of the form [capture-stmt, write-stmt]
2435 CheckAtomicWriteStmt(stmt2);
2437 auto *v{stmt2Var.typedExpr.get()};
2438 auto *e{stmt1Expr.typedExpr.get()};
2439 if (v && e && !(v->v == e->v)) {
2440 context_.Say(stmt1Expr.source,
2441 "Captured variable/array element/derived-type component %s expected to be assigned in the second statement of ATOMIC CAPTURE construct"_err_en_US,
2442 stmt1Expr.source);
2444 } else if (Fortran::semantics::checkForSymbolMatch(stmt1) &&
2445 Fortran::semantics::checkForSingleVariableOnRHS(stmt2)) {
2446 // ATOMIC CAPTURE construct is of the form [update-stmt, capture-stmt]
2447 CheckAtomicUpdateStmt(stmt1);
2448 CheckAtomicCaptureStmt(stmt2);
2449 // Variable updated in stmt1 should be captured in stmt2
2450 auto *v{stmt1Var.typedExpr.get()};
2451 auto *e{stmt2Expr.typedExpr.get()};
2452 if (v && e && !(v->v == e->v)) {
2453 context_.Say(stmt1Var.GetSource(),
2454 "Updated variable/array element/derived-type component %s expected to be captured in the second statement of ATOMIC CAPTURE construct"_err_en_US,
2455 stmt1Var.GetSource());
2457 } else {
2458 context_.Say(stmt1Expr.source,
2459 "Invalid ATOMIC CAPTURE construct statements. Expected one of [update-stmt, capture-stmt], [capture-stmt, update-stmt], or [capture-stmt, write-stmt]"_err_en_US);
2463 void OmpStructureChecker::CheckAtomicMemoryOrderClause(
2464 const parser::OmpAtomicClauseList *leftHandClauseList,
2465 const parser::OmpAtomicClauseList *rightHandClauseList) {
2466 int numMemoryOrderClause = 0;
2467 auto checkForValidMemoryOrderClause =
2468 [&](const parser::OmpAtomicClauseList *clauseList) {
2469 for (const auto &clause : clauseList->v) {
2470 if (std::get_if<Fortran::parser::OmpMemoryOrderClause>(&clause.u)) {
2471 numMemoryOrderClause++;
2472 if (numMemoryOrderClause > 1) {
2473 context_.Say(clause.source,
2474 "More than one memory order clause not allowed on "
2475 "OpenMP Atomic construct"_err_en_US);
2476 return;
2481 if (leftHandClauseList) {
2482 checkForValidMemoryOrderClause(leftHandClauseList);
2484 if (rightHandClauseList) {
2485 checkForValidMemoryOrderClause(rightHandClauseList);
2489 void OmpStructureChecker::Enter(const parser::OpenMPAtomicConstruct &x) {
2490 common::visit(
2491 common::visitors{
2492 [&](const parser::OmpAtomic &atomicConstruct) {
2493 const auto &dir{std::get<parser::Verbatim>(atomicConstruct.t)};
2494 PushContextAndClauseSets(
2495 dir.source, llvm::omp::Directive::OMPD_atomic);
2496 CheckAtomicUpdateStmt(
2497 std::get<parser::Statement<parser::AssignmentStmt>>(
2498 atomicConstruct.t)
2499 .statement);
2500 CheckAtomicMemoryOrderClause(
2501 &std::get<parser::OmpAtomicClauseList>(atomicConstruct.t),
2502 nullptr);
2503 CheckHintClause<const parser::OmpAtomicClauseList>(
2504 &std::get<parser::OmpAtomicClauseList>(atomicConstruct.t),
2505 nullptr);
2507 [&](const parser::OmpAtomicUpdate &atomicUpdate) {
2508 const auto &dir{std::get<parser::Verbatim>(atomicUpdate.t)};
2509 PushContextAndClauseSets(
2510 dir.source, llvm::omp::Directive::OMPD_atomic);
2511 CheckAtomicUpdateStmt(
2512 std::get<parser::Statement<parser::AssignmentStmt>>(
2513 atomicUpdate.t)
2514 .statement);
2515 CheckAtomicMemoryOrderClause(
2516 &std::get<0>(atomicUpdate.t), &std::get<2>(atomicUpdate.t));
2517 CheckHintClause<const parser::OmpAtomicClauseList>(
2518 &std::get<0>(atomicUpdate.t), &std::get<2>(atomicUpdate.t));
2520 [&](const parser::OmpAtomicRead &atomicRead) {
2521 const auto &dir{std::get<parser::Verbatim>(atomicRead.t)};
2522 PushContextAndClauseSets(
2523 dir.source, llvm::omp::Directive::OMPD_atomic);
2524 CheckAtomicMemoryOrderClause(
2525 &std::get<0>(atomicRead.t), &std::get<2>(atomicRead.t));
2526 CheckHintClause<const parser::OmpAtomicClauseList>(
2527 &std::get<0>(atomicRead.t), &std::get<2>(atomicRead.t));
2528 CheckAtomicCaptureStmt(
2529 std::get<parser::Statement<parser::AssignmentStmt>>(
2530 atomicRead.t)
2531 .statement);
2533 [&](const parser::OmpAtomicWrite &atomicWrite) {
2534 const auto &dir{std::get<parser::Verbatim>(atomicWrite.t)};
2535 PushContextAndClauseSets(
2536 dir.source, llvm::omp::Directive::OMPD_atomic);
2537 CheckAtomicMemoryOrderClause(
2538 &std::get<0>(atomicWrite.t), &std::get<2>(atomicWrite.t));
2539 CheckHintClause<const parser::OmpAtomicClauseList>(
2540 &std::get<0>(atomicWrite.t), &std::get<2>(atomicWrite.t));
2541 CheckAtomicWriteStmt(
2542 std::get<parser::Statement<parser::AssignmentStmt>>(
2543 atomicWrite.t)
2544 .statement);
2546 [&](const parser::OmpAtomicCapture &atomicCapture) {
2547 const auto &dir{std::get<parser::Verbatim>(atomicCapture.t)};
2548 PushContextAndClauseSets(
2549 dir.source, llvm::omp::Directive::OMPD_atomic);
2550 CheckAtomicMemoryOrderClause(
2551 &std::get<0>(atomicCapture.t), &std::get<2>(atomicCapture.t));
2552 CheckHintClause<const parser::OmpAtomicClauseList>(
2553 &std::get<0>(atomicCapture.t), &std::get<2>(atomicCapture.t));
2554 CheckAtomicCaptureConstruct(atomicCapture);
2557 x.u);
2560 void OmpStructureChecker::Leave(const parser::OpenMPAtomicConstruct &) {
2561 dirContext_.pop_back();
2564 // Clauses
2565 // Mainly categorized as
2566 // 1. Checks on 'OmpClauseList' from 'parse-tree.h'.
2567 // 2. Checks on clauses which fall under 'struct OmpClause' from parse-tree.h.
2568 // 3. Checks on clauses which are not in 'struct OmpClause' from parse-tree.h.
2570 void OmpStructureChecker::Leave(const parser::OmpClauseList &) {
2571 // 2.7.1 Loop Construct Restriction
2572 if (llvm::omp::allDoSet.test(GetContext().directive)) {
2573 if (auto *clause{FindClause(llvm::omp::Clause::OMPC_schedule)}) {
2574 // only one schedule clause is allowed
2575 const auto &schedClause{std::get<parser::OmpClause::Schedule>(clause->u)};
2576 if (ScheduleModifierHasType(schedClause.v,
2577 parser::OmpScheduleModifierType::ModType::Nonmonotonic)) {
2578 if (FindClause(llvm::omp::Clause::OMPC_ordered)) {
2579 context_.Say(clause->source,
2580 "The NONMONOTONIC modifier cannot be specified "
2581 "if an ORDERED clause is specified"_err_en_US);
2583 if (ScheduleModifierHasType(schedClause.v,
2584 parser::OmpScheduleModifierType::ModType::Monotonic)) {
2585 context_.Say(clause->source,
2586 "The MONOTONIC and NONMONOTONIC modifiers "
2587 "cannot be both specified"_err_en_US);
2592 if (auto *clause{FindClause(llvm::omp::Clause::OMPC_ordered)}) {
2593 // only one ordered clause is allowed
2594 const auto &orderedClause{
2595 std::get<parser::OmpClause::Ordered>(clause->u)};
2597 if (orderedClause.v) {
2598 CheckNotAllowedIfClause(
2599 llvm::omp::Clause::OMPC_ordered, {llvm::omp::Clause::OMPC_linear});
2601 if (auto *clause2{FindClause(llvm::omp::Clause::OMPC_collapse)}) {
2602 const auto &collapseClause{
2603 std::get<parser::OmpClause::Collapse>(clause2->u)};
2604 // ordered and collapse both have parameters
2605 if (const auto orderedValue{GetIntValue(orderedClause.v)}) {
2606 if (const auto collapseValue{GetIntValue(collapseClause.v)}) {
2607 if (*orderedValue > 0 && *orderedValue < *collapseValue) {
2608 context_.Say(clause->source,
2609 "The parameter of the ORDERED clause must be "
2610 "greater than or equal to "
2611 "the parameter of the COLLAPSE clause"_err_en_US);
2618 // TODO: ordered region binding check (requires nesting implementation)
2620 } // doSet
2622 // 2.8.1 Simd Construct Restriction
2623 if (llvm::omp::allSimdSet.test(GetContext().directive)) {
2624 if (auto *clause{FindClause(llvm::omp::Clause::OMPC_simdlen)}) {
2625 if (auto *clause2{FindClause(llvm::omp::Clause::OMPC_safelen)}) {
2626 const auto &simdlenClause{
2627 std::get<parser::OmpClause::Simdlen>(clause->u)};
2628 const auto &safelenClause{
2629 std::get<parser::OmpClause::Safelen>(clause2->u)};
2630 // simdlen and safelen both have parameters
2631 if (const auto simdlenValue{GetIntValue(simdlenClause.v)}) {
2632 if (const auto safelenValue{GetIntValue(safelenClause.v)}) {
2633 if (*safelenValue > 0 && *simdlenValue > *safelenValue) {
2634 context_.Say(clause->source,
2635 "The parameter of the SIMDLEN clause must be less than or "
2636 "equal to the parameter of the SAFELEN clause"_err_en_US);
2643 // 2.11.5 Simd construct restriction (OpenMP 5.1)
2644 if (auto *sl_clause{FindClause(llvm::omp::Clause::OMPC_safelen)}) {
2645 if (auto *o_clause{FindClause(llvm::omp::Clause::OMPC_order)}) {
2646 const auto &orderClause{
2647 std::get<parser::OmpClause::Order>(o_clause->u)};
2648 if (std::get<parser::OmpOrderClause::Type>(orderClause.v.t) ==
2649 parser::OmpOrderClause::Type::Concurrent) {
2650 context_.Say(sl_clause->source,
2651 "The `SAFELEN` clause cannot appear in the `SIMD` directive "
2652 "with `ORDER(CONCURRENT)` clause"_err_en_US);
2657 // Sema checks related to presence of multiple list items within the same
2658 // clause
2659 CheckMultListItems();
2660 } // SIMD
2662 // 2.7.3 Single Construct Restriction
2663 if (GetContext().directive == llvm::omp::Directive::OMPD_end_single) {
2664 CheckNotAllowedIfClause(
2665 llvm::omp::Clause::OMPC_copyprivate, {llvm::omp::Clause::OMPC_nowait});
2668 auto testThreadprivateVarErr = [&](Symbol sym, parser::Name name,
2669 llvmOmpClause clauseTy) {
2670 if (sym.test(Symbol::Flag::OmpThreadprivate))
2671 context_.Say(name.source,
2672 "A THREADPRIVATE variable cannot be in %s clause"_err_en_US,
2673 parser::ToUpperCaseLetters(getClauseName(clauseTy).str()));
2676 // [5.1] 2.21.2 Threadprivate Directive Restriction
2677 OmpClauseSet threadprivateAllowedSet{llvm::omp::Clause::OMPC_copyin,
2678 llvm::omp::Clause::OMPC_copyprivate, llvm::omp::Clause::OMPC_schedule,
2679 llvm::omp::Clause::OMPC_num_threads, llvm::omp::Clause::OMPC_thread_limit,
2680 llvm::omp::Clause::OMPC_if};
2681 for (auto it : GetContext().clauseInfo) {
2682 llvmOmpClause type = it.first;
2683 const auto *clause = it.second;
2684 if (!threadprivateAllowedSet.test(type)) {
2685 if (const auto *objList{GetOmpObjectList(*clause)}) {
2686 for (const auto &ompObject : objList->v) {
2687 common::visit(
2688 common::visitors{
2689 [&](const parser::Designator &) {
2690 if (const auto *name{
2691 parser::Unwrap<parser::Name>(ompObject)}) {
2692 if (name->symbol) {
2693 testThreadprivateVarErr(
2694 name->symbol->GetUltimate(), *name, type);
2698 [&](const parser::Name &name) {
2699 if (name.symbol) {
2700 for (const auto &mem :
2701 name.symbol->get<CommonBlockDetails>().objects()) {
2702 testThreadprivateVarErr(mem->GetUltimate(), name, type);
2703 break;
2708 ompObject.u);
2714 CheckRequireAtLeastOneOf();
2717 void OmpStructureChecker::Enter(const parser::OmpClause &x) {
2718 SetContextClause(x);
2720 // The visitors for these clauses do their own checks.
2721 switch (x.Id()) {
2722 case llvm::omp::Clause::OMPC_copyprivate:
2723 case llvm::omp::Clause::OMPC_enter:
2724 case llvm::omp::Clause::OMPC_lastprivate:
2725 case llvm::omp::Clause::OMPC_reduction:
2726 case llvm::omp::Clause::OMPC_to:
2727 return;
2728 default:
2729 break;
2732 if (const parser::OmpObjectList *objList{GetOmpObjectList(x)}) {
2733 SymbolSourceMap symbols;
2734 GetSymbolsInObjectList(*objList, symbols);
2735 for (const auto &[sym, source] : symbols) {
2736 if (!IsVariableListItem(*sym)) {
2737 deferredNonVariables_.insert({sym, source});
2743 // Following clauses do not have a separate node in parse-tree.h.
2744 CHECK_SIMPLE_CLAUSE(Absent, OMPC_absent)
2745 CHECK_SIMPLE_CLAUSE(AcqRel, OMPC_acq_rel)
2746 CHECK_SIMPLE_CLAUSE(Acquire, OMPC_acquire)
2747 CHECK_SIMPLE_CLAUSE(Affinity, OMPC_affinity)
2748 CHECK_SIMPLE_CLAUSE(Capture, OMPC_capture)
2749 CHECK_SIMPLE_CLAUSE(Contains, OMPC_contains)
2750 CHECK_SIMPLE_CLAUSE(Default, OMPC_default)
2751 CHECK_SIMPLE_CLAUSE(Depobj, OMPC_depobj)
2752 CHECK_SIMPLE_CLAUSE(Detach, OMPC_detach)
2753 CHECK_SIMPLE_CLAUSE(DeviceType, OMPC_device_type)
2754 CHECK_SIMPLE_CLAUSE(DistSchedule, OMPC_dist_schedule)
2755 CHECK_SIMPLE_CLAUSE(Exclusive, OMPC_exclusive)
2756 CHECK_SIMPLE_CLAUSE(Final, OMPC_final)
2757 CHECK_SIMPLE_CLAUSE(Flush, OMPC_flush)
2758 CHECK_SIMPLE_CLAUSE(Full, OMPC_full)
2759 CHECK_SIMPLE_CLAUSE(Grainsize, OMPC_grainsize)
2760 CHECK_SIMPLE_CLAUSE(Hint, OMPC_hint)
2761 CHECK_SIMPLE_CLAUSE(Holds, OMPC_holds)
2762 CHECK_SIMPLE_CLAUSE(Inclusive, OMPC_inclusive)
2763 CHECK_SIMPLE_CLAUSE(InReduction, OMPC_in_reduction)
2764 CHECK_SIMPLE_CLAUSE(Match, OMPC_match)
2765 CHECK_SIMPLE_CLAUSE(Nontemporal, OMPC_nontemporal)
2766 CHECK_SIMPLE_CLAUSE(NumTasks, OMPC_num_tasks)
2767 CHECK_SIMPLE_CLAUSE(Order, OMPC_order)
2768 CHECK_SIMPLE_CLAUSE(Read, OMPC_read)
2769 CHECK_SIMPLE_CLAUSE(Threadprivate, OMPC_threadprivate)
2770 CHECK_SIMPLE_CLAUSE(Threads, OMPC_threads)
2771 CHECK_SIMPLE_CLAUSE(Inbranch, OMPC_inbranch)
2772 CHECK_SIMPLE_CLAUSE(Link, OMPC_link)
2773 CHECK_SIMPLE_CLAUSE(Indirect, OMPC_indirect)
2774 CHECK_SIMPLE_CLAUSE(Mergeable, OMPC_mergeable)
2775 CHECK_SIMPLE_CLAUSE(NoOpenmp, OMPC_no_openmp)
2776 CHECK_SIMPLE_CLAUSE(NoOpenmpRoutines, OMPC_no_openmp_routines)
2777 CHECK_SIMPLE_CLAUSE(NoParallelism, OMPC_no_parallelism)
2778 CHECK_SIMPLE_CLAUSE(Nogroup, OMPC_nogroup)
2779 CHECK_SIMPLE_CLAUSE(Notinbranch, OMPC_notinbranch)
2780 CHECK_SIMPLE_CLAUSE(Partial, OMPC_partial)
2781 CHECK_SIMPLE_CLAUSE(ProcBind, OMPC_proc_bind)
2782 CHECK_SIMPLE_CLAUSE(Release, OMPC_release)
2783 CHECK_SIMPLE_CLAUSE(Relaxed, OMPC_relaxed)
2784 CHECK_SIMPLE_CLAUSE(SeqCst, OMPC_seq_cst)
2785 CHECK_SIMPLE_CLAUSE(Simd, OMPC_simd)
2786 CHECK_SIMPLE_CLAUSE(Sizes, OMPC_sizes)
2787 CHECK_SIMPLE_CLAUSE(Permutation, OMPC_permutation)
2788 CHECK_SIMPLE_CLAUSE(TaskReduction, OMPC_task_reduction)
2789 CHECK_SIMPLE_CLAUSE(Uniform, OMPC_uniform)
2790 CHECK_SIMPLE_CLAUSE(Unknown, OMPC_unknown)
2791 CHECK_SIMPLE_CLAUSE(Untied, OMPC_untied)
2792 CHECK_SIMPLE_CLAUSE(UsesAllocators, OMPC_uses_allocators)
2793 CHECK_SIMPLE_CLAUSE(Write, OMPC_write)
2794 CHECK_SIMPLE_CLAUSE(Init, OMPC_init)
2795 CHECK_SIMPLE_CLAUSE(Use, OMPC_use)
2796 CHECK_SIMPLE_CLAUSE(Novariants, OMPC_novariants)
2797 CHECK_SIMPLE_CLAUSE(Nocontext, OMPC_nocontext)
2798 CHECK_SIMPLE_CLAUSE(At, OMPC_at)
2799 CHECK_SIMPLE_CLAUSE(Severity, OMPC_severity)
2800 CHECK_SIMPLE_CLAUSE(Message, OMPC_message)
2801 CHECK_SIMPLE_CLAUSE(Filter, OMPC_filter)
2802 CHECK_SIMPLE_CLAUSE(When, OMPC_when)
2803 CHECK_SIMPLE_CLAUSE(AdjustArgs, OMPC_adjust_args)
2804 CHECK_SIMPLE_CLAUSE(AppendArgs, OMPC_append_args)
2805 CHECK_SIMPLE_CLAUSE(MemoryOrder, OMPC_memory_order)
2806 CHECK_SIMPLE_CLAUSE(Bind, OMPC_bind)
2807 CHECK_SIMPLE_CLAUSE(Align, OMPC_align)
2808 CHECK_SIMPLE_CLAUSE(Compare, OMPC_compare)
2809 CHECK_SIMPLE_CLAUSE(CancellationConstructType, OMPC_cancellation_construct_type)
2810 CHECK_SIMPLE_CLAUSE(OmpxAttribute, OMPC_ompx_attribute)
2811 CHECK_SIMPLE_CLAUSE(OmpxBare, OMPC_ompx_bare)
2812 CHECK_SIMPLE_CLAUSE(Fail, OMPC_fail)
2813 CHECK_SIMPLE_CLAUSE(Weak, OMPC_weak)
2815 CHECK_REQ_SCALAR_INT_CLAUSE(NumTeams, OMPC_num_teams)
2816 CHECK_REQ_SCALAR_INT_CLAUSE(NumThreads, OMPC_num_threads)
2817 CHECK_REQ_SCALAR_INT_CLAUSE(OmpxDynCgroupMem, OMPC_ompx_dyn_cgroup_mem)
2818 CHECK_REQ_SCALAR_INT_CLAUSE(Priority, OMPC_priority)
2819 CHECK_REQ_SCALAR_INT_CLAUSE(ThreadLimit, OMPC_thread_limit)
2821 CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(Collapse, OMPC_collapse)
2822 CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(Safelen, OMPC_safelen)
2823 CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(Simdlen, OMPC_simdlen)
2825 // Restrictions specific to each clause are implemented apart from the
2826 // generalized restrictions.
2828 void OmpStructureChecker::Enter(const parser::OmpClause::Destroy &x) {
2829 CheckAllowedClause(llvm::omp::Clause::OMPC_destroy);
2831 llvm::omp::Directive dir{GetContext().directive};
2832 unsigned version{context_.langOptions().OpenMPVersion};
2833 if (dir == llvm::omp::Directive::OMPD_depobj) {
2834 unsigned argSince{52}, noargDeprecatedIn{52};
2835 if (x.v) {
2836 if (version < argSince) {
2837 context_.Say(GetContext().clauseSource,
2838 "The object parameter in DESTROY clause on DEPOPJ construct is not allowed in %s, %s"_warn_en_US,
2839 ThisVersion(version), TryVersion(argSince));
2841 } else {
2842 if (version >= noargDeprecatedIn) {
2843 context_.Say(GetContext().clauseSource,
2844 "The DESTROY clause without argument on DEPOBJ construct is deprecated in %s"_warn_en_US,
2845 ThisVersion(noargDeprecatedIn));
2851 void OmpStructureChecker::Enter(const parser::OmpClause::Reduction &x) {
2852 CheckAllowedClause(llvm::omp::Clause::OMPC_reduction);
2853 if (CheckReductionOperators(x)) {
2854 CheckReductionTypeList(x);
2856 if (const auto &maybeModifier{
2857 std::get<std::optional<ReductionModifier>>(x.v.t)}) {
2858 const ReductionModifier modifier{*maybeModifier};
2859 CheckReductionModifier(modifier);
2863 bool OmpStructureChecker::CheckReductionOperators(
2864 const parser::OmpClause::Reduction &x) {
2866 const auto &definedOp{std::get<parser::OmpReductionIdentifier>(x.v.t)};
2867 bool ok = false;
2868 common::visit(
2869 common::visitors{
2870 [&](const parser::DefinedOperator &dOpr) {
2871 if (const auto *intrinsicOp{
2872 std::get_if<parser::DefinedOperator::IntrinsicOperator>(
2873 &dOpr.u)}) {
2874 ok = CheckIntrinsicOperator(*intrinsicOp);
2875 } else {
2876 context_.Say(GetContext().clauseSource,
2877 "Invalid reduction operator in REDUCTION clause."_err_en_US,
2878 ContextDirectiveAsFortran());
2881 [&](const parser::ProcedureDesignator &procD) {
2882 const parser::Name *name{std::get_if<parser::Name>(&procD.u)};
2883 if (name && name->symbol) {
2884 const SourceName &realName{name->symbol->GetUltimate().name()};
2885 if (realName == "max" || realName == "min" ||
2886 realName == "iand" || realName == "ior" ||
2887 realName == "ieor") {
2888 ok = true;
2891 if (!ok) {
2892 context_.Say(GetContext().clauseSource,
2893 "Invalid reduction identifier in REDUCTION "
2894 "clause."_err_en_US,
2895 ContextDirectiveAsFortran());
2899 definedOp.u);
2901 return ok;
2904 bool OmpStructureChecker::CheckIntrinsicOperator(
2905 const parser::DefinedOperator::IntrinsicOperator &op) {
2907 switch (op) {
2908 case parser::DefinedOperator::IntrinsicOperator::Add:
2909 case parser::DefinedOperator::IntrinsicOperator::Multiply:
2910 case parser::DefinedOperator::IntrinsicOperator::AND:
2911 case parser::DefinedOperator::IntrinsicOperator::OR:
2912 case parser::DefinedOperator::IntrinsicOperator::EQV:
2913 case parser::DefinedOperator::IntrinsicOperator::NEQV:
2914 return true;
2915 case parser::DefinedOperator::IntrinsicOperator::Subtract:
2916 context_.Say(GetContext().clauseSource,
2917 "The minus reduction operator is deprecated since OpenMP 5.2 and is "
2918 "not supported in the REDUCTION clause."_err_en_US,
2919 ContextDirectiveAsFortran());
2920 break;
2921 default:
2922 context_.Say(GetContext().clauseSource,
2923 "Invalid reduction operator in REDUCTION clause."_err_en_US,
2924 ContextDirectiveAsFortran());
2926 return false;
2929 static bool IsReductionAllowedForType(
2930 const parser::OmpClause::Reduction &x, const DeclTypeSpec &type) {
2931 const auto &definedOp{std::get<parser::OmpReductionIdentifier>(x.v.t)};
2932 // TODO: user defined reduction operators. Just allow everything for now.
2933 bool ok{true};
2935 auto IsLogical{[](const DeclTypeSpec &type) -> bool {
2936 return type.category() == DeclTypeSpec::Logical;
2938 auto IsCharacter{[](const DeclTypeSpec &type) -> bool {
2939 return type.category() == DeclTypeSpec::Character;
2942 common::visit(
2943 common::visitors{
2944 [&](const parser::DefinedOperator &dOpr) {
2945 if (const auto *intrinsicOp{
2946 std::get_if<parser::DefinedOperator::IntrinsicOperator>(
2947 &dOpr.u)}) {
2948 // OMP5.2: The type [...] of a list item that appears in a
2949 // reduction clause must be valid for the combiner expression
2950 // See F2023: Table 10.2
2951 // .LT., .LE., .GT., .GE. are handled as procedure designators
2952 // below.
2953 switch (*intrinsicOp) {
2954 case parser::DefinedOperator::IntrinsicOperator::Multiply:
2955 [[fallthrough]];
2956 case parser::DefinedOperator::IntrinsicOperator::Add:
2957 [[fallthrough]];
2958 case parser::DefinedOperator::IntrinsicOperator::Subtract:
2959 ok = type.IsNumeric(TypeCategory::Integer) ||
2960 type.IsNumeric(TypeCategory::Real) ||
2961 type.IsNumeric(TypeCategory::Complex);
2962 break;
2964 case parser::DefinedOperator::IntrinsicOperator::AND:
2965 [[fallthrough]];
2966 case parser::DefinedOperator::IntrinsicOperator::OR:
2967 [[fallthrough]];
2968 case parser::DefinedOperator::IntrinsicOperator::EQV:
2969 [[fallthrough]];
2970 case parser::DefinedOperator::IntrinsicOperator::NEQV:
2971 ok = IsLogical(type);
2972 break;
2974 // Reduction identifier is not in OMP5.2 Table 5.2
2975 default:
2976 DIE("This should have been caught in CheckIntrinsicOperator");
2977 ok = false;
2978 break;
2982 [&](const parser::ProcedureDesignator &procD) {
2983 const parser::Name *name{std::get_if<parser::Name>(&procD.u)};
2984 if (name && name->symbol) {
2985 const SourceName &realName{name->symbol->GetUltimate().name()};
2986 // OMP5.2: The type [...] of a list item that appears in a
2987 // reduction clause must be valid for the combiner expression
2988 if (realName == "iand" || realName == "ior" ||
2989 realName == "ieor") {
2990 // IAND: arguments must be integers: F2023 16.9.100
2991 // IEOR: arguments must be integers: F2023 16.9.106
2992 // IOR: arguments must be integers: F2023 16.9.111
2993 ok = type.IsNumeric(TypeCategory::Integer);
2994 } else if (realName == "max" || realName == "min") {
2995 // MAX: arguments must be integer, real, or character:
2996 // F2023 16.9.135
2997 // MIN: arguments must be integer, real, or character:
2998 // F2023 16.9.141
2999 ok = type.IsNumeric(TypeCategory::Integer) ||
3000 type.IsNumeric(TypeCategory::Real) || IsCharacter(type);
3005 definedOp.u);
3007 return ok;
3010 void OmpStructureChecker::CheckReductionTypeList(
3011 const parser::OmpClause::Reduction &x) {
3012 const auto &ompObjectList{std::get<parser::OmpObjectList>(x.v.t)};
3013 CheckIntentInPointerAndDefinable(
3014 ompObjectList, llvm::omp::Clause::OMPC_reduction);
3015 CheckReductionArraySection(ompObjectList);
3016 // If this is a worksharing construct then ensure the reduction variable
3017 // is not private in the parallel region that it binds to.
3018 if (llvm::omp::nestedReduceWorkshareAllowedSet.test(GetContext().directive)) {
3019 CheckSharedBindingInOuterContext(ompObjectList);
3022 SymbolSourceMap symbols;
3023 GetSymbolsInObjectList(ompObjectList, symbols);
3024 for (auto &[symbol, source] : symbols) {
3025 if (IsProcedurePointer(*symbol)) {
3026 context_.Say(source,
3027 "A procedure pointer '%s' must not appear in a REDUCTION clause."_err_en_US,
3028 symbol->name());
3029 } else if (!IsReductionAllowedForType(x, DEREF(symbol->GetType()))) {
3030 context_.Say(source,
3031 "The type of '%s' is incompatible with the reduction operator."_err_en_US,
3032 symbol->name());
3037 void OmpStructureChecker::CheckReductionModifier(
3038 const ReductionModifier &modifier) {
3039 if (modifier == ReductionModifier::Default) {
3040 // The default one is always ok.
3041 return;
3043 const DirectiveContext &dirCtx{GetContext()};
3044 if (dirCtx.directive == llvm::omp::Directive::OMPD_loop) {
3045 // [5.2:257:33-34]
3046 // If a reduction-modifier is specified in a reduction clause that
3047 // appears on the directive, then the reduction modifier must be
3048 // default.
3049 context_.Say(GetContext().clauseSource,
3050 "REDUCTION modifier on LOOP directive must be DEFAULT"_err_en_US);
3052 if (modifier == ReductionModifier::Task) {
3053 // "Task" is only allowed on worksharing or "parallel" directive.
3054 static llvm::omp::Directive worksharing[]{
3055 llvm::omp::Directive::OMPD_do, llvm::omp::Directive::OMPD_scope,
3056 llvm::omp::Directive::OMPD_sections,
3057 // There are more worksharing directives, but they do not apply:
3058 // "for" is C++ only,
3059 // "single" and "workshare" don't allow reduction clause,
3060 // "loop" has different restrictions (checked above).
3062 if (dirCtx.directive != llvm::omp::Directive::OMPD_parallel &&
3063 !llvm::is_contained(worksharing, dirCtx.directive)) {
3064 context_.Say(GetContext().clauseSource,
3065 "Modifier 'TASK' on REDUCTION clause is only allowed with "
3066 "PARALLEL or worksharing directive"_err_en_US);
3068 } else if (modifier == ReductionModifier::Inscan) {
3069 // "Inscan" is only allowed on worksharing-loop, worksharing-loop simd,
3070 // or "simd" directive.
3071 // The worksharing-loop directives are OMPD_do and OMPD_for. Only the
3072 // former is allowed in Fortran.
3073 if (!llvm::omp::scanParentAllowedSet.test(dirCtx.directive)) {
3074 context_.Say(GetContext().clauseSource,
3075 "Modifier 'INSCAN' on REDUCTION clause is only allowed with "
3076 "WORKSHARING LOOP, WORKSHARING LOOP SIMD, "
3077 "or SIMD directive"_err_en_US);
3079 } else {
3080 // Catch-all for potential future modifiers to make sure that this
3081 // function is up-to-date.
3082 context_.Say(GetContext().clauseSource,
3083 "Unexpected modifier on REDUCTION clause"_err_en_US);
3087 void OmpStructureChecker::CheckIntentInPointerAndDefinable(
3088 const parser::OmpObjectList &objectList, const llvm::omp::Clause clause) {
3089 for (const auto &ompObject : objectList.v) {
3090 if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
3091 if (const auto *symbol{name->symbol}) {
3092 if (IsPointer(symbol->GetUltimate()) &&
3093 IsIntentIn(symbol->GetUltimate())) {
3094 context_.Say(GetContext().clauseSource,
3095 "Pointer '%s' with the INTENT(IN) attribute may not appear "
3096 "in a %s clause"_err_en_US,
3097 symbol->name(),
3098 parser::ToUpperCaseLetters(getClauseName(clause).str()));
3099 } else if (auto msg{WhyNotDefinable(name->source,
3100 context_.FindScope(name->source), DefinabilityFlags{},
3101 *symbol)}) {
3102 context_
3103 .Say(GetContext().clauseSource,
3104 "Variable '%s' on the %s clause is not definable"_err_en_US,
3105 symbol->name(),
3106 parser::ToUpperCaseLetters(getClauseName(clause).str()))
3107 .Attach(std::move(msg->set_severity(parser::Severity::Because)));
3114 void OmpStructureChecker::CheckReductionArraySection(
3115 const parser::OmpObjectList &ompObjectList) {
3116 for (const auto &ompObject : ompObjectList.v) {
3117 if (const auto *dataRef{parser::Unwrap<parser::DataRef>(ompObject)}) {
3118 if (const auto *arrayElement{
3119 parser::Unwrap<parser::ArrayElement>(ompObject)}) {
3120 if (arrayElement) {
3121 CheckArraySection(*arrayElement, GetLastName(*dataRef),
3122 llvm::omp::Clause::OMPC_reduction);
3129 void OmpStructureChecker::CheckSharedBindingInOuterContext(
3130 const parser::OmpObjectList &redObjectList) {
3131 // TODO: Verify the assumption here that the immediately enclosing region is
3132 // the parallel region to which the worksharing construct having reduction
3133 // binds to.
3134 if (auto *enclosingContext{GetEnclosingDirContext()}) {
3135 for (auto it : enclosingContext->clauseInfo) {
3136 llvmOmpClause type = it.first;
3137 const auto *clause = it.second;
3138 if (llvm::omp::privateReductionSet.test(type)) {
3139 if (const auto *objList{GetOmpObjectList(*clause)}) {
3140 for (const auto &ompObject : objList->v) {
3141 if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
3142 if (const auto *symbol{name->symbol}) {
3143 for (const auto &redOmpObject : redObjectList.v) {
3144 if (const auto *rname{
3145 parser::Unwrap<parser::Name>(redOmpObject)}) {
3146 if (const auto *rsymbol{rname->symbol}) {
3147 if (rsymbol->name() == symbol->name()) {
3148 context_.Say(GetContext().clauseSource,
3149 "%s variable '%s' is %s in outer context must"
3150 " be shared in the parallel regions to which any"
3151 " of the worksharing regions arising from the "
3152 "worksharing construct bind."_err_en_US,
3153 parser::ToUpperCaseLetters(
3154 getClauseName(llvm::omp::Clause::OMPC_reduction)
3155 .str()),
3156 symbol->name(),
3157 parser::ToUpperCaseLetters(
3158 getClauseName(type).str()));
3172 void OmpStructureChecker::Enter(const parser::OmpClause::Ordered &x) {
3173 CheckAllowedClause(llvm::omp::Clause::OMPC_ordered);
3174 // the parameter of ordered clause is optional
3175 if (const auto &expr{x.v}) {
3176 RequiresConstantPositiveParameter(llvm::omp::Clause::OMPC_ordered, *expr);
3177 // 2.8.3 Loop SIMD Construct Restriction
3178 if (llvm::omp::allDoSimdSet.test(GetContext().directive)) {
3179 context_.Say(GetContext().clauseSource,
3180 "No ORDERED clause with a parameter can be specified "
3181 "on the %s directive"_err_en_US,
3182 ContextDirectiveAsFortran());
3187 void OmpStructureChecker::Enter(const parser::OmpClause::Shared &x) {
3188 CheckAllowedClause(llvm::omp::Clause::OMPC_shared);
3189 CheckIsVarPartOfAnotherVar(GetContext().clauseSource, x.v, "SHARED");
3191 void OmpStructureChecker::Enter(const parser::OmpClause::Private &x) {
3192 CheckAllowedClause(llvm::omp::Clause::OMPC_private);
3193 CheckIsVarPartOfAnotherVar(GetContext().clauseSource, x.v, "PRIVATE");
3194 CheckIntentInPointer(x.v, llvm::omp::Clause::OMPC_private);
3197 void OmpStructureChecker::Enter(const parser::OmpClause::Nowait &x) {
3198 CheckAllowedClause(llvm::omp::Clause::OMPC_nowait);
3199 if (llvm::omp::noWaitClauseNotAllowedSet.test(GetContext().directive)) {
3200 context_.Say(GetContext().clauseSource,
3201 "%s clause is not allowed on the OMP %s directive,"
3202 " use it on OMP END %s directive "_err_en_US,
3203 parser::ToUpperCaseLetters(
3204 getClauseName(llvm::omp::Clause::OMPC_nowait).str()),
3205 parser::ToUpperCaseLetters(GetContext().directiveSource.ToString()),
3206 parser::ToUpperCaseLetters(GetContext().directiveSource.ToString()));
3210 bool OmpStructureChecker::IsDataRefTypeParamInquiry(
3211 const parser::DataRef *dataRef) {
3212 bool dataRefIsTypeParamInquiry{false};
3213 if (const auto *structComp{
3214 parser::Unwrap<parser::StructureComponent>(dataRef)}) {
3215 if (const auto *compSymbol{structComp->component.symbol}) {
3216 if (const auto *compSymbolMiscDetails{
3217 std::get_if<MiscDetails>(&compSymbol->details())}) {
3218 const auto detailsKind = compSymbolMiscDetails->kind();
3219 dataRefIsTypeParamInquiry =
3220 (detailsKind == MiscDetails::Kind::KindParamInquiry ||
3221 detailsKind == MiscDetails::Kind::LenParamInquiry);
3222 } else if (compSymbol->has<TypeParamDetails>()) {
3223 dataRefIsTypeParamInquiry = true;
3227 return dataRefIsTypeParamInquiry;
3230 void OmpStructureChecker::CheckIsVarPartOfAnotherVar(
3231 const parser::CharBlock &source, const parser::OmpObjectList &objList,
3232 llvm::StringRef clause) {
3233 for (const auto &ompObject : objList.v) {
3234 common::visit(
3235 common::visitors{
3236 [&](const parser::Designator &designator) {
3237 if (const auto *dataRef{
3238 std::get_if<parser::DataRef>(&designator.u)}) {
3239 if (IsDataRefTypeParamInquiry(dataRef)) {
3240 context_.Say(source,
3241 "A type parameter inquiry cannot appear on the %s "
3242 "directive"_err_en_US,
3243 ContextDirectiveAsFortran());
3244 } else if (parser::Unwrap<parser::StructureComponent>(
3245 ompObject) ||
3246 parser::Unwrap<parser::ArrayElement>(ompObject)) {
3247 if (llvm::omp::nonPartialVarSet.test(
3248 GetContext().directive)) {
3249 context_.Say(source,
3250 "A variable that is part of another variable (as an "
3251 "array or structure element) cannot appear on the %s "
3252 "directive"_err_en_US,
3253 ContextDirectiveAsFortran());
3254 } else {
3255 context_.Say(source,
3256 "A variable that is part of another variable (as an "
3257 "array or structure element) cannot appear in a "
3258 "%s clause"_err_en_US,
3259 clause.data());
3264 [&](const parser::Name &name) {},
3266 ompObject.u);
3270 void OmpStructureChecker::Enter(const parser::OmpClause::Firstprivate &x) {
3271 CheckAllowedClause(llvm::omp::Clause::OMPC_firstprivate);
3273 CheckIsVarPartOfAnotherVar(GetContext().clauseSource, x.v, "FIRSTPRIVATE");
3274 CheckIsLoopIvPartOfClause(llvmOmpClause::OMPC_firstprivate, x.v);
3276 SymbolSourceMap currSymbols;
3277 GetSymbolsInObjectList(x.v, currSymbols);
3278 CheckCopyingPolymorphicAllocatable(
3279 currSymbols, llvm::omp::Clause::OMPC_firstprivate);
3281 DirectivesClauseTriple dirClauseTriple;
3282 // Check firstprivate variables in worksharing constructs
3283 dirClauseTriple.emplace(llvm::omp::Directive::OMPD_do,
3284 std::make_pair(
3285 llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet));
3286 dirClauseTriple.emplace(llvm::omp::Directive::OMPD_sections,
3287 std::make_pair(
3288 llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet));
3289 dirClauseTriple.emplace(llvm::omp::Directive::OMPD_single,
3290 std::make_pair(
3291 llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet));
3292 // Check firstprivate variables in distribute construct
3293 dirClauseTriple.emplace(llvm::omp::Directive::OMPD_distribute,
3294 std::make_pair(
3295 llvm::omp::Directive::OMPD_teams, llvm::omp::privateReductionSet));
3296 dirClauseTriple.emplace(llvm::omp::Directive::OMPD_distribute,
3297 std::make_pair(llvm::omp::Directive::OMPD_target_teams,
3298 llvm::omp::privateReductionSet));
3299 // Check firstprivate variables in task and taskloop constructs
3300 dirClauseTriple.emplace(llvm::omp::Directive::OMPD_task,
3301 std::make_pair(llvm::omp::Directive::OMPD_parallel,
3302 OmpClauseSet{llvm::omp::Clause::OMPC_reduction}));
3303 dirClauseTriple.emplace(llvm::omp::Directive::OMPD_taskloop,
3304 std::make_pair(llvm::omp::Directive::OMPD_parallel,
3305 OmpClauseSet{llvm::omp::Clause::OMPC_reduction}));
3307 CheckPrivateSymbolsInOuterCxt(
3308 currSymbols, dirClauseTriple, llvm::omp::Clause::OMPC_firstprivate);
3311 void OmpStructureChecker::CheckIsLoopIvPartOfClause(
3312 llvmOmpClause clause, const parser::OmpObjectList &ompObjectList) {
3313 for (const auto &ompObject : ompObjectList.v) {
3314 if (const parser::Name *name{parser::Unwrap<parser::Name>(ompObject)}) {
3315 if (name->symbol == GetContext().loopIV) {
3316 context_.Say(name->source,
3317 "DO iteration variable %s is not allowed in %s clause."_err_en_US,
3318 name->ToString(),
3319 parser::ToUpperCaseLetters(getClauseName(clause).str()));
3324 // Following clauses have a separate node in parse-tree.h.
3325 // Atomic-clause
3326 CHECK_SIMPLE_PARSER_CLAUSE(OmpAtomicRead, OMPC_read)
3327 CHECK_SIMPLE_PARSER_CLAUSE(OmpAtomicWrite, OMPC_write)
3328 CHECK_SIMPLE_PARSER_CLAUSE(OmpAtomicUpdate, OMPC_update)
3329 CHECK_SIMPLE_PARSER_CLAUSE(OmpAtomicCapture, OMPC_capture)
3331 void OmpStructureChecker::Leave(const parser::OmpAtomicRead &) {
3332 CheckNotAllowedIfClause(llvm::omp::Clause::OMPC_read,
3333 {llvm::omp::Clause::OMPC_release, llvm::omp::Clause::OMPC_acq_rel});
3336 void OmpStructureChecker::Leave(const parser::OmpAtomicWrite &) {
3337 CheckNotAllowedIfClause(llvm::omp::Clause::OMPC_write,
3338 {llvm::omp::Clause::OMPC_acquire, llvm::omp::Clause::OMPC_acq_rel});
3341 void OmpStructureChecker::Leave(const parser::OmpAtomicUpdate &) {
3342 CheckNotAllowedIfClause(llvm::omp::Clause::OMPC_update,
3343 {llvm::omp::Clause::OMPC_acquire, llvm::omp::Clause::OMPC_acq_rel});
3346 // OmpAtomic node represents atomic directive without atomic-clause.
3347 // atomic-clause - READ,WRITE,UPDATE,CAPTURE.
3348 void OmpStructureChecker::Leave(const parser::OmpAtomic &) {
3349 if (const auto *clause{FindClause(llvm::omp::Clause::OMPC_acquire)}) {
3350 context_.Say(clause->source,
3351 "Clause ACQUIRE is not allowed on the ATOMIC directive"_err_en_US);
3353 if (const auto *clause{FindClause(llvm::omp::Clause::OMPC_acq_rel)}) {
3354 context_.Say(clause->source,
3355 "Clause ACQ_REL is not allowed on the ATOMIC directive"_err_en_US);
3359 // Restrictions specific to each clause are implemented apart from the
3360 // generalized restrictions.
3361 void OmpStructureChecker::Enter(const parser::OmpClause::Aligned &x) {
3362 CheckAllowedClause(llvm::omp::Clause::OMPC_aligned);
3364 if (const auto &expr{
3365 std::get<std::optional<parser::ScalarIntConstantExpr>>(x.v.t)}) {
3366 RequiresConstantPositiveParameter(llvm::omp::Clause::OMPC_aligned, *expr);
3368 // 2.8.1 TODO: list-item attribute check
3371 void OmpStructureChecker::Enter(const parser::OmpClause::Defaultmap &x) {
3372 CheckAllowedClause(llvm::omp::Clause::OMPC_defaultmap);
3373 unsigned version{context_.langOptions().OpenMPVersion};
3374 using ImplicitBehavior = parser::OmpDefaultmapClause::ImplicitBehavior;
3375 auto behavior{std::get<ImplicitBehavior>(x.v.t)};
3376 if (version <= 45) {
3377 if (behavior != ImplicitBehavior::Tofrom) {
3378 context_.Say(GetContext().clauseSource,
3379 "%s is not allowed in %s, %s"_warn_en_US,
3380 parser::ToUpperCaseLetters(
3381 parser::OmpDefaultmapClause::EnumToString(behavior)),
3382 ThisVersion(version), TryVersion(50));
3385 using VariableCategory = parser::OmpDefaultmapClause::VariableCategory;
3386 auto maybeCategory{std::get<std::optional<VariableCategory>>(x.v.t)};
3387 if (!maybeCategory) {
3388 if (version <= 45) {
3389 context_.Say(GetContext().clauseSource,
3390 "The DEFAULTMAP clause requires a variable-category SCALAR in %s, %s"_warn_en_US,
3391 ThisVersion(version), TryVersion(50));
3393 } else {
3394 VariableCategory category{*maybeCategory};
3395 unsigned tryVersion{0};
3396 if (version <= 45 && category != VariableCategory::Scalar) {
3397 tryVersion = 50;
3399 if (version < 52 && category == VariableCategory::All) {
3400 tryVersion = 52;
3402 if (tryVersion) {
3403 context_.Say(GetContext().clauseSource,
3404 "%s is not allowed in %s, %s"_warn_en_US,
3405 parser::ToUpperCaseLetters(
3406 parser::OmpDefaultmapClause::EnumToString(category)),
3407 ThisVersion(version), TryVersion(tryVersion));
3412 void OmpStructureChecker::Enter(const parser::OmpClause::If &x) {
3413 CheckAllowedClause(llvm::omp::Clause::OMPC_if);
3414 using dirNameModifier = parser::OmpIfClause::DirectiveNameModifier;
3415 // TODO Check that, when multiple 'if' clauses are applied to a combined
3416 // construct, at most one of them applies to each directive.
3417 static std::unordered_map<dirNameModifier, OmpDirectiveSet>
3418 dirNameModifierMap{{dirNameModifier::Parallel, llvm::omp::allParallelSet},
3419 {dirNameModifier::Simd, llvm::omp::allSimdSet},
3420 {dirNameModifier::Target, llvm::omp::allTargetSet},
3421 {dirNameModifier::TargetData,
3422 {llvm::omp::Directive::OMPD_target_data}},
3423 {dirNameModifier::TargetEnterData,
3424 {llvm::omp::Directive::OMPD_target_enter_data}},
3425 {dirNameModifier::TargetExitData,
3426 {llvm::omp::Directive::OMPD_target_exit_data}},
3427 {dirNameModifier::TargetUpdate,
3428 {llvm::omp::Directive::OMPD_target_update}},
3429 {dirNameModifier::Task, {llvm::omp::Directive::OMPD_task}},
3430 {dirNameModifier::Taskloop, llvm::omp::allTaskloopSet},
3431 {dirNameModifier::Teams, llvm::omp::allTeamsSet}};
3432 if (const auto &directiveName{
3433 std::get<std::optional<dirNameModifier>>(x.v.t)}) {
3434 auto search{dirNameModifierMap.find(*directiveName)};
3435 if (search == dirNameModifierMap.end() ||
3436 !search->second.test(GetContext().directive)) {
3437 context_
3438 .Say(GetContext().clauseSource,
3439 "Unmatched directive name modifier %s on the IF clause"_err_en_US,
3440 parser::ToUpperCaseLetters(
3441 parser::OmpIfClause::EnumToString(*directiveName)))
3442 .Attach(
3443 GetContext().directiveSource, "Cannot apply to directive"_en_US);
3448 void OmpStructureChecker::Enter(const parser::OmpClause::Linear &x) {
3449 CheckAllowedClause(llvm::omp::Clause::OMPC_linear);
3451 // 2.7 Loop Construct Restriction
3452 if ((llvm::omp::allDoSet | llvm::omp::allSimdSet)
3453 .test(GetContext().directive)) {
3454 if (std::holds_alternative<parser::OmpLinearClause::WithModifier>(x.v.u)) {
3455 context_.Say(GetContext().clauseSource,
3456 "A modifier may not be specified in a LINEAR clause "
3457 "on the %s directive"_err_en_US,
3458 ContextDirectiveAsFortran());
3463 void OmpStructureChecker::CheckAllowedMapTypes(
3464 const parser::OmpMapClause::Type &type,
3465 const std::list<parser::OmpMapClause::Type> &allowedMapTypeList) {
3466 if (!llvm::is_contained(allowedMapTypeList, type)) {
3467 std::string commaSeparatedMapTypes;
3468 llvm::interleave(
3469 allowedMapTypeList.begin(), allowedMapTypeList.end(),
3470 [&](const parser::OmpMapClause::Type &mapType) {
3471 commaSeparatedMapTypes.append(parser::ToUpperCaseLetters(
3472 parser::OmpMapClause::EnumToString(mapType)));
3474 [&] { commaSeparatedMapTypes.append(", "); });
3475 context_.Say(GetContext().clauseSource,
3476 "Only the %s map types are permitted "
3477 "for MAP clauses on the %s directive"_err_en_US,
3478 commaSeparatedMapTypes, ContextDirectiveAsFortran());
3482 void OmpStructureChecker::Enter(const parser::OmpClause::Map &x) {
3483 CheckAllowedClause(llvm::omp::Clause::OMPC_map);
3484 using TypeMod = parser::OmpMapClause::TypeModifier;
3485 using Type = parser::OmpMapClause::Type;
3486 using IterMod = parser::OmpIterator;
3488 unsigned version{context_.langOptions().OpenMPVersion};
3489 if (auto commas{std::get<bool>(x.v.t)}; !commas && version >= 52) {
3490 context_.Say(GetContext().clauseSource,
3491 "The specification of modifiers without comma separators for the "
3492 "'MAP' clause has been deprecated in OpenMP 5.2"_port_en_US);
3494 if (auto &mapTypeMod{std::get<std::optional<std::list<TypeMod>>>(x.v.t)}) {
3495 if (auto *dup{FindDuplicateEntry(*mapTypeMod)}) {
3496 context_.Say(GetContext().clauseSource,
3497 "Duplicate map-type-modifier entry '%s' will be ignored"_warn_en_US,
3498 parser::ToUpperCaseLetters(parser::OmpMapClause::EnumToString(*dup)));
3501 // The size of any of the optional lists is never 0, instead of the list
3502 // being empty, it will be a nullopt.
3503 if (auto &iterMod{std::get<std::optional<std::list<IterMod>>>(x.v.t)}) {
3504 if (iterMod->size() != 1) {
3505 context_.Say(GetContext().clauseSource,
3506 "Only one iterator-modifier is allowed"_err_en_US);
3508 CheckIteratorModifier(iterMod->front());
3510 if (auto &mapType{std::get<std::optional<std::list<Type>>>(x.v.t)}) {
3511 if (mapType->size() != 1) {
3512 context_.Say(GetContext().clauseSource,
3513 "Multiple map types are not allowed"_err_en_US);
3514 return;
3516 parser::OmpMapClause::Type type{mapType->front()};
3518 switch (GetContext().directive) {
3519 case llvm::omp::Directive::OMPD_target:
3520 case llvm::omp::Directive::OMPD_target_teams:
3521 case llvm::omp::Directive::OMPD_target_teams_distribute:
3522 case llvm::omp::Directive::OMPD_target_teams_distribute_simd:
3523 case llvm::omp::Directive::OMPD_target_teams_distribute_parallel_do:
3524 case llvm::omp::Directive::OMPD_target_teams_distribute_parallel_do_simd:
3525 case llvm::omp::Directive::OMPD_target_data:
3526 CheckAllowedMapTypes(
3527 type, {Type::To, Type::From, Type::Tofrom, Type::Alloc});
3528 break;
3529 case llvm::omp::Directive::OMPD_target_enter_data:
3530 CheckAllowedMapTypes(type, {Type::To, Type::Alloc});
3531 break;
3532 case llvm::omp::Directive::OMPD_target_exit_data:
3533 CheckAllowedMapTypes(type, {Type::From, Type::Release, Type::Delete});
3534 break;
3535 default:
3536 break;
3541 bool OmpStructureChecker::ScheduleModifierHasType(
3542 const parser::OmpScheduleClause &x,
3543 const parser::OmpScheduleModifierType::ModType &type) {
3544 const auto &modifier{
3545 std::get<std::optional<parser::OmpScheduleModifier>>(x.t)};
3546 if (modifier) {
3547 const auto &modType1{
3548 std::get<parser::OmpScheduleModifier::Modifier1>(modifier->t)};
3549 const auto &modType2{
3550 std::get<std::optional<parser::OmpScheduleModifier::Modifier2>>(
3551 modifier->t)};
3552 if (modType1.v.v == type || (modType2 && modType2->v.v == type)) {
3553 return true;
3556 return false;
3558 void OmpStructureChecker::Enter(const parser::OmpClause::Schedule &x) {
3559 CheckAllowedClause(llvm::omp::Clause::OMPC_schedule);
3560 const parser::OmpScheduleClause &scheduleClause = x.v;
3562 // 2.7 Loop Construct Restriction
3563 if (llvm::omp::allDoSet.test(GetContext().directive)) {
3564 const auto &kind{std::get<1>(scheduleClause.t)};
3565 const auto &chunk{std::get<2>(scheduleClause.t)};
3566 if (chunk) {
3567 if (kind == parser::OmpScheduleClause::ScheduleType::Runtime ||
3568 kind == parser::OmpScheduleClause::ScheduleType::Auto) {
3569 context_.Say(GetContext().clauseSource,
3570 "When SCHEDULE clause has %s specified, "
3571 "it must not have chunk size specified"_err_en_US,
3572 parser::ToUpperCaseLetters(
3573 parser::OmpScheduleClause::EnumToString(kind)));
3575 if (const auto &chunkExpr{std::get<std::optional<parser::ScalarIntExpr>>(
3576 scheduleClause.t)}) {
3577 RequiresPositiveParameter(
3578 llvm::omp::Clause::OMPC_schedule, *chunkExpr, "chunk size");
3582 if (ScheduleModifierHasType(scheduleClause,
3583 parser::OmpScheduleModifierType::ModType::Nonmonotonic)) {
3584 if (kind != parser::OmpScheduleClause::ScheduleType::Dynamic &&
3585 kind != parser::OmpScheduleClause::ScheduleType::Guided) {
3586 context_.Say(GetContext().clauseSource,
3587 "The NONMONOTONIC modifier can only be specified with "
3588 "SCHEDULE(DYNAMIC) or SCHEDULE(GUIDED)"_err_en_US);
3594 void OmpStructureChecker::Enter(const parser::OmpClause::Device &x) {
3595 CheckAllowedClause(llvm::omp::Clause::OMPC_device);
3596 const parser::OmpDeviceClause &deviceClause = x.v;
3597 const auto &device{std::get<1>(deviceClause.t)};
3598 RequiresPositiveParameter(
3599 llvm::omp::Clause::OMPC_device, device, "device expression");
3600 std::optional<parser::OmpDeviceClause::DeviceModifier> modifier =
3601 std::get<0>(deviceClause.t);
3602 if (modifier &&
3603 *modifier == parser::OmpDeviceClause::DeviceModifier::Ancestor) {
3604 if (GetContext().directive != llvm::omp::OMPD_target) {
3605 context_.Say(GetContext().clauseSource,
3606 "The ANCESTOR device-modifier must not appear on the DEVICE clause on"
3607 " any directive other than the TARGET construct. Found on %s construct."_err_en_US,
3608 parser::ToUpperCaseLetters(getDirectiveName(GetContext().directive)));
3613 void OmpStructureChecker::Enter(const parser::OmpClause::Depend &x) {
3614 CheckAllowedClause(llvm::omp::Clause::OMPC_depend);
3615 llvm::omp::Directive dir{GetContext().directive};
3616 unsigned version{context_.langOptions().OpenMPVersion};
3618 auto *doaDep{std::get_if<parser::OmpDoacross>(&x.v.u)};
3619 auto *taskDep{std::get_if<parser::OmpDependClause::TaskDep>(&x.v.u)};
3620 assert(((doaDep == nullptr) != (taskDep == nullptr)) &&
3621 "Unexpected alternative in update clause");
3623 if (doaDep) {
3624 CheckDoacross(*doaDep);
3625 CheckDependenceType(doaDep->GetDepType());
3626 } else {
3627 CheckTaskDependenceType(taskDep->GetTaskDepType());
3630 if (dir == llvm::omp::OMPD_depobj) {
3631 // [5.0:255:11], [5.1:288:3]
3632 // A depend clause on a depobj construct must not have source, sink [or
3633 // depobj](5.0) as dependence-type.
3634 if (version >= 50) {
3635 bool invalidDep{false};
3636 if (taskDep) {
3637 if (version == 50) {
3638 invalidDep = taskDep->GetTaskDepType() ==
3639 parser::OmpTaskDependenceType::Value::Depobj;
3641 } else {
3642 invalidDep = true;
3644 if (invalidDep) {
3645 context_.Say(GetContext().clauseSource,
3646 "A DEPEND clause on a DEPOBJ construct must not have %s as dependence type"_err_en_US,
3647 version == 50 ? "SINK, SOURCE or DEPOBJ" : "SINK or SOURCE");
3650 } else if (dir != llvm::omp::OMPD_ordered) {
3651 if (doaDep) {
3652 context_.Say(GetContext().clauseSource,
3653 "The SINK and SOURCE dependence types can only be used with the ORDERED directive, used here in the %s construct"_err_en_US,
3654 parser::ToUpperCaseLetters(getDirectiveName(dir)));
3657 if (taskDep) {
3658 auto &objList{std::get<parser::OmpObjectList>(taskDep->t)};
3659 if (dir == llvm::omp::OMPD_depobj) {
3660 // [5.0:255:13], [5.1:288:6], [5.2:322:26]
3661 // A depend clause on a depobj construct must only specify one locator.
3662 if (objList.v.size() != 1) {
3663 context_.Say(GetContext().clauseSource,
3664 "A DEPEND clause on a DEPOBJ construct must only specify "
3665 "one locator"_err_en_US);
3668 for (const auto &object : objList.v) {
3669 if (const auto *name{std::get_if<parser::Name>(&object.u)}) {
3670 context_.Say(GetContext().clauseSource,
3671 "Common block name ('%s') cannot appear in a DEPEND "
3672 "clause"_err_en_US,
3673 name->ToString());
3674 } else if (auto *designator{std::get_if<parser::Designator>(&object.u)}) {
3675 if (auto *dataRef{std::get_if<parser::DataRef>(&designator->u)}) {
3676 CheckDependList(*dataRef);
3677 if (const auto *arr{
3678 std::get_if<common::Indirection<parser::ArrayElement>>(
3679 &dataRef->u)}) {
3680 CheckArraySection(arr->value(), GetLastName(*dataRef),
3681 llvm::omp::Clause::OMPC_depend);
3686 if (std::get<std::optional<parser::OmpIterator>>(taskDep->t)) {
3687 unsigned allowedInVersion{50};
3688 if (version < allowedInVersion) {
3689 context_.Say(GetContext().clauseSource,
3690 "Iterator modifiers are not supported in %s, %s"_warn_en_US,
3691 ThisVersion(version), TryVersion(allowedInVersion));
3692 } else {
3693 if (dir == llvm::omp::OMPD_depobj) {
3694 context_.Say(GetContext().clauseSource,
3695 "An iterator-modifier may specify multiple locators, "
3696 "a DEPEND clause on a DEPOBJ construct must only specify "
3697 "one locator"_warn_en_US);
3704 void OmpStructureChecker::Enter(const parser::OmpClause::Doacross &x) {
3705 CheckAllowedClause(llvm::omp::Clause::OMPC_doacross);
3706 CheckDoacross(x.v.v);
3709 void OmpStructureChecker::CheckDoacross(const parser::OmpDoacross &doa) {
3710 if (std::holds_alternative<parser::OmpDoacross::Source>(doa.u)) {
3711 // Nothing to check here.
3712 return;
3715 // Process SINK dependence type. SINK may only appear in an ORDER construct,
3716 // which references a prior ORDERED(n) clause on a DO or SIMD construct
3717 // that marks the top of the loop nest.
3719 auto &sink{std::get<parser::OmpDoacross::Sink>(doa.u)};
3720 const std::list<parser::OmpIteration> &vec{sink.v.v};
3722 // Check if the variables in the iteration vector are unique.
3723 struct Less {
3724 bool operator()(
3725 const parser::OmpIteration *a, const parser::OmpIteration *b) const {
3726 auto namea{std::get<parser::Name>(a->t)};
3727 auto nameb{std::get<parser::Name>(b->t)};
3728 assert(namea.symbol && nameb.symbol && "Unresolved symbols");
3729 // The non-determinism of the "<" doesn't matter, we only care about
3730 // equality, i.e. a == b <=> !(a < b) && !(b < a)
3731 return reinterpret_cast<uintptr_t>(namea.symbol) <
3732 reinterpret_cast<uintptr_t>(nameb.symbol);
3735 if (auto *duplicate{FindDuplicateEntry<parser::OmpIteration, Less>(vec)}) {
3736 auto name{std::get<parser::Name>(duplicate->t)};
3737 context_.Say(name.source,
3738 "Duplicate variable '%s' in the iteration vector"_err_en_US,
3739 name.ToString());
3742 // Check if the variables in the iteration vector are induction variables.
3743 // Ignore any mismatch between the size of the iteration vector and the
3744 // number of DO constructs on the stack. This is checked elsewhere.
3746 auto GetLoopDirective{[](const parser::OpenMPLoopConstruct &x) {
3747 auto &begin{std::get<parser::OmpBeginLoopDirective>(x.t)};
3748 return std::get<parser::OmpLoopDirective>(begin.t).v;
3750 auto GetLoopClauses{[](const parser::OpenMPLoopConstruct &x)
3751 -> const std::list<parser::OmpClause> & {
3752 auto &begin{std::get<parser::OmpBeginLoopDirective>(x.t)};
3753 return std::get<parser::OmpClauseList>(begin.t).v;
3756 std::set<const Symbol *> inductionVars;
3757 for (const LoopConstruct &loop : llvm::reverse(loopStack_)) {
3758 if (auto *doc{std::get_if<const parser::DoConstruct *>(&loop)}) {
3759 // Do-construct, collect the induction variable.
3760 if (auto &control{(*doc)->GetLoopControl()}) {
3761 if (auto *b{std::get_if<parser::LoopControl::Bounds>(&control->u)}) {
3762 inductionVars.insert(b->name.thing.symbol);
3765 } else {
3766 // Omp-loop-construct, check if it's do/simd with an ORDERED clause.
3767 auto *loopc{std::get_if<const parser::OpenMPLoopConstruct *>(&loop)};
3768 assert(loopc && "Expecting OpenMPLoopConstruct");
3769 llvm::omp::Directive loopDir{GetLoopDirective(**loopc)};
3770 if (loopDir == llvm::omp::OMPD_do || loopDir == llvm::omp::OMPD_simd) {
3771 auto IsOrdered{[](const parser::OmpClause &c) {
3772 return c.Id() == llvm::omp::OMPC_ordered;
3774 // If it has ORDERED clause, stop the traversal.
3775 if (llvm::any_of(GetLoopClauses(**loopc), IsOrdered)) {
3776 break;
3781 for (const parser::OmpIteration &iter : vec) {
3782 auto &name{std::get<parser::Name>(iter.t)};
3783 if (!inductionVars.count(name.symbol)) {
3784 context_.Say(name.source,
3785 "The iteration vector element '%s' is not an induction variable within the ORDERED loop nest"_err_en_US,
3786 name.ToString());
3791 void OmpStructureChecker::CheckCopyingPolymorphicAllocatable(
3792 SymbolSourceMap &symbols, const llvm::omp::Clause clause) {
3793 if (context_.ShouldWarn(common::UsageWarning::Portability)) {
3794 for (auto it{symbols.begin()}; it != symbols.end(); ++it) {
3795 const auto *symbol{it->first};
3796 const auto source{it->second};
3797 if (IsPolymorphicAllocatable(*symbol)) {
3798 context_.Warn(common::UsageWarning::Portability, source,
3799 "If a polymorphic variable with allocatable attribute '%s' is in %s clause, the behavior is unspecified"_port_en_US,
3800 symbol->name(),
3801 parser::ToUpperCaseLetters(getClauseName(clause).str()));
3807 void OmpStructureChecker::Enter(const parser::OmpClause::Copyprivate &x) {
3808 CheckAllowedClause(llvm::omp::Clause::OMPC_copyprivate);
3809 CheckIntentInPointer(x.v, llvm::omp::Clause::OMPC_copyprivate);
3810 SymbolSourceMap currSymbols;
3811 GetSymbolsInObjectList(x.v, currSymbols);
3812 CheckCopyingPolymorphicAllocatable(
3813 currSymbols, llvm::omp::Clause::OMPC_copyprivate);
3814 if (GetContext().directive == llvm::omp::Directive::OMPD_single) {
3815 context_.Say(GetContext().clauseSource,
3816 "%s clause is not allowed on the OMP %s directive,"
3817 " use it on OMP END %s directive "_err_en_US,
3818 parser::ToUpperCaseLetters(
3819 getClauseName(llvm::omp::Clause::OMPC_copyprivate).str()),
3820 parser::ToUpperCaseLetters(GetContext().directiveSource.ToString()),
3821 parser::ToUpperCaseLetters(GetContext().directiveSource.ToString()));
3825 void OmpStructureChecker::Enter(const parser::OmpClause::Lastprivate &x) {
3826 CheckAllowedClause(llvm::omp::Clause::OMPC_lastprivate);
3828 const auto &objectList{std::get<parser::OmpObjectList>(x.v.t)};
3829 CheckIsVarPartOfAnotherVar(
3830 GetContext().clauseSource, objectList, "LASTPRIVATE");
3832 DirectivesClauseTriple dirClauseTriple;
3833 SymbolSourceMap currSymbols;
3834 GetSymbolsInObjectList(objectList, currSymbols);
3835 CheckDefinableObjects(currSymbols, llvm::omp::Clause::OMPC_lastprivate);
3836 CheckCopyingPolymorphicAllocatable(
3837 currSymbols, llvm::omp::Clause::OMPC_lastprivate);
3839 // Check lastprivate variables in worksharing constructs
3840 dirClauseTriple.emplace(llvm::omp::Directive::OMPD_do,
3841 std::make_pair(
3842 llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet));
3843 dirClauseTriple.emplace(llvm::omp::Directive::OMPD_sections,
3844 std::make_pair(
3845 llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet));
3847 CheckPrivateSymbolsInOuterCxt(
3848 currSymbols, dirClauseTriple, llvm::omp::Clause::OMPC_lastprivate);
3850 using LastprivateModifier = parser::OmpLastprivateClause::LastprivateModifier;
3851 const auto &maybeMod{std::get<std::optional<LastprivateModifier>>(x.v.t)};
3852 if (maybeMod) {
3853 unsigned version{context_.langOptions().OpenMPVersion};
3854 unsigned allowedInVersion = 50;
3855 if (version < allowedInVersion) {
3856 std::string thisVersion{
3857 std::to_string(version / 10) + "." + std::to_string(version % 10)};
3858 context_.Say(GetContext().clauseSource,
3859 "LASTPRIVATE clause with CONDITIONAL modifier is not "
3860 "allowed in %s, %s"_err_en_US,
3861 ThisVersion(version), TryVersion(allowedInVersion));
3866 void OmpStructureChecker::Enter(const parser::OmpClause::Copyin &x) {
3867 CheckAllowedClause(llvm::omp::Clause::OMPC_copyin);
3869 SymbolSourceMap currSymbols;
3870 GetSymbolsInObjectList(x.v, currSymbols);
3871 CheckCopyingPolymorphicAllocatable(
3872 currSymbols, llvm::omp::Clause::OMPC_copyin);
3875 void OmpStructureChecker::CheckStructureElement(
3876 const parser::OmpObjectList &ompObjectList,
3877 const llvm::omp::Clause clause) {
3878 for (const auto &ompObject : ompObjectList.v) {
3879 common::visit(
3880 common::visitors{
3881 [&](const parser::Designator &designator) {
3882 if (std::get_if<parser::DataRef>(&designator.u)) {
3883 if (parser::Unwrap<parser::StructureComponent>(ompObject)) {
3884 context_.Say(GetContext().clauseSource,
3885 "A variable that is part of another variable "
3886 "(structure element) cannot appear on the %s "
3887 "%s clause"_err_en_US,
3888 ContextDirectiveAsFortran(),
3889 parser::ToUpperCaseLetters(getClauseName(clause).str()));
3893 [&](const parser::Name &name) {},
3895 ompObject.u);
3897 return;
3900 void OmpStructureChecker::Enter(const parser::OmpClause::Update &x) {
3901 CheckAllowedClause(llvm::omp::Clause::OMPC_update);
3902 llvm::omp::Directive dir{GetContext().directive};
3903 unsigned version{context_.langOptions().OpenMPVersion};
3905 auto *depType{std::get_if<parser::OmpDependenceType>(&x.v.u)};
3906 auto *taskType{std::get_if<parser::OmpTaskDependenceType>(&x.v.u)};
3907 assert(((depType == nullptr) != (taskType == nullptr)) &&
3908 "Unexpected alternative in update clause");
3910 if (depType) {
3911 CheckDependenceType(depType->v);
3912 } else if (taskType) {
3913 CheckTaskDependenceType(taskType->v);
3916 // [5.1:288:4-5]
3917 // An update clause on a depobj construct must not have source, sink or depobj
3918 // as dependence-type.
3919 // [5.2:322:3]
3920 // task-dependence-type must not be depobj.
3921 if (dir == llvm::omp::OMPD_depobj) {
3922 if (version >= 51) {
3923 bool invalidDep{false};
3924 if (taskType) {
3925 invalidDep =
3926 taskType->v == parser::OmpTaskDependenceType::Value::Depobj;
3927 } else {
3928 invalidDep = true;
3930 if (invalidDep) {
3931 context_.Say(GetContext().clauseSource,
3932 "An UPDATE clause on a DEPOBJ construct must not have SINK, SOURCE or DEPOBJ as dependence type"_err_en_US);
3938 void OmpStructureChecker::Enter(const parser::OmpClause::UseDevicePtr &x) {
3939 CheckStructureElement(x.v, llvm::omp::Clause::OMPC_use_device_ptr);
3940 CheckAllowedClause(llvm::omp::Clause::OMPC_use_device_ptr);
3941 SymbolSourceMap currSymbols;
3942 GetSymbolsInObjectList(x.v, currSymbols);
3943 semantics::UnorderedSymbolSet listVars;
3944 for (auto [_, clause] : FindClauses(llvm::omp::Clause::OMPC_use_device_ptr)) {
3945 const auto &useDevicePtrClause{
3946 std::get<parser::OmpClause::UseDevicePtr>(clause->u)};
3947 const auto &useDevicePtrList{useDevicePtrClause.v};
3948 std::list<parser::Name> useDevicePtrNameList;
3949 for (const auto &ompObject : useDevicePtrList.v) {
3950 if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
3951 if (name->symbol) {
3952 if (!(IsBuiltinCPtr(*(name->symbol)))) {
3953 context_.Warn(common::UsageWarning::OpenMPUsage, clause->source,
3954 "Use of non-C_PTR type '%s' in USE_DEVICE_PTR is deprecated, use USE_DEVICE_ADDR instead"_warn_en_US,
3955 name->ToString());
3956 } else {
3957 useDevicePtrNameList.push_back(*name);
3962 CheckMultipleOccurrence(
3963 listVars, useDevicePtrNameList, clause->source, "USE_DEVICE_PTR");
3967 void OmpStructureChecker::Enter(const parser::OmpClause::UseDeviceAddr &x) {
3968 CheckStructureElement(x.v, llvm::omp::Clause::OMPC_use_device_addr);
3969 CheckAllowedClause(llvm::omp::Clause::OMPC_use_device_addr);
3970 SymbolSourceMap currSymbols;
3971 GetSymbolsInObjectList(x.v, currSymbols);
3972 semantics::UnorderedSymbolSet listVars;
3973 for (auto [_, clause] :
3974 FindClauses(llvm::omp::Clause::OMPC_use_device_addr)) {
3975 const auto &useDeviceAddrClause{
3976 std::get<parser::OmpClause::UseDeviceAddr>(clause->u)};
3977 const auto &useDeviceAddrList{useDeviceAddrClause.v};
3978 std::list<parser::Name> useDeviceAddrNameList;
3979 for (const auto &ompObject : useDeviceAddrList.v) {
3980 if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
3981 if (name->symbol) {
3982 useDeviceAddrNameList.push_back(*name);
3986 CheckMultipleOccurrence(
3987 listVars, useDeviceAddrNameList, clause->source, "USE_DEVICE_ADDR");
3991 void OmpStructureChecker::Enter(const parser::OmpClause::IsDevicePtr &x) {
3992 CheckAllowedClause(llvm::omp::Clause::OMPC_is_device_ptr);
3993 SymbolSourceMap currSymbols;
3994 GetSymbolsInObjectList(x.v, currSymbols);
3995 semantics::UnorderedSymbolSet listVars;
3996 for (auto [_, clause] : FindClauses(llvm::omp::Clause::OMPC_is_device_ptr)) {
3997 const auto &isDevicePtrClause{
3998 std::get<parser::OmpClause::IsDevicePtr>(clause->u)};
3999 const auto &isDevicePtrList{isDevicePtrClause.v};
4000 SymbolSourceMap currSymbols;
4001 GetSymbolsInObjectList(isDevicePtrList, currSymbols);
4002 for (auto &[symbol, source] : currSymbols) {
4003 if (!(IsBuiltinCPtr(*symbol))) {
4004 context_.Say(clause->source,
4005 "Variable '%s' in IS_DEVICE_PTR clause must be of type C_PTR"_err_en_US,
4006 source.ToString());
4007 } else if (!(IsDummy(*symbol))) {
4008 context_.Warn(common::UsageWarning::OpenMPUsage, clause->source,
4009 "Variable '%s' in IS_DEVICE_PTR clause must be a dummy argument. "
4010 "This semantic check is deprecated from OpenMP 5.2 and later."_warn_en_US,
4011 source.ToString());
4012 } else if (IsAllocatableOrPointer(*symbol) || IsValue(*symbol)) {
4013 context_.Warn(common::UsageWarning::OpenMPUsage, clause->source,
4014 "Variable '%s' in IS_DEVICE_PTR clause must be a dummy argument "
4015 "that does not have the ALLOCATABLE, POINTER or VALUE attribute. "
4016 "This semantic check is deprecated from OpenMP 5.2 and later."_warn_en_US,
4017 source.ToString());
4023 void OmpStructureChecker::Enter(const parser::OmpClause::HasDeviceAddr &x) {
4024 CheckAllowedClause(llvm::omp::Clause::OMPC_has_device_addr);
4025 SymbolSourceMap currSymbols;
4026 GetSymbolsInObjectList(x.v, currSymbols);
4027 semantics::UnorderedSymbolSet listVars;
4028 for (auto [_, clause] :
4029 FindClauses(llvm::omp::Clause::OMPC_has_device_addr)) {
4030 const auto &hasDeviceAddrClause{
4031 std::get<parser::OmpClause::HasDeviceAddr>(clause->u)};
4032 const auto &hasDeviceAddrList{hasDeviceAddrClause.v};
4033 std::list<parser::Name> hasDeviceAddrNameList;
4034 for (const auto &ompObject : hasDeviceAddrList.v) {
4035 if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
4036 if (name->symbol) {
4037 hasDeviceAddrNameList.push_back(*name);
4044 void OmpStructureChecker::Enter(const parser::OmpClause::Enter &x) {
4045 CheckAllowedClause(llvm::omp::Clause::OMPC_enter);
4046 const parser::OmpObjectList &objList{x.v};
4047 SymbolSourceMap symbols;
4048 GetSymbolsInObjectList(objList, symbols);
4049 for (const auto &[sym, source] : symbols) {
4050 if (!IsExtendedListItem(*sym)) {
4051 context_.SayWithDecl(*sym, source,
4052 "'%s' must be a variable or a procedure"_err_en_US, sym->name());
4057 void OmpStructureChecker::Enter(const parser::OmpClause::From &x) {
4058 CheckAllowedClause(llvm::omp::Clause::OMPC_from);
4059 unsigned version{context_.langOptions().OpenMPVersion};
4060 using ExpMod = parser::OmpFromClause::Expectation;
4061 using IterMod = parser::OmpIterator;
4063 if (auto &expMod{std::get<std::optional<std::list<ExpMod>>>(x.v.t)}) {
4064 unsigned allowedInVersion{51};
4065 if (version < allowedInVersion) {
4066 context_.Say(GetContext().clauseSource,
4067 "The PRESENT modifier is not supported in %s, %s"_warn_en_US,
4068 ThisVersion(version), TryVersion(allowedInVersion));
4070 if (expMod->size() != 1) {
4071 context_.Say(GetContext().clauseSource,
4072 "Only one PRESENT modifier is allowed"_err_en_US);
4076 if (auto &iterMod{std::get<std::optional<std::list<IterMod>>>(x.v.t)}) {
4077 unsigned allowedInVersion{51};
4078 if (version < allowedInVersion) {
4079 context_.Say(GetContext().clauseSource,
4080 "Iterator modifiers are not supported in %s, %s"_warn_en_US,
4081 ThisVersion(version), TryVersion(allowedInVersion));
4083 if (iterMod->size() != 1) {
4084 context_.Say(GetContext().clauseSource,
4085 "Only one iterator-modifier is allowed"_err_en_US);
4087 CheckIteratorModifier(iterMod->front());
4090 const auto &objList{std::get<parser::OmpObjectList>(x.v.t)};
4091 SymbolSourceMap symbols;
4092 GetSymbolsInObjectList(objList, symbols);
4093 for (const auto &[sym, source] : symbols) {
4094 if (!IsVariableListItem(*sym)) {
4095 context_.SayWithDecl(
4096 *sym, source, "'%s' must be a variable"_err_en_US, sym->name());
4100 // Ref: [4.5:109:19]
4101 // If a list item is an array section it must specify contiguous storage.
4102 if (version <= 45) {
4103 for (const parser::OmpObject &object : objList.v) {
4104 CheckIfContiguous(object);
4109 void OmpStructureChecker::Enter(const parser::OmpClause::To &x) {
4110 CheckAllowedClause(llvm::omp::Clause::OMPC_to);
4111 unsigned version{context_.langOptions().OpenMPVersion};
4113 // The "to" clause is only allowed on "declare target" (pre-5.1), and
4114 // "target update". In the former case it can take an extended list item,
4115 // in the latter a variable (a locator).
4117 // The "declare target" construct (and the "to" clause on it) are already
4118 // handled (in the declare-target checkers), so just look at "to" in "target
4119 // update".
4120 if (GetContext().directive == llvm::omp::OMPD_declare_target) {
4121 return;
4123 assert(GetContext().directive == llvm::omp::OMPD_target_update);
4124 using ExpMod = parser::OmpFromClause::Expectation;
4125 using IterMod = parser::OmpIterator;
4127 if (auto &expMod{std::get<std::optional<std::list<ExpMod>>>(x.v.t)}) {
4128 unsigned allowedInVersion{51};
4129 if (version < allowedInVersion) {
4130 context_.Say(GetContext().clauseSource,
4131 "The PRESENT modifier is not supported in %s, %s"_warn_en_US,
4132 ThisVersion(version), TryVersion(allowedInVersion));
4134 if (expMod->size() != 1) {
4135 context_.Say(GetContext().clauseSource,
4136 "Only one PRESENT modifier is allowed"_err_en_US);
4140 if (auto &iterMod{std::get<std::optional<std::list<IterMod>>>(x.v.t)}) {
4141 unsigned allowedInVersion{51};
4142 if (version < allowedInVersion) {
4143 context_.Say(GetContext().clauseSource,
4144 "Iterator modifiers are not supported in %s, %s"_warn_en_US,
4145 ThisVersion(version), TryVersion(allowedInVersion));
4147 if (iterMod->size() != 1) {
4148 context_.Say(GetContext().clauseSource,
4149 "Only one iterator-modifier is allowed"_err_en_US);
4151 CheckIteratorModifier(iterMod->front());
4154 const auto &objList{std::get<parser::OmpObjectList>(x.v.t)};
4155 SymbolSourceMap symbols;
4156 GetSymbolsInObjectList(objList, symbols);
4157 for (const auto &[sym, source] : symbols) {
4158 if (!IsVariableListItem(*sym)) {
4159 context_.SayWithDecl(
4160 *sym, source, "'%s' must be a variable"_err_en_US, sym->name());
4164 // Ref: [4.5:109:19]
4165 // If a list item is an array section it must specify contiguous storage.
4166 if (version <= 45) {
4167 for (const parser::OmpObject &object : objList.v) {
4168 CheckIfContiguous(object);
4173 llvm::StringRef OmpStructureChecker::getClauseName(llvm::omp::Clause clause) {
4174 return llvm::omp::getOpenMPClauseName(clause);
4177 llvm::StringRef OmpStructureChecker::getDirectiveName(
4178 llvm::omp::Directive directive) {
4179 return llvm::omp::getOpenMPDirectiveName(directive);
4182 void OmpStructureChecker::CheckDependList(const parser::DataRef &d) {
4183 common::visit(
4184 common::visitors{
4185 [&](const common::Indirection<parser::ArrayElement> &elem) {
4186 // Check if the base element is valid on Depend Clause
4187 CheckDependList(elem.value().base);
4189 [&](const common::Indirection<parser::StructureComponent> &) {
4190 context_.Say(GetContext().clauseSource,
4191 "A variable that is part of another variable "
4192 "(such as an element of a structure) but is not an array "
4193 "element or an array section cannot appear in a DEPEND "
4194 "clause"_err_en_US);
4196 [&](const common::Indirection<parser::CoindexedNamedObject> &) {
4197 context_.Say(GetContext().clauseSource,
4198 "Coarrays are not supported in DEPEND clause"_err_en_US);
4200 [&](const parser::Name &) {},
4202 d.u);
4205 // Called from both Reduction and Depend clause.
4206 void OmpStructureChecker::CheckArraySection(
4207 const parser::ArrayElement &arrayElement, const parser::Name &name,
4208 const llvm::omp::Clause clause) {
4209 if (!arrayElement.subscripts.empty()) {
4210 for (const auto &subscript : arrayElement.subscripts) {
4211 if (const auto *triplet{
4212 std::get_if<parser::SubscriptTriplet>(&subscript.u)}) {
4213 if (std::get<0>(triplet->t) && std::get<1>(triplet->t)) {
4214 const auto &lower{std::get<0>(triplet->t)};
4215 const auto &upper{std::get<1>(triplet->t)};
4216 if (lower && upper) {
4217 const auto lval{GetIntValue(lower)};
4218 const auto uval{GetIntValue(upper)};
4219 if (lval && uval && *uval < *lval) {
4220 context_.Say(GetContext().clauseSource,
4221 "'%s' in %s clause"
4222 " is a zero size array section"_err_en_US,
4223 name.ToString(),
4224 parser::ToUpperCaseLetters(getClauseName(clause).str()));
4225 break;
4226 } else if (std::get<2>(triplet->t)) {
4227 const auto &strideExpr{std::get<2>(triplet->t)};
4228 if (strideExpr) {
4229 if (clause == llvm::omp::Clause::OMPC_depend) {
4230 context_.Say(GetContext().clauseSource,
4231 "Stride should not be specified for array section in "
4232 "DEPEND "
4233 "clause"_err_en_US);
4235 const auto stride{GetIntValue(strideExpr)};
4236 if ((stride && stride != 1)) {
4237 context_.Say(GetContext().clauseSource,
4238 "A list item that appears in a REDUCTION clause"
4239 " should have a contiguous storage array "
4240 "section."_err_en_US,
4241 ContextDirectiveAsFortran());
4242 break;
4253 void OmpStructureChecker::CheckIntentInPointer(
4254 const parser::OmpObjectList &objectList, const llvm::omp::Clause clause) {
4255 SymbolSourceMap symbols;
4256 GetSymbolsInObjectList(objectList, symbols);
4257 for (auto it{symbols.begin()}; it != symbols.end(); ++it) {
4258 const auto *symbol{it->first};
4259 const auto source{it->second};
4260 if (IsPointer(*symbol) && IsIntentIn(*symbol)) {
4261 context_.Say(source,
4262 "Pointer '%s' with the INTENT(IN) attribute may not appear "
4263 "in a %s clause"_err_en_US,
4264 symbol->name(),
4265 parser::ToUpperCaseLetters(getClauseName(clause).str()));
4270 void OmpStructureChecker::GetSymbolsInObjectList(
4271 const parser::OmpObjectList &objectList, SymbolSourceMap &symbols) {
4272 for (const auto &ompObject : objectList.v) {
4273 if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
4274 if (const auto *symbol{name->symbol}) {
4275 if (const auto *commonBlockDetails{
4276 symbol->detailsIf<CommonBlockDetails>()}) {
4277 for (const auto &object : commonBlockDetails->objects()) {
4278 symbols.emplace(&object->GetUltimate(), name->source);
4280 } else {
4281 symbols.emplace(&symbol->GetUltimate(), name->source);
4288 void OmpStructureChecker::CheckDefinableObjects(
4289 SymbolSourceMap &symbols, const llvm::omp::Clause clause) {
4290 for (auto it{symbols.begin()}; it != symbols.end(); ++it) {
4291 const auto *symbol{it->first};
4292 const auto source{it->second};
4293 if (auto msg{WhyNotDefinable(source, context_.FindScope(source),
4294 DefinabilityFlags{}, *symbol)}) {
4295 context_
4296 .Say(source,
4297 "Variable '%s' on the %s clause is not definable"_err_en_US,
4298 symbol->name(),
4299 parser::ToUpperCaseLetters(getClauseName(clause).str()))
4300 .Attach(std::move(msg->set_severity(parser::Severity::Because)));
4305 void OmpStructureChecker::CheckPrivateSymbolsInOuterCxt(
4306 SymbolSourceMap &currSymbols, DirectivesClauseTriple &dirClauseTriple,
4307 const llvm::omp::Clause currClause) {
4308 SymbolSourceMap enclosingSymbols;
4309 auto range{dirClauseTriple.equal_range(GetContext().directive)};
4310 for (auto dirIter{range.first}; dirIter != range.second; ++dirIter) {
4311 auto enclosingDir{dirIter->second.first};
4312 auto enclosingClauseSet{dirIter->second.second};
4313 if (auto *enclosingContext{GetEnclosingContextWithDir(enclosingDir)}) {
4314 for (auto it{enclosingContext->clauseInfo.begin()};
4315 it != enclosingContext->clauseInfo.end(); ++it) {
4316 if (enclosingClauseSet.test(it->first)) {
4317 if (const auto *ompObjectList{GetOmpObjectList(*it->second)}) {
4318 GetSymbolsInObjectList(*ompObjectList, enclosingSymbols);
4323 // Check if the symbols in current context are private in outer context
4324 for (auto iter{currSymbols.begin()}; iter != currSymbols.end(); ++iter) {
4325 const auto *symbol{iter->first};
4326 const auto source{iter->second};
4327 if (enclosingSymbols.find(symbol) != enclosingSymbols.end()) {
4328 context_.Say(source,
4329 "%s variable '%s' is PRIVATE in outer context"_err_en_US,
4330 parser::ToUpperCaseLetters(getClauseName(currClause).str()),
4331 symbol->name());
4338 bool OmpStructureChecker::CheckTargetBlockOnlyTeams(
4339 const parser::Block &block) {
4340 bool nestedTeams{false};
4342 if (!block.empty()) {
4343 auto it{block.begin()};
4344 if (const auto *ompConstruct{
4345 parser::Unwrap<parser::OpenMPConstruct>(*it)}) {
4346 if (const auto *ompBlockConstruct{
4347 std::get_if<parser::OpenMPBlockConstruct>(&ompConstruct->u)}) {
4348 const auto &beginBlockDir{
4349 std::get<parser::OmpBeginBlockDirective>(ompBlockConstruct->t)};
4350 const auto &beginDir{
4351 std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
4352 if (beginDir.v == llvm::omp::Directive::OMPD_teams) {
4353 nestedTeams = true;
4358 if (nestedTeams && ++it == block.end()) {
4359 return true;
4363 return false;
4366 void OmpStructureChecker::CheckWorkshareBlockStmts(
4367 const parser::Block &block, parser::CharBlock source) {
4368 OmpWorkshareBlockChecker ompWorkshareBlockChecker{context_, source};
4370 for (auto it{block.begin()}; it != block.end(); ++it) {
4371 if (parser::Unwrap<parser::AssignmentStmt>(*it) ||
4372 parser::Unwrap<parser::ForallStmt>(*it) ||
4373 parser::Unwrap<parser::ForallConstruct>(*it) ||
4374 parser::Unwrap<parser::WhereStmt>(*it) ||
4375 parser::Unwrap<parser::WhereConstruct>(*it)) {
4376 parser::Walk(*it, ompWorkshareBlockChecker);
4377 } else if (const auto *ompConstruct{
4378 parser::Unwrap<parser::OpenMPConstruct>(*it)}) {
4379 if (const auto *ompAtomicConstruct{
4380 std::get_if<parser::OpenMPAtomicConstruct>(&ompConstruct->u)}) {
4381 // Check if assignment statements in the enclosing OpenMP Atomic
4382 // construct are allowed in the Workshare construct
4383 parser::Walk(*ompAtomicConstruct, ompWorkshareBlockChecker);
4384 } else if (const auto *ompCriticalConstruct{
4385 std::get_if<parser::OpenMPCriticalConstruct>(
4386 &ompConstruct->u)}) {
4387 // All the restrictions on the Workshare construct apply to the
4388 // statements in the enclosing critical constructs
4389 const auto &criticalBlock{
4390 std::get<parser::Block>(ompCriticalConstruct->t)};
4391 CheckWorkshareBlockStmts(criticalBlock, source);
4392 } else {
4393 // Check if OpenMP constructs enclosed in the Workshare construct are
4394 // 'Parallel' constructs
4395 auto currentDir{llvm::omp::Directive::OMPD_unknown};
4396 if (const auto *ompBlockConstruct{
4397 std::get_if<parser::OpenMPBlockConstruct>(&ompConstruct->u)}) {
4398 const auto &beginBlockDir{
4399 std::get<parser::OmpBeginBlockDirective>(ompBlockConstruct->t)};
4400 const auto &beginDir{
4401 std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
4402 currentDir = beginDir.v;
4403 } else if (const auto *ompLoopConstruct{
4404 std::get_if<parser::OpenMPLoopConstruct>(
4405 &ompConstruct->u)}) {
4406 const auto &beginLoopDir{
4407 std::get<parser::OmpBeginLoopDirective>(ompLoopConstruct->t)};
4408 const auto &beginDir{
4409 std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
4410 currentDir = beginDir.v;
4411 } else if (const auto *ompSectionsConstruct{
4412 std::get_if<parser::OpenMPSectionsConstruct>(
4413 &ompConstruct->u)}) {
4414 const auto &beginSectionsDir{
4415 std::get<parser::OmpBeginSectionsDirective>(
4416 ompSectionsConstruct->t)};
4417 const auto &beginDir{
4418 std::get<parser::OmpSectionsDirective>(beginSectionsDir.t)};
4419 currentDir = beginDir.v;
4422 if (!llvm::omp::topParallelSet.test(currentDir)) {
4423 context_.Say(source,
4424 "OpenMP constructs enclosed in WORKSHARE construct may consist "
4425 "of ATOMIC, CRITICAL or PARALLEL constructs only"_err_en_US);
4428 } else {
4429 context_.Say(source,
4430 "The structured block in a WORKSHARE construct may consist of only "
4431 "SCALAR or ARRAY assignments, FORALL or WHERE statements, "
4432 "FORALL, WHERE, ATOMIC, CRITICAL or PARALLEL constructs"_err_en_US);
4437 void OmpStructureChecker::CheckIfContiguous(const parser::OmpObject &object) {
4438 if (auto contig{IsContiguous(object)}; contig && !*contig) {
4439 const parser::Name *name{GetObjectName(object)};
4440 assert(name && "Expecting name component");
4441 context_.Say(name->source,
4442 "Reference to %s must be a contiguous object"_err_en_US,
4443 name->ToString());
4447 namespace {
4448 struct NameHelper {
4449 template <typename T>
4450 static const parser::Name *Visit(const common::Indirection<T> &x) {
4451 return Visit(x.value());
4453 static const parser::Name *Visit(const parser::Substring &x) {
4454 return Visit(std::get<parser::DataRef>(x.t));
4456 static const parser::Name *Visit(const parser::ArrayElement &x) {
4457 return Visit(x.base);
4459 static const parser::Name *Visit(const parser::Designator &x) {
4460 return common::visit([](auto &&s) { return Visit(s); }, x.u);
4462 static const parser::Name *Visit(const parser::DataRef &x) {
4463 return common::visit([](auto &&s) { return Visit(s); }, x.u);
4465 static const parser::Name *Visit(const parser::OmpObject &x) {
4466 return common::visit([](auto &&s) { return Visit(s); }, x.u);
4468 template <typename T> static const parser::Name *Visit(T &&) {
4469 return nullptr;
4471 static const parser::Name *Visit(const parser::Name &x) { return &x; }
4473 } // namespace
4475 const parser::Name *OmpStructureChecker::GetObjectName(
4476 const parser::OmpObject &object) {
4477 return NameHelper::Visit(object);
4480 const parser::OmpObjectList *OmpStructureChecker::GetOmpObjectList(
4481 const parser::OmpClause &clause) {
4483 // Clauses with OmpObjectList as its data member
4484 using MemberObjectListClauses = std::tuple<parser::OmpClause::Copyprivate,
4485 parser::OmpClause::Copyin, parser::OmpClause::Enter,
4486 parser::OmpClause::Firstprivate, parser::OmpClause::Link,
4487 parser::OmpClause::Private, parser::OmpClause::Shared,
4488 parser::OmpClause::UseDevicePtr, parser::OmpClause::UseDeviceAddr>;
4490 // Clauses with OmpObjectList in the tuple
4491 using TupleObjectListClauses = std::tuple<parser::OmpClause::Aligned,
4492 parser::OmpClause::Allocate, parser::OmpClause::From,
4493 parser::OmpClause::Lastprivate, parser::OmpClause::Map,
4494 parser::OmpClause::Reduction, parser::OmpClause::To>;
4496 // TODO:: Generate the tuples using TableGen.
4497 // Handle other constructs with OmpObjectList such as OpenMPThreadprivate.
4498 return common::visit(
4499 common::visitors{
4500 [&](const auto &x) -> const parser::OmpObjectList * {
4501 using Ty = std::decay_t<decltype(x)>;
4502 if constexpr (common::HasMember<Ty, MemberObjectListClauses>) {
4503 return &x.v;
4504 } else if constexpr (common::HasMember<Ty,
4505 TupleObjectListClauses>) {
4506 return &(std::get<parser::OmpObjectList>(x.v.t));
4507 } else {
4508 return nullptr;
4512 clause.u);
4515 void OmpStructureChecker::Enter(
4516 const parser::OmpClause::AtomicDefaultMemOrder &x) {
4517 CheckAllowedRequiresClause(llvm::omp::Clause::OMPC_atomic_default_mem_order);
4520 void OmpStructureChecker::Enter(const parser::OmpClause::DynamicAllocators &x) {
4521 CheckAllowedRequiresClause(llvm::omp::Clause::OMPC_dynamic_allocators);
4524 void OmpStructureChecker::Enter(const parser::OmpClause::ReverseOffload &x) {
4525 CheckAllowedRequiresClause(llvm::omp::Clause::OMPC_reverse_offload);
4528 void OmpStructureChecker::Enter(const parser::OmpClause::UnifiedAddress &x) {
4529 CheckAllowedRequiresClause(llvm::omp::Clause::OMPC_unified_address);
4532 void OmpStructureChecker::Enter(
4533 const parser::OmpClause::UnifiedSharedMemory &x) {
4534 CheckAllowedRequiresClause(llvm::omp::Clause::OMPC_unified_shared_memory);
4537 void OmpStructureChecker::Enter(const parser::DoConstruct &x) {
4538 Base::Enter(x);
4539 loopStack_.push_back(&x);
4542 void OmpStructureChecker::Leave(const parser::DoConstruct &x) {
4543 assert(!loopStack_.empty() && "Expecting non-empty loop stack");
4544 #ifndef NDEBUG
4545 const LoopConstruct &top = loopStack_.back();
4546 auto *doc{std::get_if<const parser::DoConstruct *>(&top)};
4547 assert(doc != nullptr && *doc == &x && "Mismatched loop constructs");
4548 #endif
4549 loopStack_.pop_back();
4550 Base::Leave(x);
4553 void OmpStructureChecker::CheckAllowedRequiresClause(llvmOmpClause clause) {
4554 CheckAllowedClause(clause);
4556 if (clause != llvm::omp::Clause::OMPC_atomic_default_mem_order) {
4557 // Check that it does not appear after a device construct
4558 if (deviceConstructFound_) {
4559 context_.Say(GetContext().clauseSource,
4560 "REQUIRES directive with '%s' clause found lexically after device "
4561 "construct"_err_en_US,
4562 parser::ToUpperCaseLetters(getClauseName(clause).str()));
4567 } // namespace Fortran::semantics