1//===-- lib/Semantics/check-omp-structure.cpp -----------------------------===//
2//
3// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
4// See https://llvm.org/LICENSE.txt for license information.
5// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
6//
7//===----------------------------------------------------------------------===//
8
9#include "check-omp-structure.h"
10#include "definable.h"
11#include "resolve-names-utils.h"
12#include "flang/Evaluate/check-expression.h"
13#include "flang/Evaluate/expression.h"
14#include "flang/Evaluate/type.h"
15#include "flang/Parser/parse-tree.h"
16#include "flang/Semantics/expression.h"
17#include "flang/Semantics/openmp-modifiers.h"
18#include "flang/Semantics/tools.h"
19#include "llvm/ADT/STLExtras.h"
20#include "llvm/ADT/StringSwitch.h"
21#include <variant>
22
23namespace Fortran::semantics {
24
25template <typename T, typename U>
26static bool operator!=(const evaluate::Expr<T> &e, const evaluate::Expr<U> &f) {
27 return !(e == f);
28}
29
30// Use when clause falls under 'struct OmpClause' in 'parse-tree.h'.
31#define CHECK_SIMPLE_CLAUSE(X, Y) \
32 void OmpStructureChecker::Enter(const parser::OmpClause::X &) { \
33 CheckAllowedClause(llvm::omp::Clause::Y); \
34 }
35
36#define CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(X, Y) \
37 void OmpStructureChecker::Enter(const parser::OmpClause::X &c) { \
38 CheckAllowedClause(llvm::omp::Clause::Y); \
39 RequiresConstantPositiveParameter(llvm::omp::Clause::Y, c.v); \
40 }
41
42#define CHECK_REQ_SCALAR_INT_CLAUSE(X, Y) \
43 void OmpStructureChecker::Enter(const parser::OmpClause::X &c) { \
44 CheckAllowedClause(llvm::omp::Clause::Y); \
45 RequiresPositiveParameter(llvm::omp::Clause::Y, c.v); \
46 }
47
48// Use when clause don't falls under 'struct OmpClause' in 'parse-tree.h'.
49#define CHECK_SIMPLE_PARSER_CLAUSE(X, Y) \
50 void OmpStructureChecker::Enter(const parser::X &) { \
51 CheckAllowedClause(llvm::omp::Y); \
52 }
53
54std::string ThisVersion(unsigned version) {
55 std::string tv{
56 std::to_string(val: version / 10) + "." + std::to_string(val: version % 10)};
57 return "OpenMP v" + tv;
58}
59
60std::string TryVersion(unsigned version) {
61 return "try -fopenmp-version=" + std::to_string(val: version);
62}
63
64static const parser::Designator *GetDesignatorFromObj(
65 const parser::OmpObject &object) {
66 return std::get_if<parser::Designator>(&object.u);
67}
68
69static const parser::DataRef *GetDataRefFromObj(
70 const parser::OmpObject &object) {
71 if (auto *desg{GetDesignatorFromObj(object)}) {
72 return std::get_if<parser::DataRef>(&desg->u);
73 }
74 return nullptr;
75}
76
77static const parser::ArrayElement *GetArrayElementFromObj(
78 const parser::OmpObject &object) {
79 if (auto *dataRef{GetDataRefFromObj(object)}) {
80 using ElementIndirection = common::Indirection<parser::ArrayElement>;
81 if (auto *ind{std::get_if<ElementIndirection>(&dataRef->u)}) {
82 return &ind->value();
83 }
84 }
85 return nullptr;
86}
87
88static bool IsVarOrFunctionRef(const MaybeExpr &expr) {
89 if (expr) {
90 return evaluate::UnwrapProcedureRef(*expr) != nullptr ||
91 evaluate::IsVariable(*expr);
92 } else {
93 return false;
94 }
95}
96
97static std::optional<SomeExpr> GetEvaluateExpr(const parser::Expr &parserExpr) {
98 const parser::TypedExpr &typedExpr{parserExpr.typedExpr};
99 // ForwardOwningPointer typedExpr
100 // `- GenericExprWrapper ^.get()
101 // `- std::optional<Expr> ^->v
102 return typedExpr.get()->v;
103}
104
105static std::optional<evaluate::DynamicType> GetDynamicType(
106 const parser::Expr &parserExpr) {
107 if (auto maybeExpr{GetEvaluateExpr(parserExpr)}) {
108 return maybeExpr->GetType();
109 } else {
110 return std::nullopt;
111 }
112}
113
114// 'OmpWorkshareBlockChecker' is used to check the validity of the assignment
115// statements and the expressions enclosed in an OpenMP Workshare construct
116class OmpWorkshareBlockChecker {
117public:
118 OmpWorkshareBlockChecker(SemanticsContext &context, parser::CharBlock source)
119 : context_{context}, source_{source} {}
120
121 template <typename T> bool Pre(const T &) { return true; }
122 template <typename T> void Post(const T &) {}
123
124 bool Pre(const parser::AssignmentStmt &assignment) {
125 const auto &var{std::get<parser::Variable>(assignment.t)};
126 const auto &expr{std::get<parser::Expr>(assignment.t)};
127 const auto *lhs{GetExpr(context_, var)};
128 const auto *rhs{GetExpr(context_, expr)};
129 if (lhs && rhs) {
130 Tristate isDefined{semantics::IsDefinedAssignment(
131 lhs->GetType(), lhs->Rank(), rhs->GetType(), rhs->Rank())};
132 if (isDefined == Tristate::Yes) {
133 context_.Say(expr.source,
134 "Defined assignment statement is not "
135 "allowed in a WORKSHARE construct"_err_en_US);
136 }
137 }
138 return true;
139 }
140
141 bool Pre(const parser::Expr &expr) {
142 if (const auto *e{GetExpr(context_, expr)}) {
143 for (const Symbol &symbol : evaluate::CollectSymbols(*e)) {
144 const Symbol &root{GetAssociationRoot(symbol)};
145 if (IsFunction(root)) {
146 std::string attrs{""};
147 if (!IsElementalProcedure(root)) {
148 attrs = " non-ELEMENTAL";
149 }
150 if (root.attrs().test(Attr::IMPURE)) {
151 if (attrs != "") {
152 attrs = "," + attrs;
153 }
154 attrs = " IMPURE" + attrs;
155 }
156 if (attrs != "") {
157 context_.Say(expr.source,
158 "User defined%s function '%s' is not allowed in a "
159 "WORKSHARE construct"_err_en_US,
160 attrs, root.name());
161 }
162 }
163 }
164 }
165 return false;
166 }
167
168private:
169 SemanticsContext &context_;
170 parser::CharBlock source_;
171};
172
173class AssociatedLoopChecker {
174public:
175 AssociatedLoopChecker(SemanticsContext &context, std::int64_t level)
176 : context_{context}, level_{level} {}
177
178 template <typename T> bool Pre(const T &) { return true; }
179 template <typename T> void Post(const T &) {}
180
181 bool Pre(const parser::DoConstruct &dc) {
182 level_--;
183 const auto &doStmt{
184 std::get<parser::Statement<parser::NonLabelDoStmt>>(dc.t)};
185 const auto &constructName{
186 std::get<std::optional<parser::Name>>(doStmt.statement.t)};
187 if (constructName) {
188 constructNamesAndLevels_.emplace(
189 constructName.value().ToString(), level_);
190 }
191 if (level_ >= 0) {
192 if (dc.IsDoWhile()) {
193 context_.Say(doStmt.source,
194 "The associated loop of a loop-associated directive cannot be a DO WHILE."_err_en_US);
195 }
196 if (!dc.GetLoopControl()) {
197 context_.Say(doStmt.source,
198 "The associated loop of a loop-associated directive cannot be a DO without control."_err_en_US);
199 }
200 }
201 return true;
202 }
203
204 void Post(const parser::DoConstruct &dc) { level_++; }
205
206 bool Pre(const parser::CycleStmt &cyclestmt) {
207 std::map<std::string, std::int64_t>::iterator it;
208 bool err{false};
209 if (cyclestmt.v) {
210 it = constructNamesAndLevels_.find(cyclestmt.v->source.ToString());
211 err = (it != constructNamesAndLevels_.end() && it->second > 0);
212 } else { // If there is no label then use the level of the last enclosing DO
213 err = level_ > 0;
214 }
215 if (err) {
216 context_.Say(*source_,
217 "CYCLE statement to non-innermost associated loop of an OpenMP DO "
218 "construct"_err_en_US);
219 }
220 return true;
221 }
222
223 bool Pre(const parser::ExitStmt &exitStmt) {
224 std::map<std::string, std::int64_t>::iterator it;
225 bool err{false};
226 if (exitStmt.v) {
227 it = constructNamesAndLevels_.find(exitStmt.v->source.ToString());
228 err = (it != constructNamesAndLevels_.end() && it->second >= 0);
229 } else { // If there is no label then use the level of the last enclosing DO
230 err = level_ >= 0;
231 }
232 if (err) {
233 context_.Say(*source_,
234 "EXIT statement terminates associated loop of an OpenMP DO "
235 "construct"_err_en_US);
236 }
237 return true;
238 }
239
240 bool Pre(const parser::Statement<parser::ActionStmt> &actionstmt) {
241 source_ = &actionstmt.source;
242 return true;
243 }
244
245private:
246 SemanticsContext &context_;
247 const parser::CharBlock *source_;
248 std::int64_t level_;
249 std::map<std::string, std::int64_t> constructNamesAndLevels_;
250};
251
252// `OmpUnitedTaskDesignatorChecker` is used to check if the designator
253// can appear within the TASK construct
254class OmpUnitedTaskDesignatorChecker {
255public:
256 OmpUnitedTaskDesignatorChecker(SemanticsContext &context)
257 : context_{context} {}
258
259 template <typename T> bool Pre(const T &) { return true; }
260 template <typename T> void Post(const T &) {}
261
262 bool Pre(const parser::Name &name) {
263 if (name.symbol->test(Symbol::Flag::OmpThreadprivate)) {
264 // OpenMP 5.2: 5.2 threadprivate directive restriction
265 context_.Say(name.source,
266 "A THREADPRIVATE variable `%s` cannot appear in an UNTIED TASK region"_err_en_US,
267 name.source);
268 }
269 return true;
270 }
271
272private:
273 SemanticsContext &context_;
274};
275
276bool OmpStructureChecker::CheckAllowedClause(llvmOmpClause clause) {
277 // Do not do clause checks while processing METADIRECTIVE.
278 // Context selectors can contain clauses that are not given as a part
279 // of a construct, but as trait properties. Testing whether they are
280 // valid or not is deferred to the checks of the context selectors.
281 // As it stands now, these clauses would appear as if they were present
282 // on METADIRECTIVE, leading to incorrect diagnostics.
283 if (GetDirectiveNest(index: ContextSelectorNest) > 0) {
284 return true;
285 }
286
287 unsigned version{context_.langOptions().OpenMPVersion};
288 DirectiveContext &dirCtx = GetContext();
289 llvm::omp::Directive dir{dirCtx.directive};
290
291 if (!llvm::omp::isAllowedClauseForDirective(dir, clause, version)) {
292 unsigned allowedInVersion{[&] {
293 for (unsigned v : llvm::omp::getOpenMPVersions()) {
294 if (v <= version) {
295 continue;
296 }
297 if (llvm::omp::isAllowedClauseForDirective(dir, clause, v)) {
298 return v;
299 }
300 }
301 return 0u;
302 }()};
303
304 // Only report it if there is a later version that allows it.
305 // If it's not allowed at all, it will be reported by CheckAllowed.
306 if (allowedInVersion != 0) {
307 auto clauseName{parser::ToUpperCaseLetters(getClauseName(clause).str())};
308 auto dirName{parser::ToUpperCaseLetters(getDirectiveName(dir).str())};
309
310 context_.Say(dirCtx.clauseSource,
311 "%s clause is not allowed on directive %s in %s, %s"_err_en_US,
312 clauseName, dirName, ThisVersion(version),
313 TryVersion(allowedInVersion));
314 }
315 }
316 return CheckAllowed(clause);
317}
318
319bool OmpStructureChecker::IsCommonBlock(const Symbol &sym) {
320 return sym.detailsIf<CommonBlockDetails>() != nullptr;
321}
322
323bool OmpStructureChecker::IsVariableListItem(const Symbol &sym) {
324 return evaluate::IsVariable(sym) || sym.attrs().test(Attr::POINTER);
325}
326
327bool OmpStructureChecker::IsExtendedListItem(const Symbol &sym) {
328 return IsVariableListItem(sym) || sym.IsSubprogram();
329}
330
331bool OmpStructureChecker::IsCloselyNestedRegion(const OmpDirectiveSet &set) {
332 // Definition of close nesting:
333 //
334 // `A region nested inside another region with no parallel region nested
335 // between them`
336 //
337 // Examples:
338 // non-parallel construct 1
339 // non-parallel construct 2
340 // parallel construct
341 // construct 3
342 // In the above example, construct 3 is NOT closely nested inside construct 1
343 // or 2
344 //
345 // non-parallel construct 1
346 // non-parallel construct 2
347 // construct 3
348 // In the above example, construct 3 is closely nested inside BOTH construct 1
349 // and 2
350 //
351 // Algorithm:
352 // Starting from the parent context, Check in a bottom-up fashion, each level
353 // of the context stack. If we have a match for one of the (supplied)
354 // violating directives, `close nesting` is satisfied. If no match is there in
355 // the entire stack, `close nesting` is not satisfied. If at any level, a
356 // `parallel` region is found, `close nesting` is not satisfied.
357
358 if (CurrentDirectiveIsNested()) {
359 int index = dirContext_.size() - 2;
360 while (index != -1) {
361 if (set.test(dirContext_[index].directive)) {
362 return true;
363 } else if (llvm::omp::allParallelSet.test(dirContext_[index].directive)) {
364 return false;
365 }
366 index--;
367 }
368 }
369 return false;
370}
371
372namespace {
373struct ContiguousHelper {
374 ContiguousHelper(SemanticsContext &context)
375 : fctx_(context.foldingContext()) {}
376
377 template <typename Contained>
378 std::optional<bool> Visit(const common::Indirection<Contained> &x) {
379 return Visit(x.value());
380 }
381 template <typename Contained>
382 std::optional<bool> Visit(const common::Reference<Contained> &x) {
383 return Visit(x.get());
384 }
385 template <typename T> std::optional<bool> Visit(const evaluate::Expr<T> &x) {
386 return common::visit([&](auto &&s) { return Visit(s); }, x.u);
387 }
388 template <typename T>
389 std::optional<bool> Visit(const evaluate::Designator<T> &x) {
390 return common::visit(
391 [this](auto &&s) { return evaluate::IsContiguous(s, fctx_); }, x.u);
392 }
393 template <typename T> std::optional<bool> Visit(const T &) {
394 // Everything else.
395 return std::nullopt;
396 }
397
398private:
399 evaluate::FoldingContext &fctx_;
400};
401} // namespace
402
403// Return values:
404// - std::optional<bool>{true} if the object is known to be contiguous
405// - std::optional<bool>{false} if the object is known not to be contiguous
406// - std::nullopt if the object contiguity cannot be determined
407std::optional<bool> OmpStructureChecker::IsContiguous(
408 const parser::OmpObject &object) {
409 return common::visit( //
410 common::visitors{
411 [&](const parser::Name &x) {
412 // Any member of a common block must be contiguous.
413 return std::optional<bool>{true};
414 },
415 [&](const parser::Designator &x) {
416 evaluate::ExpressionAnalyzer ea{context_};
417 if (MaybeExpr maybeExpr{ea.Analyze(x)}) {
418 return ContiguousHelper{context_}.Visit(*maybeExpr);
419 }
420 return std::optional<bool>{};
421 },
422 },
423 object.u);
424}
425
426void OmpStructureChecker::CheckVariableListItem(
427 const SymbolSourceMap &symbols) {
428 for (auto &[symbol, source] : symbols) {
429 if (!IsVariableListItem(*symbol)) {
430 context_.SayWithDecl(
431 *symbol, source, "'%s' must be a variable"_err_en_US, symbol->name());
432 }
433 }
434}
435
436void OmpStructureChecker::CheckMultipleOccurrence(
437 semantics::UnorderedSymbolSet &listVars,
438 const std::list<parser::Name> &nameList, const parser::CharBlock &item,
439 const std::string &clauseName) {
440 for (auto const &var : nameList) {
441 if (llvm::is_contained(listVars, *(var.symbol))) {
442 context_.Say(item,
443 "List item '%s' present at multiple %s clauses"_err_en_US,
444 var.ToString(), clauseName);
445 }
446 listVars.insert(*(var.symbol));
447 }
448}
449
450void OmpStructureChecker::CheckMultListItems() {
451 semantics::UnorderedSymbolSet listVars;
452
453 // Aligned clause
454 for (auto [_, clause] : FindClauses(llvm::omp::Clause::OMPC_aligned)) {
455 const auto &alignedClause{std::get<parser::OmpClause::Aligned>(clause->u)};
456 const auto &alignedList{std::get<0>(alignedClause.v.t)};
457 std::list<parser::Name> alignedNameList;
458 for (const auto &ompObject : alignedList.v) {
459 if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
460 if (name->symbol) {
461 if (FindCommonBlockContaining(*(name->symbol))) {
462 context_.Say(clause->source,
463 "'%s' is a common block name and can not appear in an "
464 "ALIGNED clause"_err_en_US,
465 name->ToString());
466 } else if (!(IsBuiltinCPtr(*(name->symbol)) ||
467 IsAllocatableOrObjectPointer(
468 &name->symbol->GetUltimate()))) {
469 context_.Say(clause->source,
470 "'%s' in ALIGNED clause must be of type C_PTR, POINTER or "
471 "ALLOCATABLE"_err_en_US,
472 name->ToString());
473 } else {
474 alignedNameList.push_back(*name);
475 }
476 } else {
477 // The symbol is null, return early
478 return;
479 }
480 }
481 }
482 CheckMultipleOccurrence(
483 listVars, alignedNameList, clause->source, "ALIGNED");
484 }
485
486 // Nontemporal clause
487 for (auto [_, clause] : FindClauses(llvm::omp::Clause::OMPC_nontemporal)) {
488 const auto &nontempClause{
489 std::get<parser::OmpClause::Nontemporal>(clause->u)};
490 const auto &nontempNameList{nontempClause.v};
491 CheckMultipleOccurrence(
492 listVars, nontempNameList, clause->source, "NONTEMPORAL");
493 }
494
495 // Linear clause
496 for (auto [_, clause] : FindClauses(llvm::omp::Clause::OMPC_linear)) {
497 auto &linearClause{std::get<parser::OmpClause::Linear>(clause->u)};
498 std::list<parser::Name> nameList;
499 SymbolSourceMap symbols;
500 GetSymbolsInObjectList(
501 std::get<parser::OmpObjectList>(linearClause.v.t), symbols);
502 llvm::transform(symbols, std::back_inserter(nameList), [&](auto &&pair) {
503 return parser::Name{pair.second, const_cast<Symbol *>(pair.first)};
504 });
505 CheckMultipleOccurrence(listVars, nameList, clause->source, "LINEAR");
506 }
507}
508
509bool OmpStructureChecker::HasInvalidWorksharingNesting(
510 const parser::CharBlock &source, const OmpDirectiveSet &set) {
511 // set contains all the invalid closely nested directives
512 // for the given directive (`source` here)
513 if (IsCloselyNestedRegion(set)) {
514 context_.Say(source,
515 "A worksharing region may not be closely nested inside a "
516 "worksharing, explicit task, taskloop, critical, ordered, atomic, or "
517 "master region"_err_en_US);
518 return true;
519 }
520 return false;
521}
522
523void OmpStructureChecker::HasInvalidDistributeNesting(
524 const parser::OpenMPLoopConstruct &x) {
525 bool violation{false};
526 const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
527 const auto &beginDir{std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
528 if (llvm::omp::topDistributeSet.test(beginDir.v)) {
529 // `distribute` region has to be nested
530 if (!CurrentDirectiveIsNested()) {
531 violation = true;
532 } else {
533 // `distribute` region has to be strictly nested inside `teams`
534 if (!llvm::omp::bottomTeamsSet.test(GetContextParent().directive)) {
535 violation = true;
536 }
537 }
538 }
539 if (violation) {
540 context_.Say(beginDir.source,
541 "`DISTRIBUTE` region has to be strictly nested inside `TEAMS` "
542 "region."_err_en_US);
543 }
544}
545void OmpStructureChecker::HasInvalidLoopBinding(
546 const parser::OpenMPLoopConstruct &x) {
547 const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
548 const auto &beginDir{std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
549
550 auto teamsBindingChecker = [&](parser::MessageFixedText msg) {
551 const auto &clauseList{std::get<parser::OmpClauseList>(beginLoopDir.t)};
552 for (const auto &clause : clauseList.v) {
553 if (const auto *bindClause{
554 std::get_if<parser::OmpClause::Bind>(&clause.u)}) {
555 if (bindClause->v.v != parser::OmpBindClause::Binding::Teams) {
556 context_.Say(beginDir.source, msg);
557 }
558 }
559 }
560 };
561
562 if (llvm::omp::Directive::OMPD_loop == beginDir.v &&
563 CurrentDirectiveIsNested() &&
564 llvm::omp::bottomTeamsSet.test(GetContextParent().directive)) {
565 teamsBindingChecker(
566 "`BIND(TEAMS)` must be specified since the `LOOP` region is "
567 "strictly nested inside a `TEAMS` region."_err_en_US);
568 }
569
570 if (OmpDirectiveSet{
571 llvm::omp::OMPD_teams_loop, llvm::omp::OMPD_target_teams_loop}
572 .test(beginDir.v)) {
573 teamsBindingChecker(
574 "`BIND(TEAMS)` must be specified since the `LOOP` directive is "
575 "combined with a `TEAMS` construct."_err_en_US);
576 }
577}
578
579void OmpStructureChecker::HasInvalidTeamsNesting(
580 const llvm::omp::Directive &dir, const parser::CharBlock &source) {
581 if (!llvm::omp::nestedTeamsAllowedSet.test(dir)) {
582 context_.Say(source,
583 "Only `DISTRIBUTE`, `PARALLEL`, or `LOOP` regions are allowed to be "
584 "strictly nested inside `TEAMS` region."_err_en_US);
585 }
586}
587
588void OmpStructureChecker::CheckPredefinedAllocatorRestriction(
589 const parser::CharBlock &source, const parser::Name &name) {
590 if (const auto *symbol{name.symbol}) {
591 const auto *commonBlock{FindCommonBlockContaining(*symbol)};
592 const auto &scope{context_.FindScope(symbol->name())};
593 const Scope &containingScope{GetProgramUnitContaining(scope)};
594 if (!isPredefinedAllocator &&
595 (IsSaved(*symbol) || commonBlock ||
596 containingScope.kind() == Scope::Kind::Module)) {
597 context_.Say(source,
598 "If list items within the %s directive have the "
599 "SAVE attribute, are a common block name, or are "
600 "declared in the scope of a module, then only "
601 "predefined memory allocator parameters can be used "
602 "in the allocator clause"_err_en_US,
603 ContextDirectiveAsFortran());
604 }
605 }
606}
607
608void OmpStructureChecker::CheckPredefinedAllocatorRestriction(
609 const parser::CharBlock &source,
610 const parser::OmpObjectList &ompObjectList) {
611 for (const auto &ompObject : ompObjectList.v) {
612 common::visit(
613 common::visitors{
614 [&](const parser::Designator &designator) {
615 if (const auto *dataRef{
616 std::get_if<parser::DataRef>(&designator.u)}) {
617 if (const auto *name{std::get_if<parser::Name>(&dataRef->u)}) {
618 CheckPredefinedAllocatorRestriction(source, *name);
619 }
620 }
621 },
622 [&](const parser::Name &name) {
623 CheckPredefinedAllocatorRestriction(source, name);
624 },
625 },
626 ompObject.u);
627 }
628}
629
630void OmpStructureChecker::Enter(const parser::OmpClause::Hint &x) {
631 CheckAllowedClause(llvm::omp::Clause::OMPC_hint);
632 auto &dirCtx{GetContext()};
633
634 if (std::optional<int64_t> maybeVal{GetIntValue(x.v.v)}) {
635 int64_t val{*maybeVal};
636 if (val >= 0) {
637 // Check contradictory values.
638 if ((val & 0xC) == 0xC || // omp_sync_hint_speculative and nonspeculative
639 (val & 0x3) == 0x3) { // omp_sync_hint_contended and uncontended
640 context_.Say(dirCtx.clauseSource,
641 "The synchronization hint is not valid"_err_en_US);
642 }
643 } else {
644 context_.Say(dirCtx.clauseSource,
645 "Synchronization hint must be non-negative"_err_en_US);
646 }
647 } else {
648 context_.Say(dirCtx.clauseSource,
649 "Synchronization hint must be a constant integer value"_err_en_US);
650 }
651}
652
653void OmpStructureChecker::Enter(const parser::OmpDirectiveSpecification &x) {
654 // OmpDirectiveSpecification exists on its own only in METADIRECTIVE.
655 // In other cases it's a part of other constructs that handle directive
656 // context stack by themselves.
657 if (GetDirectiveNest(index: MetadirectiveNest)) {
658 PushContextAndClauseSets(
659 std::get<parser::OmpDirectiveName>(x.t).source, x.DirId());
660 }
661}
662
663void OmpStructureChecker::Leave(const parser::OmpDirectiveSpecification &) {
664 if (GetDirectiveNest(index: MetadirectiveNest)) {
665 dirContext_.pop_back();
666 }
667}
668
669void OmpStructureChecker::Enter(const parser::OmpMetadirectiveDirective &x) {
670 EnterDirectiveNest(index: MetadirectiveNest);
671 PushContextAndClauseSets(x.source, llvm::omp::Directive::OMPD_metadirective);
672}
673
674void OmpStructureChecker::Leave(const parser::OmpMetadirectiveDirective &) {
675 ExitDirectiveNest(index: MetadirectiveNest);
676 dirContext_.pop_back();
677}
678
679void OmpStructureChecker::Enter(const parser::OpenMPConstruct &x) {
680 // Simd Construct with Ordered Construct Nesting check
681 // We cannot use CurrentDirectiveIsNested() here because
682 // PushContextAndClauseSets() has not been called yet, it is
683 // called individually for each construct. Therefore a
684 // dirContext_ size `1` means the current construct is nested
685 if (dirContext_.size() >= 1) {
686 if (GetDirectiveNest(index: SIMDNest) > 0) {
687 CheckSIMDNest(x);
688 }
689 if (GetDirectiveNest(index: TargetNest) > 0) {
690 CheckTargetNest(x);
691 }
692 }
693}
694
695void OmpStructureChecker::Leave(const parser::OpenMPConstruct &) {
696 for (const auto &[sym, source] : deferredNonVariables_) {
697 context_.SayWithDecl(
698 *sym, source, "'%s' must be a variable"_err_en_US, sym->name());
699 }
700 deferredNonVariables_.clear();
701}
702
703void OmpStructureChecker::Enter(const parser::OpenMPDeclarativeConstruct &x) {
704 EnterDirectiveNest(index: DeclarativeNest);
705}
706
707void OmpStructureChecker::Leave(const parser::OpenMPDeclarativeConstruct &x) {
708 ExitDirectiveNest(index: DeclarativeNest);
709}
710
711void OmpStructureChecker::AddEndDirectiveClauses(
712 const parser::OmpClauseList &clauses) {
713 for (const parser::OmpClause &clause : clauses.v) {
714 GetContext().endDirectiveClauses.push_back(clause.Id());
715 }
716}
717
718void OmpStructureChecker::Enter(const parser::OpenMPLoopConstruct &x) {
719 loopStack_.push_back(&x);
720 const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
721 const auto &beginDir{std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
722
723 PushContextAndClauseSets(beginDir.source, beginDir.v);
724
725 // check matching, End directive is optional
726 if (const auto &endLoopDir{
727 std::get<std::optional<parser::OmpEndLoopDirective>>(x.t)}) {
728 const auto &endDir{
729 std::get<parser::OmpLoopDirective>(endLoopDir.value().t)};
730
731 CheckMatching<parser::OmpLoopDirective>(beginDir, endDir);
732
733 AddEndDirectiveClauses(std::get<parser::OmpClauseList>(endLoopDir->t));
734 }
735
736 if (llvm::omp::allSimdSet.test(GetContext().directive)) {
737 EnterDirectiveNest(index: SIMDNest);
738 }
739
740 // Combined target loop constructs are target device constructs. Keep track of
741 // whether any such construct has been visited to later check that REQUIRES
742 // directives for target-related options don't appear after them.
743 if (llvm::omp::allTargetSet.test(beginDir.v)) {
744 deviceConstructFound_ = true;
745 }
746
747 if (beginDir.v == llvm::omp::Directive::OMPD_do) {
748 // 2.7.1 do-clause -> private-clause |
749 // firstprivate-clause |
750 // lastprivate-clause |
751 // linear-clause |
752 // reduction-clause |
753 // schedule-clause |
754 // collapse-clause |
755 // ordered-clause
756
757 // nesting check
758 HasInvalidWorksharingNesting(
759 beginDir.source, llvm::omp::nestedWorkshareErrSet);
760 }
761 SetLoopInfo(x);
762
763 if (const auto &doConstruct{
764 std::get<std::optional<parser::DoConstruct>>(x.t)}) {
765 const auto &doBlock{std::get<parser::Block>(doConstruct->t)};
766 CheckNoBranching(doBlock, beginDir.v, beginDir.source);
767 }
768 CheckLoopItrVariableIsInt(x);
769 CheckAssociatedLoopConstraints(x);
770 HasInvalidDistributeNesting(x);
771 HasInvalidLoopBinding(x);
772 if (CurrentDirectiveIsNested() &&
773 llvm::omp::bottomTeamsSet.test(GetContextParent().directive)) {
774 HasInvalidTeamsNesting(beginDir.v, beginDir.source);
775 }
776 if ((beginDir.v == llvm::omp::Directive::OMPD_distribute_parallel_do_simd) ||
777 (beginDir.v == llvm::omp::Directive::OMPD_distribute_simd)) {
778 CheckDistLinear(x);
779 }
780}
781const parser::Name OmpStructureChecker::GetLoopIndex(
782 const parser::DoConstruct *x) {
783 using Bounds = parser::LoopControl::Bounds;
784 return std::get<Bounds>(x->GetLoopControl()->u).name.thing;
785}
786void OmpStructureChecker::SetLoopInfo(const parser::OpenMPLoopConstruct &x) {
787 if (const auto &loopConstruct{
788 std::get<std::optional<parser::DoConstruct>>(x.t)}) {
789 const parser::DoConstruct *loop{&*loopConstruct};
790 if (loop && loop->IsDoNormal()) {
791 const parser::Name &itrVal{GetLoopIndex(loop)};
792 SetLoopIv(itrVal.symbol);
793 }
794 }
795}
796
797void OmpStructureChecker::CheckIteratorRange(
798 const parser::OmpIteratorSpecifier &x) {
799 // Check:
800 // 1. Whether begin/end are present.
801 // 2. Whether the step value is non-zero.
802 // 3. If the step has a known sign, whether the lower/upper bounds form
803 // a proper interval.
804 const auto &[begin, end, step]{std::get<parser::SubscriptTriplet>(x.t).t};
805 if (!begin || !end) {
806 context_.Say(x.source,
807 "The begin and end expressions in iterator range-specification are "
808 "mandatory"_err_en_US);
809 }
810 // [5.2:67:19] In a range-specification, if the step is not specified its
811 // value is implicitly defined to be 1.
812 if (auto stepv{step ? GetIntValue(*step) : std::optional<int64_t>{1}}) {
813 if (*stepv == 0) {
814 context_.Say(
815 x.source, "The step value in the iterator range is 0"_warn_en_US);
816 } else if (begin && end) {
817 std::optional<int64_t> beginv{GetIntValue(*begin)};
818 std::optional<int64_t> endv{GetIntValue(*end)};
819 if (beginv && endv) {
820 if (*stepv > 0 && *beginv > *endv) {
821 context_.Say(x.source,
822 "The begin value is greater than the end value in iterator "
823 "range-specification with a positive step"_warn_en_US);
824 } else if (*stepv < 0 && *beginv < *endv) {
825 context_.Say(x.source,
826 "The begin value is less than the end value in iterator "
827 "range-specification with a negative step"_warn_en_US);
828 }
829 }
830 }
831 }
832}
833
834void OmpStructureChecker::CheckIteratorModifier(const parser::OmpIterator &x) {
835 // Check if all iterator variables have integer type.
836 for (auto &&iterSpec : x.v) {
837 bool isInteger{true};
838 auto &typeDecl{std::get<parser::TypeDeclarationStmt>(iterSpec.t)};
839 auto &typeSpec{std::get<parser::DeclarationTypeSpec>(typeDecl.t)};
840 if (!std::holds_alternative<parser::IntrinsicTypeSpec>(typeSpec.u)) {
841 isInteger = false;
842 } else {
843 auto &intrinType{std::get<parser::IntrinsicTypeSpec>(typeSpec.u)};
844 if (!std::holds_alternative<parser::IntegerTypeSpec>(intrinType.u)) {
845 isInteger = false;
846 }
847 }
848 if (!isInteger) {
849 context_.Say(iterSpec.source,
850 "The iterator variable must be of integer type"_err_en_US);
851 }
852 CheckIteratorRange(iterSpec);
853 }
854}
855
856void OmpStructureChecker::CheckLoopItrVariableIsInt(
857 const parser::OpenMPLoopConstruct &x) {
858 if (const auto &loopConstruct{
859 std::get<std::optional<parser::DoConstruct>>(x.t)}) {
860
861 for (const parser::DoConstruct *loop{&*loopConstruct}; loop;) {
862 if (loop->IsDoNormal()) {
863 const parser::Name &itrVal{GetLoopIndex(loop)};
864 if (itrVal.symbol) {
865 const auto *type{itrVal.symbol->GetType()};
866 if (!type->IsNumeric(TypeCategory::Integer)) {
867 context_.Say(itrVal.source,
868 "The DO loop iteration"
869 " variable must be of the type integer."_err_en_US,
870 itrVal.ToString());
871 }
872 }
873 }
874 // Get the next DoConstruct if block is not empty.
875 const auto &block{std::get<parser::Block>(loop->t)};
876 const auto it{block.begin()};
877 loop = it != block.end() ? parser::Unwrap<parser::DoConstruct>(*it)
878 : nullptr;
879 }
880 }
881}
882
883void OmpStructureChecker::CheckSIMDNest(const parser::OpenMPConstruct &c) {
884 // Check the following:
885 // The only OpenMP constructs that can be encountered during execution of
886 // a simd region are the `atomic` construct, the `loop` construct, the `simd`
887 // construct and the `ordered` construct with the `simd` clause.
888
889 // Check if the parent context has the SIMD clause
890 // Please note that we use GetContext() instead of GetContextParent()
891 // because PushContextAndClauseSets() has not been called on the
892 // current context yet.
893 // TODO: Check for declare simd regions.
894 bool eligibleSIMD{false};
895 common::visit(
896 common::visitors{
897 // Allow `!$OMP ORDERED SIMD`
898 [&](const parser::OpenMPBlockConstruct &c) {
899 const auto &beginBlockDir{
900 std::get<parser::OmpBeginBlockDirective>(c.t)};
901 const auto &beginDir{
902 std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
903 if (beginDir.v == llvm::omp::Directive::OMPD_ordered) {
904 const auto &clauses{
905 std::get<parser::OmpClauseList>(beginBlockDir.t)};
906 for (const auto &clause : clauses.v) {
907 if (std::get_if<parser::OmpClause::Simd>(&clause.u)) {
908 eligibleSIMD = true;
909 break;
910 }
911 }
912 }
913 },
914 [&](const parser::OpenMPStandaloneConstruct &c) {
915 if (auto *ssc{std::get_if<parser::OpenMPSimpleStandaloneConstruct>(
916 &c.u)}) {
917 llvm::omp::Directive dirId{ssc->v.DirId()};
918 if (dirId == llvm::omp::Directive::OMPD_ordered) {
919 for (const parser::OmpClause &x : ssc->v.Clauses().v) {
920 if (x.Id() == llvm::omp::Clause::OMPC_simd) {
921 eligibleSIMD = true;
922 break;
923 }
924 }
925 } else if (dirId == llvm::omp::Directive::OMPD_scan) {
926 eligibleSIMD = true;
927 }
928 }
929 },
930 // Allowing SIMD and loop construct
931 [&](const parser::OpenMPLoopConstruct &c) {
932 const auto &beginLoopDir{
933 std::get<parser::OmpBeginLoopDirective>(c.t)};
934 const auto &beginDir{
935 std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
936 if ((beginDir.v == llvm::omp::Directive::OMPD_simd) ||
937 (beginDir.v == llvm::omp::Directive::OMPD_do_simd) ||
938 (beginDir.v == llvm::omp::Directive::OMPD_loop)) {
939 eligibleSIMD = true;
940 }
941 },
942 [&](const parser::OpenMPAtomicConstruct &c) {
943 // Allow `!$OMP ATOMIC`
944 eligibleSIMD = true;
945 },
946 [&](const auto &c) {},
947 },
948 c.u);
949 if (!eligibleSIMD) {
950 context_.Say(parser::FindSourceLocation(c),
951 "The only OpenMP constructs that can be encountered during execution "
952 "of a 'SIMD' region are the `ATOMIC` construct, the `LOOP` construct, "
953 "the `SIMD` construct, the `SCAN` construct and the `ORDERED` "
954 "construct with the `SIMD` clause."_err_en_US);
955 }
956}
957
958void OmpStructureChecker::CheckTargetNest(const parser::OpenMPConstruct &c) {
959 // 2.12.5 Target Construct Restriction
960 bool eligibleTarget{true};
961 llvm::omp::Directive ineligibleTargetDir;
962 common::visit(
963 common::visitors{
964 [&](const parser::OpenMPBlockConstruct &c) {
965 const auto &beginBlockDir{
966 std::get<parser::OmpBeginBlockDirective>(c.t)};
967 const auto &beginDir{
968 std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
969 if (beginDir.v == llvm::omp::Directive::OMPD_target_data) {
970 eligibleTarget = false;
971 ineligibleTargetDir = beginDir.v;
972 }
973 },
974 [&](const parser::OpenMPStandaloneConstruct &c) {
975 common::visit(
976 common::visitors{
977 [&](const parser::OpenMPSimpleStandaloneConstruct &c) {
978 switch (llvm::omp::Directive dirId{c.v.DirId()}) {
979 case llvm::omp::Directive::OMPD_target_update:
980 case llvm::omp::Directive::OMPD_target_enter_data:
981 case llvm::omp::Directive::OMPD_target_exit_data:
982 eligibleTarget = false;
983 ineligibleTargetDir = dirId;
984 break;
985 default:
986 break;
987 }
988 },
989 [&](const auto &c) {},
990 },
991 c.u);
992 },
993 [&](const parser::OpenMPLoopConstruct &c) {
994 const auto &beginLoopDir{
995 std::get<parser::OmpBeginLoopDirective>(c.t)};
996 const auto &beginDir{
997 std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
998 if (llvm::omp::allTargetSet.test(beginDir.v)) {
999 eligibleTarget = false;
1000 ineligibleTargetDir = beginDir.v;
1001 }
1002 },
1003 [&](const auto &c) {},
1004 },
1005 c.u);
1006 if (!eligibleTarget) {
1007 context_.Warn(common::UsageWarning::OpenMPUsage,
1008 parser::FindSourceLocation(c),
1009 "If %s directive is nested inside TARGET region, the behaviour is unspecified"_port_en_US,
1010 parser::ToUpperCaseLetters(
1011 getDirectiveName(ineligibleTargetDir).str()));
1012 }
1013}
1014
1015std::int64_t OmpStructureChecker::GetOrdCollapseLevel(
1016 const parser::OpenMPLoopConstruct &x) {
1017 const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
1018 const auto &clauseList{std::get<parser::OmpClauseList>(beginLoopDir.t)};
1019 std::int64_t orderedCollapseLevel{1};
1020 std::int64_t orderedLevel{1};
1021 std::int64_t collapseLevel{1};
1022
1023 for (const auto &clause : clauseList.v) {
1024 if (const auto *collapseClause{
1025 std::get_if<parser::OmpClause::Collapse>(&clause.u)}) {
1026 if (const auto v{GetIntValue(collapseClause->v)}) {
1027 collapseLevel = *v;
1028 }
1029 }
1030 if (const auto *orderedClause{
1031 std::get_if<parser::OmpClause::Ordered>(&clause.u)}) {
1032 if (const auto v{GetIntValue(orderedClause->v)}) {
1033 orderedLevel = *v;
1034 }
1035 }
1036 }
1037 if (orderedLevel >= collapseLevel) {
1038 orderedCollapseLevel = orderedLevel;
1039 } else {
1040 orderedCollapseLevel = collapseLevel;
1041 }
1042 return orderedCollapseLevel;
1043}
1044
1045void OmpStructureChecker::CheckAssociatedLoopConstraints(
1046 const parser::OpenMPLoopConstruct &x) {
1047 std::int64_t ordCollapseLevel{GetOrdCollapseLevel(x)};
1048 AssociatedLoopChecker checker{context_, ordCollapseLevel};
1049 parser::Walk(x, checker);
1050}
1051
1052void OmpStructureChecker::CheckDistLinear(
1053 const parser::OpenMPLoopConstruct &x) {
1054
1055 const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
1056 const auto &clauses{std::get<parser::OmpClauseList>(beginLoopDir.t)};
1057
1058 SymbolSourceMap indexVars;
1059
1060 // Collect symbols of all the variables from linear clauses
1061 for (auto &clause : clauses.v) {
1062 if (auto *linearClause{std::get_if<parser::OmpClause::Linear>(&clause.u)}) {
1063 auto &objects{std::get<parser::OmpObjectList>(linearClause->v.t)};
1064 GetSymbolsInObjectList(objects, indexVars);
1065 }
1066 }
1067
1068 if (!indexVars.empty()) {
1069 // Get collapse level, if given, to find which loops are "associated."
1070 std::int64_t collapseVal{GetOrdCollapseLevel(x)};
1071 // Include the top loop if no collapse is specified
1072 if (collapseVal == 0) {
1073 collapseVal = 1;
1074 }
1075
1076 // Match the loop index variables with the collected symbols from linear
1077 // clauses.
1078 if (const auto &loopConstruct{
1079 std::get<std::optional<parser::DoConstruct>>(x.t)}) {
1080 for (const parser::DoConstruct *loop{&*loopConstruct}; loop;) {
1081 if (loop->IsDoNormal()) {
1082 const parser::Name &itrVal{GetLoopIndex(loop)};
1083 if (itrVal.symbol) {
1084 // Remove the symbol from the collected set
1085 indexVars.erase(&itrVal.symbol->GetUltimate());
1086 }
1087 collapseVal--;
1088 if (collapseVal == 0) {
1089 break;
1090 }
1091 }
1092 // Get the next DoConstruct if block is not empty.
1093 const auto &block{std::get<parser::Block>(loop->t)};
1094 const auto it{block.begin()};
1095 loop = it != block.end() ? parser::Unwrap<parser::DoConstruct>(*it)
1096 : nullptr;
1097 }
1098 }
1099
1100 // Show error for the remaining variables
1101 for (auto &[symbol, source] : indexVars) {
1102 const Symbol &root{GetAssociationRoot(*symbol)};
1103 context_.Say(source,
1104 "Variable '%s' not allowed in LINEAR clause, only loop iterator can be specified in LINEAR clause of a construct combined with DISTRIBUTE"_err_en_US,
1105 root.name());
1106 }
1107 }
1108}
1109
1110void OmpStructureChecker::Leave(const parser::OpenMPLoopConstruct &x) {
1111 const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
1112 const auto &clauseList{std::get<parser::OmpClauseList>(beginLoopDir.t)};
1113
1114 // A few semantic checks for InScan reduction are performed below as SCAN
1115 // constructs inside LOOP may add the relevant information. Scan reduction is
1116 // supported only in loop constructs, so same checks are not applicable to
1117 // other directives.
1118 using ReductionModifier = parser::OmpReductionModifier;
1119 for (const auto &clause : clauseList.v) {
1120 if (const auto *reductionClause{
1121 std::get_if<parser::OmpClause::Reduction>(&clause.u)}) {
1122 auto &modifiers{OmpGetModifiers(reductionClause->v)};
1123 auto *maybeModifier{OmpGetUniqueModifier<ReductionModifier>(modifiers)};
1124 if (maybeModifier &&
1125 maybeModifier->v == ReductionModifier::Value::Inscan) {
1126 const auto &objectList{
1127 std::get<parser::OmpObjectList>(reductionClause->v.t)};
1128 auto checkReductionSymbolInScan = [&](const parser::Name *name) {
1129 if (auto &symbol = name->symbol) {
1130 if (!symbol->test(Symbol::Flag::OmpInclusiveScan) &&
1131 !symbol->test(Symbol::Flag::OmpExclusiveScan)) {
1132 context_.Say(name->source,
1133 "List item %s must appear in EXCLUSIVE or "
1134 "INCLUSIVE clause of an "
1135 "enclosed SCAN directive"_err_en_US,
1136 name->ToString());
1137 }
1138 }
1139 };
1140 for (const auto &ompObj : objectList.v) {
1141 common::visit(
1142 common::visitors{
1143 [&](const parser::Designator &designator) {
1144 if (const auto *name{semantics::getDesignatorNameIfDataRef(
1145 designator)}) {
1146 checkReductionSymbolInScan(name);
1147 }
1148 },
1149 [&](const auto &name) { checkReductionSymbolInScan(&name); },
1150 },
1151 ompObj.u);
1152 }
1153 }
1154 }
1155 }
1156 if (llvm::omp::allSimdSet.test(GetContext().directive)) {
1157 ExitDirectiveNest(index: SIMDNest);
1158 }
1159 dirContext_.pop_back();
1160
1161 assert(!loopStack_.empty() && "Expecting non-empty loop stack");
1162#ifndef NDEBUG
1163 const LoopConstruct &top{loopStack_.back()};
1164 auto *loopc{std::get_if<const parser::OpenMPLoopConstruct *>(&top)};
1165 assert(loopc != nullptr && *loopc == &x && "Mismatched loop constructs");
1166#endif
1167 loopStack_.pop_back();
1168}
1169
1170void OmpStructureChecker::Enter(const parser::OmpEndLoopDirective &x) {
1171 const auto &dir{std::get<parser::OmpLoopDirective>(x.t)};
1172 ResetPartialContext(dir.source);
1173 switch (dir.v) {
1174 // 2.7.1 end-do -> END DO [nowait-clause]
1175 // 2.8.3 end-do-simd -> END DO SIMD [nowait-clause]
1176 case llvm::omp::Directive::OMPD_do:
1177 PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_end_do);
1178 break;
1179 case llvm::omp::Directive::OMPD_do_simd:
1180 PushContextAndClauseSets(
1181 dir.source, llvm::omp::Directive::OMPD_end_do_simd);
1182 break;
1183 default:
1184 // no clauses are allowed
1185 break;
1186 }
1187}
1188
1189void OmpStructureChecker::Leave(const parser::OmpEndLoopDirective &x) {
1190 if ((GetContext().directive == llvm::omp::Directive::OMPD_end_do) ||
1191 (GetContext().directive == llvm::omp::Directive::OMPD_end_do_simd)) {
1192 dirContext_.pop_back();
1193 }
1194}
1195
1196void OmpStructureChecker::Enter(const parser::OpenMPBlockConstruct &x) {
1197 const auto &beginBlockDir{std::get<parser::OmpBeginBlockDirective>(x.t)};
1198 const auto &endBlockDir{std::get<parser::OmpEndBlockDirective>(x.t)};
1199 const auto &beginDir{std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
1200 const auto &endDir{std::get<parser::OmpBlockDirective>(endBlockDir.t)};
1201 const parser::Block &block{std::get<parser::Block>(x.t)};
1202
1203 CheckMatching<parser::OmpBlockDirective>(beginDir, endDir);
1204
1205 PushContextAndClauseSets(beginDir.source, beginDir.v);
1206 if (llvm::omp::allTargetSet.test(GetContext().directive)) {
1207 EnterDirectiveNest(index: TargetNest);
1208 }
1209
1210 if (CurrentDirectiveIsNested()) {
1211 if (llvm::omp::bottomTeamsSet.test(GetContextParent().directive)) {
1212 HasInvalidTeamsNesting(beginDir.v, beginDir.source);
1213 }
1214 if (GetContext().directive == llvm::omp::Directive::OMPD_master) {
1215 CheckMasterNesting(x);
1216 }
1217 // A teams region can only be strictly nested within the implicit parallel
1218 // region or a target region.
1219 if (GetContext().directive == llvm::omp::Directive::OMPD_teams &&
1220 GetContextParent().directive != llvm::omp::Directive::OMPD_target) {
1221 context_.Say(parser::FindSourceLocation(x),
1222 "%s region can only be strictly nested within the implicit parallel "
1223 "region or TARGET region"_err_en_US,
1224 ContextDirectiveAsFortran());
1225 }
1226 // If a teams construct is nested within a target construct, that target
1227 // construct must contain no statements, declarations or directives outside
1228 // of the teams construct.
1229 if (GetContext().directive == llvm::omp::Directive::OMPD_teams &&
1230 GetContextParent().directive == llvm::omp::Directive::OMPD_target &&
1231 !GetDirectiveNest(TargetBlockOnlyTeams)) {
1232 context_.Say(GetContextParent().directiveSource,
1233 "TARGET construct with nested TEAMS region contains statements or "
1234 "directives outside of the TEAMS construct"_err_en_US);
1235 }
1236 }
1237
1238 CheckNoBranching(block, beginDir.v, beginDir.source);
1239
1240 // Target block constructs are target device constructs. Keep track of
1241 // whether any such construct has been visited to later check that REQUIRES
1242 // directives for target-related options don't appear after them.
1243 if (llvm::omp::allTargetSet.test(beginDir.v)) {
1244 deviceConstructFound_ = true;
1245 }
1246
1247 if (GetContext().directive == llvm::omp::Directive::OMPD_single) {
1248 std::set<Symbol *> singleCopyprivateSyms;
1249 std::set<Symbol *> endSingleCopyprivateSyms;
1250 bool foundNowait{false};
1251 parser::CharBlock NowaitSource;
1252
1253 auto catchCopyPrivateNowaitClauses = [&](const auto &dir, bool endDir) {
1254 for (auto &clause : std::get<parser::OmpClauseList>(dir.t).v) {
1255 if (clause.Id() == llvm::omp::Clause::OMPC_copyprivate) {
1256 for (const auto &ompObject : GetOmpObjectList(clause)->v) {
1257 const auto *name{parser::Unwrap<parser::Name>(ompObject)};
1258 if (Symbol * symbol{name->symbol}) {
1259 if (singleCopyprivateSyms.count(symbol)) {
1260 if (endDir) {
1261 context_.Warn(common::UsageWarning::OpenMPUsage, name->source,
1262 "The COPYPRIVATE clause with '%s' is already used on the SINGLE directive"_warn_en_US,
1263 name->ToString());
1264 } else {
1265 context_.Say(name->source,
1266 "'%s' appears in more than one COPYPRIVATE clause on the SINGLE directive"_err_en_US,
1267 name->ToString());
1268 }
1269 } else if (endSingleCopyprivateSyms.count(symbol)) {
1270 context_.Say(name->source,
1271 "'%s' appears in more than one COPYPRIVATE clause on the END SINGLE directive"_err_en_US,
1272 name->ToString());
1273 } else {
1274 if (endDir) {
1275 endSingleCopyprivateSyms.insert(symbol);
1276 } else {
1277 singleCopyprivateSyms.insert(symbol);
1278 }
1279 }
1280 }
1281 }
1282 } else if (clause.Id() == llvm::omp::Clause::OMPC_nowait) {
1283 if (foundNowait) {
1284 context_.Say(clause.source,
1285 "At most one NOWAIT clause can appear on the SINGLE directive"_err_en_US);
1286 } else {
1287 foundNowait = !endDir;
1288 }
1289 if (!NowaitSource.ToString().size()) {
1290 NowaitSource = clause.source;
1291 }
1292 }
1293 }
1294 };
1295 catchCopyPrivateNowaitClauses(beginBlockDir, false);
1296 catchCopyPrivateNowaitClauses(endBlockDir, true);
1297 unsigned version{context_.langOptions().OpenMPVersion};
1298 if (version <= 52 && NowaitSource.ToString().size() &&
1299 (singleCopyprivateSyms.size() || endSingleCopyprivateSyms.size())) {
1300 context_.Say(NowaitSource,
1301 "NOWAIT clause must not be used with COPYPRIVATE clause on the SINGLE directive"_err_en_US);
1302 }
1303 }
1304
1305 switch (beginDir.v) {
1306 case llvm::omp::Directive::OMPD_target:
1307 if (CheckTargetBlockOnlyTeams(block)) {
1308 EnterDirectiveNest(index: TargetBlockOnlyTeams);
1309 }
1310 break;
1311 case llvm::omp::OMPD_workshare:
1312 case llvm::omp::OMPD_parallel_workshare:
1313 CheckWorkshareBlockStmts(block, beginDir.source);
1314 HasInvalidWorksharingNesting(
1315 beginDir.source, llvm::omp::nestedWorkshareErrSet);
1316 break;
1317 case llvm::omp::Directive::OMPD_scope:
1318 case llvm::omp::Directive::OMPD_single:
1319 // TODO: This check needs to be extended while implementing nesting of
1320 // regions checks.
1321 HasInvalidWorksharingNesting(
1322 beginDir.source, llvm::omp::nestedWorkshareErrSet);
1323 break;
1324 case llvm::omp::Directive::OMPD_task: {
1325 const auto &clauses{std::get<parser::OmpClauseList>(beginBlockDir.t)};
1326 for (const auto &clause : clauses.v) {
1327 if (std::get_if<parser::OmpClause::Untied>(&clause.u)) {
1328 OmpUnitedTaskDesignatorChecker check{context_};
1329 parser::Walk(block, check);
1330 }
1331 }
1332 break;
1333 }
1334 default:
1335 break;
1336 }
1337}
1338
1339void OmpStructureChecker::CheckMasterNesting(
1340 const parser::OpenMPBlockConstruct &x) {
1341 // A MASTER region may not be `closely nested` inside a worksharing, loop,
1342 // task, taskloop, or atomic region.
1343 // TODO: Expand the check to include `LOOP` construct as well when it is
1344 // supported.
1345 if (IsCloselyNestedRegion(llvm::omp::nestedMasterErrSet)) {
1346 context_.Say(parser::FindSourceLocation(x),
1347 "`MASTER` region may not be closely nested inside of `WORKSHARING`, "
1348 "`LOOP`, `TASK`, `TASKLOOP`,"
1349 " or `ATOMIC` region."_err_en_US);
1350 }
1351}
1352
1353void OmpStructureChecker::Enter(const parser::OpenMPAssumeConstruct &x) {
1354 PushContextAndClauseSets(x.source, llvm::omp::Directive::OMPD_assume);
1355}
1356
1357void OmpStructureChecker::Leave(const parser::OpenMPAssumeConstruct &) {
1358 dirContext_.pop_back();
1359}
1360
1361void OmpStructureChecker::Enter(const parser::OpenMPDeclarativeAssumes &x) {
1362 PushContextAndClauseSets(x.source, llvm::omp::Directive::OMPD_assumes);
1363}
1364
1365void OmpStructureChecker::Leave(const parser::OpenMPDeclarativeAssumes &) {
1366 dirContext_.pop_back();
1367}
1368
1369void OmpStructureChecker::Leave(const parser::OpenMPBlockConstruct &) {
1370 if (GetDirectiveNest(index: TargetBlockOnlyTeams)) {
1371 ExitDirectiveNest(index: TargetBlockOnlyTeams);
1372 }
1373 if (llvm::omp::allTargetSet.test(GetContext().directive)) {
1374 ExitDirectiveNest(index: TargetNest);
1375 }
1376 dirContext_.pop_back();
1377}
1378
1379void OmpStructureChecker::ChecksOnOrderedAsBlock() {
1380 if (FindClause(llvm::omp::Clause::OMPC_depend)) {
1381 context_.Say(GetContext().clauseSource,
1382 "DEPEND clauses are not allowed when ORDERED construct is a block construct with an ORDERED region"_err_en_US);
1383 return;
1384 }
1385
1386 bool isNestedInDo{false};
1387 bool isNestedInDoSIMD{false};
1388 bool isNestedInSIMD{false};
1389 bool noOrderedClause{false};
1390 bool isOrderedClauseWithPara{false};
1391 bool isCloselyNestedRegion{true};
1392 if (CurrentDirectiveIsNested()) {
1393 for (int i = (int)dirContext_.size() - 2; i >= 0; i--) {
1394 if (llvm::omp::nestedOrderedErrSet.test(dirContext_[i].directive)) {
1395 context_.Say(GetContext().directiveSource,
1396 "`ORDERED` region may not be closely nested inside of `CRITICAL`, "
1397 "`ORDERED`, explicit `TASK` or `TASKLOOP` region."_err_en_US);
1398 break;
1399 } else if (llvm::omp::allDoSet.test(dirContext_[i].directive)) {
1400 isNestedInDo = true;
1401 isNestedInDoSIMD =
1402 llvm::omp::allDoSimdSet.test(dirContext_[i].directive);
1403 if (const auto *clause{
1404 FindClause(dirContext_[i], llvm::omp::Clause::OMPC_ordered)}) {
1405 const auto &orderedClause{
1406 std::get<parser::OmpClause::Ordered>(clause->u)};
1407 const auto orderedValue{GetIntValue(orderedClause.v)};
1408 isOrderedClauseWithPara = orderedValue > 0;
1409 } else {
1410 noOrderedClause = true;
1411 }
1412 break;
1413 } else if (llvm::omp::allSimdSet.test(dirContext_[i].directive)) {
1414 isNestedInSIMD = true;
1415 break;
1416 } else if (llvm::omp::nestedOrderedParallelErrSet.test(
1417 dirContext_[i].directive)) {
1418 isCloselyNestedRegion = false;
1419 break;
1420 }
1421 }
1422 }
1423
1424 if (!isCloselyNestedRegion) {
1425 context_.Say(GetContext().directiveSource,
1426 "An ORDERED directive without the DEPEND clause must be closely nested "
1427 "in a SIMD, worksharing-loop, or worksharing-loop SIMD "
1428 "region"_err_en_US);
1429 } else {
1430 if (CurrentDirectiveIsNested() &&
1431 FindClause(llvm::omp::Clause::OMPC_simd) &&
1432 (!isNestedInDoSIMD && !isNestedInSIMD)) {
1433 context_.Say(GetContext().directiveSource,
1434 "An ORDERED directive with SIMD clause must be closely nested in a "
1435 "SIMD or worksharing-loop SIMD region"_err_en_US);
1436 }
1437 if (isNestedInDo && (noOrderedClause || isOrderedClauseWithPara)) {
1438 context_.Say(GetContext().directiveSource,
1439 "An ORDERED directive without the DEPEND clause must be closely "
1440 "nested in a worksharing-loop (or worksharing-loop SIMD) region with "
1441 "ORDERED clause without the parameter"_err_en_US);
1442 }
1443 }
1444}
1445
1446void OmpStructureChecker::Leave(const parser::OmpBeginBlockDirective &) {
1447 switch (GetContext().directive) {
1448 case llvm::omp::Directive::OMPD_ordered:
1449 // [5.1] 2.19.9 Ordered Construct Restriction
1450 ChecksOnOrderedAsBlock();
1451 break;
1452 default:
1453 break;
1454 }
1455}
1456
1457void OmpStructureChecker::Enter(const parser::OpenMPSectionsConstruct &x) {
1458 const auto &beginSectionsDir{
1459 std::get<parser::OmpBeginSectionsDirective>(x.t)};
1460 const auto &endSectionsDir{std::get<parser::OmpEndSectionsDirective>(x.t)};
1461 const auto &beginDir{
1462 std::get<parser::OmpSectionsDirective>(beginSectionsDir.t)};
1463 const auto &endDir{std::get<parser::OmpSectionsDirective>(endSectionsDir.t)};
1464 CheckMatching<parser::OmpSectionsDirective>(beginDir, endDir);
1465
1466 PushContextAndClauseSets(beginDir.source, beginDir.v);
1467 AddEndDirectiveClauses(std::get<parser::OmpClauseList>(endSectionsDir.t));
1468
1469 const auto &sectionBlocks{std::get<parser::OmpSectionBlocks>(x.t)};
1470 for (const parser::OpenMPConstruct &block : sectionBlocks.v) {
1471 CheckNoBranching(std::get<parser::OpenMPSectionConstruct>(block.u).v,
1472 beginDir.v, beginDir.source);
1473 }
1474 HasInvalidWorksharingNesting(
1475 beginDir.source, llvm::omp::nestedWorkshareErrSet);
1476}
1477
1478void OmpStructureChecker::Leave(const parser::OpenMPSectionsConstruct &) {
1479 dirContext_.pop_back();
1480}
1481
1482void OmpStructureChecker::Enter(const parser::OmpEndSectionsDirective &x) {
1483 const auto &dir{std::get<parser::OmpSectionsDirective>(x.t)};
1484 ResetPartialContext(dir.source);
1485 switch (dir.v) {
1486 // 2.7.2 end-sections -> END SECTIONS [nowait-clause]
1487 case llvm::omp::Directive::OMPD_sections:
1488 PushContextAndClauseSets(
1489 dir.source, llvm::omp::Directive::OMPD_end_sections);
1490 break;
1491 default:
1492 // no clauses are allowed
1493 break;
1494 }
1495}
1496
1497// TODO: Verify the popping of dirContext requirement after nowait
1498// implementation, as there is an implicit barrier at the end of the worksharing
1499// constructs unless a nowait clause is specified. Only OMPD_end_sections is
1500// popped becuase it is pushed while entering the EndSectionsDirective.
1501void OmpStructureChecker::Leave(const parser::OmpEndSectionsDirective &x) {
1502 if (GetContext().directive == llvm::omp::Directive::OMPD_end_sections) {
1503 dirContext_.pop_back();
1504 }
1505}
1506
1507void OmpStructureChecker::CheckThreadprivateOrDeclareTargetVar(
1508 const parser::OmpObjectList &objList) {
1509 for (const auto &ompObject : objList.v) {
1510 common::visit(
1511 common::visitors{
1512 [&](const parser::Designator &) {
1513 if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
1514 // The symbol is null, return early, CheckSymbolNames
1515 // should have already reported the missing symbol as a
1516 // diagnostic error
1517 if (!name->symbol) {
1518 return;
1519 }
1520
1521 if (name->symbol->GetUltimate().IsSubprogram()) {
1522 if (GetContext().directive ==
1523 llvm::omp::Directive::OMPD_threadprivate)
1524 context_.Say(name->source,
1525 "The procedure name cannot be in a %s "
1526 "directive"_err_en_US,
1527 ContextDirectiveAsFortran());
1528 // TODO: Check for procedure name in declare target directive.
1529 } else if (name->symbol->attrs().test(Attr::PARAMETER)) {
1530 if (GetContext().directive ==
1531 llvm::omp::Directive::OMPD_threadprivate)
1532 context_.Say(name->source,
1533 "The entity with PARAMETER attribute cannot be in a %s "
1534 "directive"_err_en_US,
1535 ContextDirectiveAsFortran());
1536 else if (GetContext().directive ==
1537 llvm::omp::Directive::OMPD_declare_target)
1538 context_.Warn(common::UsageWarning::OpenMPUsage,
1539 name->source,
1540 "The entity with PARAMETER attribute is used in a %s directive"_warn_en_US,
1541 ContextDirectiveAsFortran());
1542 } else if (FindCommonBlockContaining(*name->symbol)) {
1543 context_.Say(name->source,
1544 "A variable in a %s directive cannot be an element of a "
1545 "common block"_err_en_US,
1546 ContextDirectiveAsFortran());
1547 } else if (FindEquivalenceSet(*name->symbol)) {
1548 context_.Say(name->source,
1549 "A variable in a %s directive cannot appear in an "
1550 "EQUIVALENCE statement"_err_en_US,
1551 ContextDirectiveAsFortran());
1552 } else if (name->symbol->test(Symbol::Flag::OmpThreadprivate) &&
1553 GetContext().directive ==
1554 llvm::omp::Directive::OMPD_declare_target) {
1555 context_.Say(name->source,
1556 "A THREADPRIVATE variable cannot appear in a %s "
1557 "directive"_err_en_US,
1558 ContextDirectiveAsFortran());
1559 } else {
1560 const semantics::Scope &useScope{
1561 context_.FindScope(GetContext().directiveSource)};
1562 const semantics::Scope &curScope =
1563 name->symbol->GetUltimate().owner();
1564 if (!curScope.IsTopLevel()) {
1565 const semantics::Scope &declScope =
1566 GetProgramUnitOrBlockConstructContaining(curScope);
1567 const semantics::Symbol *sym{
1568 declScope.parent().FindSymbol(name->symbol->name())};
1569 if (sym &&
1570 (sym->has<MainProgramDetails>() ||
1571 sym->has<ModuleDetails>())) {
1572 context_.Say(name->source,
1573 "The module name or main program name cannot be in a "
1574 "%s "
1575 "directive"_err_en_US,
1576 ContextDirectiveAsFortran());
1577 } else if (!IsSaved(*name->symbol) &&
1578 declScope.kind() != Scope::Kind::MainProgram &&
1579 declScope.kind() != Scope::Kind::Module) {
1580 context_.Say(name->source,
1581 "A variable that appears in a %s directive must be "
1582 "declared in the scope of a module or have the SAVE "
1583 "attribute, either explicitly or "
1584 "implicitly"_err_en_US,
1585 ContextDirectiveAsFortran());
1586 } else if (useScope != declScope) {
1587 context_.Say(name->source,
1588 "The %s directive and the common block or variable "
1589 "in it must appear in the same declaration section "
1590 "of a scoping unit"_err_en_US,
1591 ContextDirectiveAsFortran());
1592 }
1593 }
1594 }
1595 }
1596 },
1597 [&](const parser::Name &name) {
1598 if (name.symbol) {
1599 if (auto *cb{name.symbol->detailsIf<CommonBlockDetails>()}) {
1600 for (const auto &obj : cb->objects()) {
1601 if (FindEquivalenceSet(*obj)) {
1602 context_.Say(name.source,
1603 "A variable in a %s directive cannot appear in an EQUIVALENCE statement (variable '%s' from common block '/%s/')"_err_en_US,
1604 ContextDirectiveAsFortran(), obj->name(),
1605 name.symbol->name());
1606 }
1607 }
1608 }
1609 }
1610 },
1611 },
1612 ompObject.u);
1613 }
1614}
1615
1616void OmpStructureChecker::Enter(const parser::OpenMPThreadprivate &c) {
1617 const auto &dir{std::get<parser::Verbatim>(c.t)};
1618 PushContextAndClauseSets(
1619 dir.source, llvm::omp::Directive::OMPD_threadprivate);
1620}
1621
1622void OmpStructureChecker::Leave(const parser::OpenMPThreadprivate &c) {
1623 const auto &dir{std::get<parser::Verbatim>(c.t)};
1624 const auto &objectList{std::get<parser::OmpObjectList>(c.t)};
1625 CheckSymbolNames(dir.source, objectList);
1626 CheckVarIsNotPartOfAnotherVar(dir.source, objectList);
1627 CheckThreadprivateOrDeclareTargetVar(objectList);
1628 dirContext_.pop_back();
1629}
1630
1631void OmpStructureChecker::Enter(const parser::OpenMPDeclareSimdConstruct &x) {
1632 const auto &dir{std::get<parser::Verbatim>(x.t)};
1633 PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_declare_simd);
1634}
1635
1636void OmpStructureChecker::Leave(const parser::OpenMPDeclareSimdConstruct &) {
1637 dirContext_.pop_back();
1638}
1639
1640void OmpStructureChecker::Enter(const parser::OmpDeclareVariantDirective &x) {
1641 const auto &dir{std::get<parser::Verbatim>(x.t)};
1642 PushContextAndClauseSets(
1643 dir.source, llvm::omp::Directive::OMPD_declare_variant);
1644}
1645
1646void OmpStructureChecker::Leave(const parser::OmpDeclareVariantDirective &) {
1647 dirContext_.pop_back();
1648}
1649
1650void OmpStructureChecker::Enter(const parser::OpenMPDepobjConstruct &x) {
1651 const auto &dirName{std::get<parser::OmpDirectiveName>(x.v.t)};
1652 PushContextAndClauseSets(dirName.source, llvm::omp::Directive::OMPD_depobj);
1653 unsigned version{context_.langOptions().OpenMPVersion};
1654
1655 const parser::OmpArgumentList &arguments{x.v.Arguments()};
1656 const parser::OmpClauseList &clauses{x.v.Clauses()};
1657
1658 // Ref: [6.0:505-506]
1659
1660 if (version < 60) {
1661 if (arguments.v.size() != 1) {
1662 parser::CharBlock source(
1663 arguments.v.empty() ? dirName.source : arguments.source);
1664 context_.Say(
1665 source, "The DEPOBJ directive requires a single argument"_err_en_US);
1666 }
1667 }
1668 if (clauses.v.size() != 1) {
1669 context_.Say(
1670 x.source, "The DEPOBJ construct requires a single clause"_err_en_US);
1671 return;
1672 }
1673
1674 auto &clause{clauses.v.front()};
1675
1676 if (version >= 60 && arguments.v.empty()) {
1677 context_.Say(x.source,
1678 "DEPOBJ syntax with no argument is not handled yet"_err_en_US);
1679 return;
1680 }
1681
1682 // [5.2:73:27-28]
1683 // If the destroy clause appears on a depobj construct, destroy-var must
1684 // refer to the same depend object as the depobj argument of the construct.
1685 if (clause.Id() == llvm::omp::Clause::OMPC_destroy) {
1686 auto getObjSymbol{[&](const parser::OmpObject &obj) {
1687 return common::visit(
1688 [&](auto &&s) { return GetLastName(s).symbol; }, obj.u);
1689 }};
1690 auto getArgSymbol{[&](const parser::OmpArgument &arg) {
1691 if (auto *locator{std::get_if<parser::OmpLocator>(&arg.u)}) {
1692 if (auto *object{std::get_if<parser::OmpObject>(&locator->u)}) {
1693 return getObjSymbol(*object);
1694 }
1695 }
1696 return static_cast<Symbol *>(nullptr);
1697 }};
1698
1699 auto &wrapper{std::get<parser::OmpClause::Destroy>(clause.u)};
1700 if (const std::optional<parser::OmpDestroyClause> &destroy{wrapper.v}) {
1701 const Symbol *constrSym{getArgSymbol(arguments.v.front())};
1702 const Symbol *clauseSym{getObjSymbol(destroy->v)};
1703 assert(constrSym && "Unresolved depobj construct symbol");
1704 assert(clauseSym && "Unresolved destroy symbol on depobj construct");
1705 if (constrSym != clauseSym) {
1706 context_.Say(x.source,
1707 "The DESTROY clause must refer to the same object as the "
1708 "DEPOBJ construct"_err_en_US);
1709 }
1710 }
1711 }
1712}
1713
1714void OmpStructureChecker::Leave(const parser::OpenMPDepobjConstruct &x) {
1715 dirContext_.pop_back();
1716}
1717
1718void OmpStructureChecker::Enter(const parser::OpenMPRequiresConstruct &x) {
1719 const auto &dir{std::get<parser::Verbatim>(x.t)};
1720 PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_requires);
1721}
1722
1723void OmpStructureChecker::Leave(const parser::OpenMPRequiresConstruct &) {
1724 dirContext_.pop_back();
1725}
1726
1727void OmpStructureChecker::CheckAlignValue(const parser::OmpClause &clause) {
1728 if (auto *align{std::get_if<parser::OmpClause::Align>(&clause.u)}) {
1729 if (const auto &v{GetIntValue(align->v)}; !v || *v <= 0) {
1730 context_.Say(clause.source,
1731 "The alignment value should be a constant positive integer"_err_en_US);
1732 }
1733 }
1734}
1735
1736void OmpStructureChecker::Enter(const parser::OpenMPDeclarativeAllocate &x) {
1737 isPredefinedAllocator = true;
1738 const auto &dir{std::get<parser::Verbatim>(x.t)};
1739 const auto &objectList{std::get<parser::OmpObjectList>(x.t)};
1740 PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_allocate);
1741 const auto &clauseList{std::get<parser::OmpClauseList>(x.t)};
1742 SymbolSourceMap currSymbols;
1743 GetSymbolsInObjectList(objectList, currSymbols);
1744 for (auto &[symbol, source] : currSymbols) {
1745 if (IsPointer(*symbol)) {
1746 context_.Say(source,
1747 "List item '%s' in ALLOCATE directive must not have POINTER "
1748 "attribute"_err_en_US,
1749 source.ToString());
1750 }
1751 if (IsDummy(*symbol)) {
1752 context_.Say(source,
1753 "List item '%s' in ALLOCATE directive must not be a dummy "
1754 "argument"_err_en_US,
1755 source.ToString());
1756 }
1757 if (symbol->GetUltimate().has<AssocEntityDetails>()) {
1758 context_.Say(source,
1759 "List item '%s' in ALLOCATE directive must not be an associate "
1760 "name"_err_en_US,
1761 source.ToString());
1762 }
1763 }
1764 for (const auto &clause : clauseList.v) {
1765 CheckAlignValue(clause);
1766 }
1767 CheckVarIsNotPartOfAnotherVar(dir.source, objectList);
1768}
1769
1770void OmpStructureChecker::Leave(const parser::OpenMPDeclarativeAllocate &x) {
1771 const auto &dir{std::get<parser::Verbatim>(x.t)};
1772 const auto &objectList{std::get<parser::OmpObjectList>(x.t)};
1773 CheckPredefinedAllocatorRestriction(dir.source, objectList);
1774 dirContext_.pop_back();
1775}
1776
1777void OmpStructureChecker::Enter(const parser::OmpClause::Allocator &x) {
1778 CheckAllowedClause(llvm::omp::Clause::OMPC_allocator);
1779 // Note: Predefined allocators are stored in ScalarExpr as numbers
1780 // whereas custom allocators are stored as strings, so if the ScalarExpr
1781 // actually has an int value, then it must be a predefined allocator
1782 isPredefinedAllocator = GetIntValue(x.v).has_value();
1783 RequiresPositiveParameter(llvm::omp::Clause::OMPC_allocator, x.v);
1784}
1785
1786void OmpStructureChecker::Enter(const parser::OmpClause::Allocate &x) {
1787 CheckAllowedClause(llvm::omp::Clause::OMPC_allocate);
1788 if (OmpVerifyModifiers(
1789 x.v, llvm::omp::OMPC_allocate, GetContext().clauseSource, context_)) {
1790 auto &modifiers{OmpGetModifiers(x.v)};
1791 if (auto *align{
1792 OmpGetUniqueModifier<parser::OmpAlignModifier>(modifiers)}) {
1793 if (const auto &v{GetIntValue(align->v)}; !v || *v <= 0) {
1794 context_.Say(OmpGetModifierSource(modifiers, align),
1795 "The alignment value should be a constant positive integer"_err_en_US);
1796 }
1797 }
1798 // The simple and complex modifiers have the same structure. They only
1799 // differ in their syntax.
1800 if (auto *alloc{OmpGetUniqueModifier<parser::OmpAllocatorComplexModifier>(
1801 modifiers)}) {
1802 isPredefinedAllocator = GetIntValue(alloc->v).has_value();
1803 }
1804 if (auto *alloc{OmpGetUniqueModifier<parser::OmpAllocatorSimpleModifier>(
1805 modifiers)}) {
1806 isPredefinedAllocator = GetIntValue(alloc->v).has_value();
1807 }
1808 }
1809}
1810
1811void OmpStructureChecker::Enter(const parser::OmpDeclareTargetWithClause &x) {
1812 SetClauseSets(llvm::omp::Directive::OMPD_declare_target);
1813}
1814
1815void OmpStructureChecker::Leave(const parser::OmpDeclareTargetWithClause &x) {
1816 if (x.v.v.size() > 0) {
1817 const parser::OmpClause *enterClause =
1818 FindClause(llvm::omp::Clause::OMPC_enter);
1819 const parser::OmpClause *toClause = FindClause(llvm::omp::Clause::OMPC_to);
1820 const parser::OmpClause *linkClause =
1821 FindClause(llvm::omp::Clause::OMPC_link);
1822 if (!enterClause && !toClause && !linkClause) {
1823 context_.Say(x.source,
1824 "If the DECLARE TARGET directive has a clause, it must contain at least one ENTER clause or LINK clause"_err_en_US);
1825 }
1826 unsigned version{context_.langOptions().OpenMPVersion};
1827 if (toClause && version >= 52) {
1828 context_.Warn(common::UsageWarning::OpenMPUsage, toClause->source,
1829 "The usage of TO clause on DECLARE TARGET directive has been deprecated. Use ENTER clause instead."_warn_en_US);
1830 }
1831 }
1832}
1833
1834void OmpStructureChecker::Enter(const parser::OpenMPDeclareMapperConstruct &x) {
1835 const auto &dir{std::get<parser::Verbatim>(x.t)};
1836 PushContextAndClauseSets(
1837 dir.source, llvm::omp::Directive::OMPD_declare_mapper);
1838 const auto &spec{std::get<parser::OmpMapperSpecifier>(x.t)};
1839 const auto &type = std::get<parser::TypeSpec>(spec.t);
1840 if (!std::get_if<parser::DerivedTypeSpec>(&type.u)) {
1841 context_.Say(dir.source, "Type is not a derived type"_err_en_US);
1842 }
1843}
1844
1845void OmpStructureChecker::Leave(const parser::OpenMPDeclareMapperConstruct &) {
1846 dirContext_.pop_back();
1847}
1848
1849void OmpStructureChecker::Enter(
1850 const parser::OpenMPDeclareReductionConstruct &x) {
1851 const auto &dir{std::get<parser::Verbatim>(x.t)};
1852 PushContextAndClauseSets(
1853 dir.source, llvm::omp::Directive::OMPD_declare_reduction);
1854}
1855
1856void OmpStructureChecker::Leave(
1857 const parser::OpenMPDeclareReductionConstruct &) {
1858 dirContext_.pop_back();
1859}
1860
1861void OmpStructureChecker::Enter(const parser::OpenMPDeclareTargetConstruct &x) {
1862 const auto &dir{std::get<parser::Verbatim>(x.t)};
1863 PushContext(dir.source, llvm::omp::Directive::OMPD_declare_target);
1864}
1865
1866void OmpStructureChecker::Enter(const parser::OmpDeclareTargetWithList &x) {
1867 SymbolSourceMap symbols;
1868 GetSymbolsInObjectList(x.v, symbols);
1869 for (auto &[symbol, source] : symbols) {
1870 const GenericDetails *genericDetails = symbol->detailsIf<GenericDetails>();
1871 if (genericDetails) {
1872 context_.Say(source,
1873 "The procedure '%s' in DECLARE TARGET construct cannot be a generic name."_err_en_US,
1874 symbol->name());
1875 genericDetails->specific();
1876 }
1877 if (IsProcedurePointer(*symbol)) {
1878 context_.Say(source,
1879 "The procedure '%s' in DECLARE TARGET construct cannot be a procedure pointer."_err_en_US,
1880 symbol->name());
1881 }
1882 const SubprogramDetails *entryDetails =
1883 symbol->detailsIf<SubprogramDetails>();
1884 if (entryDetails && entryDetails->entryScope()) {
1885 context_.Say(source,
1886 "The procedure '%s' in DECLARE TARGET construct cannot be an entry name."_err_en_US,
1887 symbol->name());
1888 }
1889 if (IsStmtFunction(*symbol)) {
1890 context_.Say(source,
1891 "The procedure '%s' in DECLARE TARGET construct cannot be a statement function."_err_en_US,
1892 symbol->name());
1893 }
1894 }
1895}
1896
1897void OmpStructureChecker::CheckSymbolNames(
1898 const parser::CharBlock &source, const parser::OmpObjectList &objList) {
1899 for (const auto &ompObject : objList.v) {
1900 common::visit(
1901 common::visitors{
1902 [&](const parser::Designator &designator) {
1903 if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
1904 if (!name->symbol) {
1905 context_.Say(source,
1906 "The given %s directive clause has an invalid argument"_err_en_US,
1907 ContextDirectiveAsFortran());
1908 }
1909 }
1910 },
1911 [&](const parser::Name &name) {
1912 if (!name.symbol) {
1913 context_.Say(source,
1914 "The given %s directive clause has an invalid argument"_err_en_US,
1915 ContextDirectiveAsFortran());
1916 }
1917 },
1918 },
1919 ompObject.u);
1920 }
1921}
1922
1923void OmpStructureChecker::Leave(const parser::OpenMPDeclareTargetConstruct &x) {
1924 const auto &dir{std::get<parser::Verbatim>(x.t)};
1925 const auto &spec{std::get<parser::OmpDeclareTargetSpecifier>(x.t)};
1926 // Handle both forms of DECLARE TARGET.
1927 // - Extended list: It behaves as if there was an ENTER/TO clause with the
1928 // list of objects as argument. It accepts no explicit clauses.
1929 // - With clauses.
1930 if (const auto *objectList{parser::Unwrap<parser::OmpObjectList>(spec.u)}) {
1931 deviceConstructFound_ = true;
1932 CheckSymbolNames(dir.source, *objectList);
1933 CheckVarIsNotPartOfAnotherVar(dir.source, *objectList);
1934 CheckThreadprivateOrDeclareTargetVar(*objectList);
1935 } else if (const auto *clauseList{
1936 parser::Unwrap<parser::OmpClauseList>(spec.u)}) {
1937 bool toClauseFound{false}, deviceTypeClauseFound{false},
1938 enterClauseFound{false};
1939 for (const auto &clause : clauseList->v) {
1940 common::visit(
1941 common::visitors{
1942 [&](const parser::OmpClause::To &toClause) {
1943 toClauseFound = true;
1944 auto &objList{std::get<parser::OmpObjectList>(toClause.v.t)};
1945 CheckSymbolNames(dir.source, objList);
1946 CheckVarIsNotPartOfAnotherVar(dir.source, objList);
1947 CheckThreadprivateOrDeclareTargetVar(objList);
1948 },
1949 [&](const parser::OmpClause::Link &linkClause) {
1950 CheckSymbolNames(dir.source, linkClause.v);
1951 CheckVarIsNotPartOfAnotherVar(dir.source, linkClause.v);
1952 CheckThreadprivateOrDeclareTargetVar(linkClause.v);
1953 },
1954 [&](const parser::OmpClause::Enter &enterClause) {
1955 enterClauseFound = true;
1956 CheckSymbolNames(dir.source, enterClause.v);
1957 CheckVarIsNotPartOfAnotherVar(dir.source, enterClause.v);
1958 CheckThreadprivateOrDeclareTargetVar(enterClause.v);
1959 },
1960 [&](const parser::OmpClause::DeviceType &deviceTypeClause) {
1961 deviceTypeClauseFound = true;
1962 if (deviceTypeClause.v.v !=
1963 parser::OmpDeviceTypeClause::DeviceTypeDescription::Host) {
1964 // Function / subroutine explicitly marked as runnable by the
1965 // target device.
1966 deviceConstructFound_ = true;
1967 }
1968 },
1969 [&](const auto &) {},
1970 },
1971 clause.u);
1972
1973 if ((toClauseFound || enterClauseFound) && !deviceTypeClauseFound) {
1974 deviceConstructFound_ = true;
1975 }
1976 }
1977 }
1978 dirContext_.pop_back();
1979}
1980
1981void OmpStructureChecker::Enter(const parser::OmpErrorDirective &x) {
1982 const auto &dir{std::get<parser::Verbatim>(x.t)};
1983 PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_error);
1984}
1985
1986void OmpStructureChecker::Enter(const parser::OpenMPDispatchConstruct &x) {
1987 PushContextAndClauseSets(x.source, llvm::omp::Directive::OMPD_dispatch);
1988 const auto &block{std::get<parser::Block>(x.t)};
1989 if (block.empty() || block.size() > 1) {
1990 context_.Say(x.source,
1991 "The DISPATCH construct is empty or contains more than one statement"_err_en_US);
1992 return;
1993 }
1994
1995 auto it{block.begin()};
1996 bool passChecks{false};
1997 if (const parser::AssignmentStmt *
1998 assignStmt{parser::Unwrap<parser::AssignmentStmt>(*it)}) {
1999 if (parser::Unwrap<parser::FunctionReference>(assignStmt->t)) {
2000 passChecks = true;
2001 }
2002 } else if (parser::Unwrap<parser::CallStmt>(*it)) {
2003 passChecks = true;
2004 }
2005
2006 if (!passChecks) {
2007 context_.Say(x.source,
2008 "The DISPATCH construct does not contain a SUBROUTINE or FUNCTION"_err_en_US);
2009 }
2010}
2011
2012void OmpStructureChecker::Leave(const parser::OpenMPDispatchConstruct &x) {
2013 dirContext_.pop_back();
2014}
2015
2016void OmpStructureChecker::Leave(const parser::OmpErrorDirective &x) {
2017 dirContext_.pop_back();
2018}
2019
2020void OmpStructureChecker::Enter(const parser::OmpClause::At &x) {
2021 CheckAllowedClause(llvm::omp::Clause::OMPC_at);
2022 if (GetDirectiveNest(index: DeclarativeNest) > 0) {
2023 if (x.v.v == parser::OmpAtClause::ActionTime::Execution) {
2024 context_.Say(GetContext().clauseSource,
2025 "The ERROR directive with AT(EXECUTION) cannot appear in the specification part"_err_en_US);
2026 }
2027 }
2028}
2029
2030void OmpStructureChecker::Enter(const parser::OpenMPExecutableAllocate &x) {
2031 isPredefinedAllocator = true;
2032 const auto &dir{std::get<parser::Verbatim>(x.t)};
2033 const auto &objectList{std::get<std::optional<parser::OmpObjectList>>(x.t)};
2034 PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_allocate);
2035 const auto &clauseList{std::get<parser::OmpClauseList>(x.t)};
2036 for (const auto &clause : clauseList.v) {
2037 CheckAlignValue(clause);
2038 }
2039 if (objectList) {
2040 CheckVarIsNotPartOfAnotherVar(dir.source, *objectList);
2041 }
2042}
2043
2044void OmpStructureChecker::Leave(const parser::OpenMPExecutableAllocate &x) {
2045 const auto &dir{std::get<parser::Verbatim>(x.t)};
2046 const auto &objectList{std::get<std::optional<parser::OmpObjectList>>(x.t)};
2047 if (objectList)
2048 CheckPredefinedAllocatorRestriction(dir.source, *objectList);
2049 dirContext_.pop_back();
2050}
2051
2052void OmpStructureChecker::Enter(const parser::OpenMPAllocatorsConstruct &x) {
2053 isPredefinedAllocator = true;
2054 const auto &dir{std::get<parser::Verbatim>(x.t)};
2055 PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_allocators);
2056 const auto &clauseList{std::get<parser::OmpClauseList>(x.t)};
2057 for (const auto &clause : clauseList.v) {
2058 if (const auto *allocClause{
2059 parser::Unwrap<parser::OmpClause::Allocate>(clause)}) {
2060 CheckVarIsNotPartOfAnotherVar(
2061 dir.source, std::get<parser::OmpObjectList>(allocClause->v.t));
2062 }
2063 }
2064}
2065
2066void OmpStructureChecker::Leave(const parser::OpenMPAllocatorsConstruct &x) {
2067 const auto &dir{std::get<parser::Verbatim>(x.t)};
2068 const auto &clauseList{std::get<parser::OmpClauseList>(x.t)};
2069 for (const auto &clause : clauseList.v) {
2070 if (const auto *allocClause{
2071 std::get_if<parser::OmpClause::Allocate>(&clause.u)}) {
2072 CheckPredefinedAllocatorRestriction(
2073 dir.source, std::get<parser::OmpObjectList>(allocClause->v.t));
2074 }
2075 }
2076 dirContext_.pop_back();
2077}
2078
2079void OmpStructureChecker::CheckScan(
2080 const parser::OpenMPSimpleStandaloneConstruct &x) {
2081 if (x.v.Clauses().v.size() != 1) {
2082 context_.Say(x.source,
2083 "Exactly one of EXCLUSIVE or INCLUSIVE clause is expected"_err_en_US);
2084 }
2085 if (!CurrentDirectiveIsNested() ||
2086 !llvm::omp::scanParentAllowedSet.test(GetContextParent().directive)) {
2087 context_.Say(x.source,
2088 "Orphaned SCAN directives are prohibited; perhaps you forgot "
2089 "to enclose the directive in to a WORKSHARING LOOP, a WORKSHARING "
2090 "LOOP SIMD or a SIMD directive."_err_en_US);
2091 }
2092}
2093
2094void OmpStructureChecker::CheckBarrierNesting(
2095 const parser::OpenMPSimpleStandaloneConstruct &x) {
2096 // A barrier region may not be `closely nested` inside a worksharing, loop,
2097 // task, taskloop, critical, ordered, atomic, or master region.
2098 // TODO: Expand the check to include `LOOP` construct as well when it is
2099 // supported.
2100 if (IsCloselyNestedRegion(llvm::omp::nestedBarrierErrSet)) {
2101 context_.Say(parser::FindSourceLocation(x),
2102 "`BARRIER` region may not be closely nested inside of `WORKSHARING`, "
2103 "`LOOP`, `TASK`, `TASKLOOP`,"
2104 "`CRITICAL`, `ORDERED`, `ATOMIC` or `MASTER` region."_err_en_US);
2105 }
2106}
2107
2108void OmpStructureChecker::ChecksOnOrderedAsStandalone() {
2109 if (FindClause(llvm::omp::Clause::OMPC_threads) ||
2110 FindClause(llvm::omp::Clause::OMPC_simd)) {
2111 context_.Say(GetContext().clauseSource,
2112 "THREADS and SIMD clauses are not allowed when ORDERED construct is a standalone construct with no ORDERED region"_err_en_US);
2113 }
2114
2115 int dependSinkCount{0}, dependSourceCount{0};
2116 bool exclusiveShown{false}, duplicateSourceShown{false};
2117
2118 auto visitDoacross{[&](const parser::OmpDoacross &doa,
2119 const parser::CharBlock &src) {
2120 common::visit(
2121 common::visitors{
2122 [&](const parser::OmpDoacross::Source &) { dependSourceCount++; },
2123 [&](const parser::OmpDoacross::Sink &) { dependSinkCount++; }},
2124 doa.u);
2125 if (!exclusiveShown && dependSinkCount > 0 && dependSourceCount > 0) {
2126 exclusiveShown = true;
2127 context_.Say(src,
2128 "The SINK and SOURCE dependence types are mutually exclusive"_err_en_US);
2129 }
2130 if (!duplicateSourceShown && dependSourceCount > 1) {
2131 duplicateSourceShown = true;
2132 context_.Say(src,
2133 "At most one SOURCE dependence type can appear on the ORDERED directive"_err_en_US);
2134 }
2135 }};
2136
2137 // Visit the DEPEND and DOACROSS clauses.
2138 for (auto [_, clause] : FindClauses(llvm::omp::Clause::OMPC_depend)) {
2139 const auto &dependClause{std::get<parser::OmpClause::Depend>(clause->u)};
2140 if (auto *doAcross{std::get_if<parser::OmpDoacross>(&dependClause.v.u)}) {
2141 visitDoacross(*doAcross, clause->source);
2142 } else {
2143 context_.Say(clause->source,
2144 "Only SINK or SOURCE dependence types are allowed when ORDERED construct is a standalone construct with no ORDERED region"_err_en_US);
2145 }
2146 }
2147 for (auto [_, clause] : FindClauses(llvm::omp::Clause::OMPC_doacross)) {
2148 auto &doaClause{std::get<parser::OmpClause::Doacross>(clause->u)};
2149 visitDoacross(doaClause.v.v, clause->source);
2150 }
2151
2152 bool isNestedInDoOrderedWithPara{false};
2153 if (CurrentDirectiveIsNested() &&
2154 llvm::omp::nestedOrderedDoAllowedSet.test(GetContextParent().directive)) {
2155 if (const auto *clause{
2156 FindClause(GetContextParent(), llvm::omp::Clause::OMPC_ordered)}) {
2157 const auto &orderedClause{
2158 std::get<parser::OmpClause::Ordered>(clause->u)};
2159 const auto orderedValue{GetIntValue(orderedClause.v)};
2160 if (orderedValue > 0) {
2161 isNestedInDoOrderedWithPara = true;
2162 CheckOrderedDependClause(orderedValue: orderedValue);
2163 }
2164 }
2165 }
2166
2167 if (FindClause(llvm::omp::Clause::OMPC_depend) &&
2168 !isNestedInDoOrderedWithPara) {
2169 context_.Say(GetContext().clauseSource,
2170 "An ORDERED construct with the DEPEND clause must be closely nested "
2171 "in a worksharing-loop (or parallel worksharing-loop) construct with "
2172 "ORDERED clause with a parameter"_err_en_US);
2173 }
2174}
2175
2176void OmpStructureChecker::CheckOrderedDependClause(
2177 std::optional<int64_t> orderedValue) {
2178 auto visitDoacross{[&](const parser::OmpDoacross &doa,
2179 const parser::CharBlock &src) {
2180 if (auto *sinkVector{std::get_if<parser::OmpDoacross::Sink>(&doa.u)}) {
2181 int64_t numVar = sinkVector->v.v.size();
2182 if (orderedValue != numVar) {
2183 context_.Say(src,
2184 "The number of variables in the SINK iteration vector does not match the parameter specified in ORDERED clause"_err_en_US);
2185 }
2186 }
2187 }};
2188 for (auto [_, clause] : FindClauses(llvm::omp::Clause::OMPC_depend)) {
2189 auto &dependClause{std::get<parser::OmpClause::Depend>(clause->u)};
2190 if (auto *doAcross{std::get_if<parser::OmpDoacross>(&dependClause.v.u)}) {
2191 visitDoacross(*doAcross, clause->source);
2192 }
2193 }
2194 for (auto [_, clause] : FindClauses(llvm::omp::Clause::OMPC_doacross)) {
2195 auto &doaClause{std::get<parser::OmpClause::Doacross>(clause->u)};
2196 visitDoacross(doaClause.v.v, clause->source);
2197 }
2198}
2199
2200void OmpStructureChecker::CheckTargetUpdate() {
2201 const parser::OmpClause *toWrapper{FindClause(llvm::omp::Clause::OMPC_to)};
2202 const parser::OmpClause *fromWrapper{
2203 FindClause(llvm::omp::Clause::OMPC_from)};
2204 if (!toWrapper && !fromWrapper) {
2205 context_.Say(GetContext().directiveSource,
2206 "At least one motion-clause (TO/FROM) must be specified on "
2207 "TARGET UPDATE construct."_err_en_US);
2208 }
2209 if (toWrapper && fromWrapper) {
2210 SymbolSourceMap toSymbols, fromSymbols;
2211 auto &fromClause{std::get<parser::OmpClause::From>(fromWrapper->u).v};
2212 auto &toClause{std::get<parser::OmpClause::To>(toWrapper->u).v};
2213 GetSymbolsInObjectList(
2214 std::get<parser::OmpObjectList>(fromClause.t), fromSymbols);
2215 GetSymbolsInObjectList(
2216 std::get<parser::OmpObjectList>(toClause.t), toSymbols);
2217
2218 for (auto &[symbol, source] : toSymbols) {
2219 auto fromSymbol{fromSymbols.find(symbol)};
2220 if (fromSymbol != fromSymbols.end()) {
2221 context_.Say(source,
2222 "A list item ('%s') can only appear in a TO or FROM clause, but not in both."_err_en_US,
2223 symbol->name());
2224 context_.Say(source, "'%s' appears in the TO clause."_because_en_US,
2225 symbol->name());
2226 context_.Say(fromSymbol->second,
2227 "'%s' appears in the FROM clause."_because_en_US,
2228 fromSymbol->first->name());
2229 }
2230 }
2231 }
2232}
2233
2234void OmpStructureChecker::CheckTaskDependenceType(
2235 const parser::OmpTaskDependenceType::Value &x) {
2236 // Common checks for task-dependence-type (DEPEND and UPDATE clauses).
2237 unsigned version{context_.langOptions().OpenMPVersion};
2238 unsigned since{0};
2239
2240 switch (x) {
2241 case parser::OmpTaskDependenceType::Value::In:
2242 case parser::OmpTaskDependenceType::Value::Out:
2243 case parser::OmpTaskDependenceType::Value::Inout:
2244 break;
2245 case parser::OmpTaskDependenceType::Value::Mutexinoutset:
2246 case parser::OmpTaskDependenceType::Value::Depobj:
2247 since = 50;
2248 break;
2249 case parser::OmpTaskDependenceType::Value::Inoutset:
2250 since = 52;
2251 break;
2252 }
2253
2254 if (version < since) {
2255 context_.Say(GetContext().clauseSource,
2256 "%s task dependence type is not supported in %s, %s"_warn_en_US,
2257 parser::ToUpperCaseLetters(
2258 parser::OmpTaskDependenceType::EnumToString(x)),
2259 ThisVersion(version), TryVersion(since));
2260 }
2261}
2262
2263void OmpStructureChecker::CheckDependenceType(
2264 const parser::OmpDependenceType::Value &x) {
2265 // Common checks for dependence-type (DEPEND and UPDATE clauses).
2266 unsigned version{context_.langOptions().OpenMPVersion};
2267 unsigned deprecatedIn{~0u};
2268
2269 switch (x) {
2270 case parser::OmpDependenceType::Value::Source:
2271 case parser::OmpDependenceType::Value::Sink:
2272 deprecatedIn = 52;
2273 break;
2274 }
2275
2276 if (version >= deprecatedIn) {
2277 context_.Say(GetContext().clauseSource,
2278 "%s dependence type is deprecated in %s"_warn_en_US,
2279 parser::ToUpperCaseLetters(parser::OmpDependenceType::EnumToString(x)),
2280 ThisVersion(deprecatedIn));
2281 }
2282}
2283
2284void OmpStructureChecker::Enter(
2285 const parser::OpenMPSimpleStandaloneConstruct &x) {
2286 const auto &dir{std::get<parser::OmpDirectiveName>(x.v.t)};
2287 PushContextAndClauseSets(dir.source, dir.v);
2288 switch (dir.v) {
2289 case llvm::omp::Directive::OMPD_barrier:
2290 CheckBarrierNesting(x);
2291 break;
2292 case llvm::omp::Directive::OMPD_scan:
2293 CheckScan(x);
2294 break;
2295 default:
2296 break;
2297 }
2298}
2299
2300void OmpStructureChecker::Leave(
2301 const parser::OpenMPSimpleStandaloneConstruct &x) {
2302 switch (GetContext().directive) {
2303 case llvm::omp::Directive::OMPD_ordered:
2304 // [5.1] 2.19.9 Ordered Construct Restriction
2305 ChecksOnOrderedAsStandalone();
2306 break;
2307 case llvm::omp::Directive::OMPD_target_update:
2308 CheckTargetUpdate();
2309 break;
2310 default:
2311 break;
2312 }
2313 dirContext_.pop_back();
2314}
2315
2316void OmpStructureChecker::Enter(const parser::OpenMPFlushConstruct &x) {
2317 const auto &dirName{std::get<parser::OmpDirectiveName>(x.v.t)};
2318 PushContextAndClauseSets(dirName.source, llvm::omp::Directive::OMPD_flush);
2319}
2320
2321void OmpStructureChecker::Leave(const parser::OpenMPFlushConstruct &x) {
2322 auto &flushList{std::get<std::optional<parser::OmpArgumentList>>(x.v.t)};
2323
2324 auto isVariableListItemOrCommonBlock{[this](const Symbol &sym) {
2325 return IsVariableListItem(sym) ||
2326 sym.detailsIf<semantics::CommonBlockDetails>();
2327 }};
2328
2329 if (flushList) {
2330 for (const parser::OmpArgument &arg : flushList->v) {
2331 if (auto *sym{GetArgumentSymbol(arg)};
2332 sym && !isVariableListItemOrCommonBlock(*sym)) {
2333 context_.Say(arg.source,
2334 "FLUSH argument must be a variable list item"_err_en_US);
2335 }
2336 }
2337
2338 if (FindClause(llvm::omp::Clause::OMPC_acquire) ||
2339 FindClause(llvm::omp::Clause::OMPC_release) ||
2340 FindClause(llvm::omp::Clause::OMPC_acq_rel)) {
2341 context_.Say(flushList->source,
2342 "If memory-order-clause is RELEASE, ACQUIRE, or ACQ_REL, list items must not be specified on the FLUSH directive"_err_en_US);
2343 }
2344 }
2345
2346 unsigned version{context_.langOptions().OpenMPVersion};
2347 if (version >= 52) {
2348 using Flags = parser::OmpDirectiveSpecification::Flags;
2349 if (std::get<Flags>(x.v.t) == Flags::DeprecatedSyntax) {
2350 context_.Say(x.source,
2351 "The syntax \"FLUSH clause (object, ...)\" has been deprecated, use \"FLUSH(object, ...) clause\" instead"_warn_en_US);
2352 }
2353 }
2354
2355 dirContext_.pop_back();
2356}
2357
2358void OmpStructureChecker::Enter(const parser::OpenMPCancelConstruct &x) {
2359 auto &dirName{std::get<parser::OmpDirectiveName>(x.v.t)};
2360 auto &maybeClauses{std::get<std::optional<parser::OmpClauseList>>(x.v.t)};
2361 PushContextAndClauseSets(dirName.source, llvm::omp::Directive::OMPD_cancel);
2362
2363 if (auto maybeConstruct{GetCancelType(
2364 llvm::omp::Directive::OMPD_cancel, x.source, maybeClauses)}) {
2365 CheckCancellationNest(dirName.source, *maybeConstruct);
2366
2367 if (CurrentDirectiveIsNested()) {
2368 // nowait can be put on the end directive rather than the start directive
2369 // so we need to check both
2370 auto getParentClauses{[&]() {
2371 const DirectiveContext &parent{GetContextParent()};
2372 return llvm::concat<const llvm::omp::Clause>(
2373 parent.actualClauses, parent.endDirectiveClauses);
2374 }};
2375
2376 if (llvm::omp::nestedCancelDoAllowedSet.test(*maybeConstruct)) {
2377 for (llvm::omp::Clause clause : getParentClauses()) {
2378 if (clause == llvm::omp::Clause::OMPC_nowait) {
2379 context_.Say(dirName.source,
2380 "The CANCEL construct cannot be nested inside of a worksharing construct with the NOWAIT clause"_err_en_US);
2381 }
2382 if (clause == llvm::omp::Clause::OMPC_ordered) {
2383 context_.Say(dirName.source,
2384 "The CANCEL construct cannot be nested inside of a worksharing construct with the ORDERED clause"_err_en_US);
2385 }
2386 }
2387 } else if (llvm::omp::nestedCancelSectionsAllowedSet.test(
2388 *maybeConstruct)) {
2389 for (llvm::omp::Clause clause : getParentClauses()) {
2390 if (clause == llvm::omp::Clause::OMPC_nowait) {
2391 context_.Say(dirName.source,
2392 "The CANCEL construct cannot be nested inside of a worksharing construct with the NOWAIT clause"_err_en_US);
2393 }
2394 }
2395 }
2396 }
2397 }
2398}
2399
2400void OmpStructureChecker::Leave(const parser::OpenMPCancelConstruct &) {
2401 dirContext_.pop_back();
2402}
2403
2404void OmpStructureChecker::Enter(const parser::OpenMPCriticalConstruct &x) {
2405 const auto &dir{std::get<parser::OmpCriticalDirective>(x.t)};
2406 const auto &dirSource{std::get<parser::Verbatim>(dir.t).source};
2407 const auto &endDir{std::get<parser::OmpEndCriticalDirective>(x.t)};
2408 PushContextAndClauseSets(dirSource, llvm::omp::Directive::OMPD_critical);
2409 const auto &block{std::get<parser::Block>(x.t)};
2410 CheckNoBranching(block, llvm::omp::Directive::OMPD_critical, dir.source);
2411 const auto &dirName{std::get<std::optional<parser::Name>>(dir.t)};
2412 const auto &endDirName{std::get<std::optional<parser::Name>>(endDir.t)};
2413 const auto &ompClause{std::get<parser::OmpClauseList>(dir.t)};
2414 if (dirName && endDirName &&
2415 dirName->ToString().compare(endDirName->ToString())) {
2416 context_
2417 .Say(endDirName->source,
2418 parser::MessageFormattedText{
2419 "CRITICAL directive names do not match"_err_en_US})
2420 .Attach(dirName->source, "should be "_en_US);
2421 } else if (dirName && !endDirName) {
2422 context_
2423 .Say(dirName->source,
2424 parser::MessageFormattedText{
2425 "CRITICAL directive names do not match"_err_en_US})
2426 .Attach(dirName->source, "should be NULL"_en_US);
2427 } else if (!dirName && endDirName) {
2428 context_
2429 .Say(endDirName->source,
2430 parser::MessageFormattedText{
2431 "CRITICAL directive names do not match"_err_en_US})
2432 .Attach(endDirName->source, "should be NULL"_en_US);
2433 }
2434 if (!dirName && !ompClause.source.empty() &&
2435 ompClause.source.NULTerminatedToString() != "hint(omp_sync_hint_none)") {
2436 context_.Say(dir.source,
2437 parser::MessageFormattedText{
2438 "Hint clause other than omp_sync_hint_none cannot be specified for "
2439 "an unnamed CRITICAL directive"_err_en_US});
2440 }
2441}
2442
2443void OmpStructureChecker::Leave(const parser::OpenMPCriticalConstruct &) {
2444 dirContext_.pop_back();
2445}
2446
2447void OmpStructureChecker::Enter(
2448 const parser::OmpClause::CancellationConstructType &x) {
2449 llvm::omp::Directive dir{GetContext().directive};
2450 auto &dirName{std::get<parser::OmpDirectiveName>(x.v.t)};
2451
2452 if (dir != llvm::omp::Directive::OMPD_cancel &&
2453 dir != llvm::omp::Directive::OMPD_cancellation_point) {
2454 // Do not call CheckAllowed/CheckAllowedClause, because in case of an error
2455 // it will print "CANCELLATION_CONSTRUCT_TYPE" as the clause name instead
2456 // of the contained construct name.
2457 context_.Say(dirName.source, "%s cannot follow %s"_err_en_US,
2458 parser::ToUpperCaseLetters(getDirectiveName(dirName.v)),
2459 parser::ToUpperCaseLetters(getDirectiveName(dir)));
2460 } else {
2461 switch (dirName.v) {
2462 case llvm::omp::Directive::OMPD_do:
2463 case llvm::omp::Directive::OMPD_parallel:
2464 case llvm::omp::Directive::OMPD_sections:
2465 case llvm::omp::Directive::OMPD_taskgroup:
2466 break;
2467 default:
2468 context_.Say(dirName.source,
2469 "%s is not a cancellable construct"_err_en_US,
2470 parser::ToUpperCaseLetters(getDirectiveName(dirName.v)));
2471 break;
2472 }
2473 }
2474}
2475
2476void OmpStructureChecker::Enter(
2477 const parser::OpenMPCancellationPointConstruct &x) {
2478 auto &dirName{std::get<parser::OmpDirectiveName>(x.v.t)};
2479 auto &maybeClauses{std::get<std::optional<parser::OmpClauseList>>(x.v.t)};
2480 PushContextAndClauseSets(
2481 dirName.source, llvm::omp::Directive::OMPD_cancellation_point);
2482
2483 if (auto maybeConstruct{
2484 GetCancelType(llvm::omp::Directive::OMPD_cancellation_point, x.source,
2485 maybeClauses)}) {
2486 CheckCancellationNest(dirName.source, *maybeConstruct);
2487 }
2488}
2489
2490void OmpStructureChecker::Leave(
2491 const parser::OpenMPCancellationPointConstruct &) {
2492 dirContext_.pop_back();
2493}
2494
2495std::optional<llvm::omp::Directive> OmpStructureChecker::GetCancelType(
2496 llvm::omp::Directive cancelDir, const parser::CharBlock &cancelSource,
2497 const std::optional<parser::OmpClauseList> &maybeClauses) {
2498 if (!maybeClauses) {
2499 return std::nullopt;
2500 }
2501 // Given clauses from CANCEL or CANCELLATION_POINT, identify the construct
2502 // to which the cancellation applies.
2503 std::optional<llvm::omp::Directive> cancelee;
2504 llvm::StringRef cancelName{getDirectiveName(cancelDir)};
2505
2506 for (const parser::OmpClause &clause : maybeClauses->v) {
2507 using CancellationConstructType =
2508 parser::OmpClause::CancellationConstructType;
2509 if (auto *cctype{std::get_if<CancellationConstructType>(&clause.u)}) {
2510 if (cancelee) {
2511 context_.Say(cancelSource,
2512 "Multiple cancel-directive-name clauses are not allowed on the %s construct"_err_en_US,
2513 parser::ToUpperCaseLetters(cancelName.str()));
2514 return std::nullopt;
2515 }
2516 cancelee = std::get<parser::OmpDirectiveName>(cctype->v.t).v;
2517 }
2518 }
2519
2520 if (!cancelee) {
2521 context_.Say(cancelSource,
2522 "Missing cancel-directive-name clause on the %s construct"_err_en_US,
2523 parser::ToUpperCaseLetters(cancelName.str()));
2524 return std::nullopt;
2525 }
2526
2527 return cancelee;
2528}
2529
2530void OmpStructureChecker::CheckCancellationNest(
2531 const parser::CharBlock &source, llvm::omp::Directive type) {
2532 llvm::StringRef typeName{getDirectiveName(type)};
2533
2534 if (CurrentDirectiveIsNested()) {
2535 // If construct-type-clause is taskgroup, the cancellation construct must be
2536 // closely nested inside a task or a taskloop construct and the cancellation
2537 // region must be closely nested inside a taskgroup region. If
2538 // construct-type-clause is sections, the cancellation construct must be
2539 // closely nested inside a sections or section construct. Otherwise, the
2540 // cancellation construct must be closely nested inside an OpenMP construct
2541 // that matches the type specified in construct-type-clause of the
2542 // cancellation construct.
2543 bool eligibleCancellation{false};
2544
2545 switch (type) {
2546 case llvm::omp::Directive::OMPD_taskgroup:
2547 if (llvm::omp::nestedCancelTaskgroupAllowedSet.test(
2548 GetContextParent().directive)) {
2549 eligibleCancellation = true;
2550 if (dirContext_.size() >= 3) {
2551 // Check if the cancellation region is closely nested inside a
2552 // taskgroup region when there are more than two levels of directives
2553 // in the directive context stack.
2554 if (GetContextParent().directive == llvm::omp::Directive::OMPD_task ||
2555 FindClauseParent(llvm::omp::Clause::OMPC_nogroup)) {
2556 for (int i = dirContext_.size() - 3; i >= 0; i--) {
2557 if (dirContext_[i].directive ==
2558 llvm::omp::Directive::OMPD_taskgroup) {
2559 break;
2560 }
2561 if (llvm::omp::nestedCancelParallelAllowedSet.test(
2562 dirContext_[i].directive)) {
2563 eligibleCancellation = false;
2564 break;
2565 }
2566 }
2567 }
2568 }
2569 }
2570 if (!eligibleCancellation) {
2571 context_.Say(source,
2572 "With %s clause, %s construct must be closely nested inside TASK or TASKLOOP construct and %s region must be closely nested inside TASKGROUP region"_err_en_US,
2573 parser::ToUpperCaseLetters(typeName.str()),
2574 ContextDirectiveAsFortran(), ContextDirectiveAsFortran());
2575 }
2576 return;
2577 case llvm::omp::Directive::OMPD_sections:
2578 if (llvm::omp::nestedCancelSectionsAllowedSet.test(
2579 GetContextParent().directive)) {
2580 eligibleCancellation = true;
2581 }
2582 break;
2583 case llvm::omp::Directive::OMPD_do:
2584 if (llvm::omp::nestedCancelDoAllowedSet.test(
2585 GetContextParent().directive)) {
2586 eligibleCancellation = true;
2587 }
2588 break;
2589 case llvm::omp::Directive::OMPD_parallel:
2590 if (llvm::omp::nestedCancelParallelAllowedSet.test(
2591 GetContextParent().directive)) {
2592 eligibleCancellation = true;
2593 }
2594 break;
2595 default:
2596 // This is diagnosed later.
2597 return;
2598 }
2599 if (!eligibleCancellation) {
2600 context_.Say(source,
2601 "With %s clause, %s construct cannot be closely nested inside %s construct"_err_en_US,
2602 parser::ToUpperCaseLetters(typeName.str()),
2603 ContextDirectiveAsFortran(),
2604 parser::ToUpperCaseLetters(
2605 getDirectiveName(GetContextParent().directive).str()));
2606 }
2607 } else {
2608 // The cancellation directive cannot be orphaned.
2609 switch (type) {
2610 case llvm::omp::Directive::OMPD_taskgroup:
2611 context_.Say(source,
2612 "%s %s directive is not closely nested inside TASK or TASKLOOP"_err_en_US,
2613 ContextDirectiveAsFortran(),
2614 parser::ToUpperCaseLetters(typeName.str()));
2615 break;
2616 case llvm::omp::Directive::OMPD_sections:
2617 context_.Say(source,
2618 "%s %s directive is not closely nested inside SECTION or SECTIONS"_err_en_US,
2619 ContextDirectiveAsFortran(),
2620 parser::ToUpperCaseLetters(typeName.str()));
2621 break;
2622 case llvm::omp::Directive::OMPD_do:
2623 context_.Say(source,
2624 "%s %s directive is not closely nested inside the construct that matches the DO clause type"_err_en_US,
2625 ContextDirectiveAsFortran(),
2626 parser::ToUpperCaseLetters(typeName.str()));
2627 break;
2628 case llvm::omp::Directive::OMPD_parallel:
2629 context_.Say(source,
2630 "%s %s directive is not closely nested inside the construct that matches the PARALLEL clause type"_err_en_US,
2631 ContextDirectiveAsFortran(),
2632 parser::ToUpperCaseLetters(typeName.str()));
2633 break;
2634 default:
2635 // This is diagnosed later.
2636 return;
2637 }
2638 }
2639}
2640
2641void OmpStructureChecker::Enter(const parser::OmpEndBlockDirective &x) {
2642 const auto &dir{std::get<parser::OmpBlockDirective>(x.t)};
2643 ResetPartialContext(dir.source);
2644 switch (dir.v) {
2645 case llvm::omp::Directive::OMPD_scope:
2646 PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_end_scope);
2647 break;
2648 // 2.7.3 end-single-clause -> copyprivate-clause |
2649 // nowait-clause
2650 case llvm::omp::Directive::OMPD_single:
2651 PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_end_single);
2652 break;
2653 // 2.7.4 end-workshare -> END WORKSHARE [nowait-clause]
2654 case llvm::omp::Directive::OMPD_workshare:
2655 PushContextAndClauseSets(
2656 dir.source, llvm::omp::Directive::OMPD_end_workshare);
2657 break;
2658 default:
2659 // no clauses are allowed
2660 break;
2661 }
2662}
2663
2664// TODO: Verify the popping of dirContext requirement after nowait
2665// implementation, as there is an implicit barrier at the end of the worksharing
2666// constructs unless a nowait clause is specified. Only OMPD_end_single and
2667// end_workshareare popped as they are pushed while entering the
2668// EndBlockDirective.
2669void OmpStructureChecker::Leave(const parser::OmpEndBlockDirective &x) {
2670 if ((GetContext().directive == llvm::omp::Directive::OMPD_end_scope) ||
2671 (GetContext().directive == llvm::omp::Directive::OMPD_end_single) ||
2672 (GetContext().directive == llvm::omp::Directive::OMPD_end_workshare)) {
2673 dirContext_.pop_back();
2674 }
2675}
2676
2677/// parser::Block is a list of executable constructs, parser::BlockConstruct
2678/// is Fortran's BLOCK/ENDBLOCK construct.
2679/// Strip the outermost BlockConstructs, return the reference to the Block
2680/// in the executable part of the innermost of the stripped constructs.
2681/// Specifically, if the given `block` has a single entry (it's a list), and
2682/// the entry is a BlockConstruct, get the Block contained within. Repeat
2683/// this step as many times as possible.
2684static const parser::Block &GetInnermostExecPart(const parser::Block &block) {
2685 const parser::Block *iter{&block};
2686 while (iter->size() == 1) {
2687 const parser::ExecutionPartConstruct &ep{iter->front()};
2688 if (auto *exec{std::get_if<parser::ExecutableConstruct>(&ep.u)}) {
2689 using BlockConstruct = common::Indirection<parser::BlockConstruct>;
2690 if (auto *bc{std::get_if<BlockConstruct>(&exec->u)}) {
2691 iter = &std::get<parser::Block>(bc->value().t);
2692 continue;
2693 }
2694 }
2695 break;
2696 }
2697 return *iter;
2698}
2699
2700// There is no consistent way to get the source of a given ActionStmt, so
2701// extract the source information from Statement<ActionStmt> when we can,
2702// and keep it around for error reporting in further analyses.
2703struct SourcedActionStmt {
2704 const parser::ActionStmt *stmt{nullptr};
2705 parser::CharBlock source;
2706
2707 operator bool() const { return stmt != nullptr; }
2708};
2709
2710struct AnalyzedCondStmt {
2711 SomeExpr cond{evaluate::NullPointer{}}; // Default ctor is deleted
2712 parser::CharBlock source;
2713 SourcedActionStmt ift, iff;
2714};
2715
2716static SourcedActionStmt GetActionStmt(
2717 const parser::ExecutionPartConstruct *x) {
2718 if (x == nullptr) {
2719 return SourcedActionStmt{};
2720 }
2721 if (auto *exec{std::get_if<parser::ExecutableConstruct>(&x->u)}) {
2722 using ActionStmt = parser::Statement<parser::ActionStmt>;
2723 if (auto *stmt{std::get_if<ActionStmt>(&exec->u)}) {
2724 return SourcedActionStmt{&stmt->statement, stmt->source};
2725 }
2726 }
2727 return SourcedActionStmt{};
2728}
2729
2730static SourcedActionStmt GetActionStmt(const parser::Block &block) {
2731 if (block.size() == 1) {
2732 return GetActionStmt(&block.front());
2733 }
2734 return SourcedActionStmt{};
2735}
2736
2737// Compute the `evaluate::Assignment` from parser::ActionStmt. The assumption
2738// is that the ActionStmt will be either an assignment or a pointer-assignment,
2739// otherwise return std::nullopt.
2740// Note: This function can return std::nullopt on [Pointer]AssignmentStmt where
2741// the "typedAssignment" is unset. This can happen if there are semantic errors
2742// in the purported assignment.
2743static std::optional<evaluate::Assignment> GetEvaluateAssignment(
2744 const parser::ActionStmt *x) {
2745 if (x == nullptr) {
2746 return std::nullopt;
2747 }
2748
2749 using AssignmentStmt = common::Indirection<parser::AssignmentStmt>;
2750 using PointerAssignmentStmt =
2751 common::Indirection<parser::PointerAssignmentStmt>;
2752 using TypedAssignment = parser::AssignmentStmt::TypedAssignment;
2753
2754 return common::visit(
2755 [](auto &&s) -> std::optional<evaluate::Assignment> {
2756 using BareS = llvm::remove_cvref_t<decltype(s)>;
2757 if constexpr (std::is_same_v<BareS, AssignmentStmt> ||
2758 std::is_same_v<BareS, PointerAssignmentStmt>) {
2759 const TypedAssignment &typed{s.value().typedAssignment};
2760 // ForwardOwningPointer typedAssignment
2761 // `- GenericAssignmentWrapper ^.get()
2762 // `- std::optional<Assignment> ^->v
2763 return typed.get()->v;
2764 } else {
2765 return std::nullopt;
2766 }
2767 },
2768 x->u);
2769}
2770
2771// Check if the ActionStmt is actually a [Pointer]AssignmentStmt. This is
2772// to separate cases where the source has something that looks like an
2773// assignment, but is semantically wrong (diagnosed by general semantic
2774// checks), and where the source has some other statement (which we want
2775// to report as "should be an assignment").
2776static bool IsAssignment(const parser::ActionStmt *x) {
2777 if (x == nullptr) {
2778 return false;
2779 }
2780
2781 using AssignmentStmt = common::Indirection<parser::AssignmentStmt>;
2782 using PointerAssignmentStmt =
2783 common::Indirection<parser::PointerAssignmentStmt>;
2784
2785 return common::visit(
2786 [](auto &&s) -> bool {
2787 using BareS = llvm::remove_cvref_t<decltype(s)>;
2788 return std::is_same_v<BareS, AssignmentStmt> ||
2789 std::is_same_v<BareS, PointerAssignmentStmt>;
2790 },
2791 x->u);
2792}
2793
2794static std::optional<AnalyzedCondStmt> AnalyzeConditionalStmt(
2795 const parser::ExecutionPartConstruct *x) {
2796 if (x == nullptr) {
2797 return std::nullopt;
2798 }
2799
2800 // Extract the evaluate::Expr from ScalarLogicalExpr.
2801 auto getFromLogical{[](const parser::ScalarLogicalExpr &logical) {
2802 // ScalarLogicalExpr is Scalar<Logical<common::Indirection<Expr>>>
2803 const parser::Expr &expr{logical.thing.thing.value()};
2804 return GetEvaluateExpr(expr);
2805 }};
2806
2807 // Recognize either
2808 // ExecutionPartConstruct -> ExecutableConstruct -> ActionStmt -> IfStmt, or
2809 // ExecutionPartConstruct -> ExecutableConstruct -> IfConstruct.
2810
2811 if (auto &&action{GetActionStmt(x)}) {
2812 if (auto *ifs{std::get_if<common::Indirection<parser::IfStmt>>(
2813 &action.stmt->u)}) {
2814 const parser::IfStmt &s{ifs->value()};
2815 auto &&maybeCond{
2816 getFromLogical(std::get<parser::ScalarLogicalExpr>(s.t))};
2817 auto &thenStmt{
2818 std::get<parser::UnlabeledStatement<parser::ActionStmt>>(s.t)};
2819 if (maybeCond) {
2820 return AnalyzedCondStmt{std::move(*maybeCond), action.source,
2821 SourcedActionStmt{&thenStmt.statement, thenStmt.source},
2822 SourcedActionStmt{}};
2823 }
2824 }
2825 return std::nullopt;
2826 }
2827
2828 if (auto *exec{std::get_if<parser::ExecutableConstruct>(&x->u)}) {
2829 if (auto *ifc{
2830 std::get_if<common::Indirection<parser::IfConstruct>>(&exec->u)}) {
2831 using ElseBlock = parser::IfConstruct::ElseBlock;
2832 using ElseIfBlock = parser::IfConstruct::ElseIfBlock;
2833 const parser::IfConstruct &s{ifc->value()};
2834
2835 if (!std::get<std::list<ElseIfBlock>>(s.t).empty()) {
2836 // Not expecting any else-if statements.
2837 return std::nullopt;
2838 }
2839 auto &stmt{std::get<parser::Statement<parser::IfThenStmt>>(s.t)};
2840 auto &&maybeCond{getFromLogical(
2841 std::get<parser::ScalarLogicalExpr>(stmt.statement.t))};
2842 if (!maybeCond) {
2843 return std::nullopt;
2844 }
2845
2846 if (auto &maybeElse{std::get<std::optional<ElseBlock>>(s.t)}) {
2847 AnalyzedCondStmt result{std::move(*maybeCond), stmt.source,
2848 GetActionStmt(std::get<parser::Block>(s.t)),
2849 GetActionStmt(std::get<parser::Block>(maybeElse->t))};
2850 if (result.ift.stmt && result.iff.stmt) {
2851 return result;
2852 }
2853 } else {
2854 AnalyzedCondStmt result{std::move(*maybeCond), stmt.source,
2855 GetActionStmt(std::get<parser::Block>(s.t)), SourcedActionStmt{}};
2856 if (result.ift.stmt) {
2857 return result;
2858 }
2859 }
2860 }
2861 return std::nullopt;
2862 }
2863
2864 return std::nullopt;
2865}
2866
2867static std::pair<parser::CharBlock, parser::CharBlock> SplitAssignmentSource(
2868 parser::CharBlock source) {
2869 // Find => in the range, if not found, find = that is not a part of
2870 // <=, >=, ==, or /=.
2871 auto trim{[](std::string_view v) {
2872 const char *begin{v.data()};
2873 const char *end{begin + v.size()};
2874 while (*begin == ' ' && begin != end) {
2875 ++begin;
2876 }
2877 while (begin != end && end[-1] == ' ') {
2878 --end;
2879 }
2880 assert(begin != end && "Source should not be empty");
2881 return parser::CharBlock(begin, end - begin);
2882 }};
2883
2884 std::string_view sv(source.begin(), source.size());
2885
2886 if (auto where{sv.find(str: "=>")}; where != sv.npos) {
2887 std::string_view lhs(sv.data(), where);
2888 std::string_view rhs(sv.data() + where + 2, sv.size() - where - 2);
2889 return std::make_pair(trim(lhs), trim(rhs));
2890 }
2891
2892 // Go backwards, since all the exclusions above end with a '='.
2893 for (size_t next{source.size()}; next > 1; --next) {
2894 if (sv[next - 1] == '=' && !llvm::is_contained(Range: "<>=/", Element: sv[next - 2])) {
2895 std::string_view lhs(sv.data(), next - 1);
2896 std::string_view rhs(sv.data() + next, sv.size() - next);
2897 return std::make_pair(trim(lhs), trim(rhs));
2898 }
2899 }
2900 llvm_unreachable("Could not find assignment operator");
2901}
2902
2903namespace atomic {
2904
2905struct DesignatorCollector : public evaluate::Traverse<DesignatorCollector,
2906 std::vector<SomeExpr>, false> {
2907 using Result = std::vector<SomeExpr>;
2908 using Base = evaluate::Traverse<DesignatorCollector, Result, false>;
2909 DesignatorCollector() : Base(*this) {}
2910
2911 Result Default() const { return {}; }
2912
2913 using Base::operator();
2914
2915 template <typename T> //
2916 Result operator()(const evaluate::Designator<T> &x) const {
2917 // Once in a designator, don't traverse it any further (i.e. only
2918 // collect top-level designators).
2919 auto copy{x};
2920 return Result{AsGenericExpr(std::move(copy))};
2921 }
2922
2923 template <typename... Rs> //
2924 Result Combine(Result &&result, Rs &&...results) const {
2925 Result v(std::move(result));
2926 auto moveAppend{[](auto &accum, auto &&other) {
2927 for (auto &&s : other) {
2928 accum.push_back(std::move(s));
2929 }
2930 }};
2931 (moveAppend(v, std::move(results)), ...);
2932 return v;
2933 }
2934};
2935
2936struct VariableFinder : public evaluate::AnyTraverse<VariableFinder> {
2937 using Base = evaluate::AnyTraverse<VariableFinder>;
2938 VariableFinder(const SomeExpr &v) : Base(*this), var(v) {}
2939
2940 using Base::operator();
2941
2942 template <typename T>
2943 bool operator()(const evaluate::Designator<T> &x) const {
2944 auto copy{x};
2945 return evaluate::AsGenericExpr(std::move(copy)) == var;
2946 }
2947
2948 template <typename T>
2949 bool operator()(const evaluate::FunctionRef<T> &x) const {
2950 auto copy{x};
2951 return evaluate::AsGenericExpr(std::move(copy)) == var;
2952 }
2953
2954private:
2955 const SomeExpr &var;
2956};
2957} // namespace atomic
2958
2959static bool IsPointerAssignment(const evaluate::Assignment &x) {
2960 return std::holds_alternative<evaluate::Assignment::BoundsSpec>(x.u) ||
2961 std::holds_alternative<evaluate::Assignment::BoundsRemapping>(x.u);
2962}
2963
2964static bool IsCheckForAssociated(const SomeExpr &cond) {
2965 return GetTopLevelOperation(cond).first == operation::Operator::Associated;
2966}
2967
2968static bool HasCommonDesignatorSymbols(
2969 const evaluate::SymbolVector &baseSyms, const SomeExpr &other) {
2970 // Compare the designators used in "other" with the designators whose
2971 // symbols are given in baseSyms.
2972 // This is a part of the check if these two expressions can access the same
2973 // storage: if the designators used in them are different enough, then they
2974 // will be assumed not to access the same memory.
2975 //
2976 // Consider an (array element) expression x%y(w%z), the corresponding symbol
2977 // vector will be {x, y, w, z} (i.e. the symbols for these names).
2978 // Check whether this exact sequence appears anywhere in any the symbol
2979 // vector for "other". This will be true for x(y) and x(y+1), so this is
2980 // not a sufficient condition, but can be used to eliminate candidates
2981 // before doing more exhaustive checks.
2982 //
2983 // If any of the symbols in this sequence are function names, assume that
2984 // there is no storage overlap, mostly because it would be impossible in
2985 // general to determine what storage the function will access.
2986 // Note: if f is pure, then two calls to f will access the same storage
2987 // when called with the same arguments. This check is not done yet.
2988
2989 if (llvm::any_of(
2990 baseSyms, [](const SymbolRef &s) { return s->IsSubprogram(); })) {
2991 // If there is a function symbol in the chain then we can't infer much
2992 // about the accessed storage.
2993 return false;
2994 }
2995
2996 auto isSubsequence{// Is u a subsequence of v.
2997 [](const evaluate::SymbolVector &u, const evaluate::SymbolVector &v) {
2998 size_t us{u.size()}, vs{v.size()};
2999 if (us > vs) {
3000 return false;
3001 }
3002 for (size_t off{0}; off != vs - us + 1; ++off) {
3003 bool same{true};
3004 for (size_t i{0}; i != us; ++i) {
3005 if (u[i] != v[off + i]) {
3006 same = false;
3007 break;
3008 }
3009 }
3010 if (same) {
3011 return true;
3012 }
3013 }
3014 return false;
3015 }};
3016
3017 evaluate::SymbolVector otherSyms{evaluate::GetSymbolVector(other)};
3018 return isSubsequence(baseSyms, otherSyms);
3019}
3020
3021static bool HasCommonTopLevelDesignators(
3022 const std::vector<SomeExpr> &baseDsgs, const SomeExpr &other) {
3023 // Compare designators directly as expressions. This will ensure
3024 // that x(y) and x(y+1) are not flagged as overlapping, whereas
3025 // the symbol vectors for both of these would be identical.
3026 std::vector<SomeExpr> otherDsgs{atomic::DesignatorCollector{}(other)};
3027
3028 for (auto &s : baseDsgs) {
3029 if (llvm::any_of(otherDsgs, [&](auto &&t) { return s == t; })) {
3030 return true;
3031 }
3032 }
3033 return false;
3034}
3035
3036static const SomeExpr *HasStorageOverlap(
3037 const SomeExpr &base, llvm::ArrayRef<SomeExpr> exprs) {
3038 evaluate::SymbolVector baseSyms{evaluate::GetSymbolVector(base)};
3039 std::vector<SomeExpr> baseDsgs{atomic::DesignatorCollector{}(base)};
3040
3041 for (const SomeExpr &expr : exprs) {
3042 if (!HasCommonDesignatorSymbols(baseSyms, expr)) {
3043 continue;
3044 }
3045 if (HasCommonTopLevelDesignators(baseDsgs, expr)) {
3046 return &expr;
3047 }
3048 }
3049 return nullptr;
3050}
3051
3052static bool IsMaybeAtomicWrite(const evaluate::Assignment &assign) {
3053 // This ignores function calls, so it will accept "f(x) = f(x) + 1"
3054 // for example.
3055 return HasStorageOverlap(assign.lhs, assign.rhs) == nullptr;
3056}
3057
3058static bool IsSubexpressionOf(const SomeExpr &sub, const SomeExpr &super) {
3059 return atomic::VariableFinder{sub}(super);
3060}
3061
3062static void SetExpr(parser::TypedExpr &expr, MaybeExpr value) {
3063 if (value) {
3064 expr.Reset(new evaluate::GenericExprWrapper(std::move(value)),
3065 evaluate::GenericExprWrapper::Deleter);
3066 }
3067}
3068
3069static void SetAssignment(parser::AssignmentStmt::TypedAssignment &assign,
3070 std::optional<evaluate::Assignment> value) {
3071 if (value) {
3072 assign.Reset(new evaluate::GenericAssignmentWrapper(std::move(value)),
3073 evaluate::GenericAssignmentWrapper::Deleter);
3074 }
3075}
3076
3077static parser::OpenMPAtomicConstruct::Analysis::Op MakeAtomicAnalysisOp(
3078 int what,
3079 const std::optional<evaluate::Assignment> &maybeAssign = std::nullopt) {
3080 parser::OpenMPAtomicConstruct::Analysis::Op operation;
3081 operation.what = what;
3082 SetAssignment(operation.assign, maybeAssign);
3083 return operation;
3084}
3085
3086static parser::OpenMPAtomicConstruct::Analysis MakeAtomicAnalysis(
3087 const SomeExpr &atom, const MaybeExpr &cond,
3088 parser::OpenMPAtomicConstruct::Analysis::Op &&op0,
3089 parser::OpenMPAtomicConstruct::Analysis::Op &&op1) {
3090 // Defined in flang/include/flang/Parser/parse-tree.h
3091 //
3092 // struct Analysis {
3093 // struct Kind {
3094 // static constexpr int None = 0;
3095 // static constexpr int Read = 1;
3096 // static constexpr int Write = 2;
3097 // static constexpr int Update = Read | Write;
3098 // static constexpr int Action = 3; // Bits containing N, R, W, U
3099 // static constexpr int IfTrue = 4;
3100 // static constexpr int IfFalse = 8;
3101 // static constexpr int Condition = 12; // Bits containing IfTrue, IfFalse
3102 // };
3103 // struct Op {
3104 // int what;
3105 // TypedAssignment assign;
3106 // };
3107 // TypedExpr atom, cond;
3108 // Op op0, op1;
3109 // };
3110
3111 parser::OpenMPAtomicConstruct::Analysis an;
3112 SetExpr(an.atom, atom);
3113 SetExpr(an.cond, cond);
3114 an.op0 = std::move(op0);
3115 an.op1 = std::move(op1);
3116 return an;
3117}
3118
3119void OmpStructureChecker::CheckStorageOverlap(const SomeExpr &base,
3120 llvm::ArrayRef<evaluate::Expr<evaluate::SomeType>> exprs,
3121 parser::CharBlock source) {
3122 if (auto *expr{HasStorageOverlap(base, exprs)}) {
3123 context_.Say(source,
3124 "Within atomic operation %s and %s access the same storage"_warn_en_US,
3125 base.AsFortran(), expr->AsFortran());
3126 }
3127}
3128
3129void OmpStructureChecker::ErrorShouldBeVariable(
3130 const MaybeExpr &expr, parser::CharBlock source) {
3131 if (expr) {
3132 context_.Say(source, "Atomic expression %s should be a variable"_err_en_US,
3133 expr->AsFortran());
3134 } else {
3135 context_.Say(source, "Atomic expression should be a variable"_err_en_US);
3136 }
3137}
3138
3139/// Check if `expr` satisfies the following conditions for x and v:
3140///
3141/// [6.0:189:10-12]
3142/// - x and v (as applicable) are either scalar variables or
3143/// function references with scalar data pointer result of non-character
3144/// intrinsic type or variables that are non-polymorphic scalar pointers
3145/// and any length type parameter must be constant.
3146void OmpStructureChecker::CheckAtomicType(
3147 SymbolRef sym, parser::CharBlock source, std::string_view name) {
3148 const DeclTypeSpec *typeSpec{sym->GetType()};
3149 if (!typeSpec) {
3150 return;
3151 }
3152
3153 if (!IsPointer(sym)) {
3154 using Category = DeclTypeSpec::Category;
3155 Category cat{typeSpec->category()};
3156 if (cat == Category::Character) {
3157 context_.Say(source,
3158 "Atomic variable %s cannot have CHARACTER type"_err_en_US, name);
3159 } else if (cat != Category::Numeric && cat != Category::Logical) {
3160 context_.Say(source,
3161 "Atomic variable %s should have an intrinsic type"_err_en_US, name);
3162 }
3163 return;
3164 }
3165
3166 // Variable is a pointer.
3167 if (typeSpec->IsPolymorphic()) {
3168 context_.Say(source,
3169 "Atomic variable %s cannot be a pointer to a polymorphic type"_err_en_US,
3170 name);
3171 return;
3172 }
3173
3174 // Go over all length parameters, if any, and check if they are
3175 // explicit.
3176 if (const DerivedTypeSpec *derived{typeSpec->AsDerived()}) {
3177 if (llvm::any_of(derived->parameters(), [](auto &&entry) {
3178 // "entry" is a map entry
3179 return entry.second.isLen() && !entry.second.isExplicit();
3180 })) {
3181 context_.Say(source,
3182 "Atomic variable %s is a pointer to a type with non-constant length parameter"_err_en_US,
3183 name);
3184 }
3185 }
3186}
3187
3188void OmpStructureChecker::CheckAtomicVariable(
3189 const SomeExpr &atom, parser::CharBlock source) {
3190 if (atom.Rank() != 0) {
3191 context_.Say(source, "Atomic variable %s should be a scalar"_err_en_US,
3192 atom.AsFortran());
3193 }
3194
3195 std::vector<SomeExpr> dsgs{atomic::DesignatorCollector{}(atom)};
3196 assert(dsgs.size() == 1 && "Should have a single top-level designator");
3197 evaluate::SymbolVector syms{evaluate::GetSymbolVector(dsgs.front())};
3198
3199 CheckAtomicType(syms.back(), source, atom.AsFortran());
3200
3201 if (IsAllocatable(syms.back()) && !IsArrayElement(atom)) {
3202 context_.Say(source, "Atomic variable %s cannot be ALLOCATABLE"_err_en_US,
3203 atom.AsFortran());
3204 }
3205}
3206
3207std::pair<const parser::ExecutionPartConstruct *,
3208 const parser::ExecutionPartConstruct *>
3209OmpStructureChecker::CheckUpdateCapture(
3210 const parser::ExecutionPartConstruct *ec1,
3211 const parser::ExecutionPartConstruct *ec2, parser::CharBlock source) {
3212 // Decide which statement is the atomic update and which is the capture.
3213 //
3214 // The two allowed cases are:
3215 // x = ... atomic-var = ...
3216 // ... = x capture-var = atomic-var (with optional converts)
3217 // or
3218 // ... = x capture-var = atomic-var (with optional converts)
3219 // x = ... atomic-var = ...
3220 //
3221 // The case of 'a = b; b = a' is ambiguous, so pick the first one as capture
3222 // (which makes more sense, as it captures the original value of the atomic
3223 // variable).
3224 //
3225 // If the two statements don't fit these criteria, return a pair of default-
3226 // constructed values.
3227 using ReturnTy = std::pair<const parser::ExecutionPartConstruct *,
3228 const parser::ExecutionPartConstruct *>;
3229
3230 SourcedActionStmt act1{GetActionStmt(ec1)};
3231 SourcedActionStmt act2{GetActionStmt(ec2)};
3232 auto maybeAssign1{GetEvaluateAssignment(act1.stmt)};
3233 auto maybeAssign2{GetEvaluateAssignment(act2.stmt)};
3234 if (!maybeAssign1 || !maybeAssign2) {
3235 if (!IsAssignment(act1.stmt) || !IsAssignment(act2.stmt)) {
3236 context_.Say(source,
3237 "ATOMIC UPDATE operation with CAPTURE should contain two assignments"_err_en_US);
3238 }
3239 return std::make_pair(x: nullptr, y: nullptr);
3240 }
3241
3242 auto as1{*maybeAssign1}, as2{*maybeAssign2};
3243
3244 auto isUpdateCapture{
3245 [](const evaluate::Assignment &u, const evaluate::Assignment &c) {
3246 return IsSameOrConvertOf(c.rhs, u.lhs);
3247 }};
3248
3249 // Do some checks that narrow down the possible choices for the update
3250 // and the capture statements. This will help to emit better diagnostics.
3251 // 1. An assignment could be an update (cbu) if the left-hand side is a
3252 // subexpression of the right-hand side.
3253 // 2. An assignment could be a capture (cbc) if the right-hand side is
3254 // a variable (or a function ref), with potential type conversions.
3255 bool cbu1{IsSubexpressionOf(as1.lhs, as1.rhs)}; // Can as1 be an update?
3256 bool cbu2{IsSubexpressionOf(as2.lhs, as2.rhs)}; // Can as2 be an update?
3257 bool cbc1{IsVarOrFunctionRef(GetConvertInput(as1.rhs))}; // Can 1 be capture?
3258 bool cbc2{IsVarOrFunctionRef(GetConvertInput(as2.rhs))}; // Can 2 be capture?
3259
3260 // We want to diagnose cases where both assignments cannot be an update,
3261 // or both cannot be a capture, as well as cases where either assignment
3262 // cannot be any of these two.
3263 //
3264 // If we organize these boolean values into a matrix
3265 // |cbu1 cbu2|
3266 // |cbc1 cbc2|
3267 // then we want to diagnose cases where the matrix has a zero (i.e. "false")
3268 // row or column, including the case where everything is zero. All these
3269 // cases correspond to the determinant of the matrix being 0, which suggests
3270 // that checking the det may be a convenient diagnostic check. There is only
3271 // one additional case where the det is 0, which is when the matrix is all 1
3272 // ("true"). The "all true" case represents the situation where both
3273 // assignments could be an update as well as a capture. On the other hand,
3274 // whenever det != 0, the roles of the update and the capture can be
3275 // unambiguously assigned to as1 and as2 [1].
3276 //
3277 // [1] This can be easily verified by hand: there are 10 2x2 matrices with
3278 // det = 0, leaving 6 cases where det != 0:
3279 // 0 1 0 1 1 0 1 0 1 1 1 1
3280 // 1 0 1 1 0 1 1 1 0 1 1 0
3281 // In each case the classification is unambiguous.
3282
3283 // |cbu1 cbu2|
3284 // det |cbc1 cbc2| = cbu1*cbc2 - cbu2*cbc1
3285 int det{int(cbu1) * int(cbc2) - int(cbu2) * int(cbc1)};
3286
3287 auto errorCaptureShouldRead{[&](const parser::CharBlock &source,
3288 const std::string &expr) {
3289 context_.Say(source,
3290 "In ATOMIC UPDATE operation with CAPTURE the right-hand side of the capture assignment should read %s"_err_en_US,
3291 expr);
3292 }};
3293
3294 auto errorNeitherWorks{[&]() {
3295 context_.Say(source,
3296 "In ATOMIC UPDATE operation with CAPTURE neither statement could be the update or the capture"_err_en_US);
3297 }};
3298
3299 auto makeSelectionFromDet{[&](int det) -> ReturnTy {
3300 // If det != 0, then the checks unambiguously suggest a specific
3301 // categorization.
3302 // If det == 0, then this function should be called only if the
3303 // checks haven't ruled out any possibility, i.e. when both assigments
3304 // could still be either updates or captures.
3305 if (det > 0) {
3306 // as1 is update, as2 is capture
3307 if (isUpdateCapture(as1, as2)) {
3308 return std::make_pair(/*Update=*/ec1, /*Capture=*/ec2);
3309 } else {
3310 errorCaptureShouldRead(act2.source, as1.lhs.AsFortran());
3311 return std::make_pair(nullptr, nullptr);
3312 }
3313 } else if (det < 0) {
3314 // as2 is update, as1 is capture
3315 if (isUpdateCapture(as2, as1)) {
3316 return std::make_pair(/*Update=*/ec2, /*Capture=*/ec1);
3317 } else {
3318 errorCaptureShouldRead(act1.source, as2.lhs.AsFortran());
3319 return std::make_pair(nullptr, nullptr);
3320 }
3321 } else {
3322 bool updateFirst{isUpdateCapture(as1, as2)};
3323 bool captureFirst{isUpdateCapture(as2, as1)};
3324 if (updateFirst && captureFirst) {
3325 // If both assignment could be the update and both could be the
3326 // capture, emit a warning about the ambiguity.
3327 context_.Say(act1.source,
3328 "In ATOMIC UPDATE operation with CAPTURE either statement could be the update and the capture, assuming the first one is the capture statement"_warn_en_US);
3329 return std::make_pair(/*Update=*/ec2, /*Capture=*/ec1);
3330 }
3331 if (updateFirst != captureFirst) {
3332 const parser::ExecutionPartConstruct *upd{updateFirst ? ec1 : ec2};
3333 const parser::ExecutionPartConstruct *cap{captureFirst ? ec1 : ec2};
3334 return std::make_pair(upd, cap);
3335 }
3336 assert(!updateFirst && !captureFirst);
3337 errorNeitherWorks();
3338 return std::make_pair(nullptr, nullptr);
3339 }
3340 }};
3341
3342 if (det != 0 || (cbu1 && cbu2 && cbc1 && cbc2)) {
3343 return makeSelectionFromDet(det);
3344 }
3345 assert(det == 0 && "Prior checks should have covered det != 0");
3346
3347 // If neither of the statements is an RMW update, it could still be a
3348 // "write" update. Pretty much any assignment can be a write update, so
3349 // recompute det with cbu1 = cbu2 = true.
3350 if (int writeDet{int(cbc2) - int(cbc1)}; writeDet || (cbc1 && cbc2)) {
3351 return makeSelectionFromDet(writeDet);
3352 }
3353
3354 // It's only errors from here on.
3355
3356 if (!cbu1 && !cbu2 && !cbc1 && !cbc2) {
3357 errorNeitherWorks();
3358 return std::make_pair(x: nullptr, y: nullptr);
3359 }
3360
3361 // The remaining cases are that
3362 // - no candidate for update, or for capture,
3363 // - one of the assigments cannot be anything.
3364
3365 if (!cbu1 && !cbu2) {
3366 context_.Say(source,
3367 "In ATOMIC UPDATE operation with CAPTURE neither statement could be the update"_err_en_US);
3368 return std::make_pair(x: nullptr, y: nullptr);
3369 } else if (!cbc1 && !cbc2) {
3370 context_.Say(source,
3371 "In ATOMIC UPDATE operation with CAPTURE neither statement could be the capture"_err_en_US);
3372 return std::make_pair(x: nullptr, y: nullptr);
3373 }
3374
3375 if ((!cbu1 && !cbc1) || (!cbu2 && !cbc2)) {
3376 auto &src = (!cbu1 && !cbc1) ? act1.source : act2.source;
3377 context_.Say(src,
3378 "In ATOMIC UPDATE operation with CAPTURE the statement could be neither the update nor the capture"_err_en_US);
3379 return std::make_pair(x: nullptr, y: nullptr);
3380 }
3381
3382 // All cases should have been covered.
3383 llvm_unreachable("Unchecked condition");
3384}
3385
3386void OmpStructureChecker::CheckAtomicCaptureAssignment(
3387 const evaluate::Assignment &capture, const SomeExpr &atom,
3388 parser::CharBlock source) {
3389 auto [lsrc, rsrc]{SplitAssignmentSource(source)};
3390 const SomeExpr &cap{capture.lhs};
3391
3392 if (!IsVarOrFunctionRef(atom)) {
3393 ErrorShouldBeVariable(atom, rsrc);
3394 } else {
3395 CheckAtomicVariable(atom, rsrc);
3396 // This part should have been checked prior to calling this function.
3397 assert(*GetConvertInput(capture.rhs) == atom &&
3398 "This cannot be a capture assignment");
3399 CheckStorageOverlap(atom, {cap}, source);
3400 }
3401}
3402
3403void OmpStructureChecker::CheckAtomicReadAssignment(
3404 const evaluate::Assignment &read, parser::CharBlock source) {
3405 auto [lsrc, rsrc]{SplitAssignmentSource(source)};
3406
3407 if (auto maybe{GetConvertInput(read.rhs)}) {
3408 const SomeExpr &atom{*maybe};
3409
3410 if (!IsVarOrFunctionRef(atom)) {
3411 ErrorShouldBeVariable(atom, rsrc);
3412 } else {
3413 CheckAtomicVariable(atom, rsrc);
3414 CheckStorageOverlap(atom, {read.lhs}, source);
3415 }
3416 } else {
3417 ErrorShouldBeVariable(read.rhs, rsrc);
3418 }
3419}
3420
3421void OmpStructureChecker::CheckAtomicWriteAssignment(
3422 const evaluate::Assignment &write, parser::CharBlock source) {
3423 // [6.0:190:13-15]
3424 // A write structured block is write-statement, a write statement that has
3425 // one of the following forms:
3426 // x = expr
3427 // x => expr
3428 auto [lsrc, rsrc]{SplitAssignmentSource(source)};
3429 const SomeExpr &atom{write.lhs};
3430
3431 if (!IsVarOrFunctionRef(atom)) {
3432 ErrorShouldBeVariable(atom, rsrc);
3433 } else {
3434 CheckAtomicVariable(atom, lsrc);
3435 CheckStorageOverlap(atom, {write.rhs}, source);
3436 }
3437}
3438
3439void OmpStructureChecker::CheckAtomicUpdateAssignment(
3440 const evaluate::Assignment &update, parser::CharBlock source) {
3441 // [6.0:191:1-7]
3442 // An update structured block is update-statement, an update statement
3443 // that has one of the following forms:
3444 // x = x operator expr
3445 // x = expr operator x
3446 // x = intrinsic-procedure-name (x)
3447 // x = intrinsic-procedure-name (x, expr-list)
3448 // x = intrinsic-procedure-name (expr-list, x)
3449 auto [lsrc, rsrc]{SplitAssignmentSource(source)};
3450 const SomeExpr &atom{update.lhs};
3451
3452 if (!IsVarOrFunctionRef(atom)) {
3453 ErrorShouldBeVariable(atom, rsrc);
3454 // Skip other checks.
3455 return;
3456 }
3457
3458 CheckAtomicVariable(atom, lsrc);
3459
3460 std::pair<operation::Operator, std::vector<SomeExpr>> top{
3461 operation::Operator::Unknown, {}};
3462 if (auto &&maybeInput{GetConvertInput(update.rhs)}) {
3463 top = GetTopLevelOperation(*maybeInput);
3464 }
3465 switch (top.first) {
3466 case operation::Operator::Add:
3467 case operation::Operator::Sub:
3468 case operation::Operator::Mul:
3469 case operation::Operator::Div:
3470 case operation::Operator::And:
3471 case operation::Operator::Or:
3472 case operation::Operator::Eqv:
3473 case operation::Operator::Neqv:
3474 case operation::Operator::Min:
3475 case operation::Operator::Max:
3476 case operation::Operator::Identity:
3477 break;
3478 case operation::Operator::Call:
3479 context_.Say(source,
3480 "A call to this function is not a valid ATOMIC UPDATE operation"_err_en_US);
3481 return;
3482 case operation::Operator::Convert:
3483 context_.Say(source,
3484 "An implicit or explicit type conversion is not a valid ATOMIC UPDATE operation"_err_en_US);
3485 return;
3486 case operation::Operator::Intrinsic:
3487 context_.Say(source,
3488 "This intrinsic function is not a valid ATOMIC UPDATE operation"_err_en_US);
3489 return;
3490 case operation::Operator::Constant:
3491 case operation::Operator::Unknown:
3492 context_.Say(
3493 source, "This is not a valid ATOMIC UPDATE operation"_err_en_US);
3494 return;
3495 default:
3496 assert(
3497 top.first != operation::Operator::Identity && "Handle this separately");
3498 context_.Say(source,
3499 "The %s operator is not a valid ATOMIC UPDATE operation"_err_en_US,
3500 operation::ToString(top.first));
3501 return;
3502 }
3503 // Check if `atom` occurs exactly once in the argument list.
3504 std::vector<SomeExpr> nonAtom;
3505 auto unique{[&]() { // -> iterator
3506 auto found{top.second.end()};
3507 for (auto i{top.second.begin()}, e{top.second.end()}; i != e; ++i) {
3508 if (IsSameOrConvertOf(*i, atom)) {
3509 if (found != top.second.end()) {
3510 return top.second.end();
3511 }
3512 found = i;
3513 } else {
3514 nonAtom.push_back(*i);
3515 }
3516 }
3517 return found;
3518 }()};
3519
3520 if (unique == top.second.end()) {
3521 if (top.first == operation::Operator::Identity) {
3522 // This is "x = y".
3523 context_.Say(rsrc,
3524 "The atomic variable %s should appear as an argument in the update operation"_err_en_US,
3525 atom.AsFortran());
3526 } else {
3527 assert(top.first != operation::Operator::Identity &&
3528 "Handle this separately");
3529 context_.Say(rsrc,
3530 "The atomic variable %s should occur exactly once among the arguments of the top-level %s operator"_err_en_US,
3531 atom.AsFortran(), operation::ToString(top.first));
3532 }
3533 } else {
3534 CheckStorageOverlap(atom, nonAtom, source);
3535 }
3536}
3537
3538void OmpStructureChecker::CheckAtomicConditionalUpdateAssignment(
3539 const SomeExpr &cond, parser::CharBlock condSource,
3540 const evaluate::Assignment &assign, parser::CharBlock assignSource) {
3541 auto [alsrc, arsrc]{SplitAssignmentSource(assignSource)};
3542 const SomeExpr &atom{assign.lhs};
3543
3544 if (!IsVarOrFunctionRef(atom)) {
3545 ErrorShouldBeVariable(atom, arsrc);
3546 // Skip other checks.
3547 return;
3548 }
3549
3550 CheckAtomicVariable(atom, alsrc);
3551
3552 auto top{GetTopLevelOperation(cond)};
3553 // Missing arguments to operations would have been diagnosed by now.
3554
3555 switch (top.first) {
3556 case operation::Operator::Associated:
3557 if (atom != top.second.front()) {
3558 context_.Say(assignSource,
3559 "The pointer argument to ASSOCIATED must be same as the target of the assignment"_err_en_US);
3560 }
3561 break;
3562 // x equalop e | e equalop x (allowing "e equalop x" is an extension)
3563 case operation::Operator::Eq:
3564 case operation::Operator::Eqv:
3565 // x ordop expr | expr ordop x
3566 case operation::Operator::Lt:
3567 case operation::Operator::Gt: {
3568 const SomeExpr &arg0{top.second[0]};
3569 const SomeExpr &arg1{top.second[1]};
3570 if (IsSameOrConvertOf(arg0, atom)) {
3571 CheckStorageOverlap(atom, {arg1}, condSource);
3572 } else if (IsSameOrConvertOf(arg1, atom)) {
3573 CheckStorageOverlap(atom, {arg0}, condSource);
3574 } else {
3575 assert(top.first != operation::Operator::Identity &&
3576 "Handle this separately");
3577 context_.Say(assignSource,
3578 "An argument of the %s operator should be the target of the assignment"_err_en_US,
3579 operation::ToString(top.first));
3580 }
3581 break;
3582 }
3583 case operation::Operator::Identity:
3584 case operation::Operator::True:
3585 case operation::Operator::False:
3586 break;
3587 default:
3588 assert(
3589 top.first != operation::Operator::Identity && "Handle this separately");
3590 context_.Say(condSource,
3591 "The %s operator is not a valid condition for ATOMIC operation"_err_en_US,
3592 operation::ToString(top.first));
3593 break;
3594 }
3595}
3596
3597void OmpStructureChecker::CheckAtomicConditionalUpdateStmt(
3598 const AnalyzedCondStmt &update, parser::CharBlock source) {
3599 // The condition/statements must be:
3600 // - cond: x equalop e ift: x = d iff: -
3601 // - cond: x ordop expr ift: x = expr iff: - (+ commute ordop)
3602 // - cond: associated(x) ift: x => expr iff: -
3603 // - cond: associated(x, e) ift: x => expr iff: -
3604
3605 // The if-true statement must be present, and must be an assignment.
3606 auto maybeAssign{GetEvaluateAssignment(update.ift.stmt)};
3607 if (!maybeAssign) {
3608 if (update.ift.stmt && !IsAssignment(update.ift.stmt)) {
3609 context_.Say(update.ift.source,
3610 "In ATOMIC UPDATE COMPARE the update statement should be an assignment"_err_en_US);
3611 } else {
3612 context_.Say(
3613 source, "Invalid body of ATOMIC UPDATE COMPARE operation"_err_en_US);
3614 }
3615 return;
3616 }
3617 const evaluate::Assignment assign{*maybeAssign};
3618 const SomeExpr &atom{assign.lhs};
3619
3620 CheckAtomicConditionalUpdateAssignment(
3621 update.cond, update.source, assign, update.ift.source);
3622
3623 CheckStorageOverlap(atom, {assign.rhs}, update.ift.source);
3624
3625 if (update.iff) {
3626 context_.Say(update.iff.source,
3627 "In ATOMIC UPDATE COMPARE the update statement should not have an ELSE branch"_err_en_US);
3628 }
3629}
3630
3631void OmpStructureChecker::CheckAtomicUpdateOnly(
3632 const parser::OpenMPAtomicConstruct &x, const parser::Block &body,
3633 parser::CharBlock source) {
3634 if (body.size() == 1) {
3635 SourcedActionStmt action{GetActionStmt(&body.front())};
3636 if (auto maybeUpdate{GetEvaluateAssignment(action.stmt)}) {
3637 const SomeExpr &atom{maybeUpdate->lhs};
3638 CheckAtomicUpdateAssignment(*maybeUpdate, action.source);
3639
3640 using Analysis = parser::OpenMPAtomicConstruct::Analysis;
3641 x.analysis = MakeAtomicAnalysis(atom, std::nullopt,
3642 MakeAtomicAnalysisOp(Analysis::Update, maybeUpdate),
3643 MakeAtomicAnalysisOp(Analysis::None));
3644 } else if (!IsAssignment(action.stmt)) {
3645 context_.Say(
3646 source, "ATOMIC UPDATE operation should be an assignment"_err_en_US);
3647 }
3648 } else {
3649 context_.Say(x.source,
3650 "ATOMIC UPDATE operation should have a single statement"_err_en_US);
3651 }
3652}
3653
3654void OmpStructureChecker::CheckAtomicConditionalUpdate(
3655 const parser::OpenMPAtomicConstruct &x, const parser::Block &body,
3656 parser::CharBlock source) {
3657 // Allowable forms are (single-statement):
3658 // - if ...
3659 // - x = (... ? ... : x)
3660 // and two-statement:
3661 // - r = cond ; if (r) ...
3662
3663 const parser::ExecutionPartConstruct *ust{nullptr}; // update
3664 const parser::ExecutionPartConstruct *cst{nullptr}; // condition
3665
3666 if (body.size() == 1) {
3667 ust = &body.front();
3668 } else if (body.size() == 2) {
3669 cst = &body.front();
3670 ust = &body.back();
3671 } else {
3672 context_.Say(source,
3673 "ATOMIC UPDATE COMPARE operation should contain one or two statements"_err_en_US);
3674 return;
3675 }
3676
3677 // Flang doesn't support conditional-expr yet, so all update statements
3678 // are if-statements.
3679
3680 // IfStmt: if (...) ...
3681 // IfConstruct: if (...) then ... endif
3682 auto maybeUpdate{AnalyzeConditionalStmt(ust)};
3683 if (!maybeUpdate) {
3684 context_.Say(source,
3685 "In ATOMIC UPDATE COMPARE the update statement should be a conditional statement"_err_en_US);
3686 return;
3687 }
3688
3689 AnalyzedCondStmt &update{*maybeUpdate};
3690
3691 if (SourcedActionStmt action{GetActionStmt(cst)}) {
3692 // The "condition" statement must be `r = cond`.
3693 if (auto maybeCond{GetEvaluateAssignment(action.stmt)}) {
3694 if (maybeCond->lhs != update.cond) {
3695 context_.Say(update.source,
3696 "In ATOMIC UPDATE COMPARE the conditional statement must use %s as the condition"_err_en_US,
3697 maybeCond->lhs.AsFortran());
3698 } else {
3699 // If it's "r = ...; if (r) ..." then put the original condition
3700 // in `update`.
3701 update.cond = maybeCond->rhs;
3702 }
3703 } else {
3704 context_.Say(action.source,
3705 "In ATOMIC UPDATE COMPARE with two statements the first statement should compute the condition"_err_en_US);
3706 }
3707 }
3708
3709 evaluate::Assignment assign{*GetEvaluateAssignment(update.ift.stmt)};
3710
3711 CheckAtomicConditionalUpdateStmt(update, source);
3712 if (IsCheckForAssociated(update.cond)) {
3713 if (!IsPointerAssignment(assign)) {
3714 context_.Say(source,
3715 "The assignment should be a pointer-assignment when the condition is ASSOCIATED"_err_en_US);
3716 }
3717 } else {
3718 if (IsPointerAssignment(assign)) {
3719 context_.Say(source,
3720 "The assignment cannot be a pointer-assignment except when the condition is ASSOCIATED"_err_en_US);
3721 }
3722 }
3723
3724 using Analysis = parser::OpenMPAtomicConstruct::Analysis;
3725 x.analysis = MakeAtomicAnalysis(assign.lhs, update.cond,
3726 MakeAtomicAnalysisOp(Analysis::Update | Analysis::IfTrue, assign),
3727 MakeAtomicAnalysisOp(Analysis::None));
3728}
3729
3730void OmpStructureChecker::CheckAtomicUpdateCapture(
3731 const parser::OpenMPAtomicConstruct &x, const parser::Block &body,
3732 parser::CharBlock source) {
3733 if (body.size() != 2) {
3734 context_.Say(source,
3735 "ATOMIC UPDATE operation with CAPTURE should contain two statements"_err_en_US);
3736 return;
3737 }
3738
3739 auto [uec, cec]{CheckUpdateCapture(&body.front(), &body.back(), source)};
3740 if (!uec || !cec) {
3741 // Diagnostics already emitted.
3742 return;
3743 }
3744 SourcedActionStmt uact{GetActionStmt(uec)};
3745 SourcedActionStmt cact{GetActionStmt(cec)};
3746 // The "dereferences" of std::optional are guaranteed to be valid after
3747 // CheckUpdateCapture.
3748 evaluate::Assignment update{*GetEvaluateAssignment(uact.stmt)};
3749 evaluate::Assignment capture{*GetEvaluateAssignment(cact.stmt)};
3750
3751 const SomeExpr &atom{update.lhs};
3752
3753 using Analysis = parser::OpenMPAtomicConstruct::Analysis;
3754 int action;
3755
3756 if (IsMaybeAtomicWrite(update)) {
3757 action = Analysis::Write;
3758 CheckAtomicWriteAssignment(update, uact.source);
3759 } else {
3760 action = Analysis::Update;
3761 CheckAtomicUpdateAssignment(update, uact.source);
3762 }
3763 CheckAtomicCaptureAssignment(capture, atom, cact.source);
3764
3765 if (IsPointerAssignment(update) != IsPointerAssignment(capture)) {
3766 context_.Say(cact.source,
3767 "The update and capture assignments should both be pointer-assignments or both be non-pointer-assignments"_err_en_US);
3768 return;
3769 }
3770
3771 if (GetActionStmt(&body.front()).stmt == uact.stmt) {
3772 x.analysis = MakeAtomicAnalysis(atom, std::nullopt,
3773 MakeAtomicAnalysisOp(action, update),
3774 MakeAtomicAnalysisOp(Analysis::Read, capture));
3775 } else {
3776 x.analysis = MakeAtomicAnalysis(atom, std::nullopt,
3777 MakeAtomicAnalysisOp(Analysis::Read, capture),
3778 MakeAtomicAnalysisOp(action, update));
3779 }
3780}
3781
3782void OmpStructureChecker::CheckAtomicConditionalUpdateCapture(
3783 const parser::OpenMPAtomicConstruct &x, const parser::Block &body,
3784 parser::CharBlock source) {
3785 // There are two different variants of this:
3786 // (1) conditional-update and capture separately:
3787 // This form only allows single-statement updates, i.e. the update
3788 // form "r = cond; if (r) ..." is not allowed.
3789 // (2) conditional-update combined with capture in a single statement:
3790 // This form does allow the condition to be calculated separately,
3791 // i.e. "r = cond; if (r) ...".
3792 // Regardless of what form it is, the actual update assignment is a
3793 // proper write, i.e. "x = d", where d does not depend on x.
3794
3795 AnalyzedCondStmt update;
3796 SourcedActionStmt capture;
3797 bool captureAlways{true}, captureFirst{true};
3798
3799 auto extractCapture{[&]() {
3800 capture = update.iff;
3801 captureAlways = false;
3802 update.iff = SourcedActionStmt{};
3803 }};
3804
3805 auto classifyNonUpdate{[&](const SourcedActionStmt &action) {
3806 // The non-update statement is either "r = cond" or the capture.
3807 if (auto maybeAssign{GetEvaluateAssignment(action.stmt)}) {
3808 if (update.cond == maybeAssign->lhs) {
3809 // If this is "r = cond; if (r) ...", then update the condition.
3810 update.cond = maybeAssign->rhs;
3811 update.source = action.source;
3812 // In this form, the update and the capture are combined into
3813 // an IF-THEN-ELSE statement.
3814 extractCapture();
3815 } else {
3816 // Assume this is the capture-statement.
3817 capture = action;
3818 }
3819 }
3820 }};
3821
3822 if (body.size() == 2) {
3823 // This could be
3824 // - capture; conditional-update (in any order), or
3825 // - r = cond; if (r) capture-update
3826 const parser::ExecutionPartConstruct *st1{&body.front()};
3827 const parser::ExecutionPartConstruct *st2{&body.back()};
3828 // In either case, the conditional statement can be analyzed by
3829 // AnalyzeConditionalStmt, whereas the other statement cannot.
3830 if (auto maybeUpdate1{AnalyzeConditionalStmt(st1)}) {
3831 update = *maybeUpdate1;
3832 classifyNonUpdate(GetActionStmt(st2));
3833 captureFirst = false;
3834 } else if (auto maybeUpdate2{AnalyzeConditionalStmt(st2)}) {
3835 update = *maybeUpdate2;
3836 classifyNonUpdate(GetActionStmt(st1));
3837 } else {
3838 // None of the statements are conditional, this rules out the
3839 // "r = cond; if (r) ..." and the "capture + conditional-update"
3840 // variants. This could still be capture + write (which is classified
3841 // as conditional-update-capture in the spec).
3842 auto [uec, cec]{CheckUpdateCapture(st1, st2, source)};
3843 if (!uec || !cec) {
3844 // Diagnostics already emitted.
3845 return;
3846 }
3847 SourcedActionStmt uact{GetActionStmt(uec)};
3848 SourcedActionStmt cact{GetActionStmt(cec)};
3849 update.ift = uact;
3850 capture = cact;
3851 if (uec == st1) {
3852 captureFirst = false;
3853 }
3854 }
3855 } else if (body.size() == 1) {
3856 if (auto maybeUpdate{AnalyzeConditionalStmt(&body.front())}) {
3857 update = *maybeUpdate;
3858 // This is the form with update and capture combined into an IF-THEN-ELSE
3859 // statement. The capture-statement is always the ELSE branch.
3860 extractCapture();
3861 } else {
3862 goto invalid;
3863 }
3864 } else {
3865 context_.Say(source,
3866 "ATOMIC UPDATE COMPARE CAPTURE operation should contain one or two statements"_err_en_US);
3867 return;
3868 invalid:
3869 context_.Say(source,
3870 "Invalid body of ATOMIC UPDATE COMPARE CAPTURE operation"_err_en_US);
3871 return;
3872 }
3873
3874 // The update must have a form `x = d` or `x => d`.
3875 if (auto maybeWrite{GetEvaluateAssignment(update.ift.stmt)}) {
3876 const SomeExpr &atom{maybeWrite->lhs};
3877 CheckAtomicWriteAssignment(*maybeWrite, update.ift.source);
3878 if (auto maybeCapture{GetEvaluateAssignment(capture.stmt)}) {
3879 CheckAtomicCaptureAssignment(*maybeCapture, atom, capture.source);
3880
3881 if (IsPointerAssignment(*maybeWrite) !=
3882 IsPointerAssignment(*maybeCapture)) {
3883 context_.Say(capture.source,
3884 "The update and capture assignments should both be pointer-assignments or both be non-pointer-assignments"_err_en_US);
3885 return;
3886 }
3887 } else {
3888 if (!IsAssignment(capture.stmt)) {
3889 context_.Say(capture.source,
3890 "In ATOMIC UPDATE COMPARE CAPTURE the capture statement should be an assignment"_err_en_US);
3891 }
3892 return;
3893 }
3894 } else {
3895 if (!IsAssignment(update.ift.stmt)) {
3896 context_.Say(update.ift.source,
3897 "In ATOMIC UPDATE COMPARE CAPTURE the update statement should be an assignment"_err_en_US);
3898 }
3899 return;
3900 }
3901
3902 // update.iff should be empty here, the capture statement should be
3903 // stored in "capture".
3904
3905 // Fill out the analysis in the AST node.
3906 using Analysis = parser::OpenMPAtomicConstruct::Analysis;
3907 bool condUnused{std::visit(
3908 [](auto &&s) {
3909 using BareS = llvm::remove_cvref_t<decltype(s)>;
3910 if constexpr (std::is_same_v<BareS, evaluate::NullPointer>) {
3911 return true;
3912 } else {
3913 return false;
3914 }
3915 },
3916 update.cond.u)};
3917
3918 int updateWhen{!condUnused ? Analysis::IfTrue : 0};
3919 int captureWhen{!captureAlways ? Analysis::IfFalse : 0};
3920
3921 evaluate::Assignment updAssign{*GetEvaluateAssignment(update.ift.stmt)};
3922 evaluate::Assignment capAssign{*GetEvaluateAssignment(capture.stmt)};
3923
3924 if (captureFirst) {
3925 x.analysis = MakeAtomicAnalysis(updAssign.lhs, update.cond,
3926 MakeAtomicAnalysisOp(Analysis::Read | captureWhen, capAssign),
3927 MakeAtomicAnalysisOp(Analysis::Write | updateWhen, updAssign));
3928 } else {
3929 x.analysis = MakeAtomicAnalysis(updAssign.lhs, update.cond,
3930 MakeAtomicAnalysisOp(Analysis::Write | updateWhen, updAssign),
3931 MakeAtomicAnalysisOp(Analysis::Read | captureWhen, capAssign));
3932 }
3933}
3934
3935void OmpStructureChecker::CheckAtomicRead(
3936 const parser::OpenMPAtomicConstruct &x) {
3937 // [6.0:190:5-7]
3938 // A read structured block is read-statement, a read statement that has one
3939 // of the following forms:
3940 // v = x
3941 // v => x
3942 auto &dirSpec{std::get<parser::OmpDirectiveSpecification>(x.t)};
3943 auto &block{std::get<parser::Block>(x.t)};
3944
3945 // Read cannot be conditional or have a capture statement.
3946 if (x.IsCompare() || x.IsCapture()) {
3947 context_.Say(dirSpec.source,
3948 "ATOMIC READ cannot have COMPARE or CAPTURE clauses"_err_en_US);
3949 return;
3950 }
3951
3952 const parser::Block &body{GetInnermostExecPart(block)};
3953
3954 if (body.size() == 1) {
3955 SourcedActionStmt action{GetActionStmt(&body.front())};
3956 if (auto maybeRead{GetEvaluateAssignment(action.stmt)}) {
3957 CheckAtomicReadAssignment(*maybeRead, action.source);
3958
3959 if (auto maybe{GetConvertInput(maybeRead->rhs)}) {
3960 const SomeExpr &atom{*maybe};
3961 using Analysis = parser::OpenMPAtomicConstruct::Analysis;
3962 x.analysis = MakeAtomicAnalysis(atom, std::nullopt,
3963 MakeAtomicAnalysisOp(Analysis::Read, maybeRead),
3964 MakeAtomicAnalysisOp(Analysis::None));
3965 }
3966 } else if (!IsAssignment(action.stmt)) {
3967 context_.Say(
3968 x.source, "ATOMIC READ operation should be an assignment"_err_en_US);
3969 }
3970 } else {
3971 context_.Say(x.source,
3972 "ATOMIC READ operation should have a single statement"_err_en_US);
3973 }
3974}
3975
3976void OmpStructureChecker::CheckAtomicWrite(
3977 const parser::OpenMPAtomicConstruct &x) {
3978 auto &dirSpec{std::get<parser::OmpDirectiveSpecification>(x.t)};
3979 auto &block{std::get<parser::Block>(x.t)};
3980
3981 // Write cannot be conditional or have a capture statement.
3982 if (x.IsCompare() || x.IsCapture()) {
3983 context_.Say(dirSpec.source,
3984 "ATOMIC WRITE cannot have COMPARE or CAPTURE clauses"_err_en_US);
3985 return;
3986 }
3987
3988 const parser::Block &body{GetInnermostExecPart(block)};
3989
3990 if (body.size() == 1) {
3991 SourcedActionStmt action{GetActionStmt(&body.front())};
3992 if (auto maybeWrite{GetEvaluateAssignment(action.stmt)}) {
3993 const SomeExpr &atom{maybeWrite->lhs};
3994 CheckAtomicWriteAssignment(*maybeWrite, action.source);
3995
3996 using Analysis = parser::OpenMPAtomicConstruct::Analysis;
3997 x.analysis = MakeAtomicAnalysis(atom, std::nullopt,
3998 MakeAtomicAnalysisOp(Analysis::Write, maybeWrite),
3999 MakeAtomicAnalysisOp(Analysis::None));
4000 } else if (!IsAssignment(action.stmt)) {
4001 context_.Say(
4002 x.source, "ATOMIC WRITE operation should be an assignment"_err_en_US);
4003 }
4004 } else {
4005 context_.Say(x.source,
4006 "ATOMIC WRITE operation should have a single statement"_err_en_US);
4007 }
4008}
4009
4010void OmpStructureChecker::CheckAtomicUpdate(
4011 const parser::OpenMPAtomicConstruct &x) {
4012 auto &block{std::get<parser::Block>(x.t)};
4013
4014 bool isConditional{x.IsCompare()};
4015 bool isCapture{x.IsCapture()};
4016 const parser::Block &body{GetInnermostExecPart(block)};
4017
4018 if (isConditional && isCapture) {
4019 CheckAtomicConditionalUpdateCapture(x, body, x.source);
4020 } else if (isConditional) {
4021 CheckAtomicConditionalUpdate(x, body, x.source);
4022 } else if (isCapture) {
4023 CheckAtomicUpdateCapture(x, body, x.source);
4024 } else { // update-only
4025 CheckAtomicUpdateOnly(x, body, x.source);
4026 }
4027}
4028
4029void OmpStructureChecker::Enter(const parser::OpenMPAtomicConstruct &x) {
4030 // All of the following groups have the "exclusive" property, i.e. at
4031 // most one clause from each group is allowed.
4032 // The exclusivity-checking code should eventually be unified for all
4033 // clauses, with clause groups defined in OMP.td.
4034 std::array atomic{llvm::omp::Clause::OMPC_read,
4035 llvm::omp::Clause::OMPC_update, llvm::omp::Clause::OMPC_write};
4036 std::array memoryOrder{llvm::omp::Clause::OMPC_acq_rel,
4037 llvm::omp::Clause::OMPC_acquire, llvm::omp::Clause::OMPC_relaxed,
4038 llvm::omp::Clause::OMPC_release, llvm::omp::Clause::OMPC_seq_cst};
4039
4040 auto checkExclusive{[&](llvm::ArrayRef<llvm::omp::Clause> group,
4041 std::string_view name,
4042 const parser::OmpClauseList &clauses) {
4043 const parser::OmpClause *present{nullptr};
4044 for (const parser::OmpClause &clause : clauses.v) {
4045 llvm::omp::Clause id{clause.Id()};
4046 if (!llvm::is_contained(group, id)) {
4047 continue;
4048 }
4049 if (present == nullptr) {
4050 present = &clause;
4051 continue;
4052 } else if (id == present->Id()) {
4053 // Ignore repetitions of the same clause, those will be diagnosed
4054 // separately.
4055 continue;
4056 }
4057 parser::MessageFormattedText txt(
4058 "At most one clause from the '%s' group is allowed on ATOMIC construct"_err_en_US,
4059 name.data());
4060 parser::Message message(clause.source, txt);
4061 message.Attach(present->source,
4062 "Previous clause from this group provided here"_en_US);
4063 context_.Say(std::move(message));
4064 return;
4065 }
4066 }};
4067
4068 auto &dirSpec{std::get<parser::OmpDirectiveSpecification>(x.t)};
4069 auto &dir{std::get<parser::OmpDirectiveName>(dirSpec.t)};
4070 PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_atomic);
4071 llvm::omp::Clause kind{x.GetKind()};
4072
4073 checkExclusive(atomic, "atomic", dirSpec.Clauses());
4074 checkExclusive(memoryOrder, "memory-order", dirSpec.Clauses());
4075
4076 switch (kind) {
4077 case llvm::omp::Clause::OMPC_read:
4078 CheckAtomicRead(x);
4079 break;
4080 case llvm::omp::Clause::OMPC_write:
4081 CheckAtomicWrite(x);
4082 break;
4083 case llvm::omp::Clause::OMPC_update:
4084 CheckAtomicUpdate(x);
4085 break;
4086 default:
4087 break;
4088 }
4089}
4090
4091void OmpStructureChecker::Leave(const parser::OpenMPAtomicConstruct &) {
4092 dirContext_.pop_back();
4093}
4094
4095// Clauses
4096// Mainly categorized as
4097// 1. Checks on 'OmpClauseList' from 'parse-tree.h'.
4098// 2. Checks on clauses which fall under 'struct OmpClause' from parse-tree.h.
4099// 3. Checks on clauses which are not in 'struct OmpClause' from parse-tree.h.
4100
4101void OmpStructureChecker::Leave(const parser::OmpClauseList &) {
4102 // 2.7.1 Loop Construct Restriction
4103 if (llvm::omp::allDoSet.test(GetContext().directive)) {
4104 if (auto *clause{FindClause(llvm::omp::Clause::OMPC_schedule)}) {
4105 // only one schedule clause is allowed
4106 const auto &schedClause{std::get<parser::OmpClause::Schedule>(clause->u)};
4107 auto &modifiers{OmpGetModifiers(schedClause.v)};
4108 auto *ordering{
4109 OmpGetUniqueModifier<parser::OmpOrderingModifier>(modifiers)};
4110 if (ordering &&
4111 ordering->v == parser::OmpOrderingModifier::Value::Nonmonotonic) {
4112 if (FindClause(llvm::omp::Clause::OMPC_ordered)) {
4113 context_.Say(clause->source,
4114 "The NONMONOTONIC modifier cannot be specified "
4115 "if an ORDERED clause is specified"_err_en_US);
4116 }
4117 }
4118 }
4119
4120 if (auto *clause{FindClause(llvm::omp::Clause::OMPC_ordered)}) {
4121 // only one ordered clause is allowed
4122 const auto &orderedClause{
4123 std::get<parser::OmpClause::Ordered>(clause->u)};
4124
4125 if (orderedClause.v) {
4126 CheckNotAllowedIfClause(
4127 llvm::omp::Clause::OMPC_ordered, {llvm::omp::Clause::OMPC_linear});
4128
4129 if (auto *clause2{FindClause(llvm::omp::Clause::OMPC_collapse)}) {
4130 const auto &collapseClause{
4131 std::get<parser::OmpClause::Collapse>(clause2->u)};
4132 // ordered and collapse both have parameters
4133 if (const auto orderedValue{GetIntValue(orderedClause.v)}) {
4134 if (const auto collapseValue{GetIntValue(collapseClause.v)}) {
4135 if (*orderedValue > 0 && *orderedValue < *collapseValue) {
4136 context_.Say(clause->source,
4137 "The parameter of the ORDERED clause must be "
4138 "greater than or equal to "
4139 "the parameter of the COLLAPSE clause"_err_en_US);
4140 }
4141 }
4142 }
4143 }
4144 }
4145
4146 // TODO: ordered region binding check (requires nesting implementation)
4147 }
4148 } // doSet
4149
4150 // 2.8.1 Simd Construct Restriction
4151 if (llvm::omp::allSimdSet.test(GetContext().directive)) {
4152 if (auto *clause{FindClause(llvm::omp::Clause::OMPC_simdlen)}) {
4153 if (auto *clause2{FindClause(llvm::omp::Clause::OMPC_safelen)}) {
4154 const auto &simdlenClause{
4155 std::get<parser::OmpClause::Simdlen>(clause->u)};
4156 const auto &safelenClause{
4157 std::get<parser::OmpClause::Safelen>(clause2->u)};
4158 // simdlen and safelen both have parameters
4159 if (const auto simdlenValue{GetIntValue(simdlenClause.v)}) {
4160 if (const auto safelenValue{GetIntValue(safelenClause.v)}) {
4161 if (*safelenValue > 0 && *simdlenValue > *safelenValue) {
4162 context_.Say(clause->source,
4163 "The parameter of the SIMDLEN clause must be less than or "
4164 "equal to the parameter of the SAFELEN clause"_err_en_US);
4165 }
4166 }
4167 }
4168 }
4169 }
4170
4171 // 2.11.5 Simd construct restriction (OpenMP 5.1)
4172 if (auto *sl_clause{FindClause(llvm::omp::Clause::OMPC_safelen)}) {
4173 if (auto *o_clause{FindClause(llvm::omp::Clause::OMPC_order)}) {
4174 const auto &orderClause{
4175 std::get<parser::OmpClause::Order>(o_clause->u)};
4176 if (std::get<parser::OmpOrderClause::Ordering>(orderClause.v.t) ==
4177 parser::OmpOrderClause::Ordering::Concurrent) {
4178 context_.Say(sl_clause->source,
4179 "The `SAFELEN` clause cannot appear in the `SIMD` directive "
4180 "with `ORDER(CONCURRENT)` clause"_err_en_US);
4181 }
4182 }
4183 }
4184 } // SIMD
4185
4186 // Semantic checks related to presence of multiple list items within the same
4187 // clause
4188 CheckMultListItems();
4189
4190 if (GetContext().directive == llvm::omp::Directive::OMPD_task) {
4191 if (auto *detachClause{FindClause(llvm::omp::Clause::OMPC_detach)}) {
4192 unsigned version{context_.langOptions().OpenMPVersion};
4193 if (version == 50 || version == 51) {
4194 // OpenMP 5.0: 2.10.1 Task construct restrictions
4195 CheckNotAllowedIfClause(llvm::omp::Clause::OMPC_detach,
4196 {llvm::omp::Clause::OMPC_mergeable});
4197 } else if (version >= 52) {
4198 // OpenMP 5.2: 12.5.2 Detach construct restrictions
4199 if (FindClause(llvm::omp::Clause::OMPC_final)) {
4200 context_.Say(GetContext().clauseSource,
4201 "If a DETACH clause appears on a directive, then the encountering task must not be a FINAL task"_err_en_US);
4202 }
4203
4204 const auto &detach{
4205 std::get<parser::OmpClause::Detach>(detachClause->u)};
4206 if (const auto *name{parser::Unwrap<parser::Name>(detach.v.v)}) {
4207 Symbol *eventHandleSym{name->symbol};
4208 auto checkVarAppearsInDataEnvClause = [&](const parser::OmpObjectList
4209 &objs,
4210 std::string clause) {
4211 for (const auto &obj : objs.v) {
4212 if (const parser::Name *
4213 objName{parser::Unwrap<parser::Name>(obj)}) {
4214 if (&objName->symbol->GetUltimate() == eventHandleSym) {
4215 context_.Say(GetContext().clauseSource,
4216 "A variable: `%s` that appears in a DETACH clause cannot appear on %s clause on the same construct"_err_en_US,
4217 objName->source, clause);
4218 }
4219 }
4220 }
4221 };
4222 if (auto *dataEnvClause{
4223 FindClause(llvm::omp::Clause::OMPC_private)}) {
4224 const auto &pClause{
4225 std::get<parser::OmpClause::Private>(dataEnvClause->u)};
4226 checkVarAppearsInDataEnvClause(pClause.v, "PRIVATE");
4227 } else if (auto *dataEnvClause{
4228 FindClause(llvm::omp::Clause::OMPC_shared)}) {
4229 const auto &sClause{
4230 std::get<parser::OmpClause::Shared>(dataEnvClause->u)};
4231 checkVarAppearsInDataEnvClause(sClause.v, "SHARED");
4232 } else if (auto *dataEnvClause{
4233 FindClause(llvm::omp::Clause::OMPC_firstprivate)}) {
4234 const auto &fpClause{
4235 std::get<parser::OmpClause::Firstprivate>(dataEnvClause->u)};
4236 checkVarAppearsInDataEnvClause(fpClause.v, "FIRSTPRIVATE");
4237 } else if (auto *dataEnvClause{
4238 FindClause(llvm::omp::Clause::OMPC_in_reduction)}) {
4239 const auto &irClause{
4240 std::get<parser::OmpClause::InReduction>(dataEnvClause->u)};
4241 checkVarAppearsInDataEnvClause(
4242 std::get<parser::OmpObjectList>(irClause.v.t), "IN_REDUCTION");
4243 }
4244 }
4245 }
4246 }
4247 }
4248
4249 auto testThreadprivateVarErr = [&](Symbol sym, parser::Name name,
4250 llvmOmpClause clauseTy) {
4251 if (sym.test(Symbol::Flag::OmpThreadprivate))
4252 context_.Say(name.source,
4253 "A THREADPRIVATE variable cannot be in %s clause"_err_en_US,
4254 parser::ToUpperCaseLetters(getClauseName(clauseTy).str()));
4255 };
4256
4257 // [5.1] 2.21.2 Threadprivate Directive Restriction
4258 OmpClauseSet threadprivateAllowedSet{llvm::omp::Clause::OMPC_copyin,
4259 llvm::omp::Clause::OMPC_copyprivate, llvm::omp::Clause::OMPC_schedule,
4260 llvm::omp::Clause::OMPC_num_threads, llvm::omp::Clause::OMPC_thread_limit,
4261 llvm::omp::Clause::OMPC_if};
4262 for (auto it : GetContext().clauseInfo) {
4263 llvmOmpClause type = it.first;
4264 const auto *clause = it.second;
4265 if (!threadprivateAllowedSet.test(type)) {
4266 if (const auto *objList{GetOmpObjectList(*clause)}) {
4267 for (const auto &ompObject : objList->v) {
4268 common::visit(
4269 common::visitors{
4270 [&](const parser::Designator &) {
4271 if (const auto *name{
4272 parser::Unwrap<parser::Name>(ompObject)}) {
4273 if (name->symbol) {
4274 testThreadprivateVarErr(
4275 name->symbol->GetUltimate(), *name, type);
4276 }
4277 }
4278 },
4279 [&](const parser::Name &name) {
4280 if (name.symbol) {
4281 for (const auto &mem :
4282 name.symbol->get<CommonBlockDetails>().objects()) {
4283 testThreadprivateVarErr(mem->GetUltimate(), name, type);
4284 break;
4285 }
4286 }
4287 },
4288 },
4289 ompObject.u);
4290 }
4291 }
4292 }
4293 }
4294
4295 CheckRequireAtLeastOneOf();
4296}
4297
4298void OmpStructureChecker::Enter(const parser::OmpClause &x) {
4299 SetContextClause(x);
4300
4301 // The visitors for these clauses do their own checks.
4302 switch (x.Id()) {
4303 case llvm::omp::Clause::OMPC_copyprivate:
4304 case llvm::omp::Clause::OMPC_enter:
4305 case llvm::omp::Clause::OMPC_lastprivate:
4306 case llvm::omp::Clause::OMPC_reduction:
4307 case llvm::omp::Clause::OMPC_to:
4308 return;
4309 default:
4310 break;
4311 }
4312
4313 if (const parser::OmpObjectList *objList{GetOmpObjectList(x)}) {
4314 SymbolSourceMap symbols;
4315 GetSymbolsInObjectList(*objList, symbols);
4316 for (const auto &[symbol, source] : symbols) {
4317 if (!IsVariableListItem(*symbol)) {
4318 deferredNonVariables_.insert({symbol, source});
4319 }
4320 }
4321 }
4322}
4323
4324// Following clauses do not have a separate node in parse-tree.h.
4325CHECK_SIMPLE_CLAUSE(Absent, OMPC_absent)
4326CHECK_SIMPLE_CLAUSE(Affinity, OMPC_affinity)
4327CHECK_SIMPLE_CLAUSE(Capture, OMPC_capture)
4328CHECK_SIMPLE_CLAUSE(Contains, OMPC_contains)
4329CHECK_SIMPLE_CLAUSE(Default, OMPC_default)
4330CHECK_SIMPLE_CLAUSE(Depobj, OMPC_depobj)
4331CHECK_SIMPLE_CLAUSE(DeviceType, OMPC_device_type)
4332CHECK_SIMPLE_CLAUSE(DistSchedule, OMPC_dist_schedule)
4333CHECK_SIMPLE_CLAUSE(Exclusive, OMPC_exclusive)
4334CHECK_SIMPLE_CLAUSE(Final, OMPC_final)
4335CHECK_SIMPLE_CLAUSE(Flush, OMPC_flush)
4336CHECK_SIMPLE_CLAUSE(Full, OMPC_full)
4337CHECK_SIMPLE_CLAUSE(Grainsize, OMPC_grainsize)
4338CHECK_SIMPLE_CLAUSE(Holds, OMPC_holds)
4339CHECK_SIMPLE_CLAUSE(Inclusive, OMPC_inclusive)
4340CHECK_SIMPLE_CLAUSE(Initializer, OMPC_initializer)
4341CHECK_SIMPLE_CLAUSE(Match, OMPC_match)
4342CHECK_SIMPLE_CLAUSE(Nontemporal, OMPC_nontemporal)
4343CHECK_SIMPLE_CLAUSE(NumTasks, OMPC_num_tasks)
4344CHECK_SIMPLE_CLAUSE(Order, OMPC_order)
4345CHECK_SIMPLE_CLAUSE(Read, OMPC_read)
4346CHECK_SIMPLE_CLAUSE(Threadprivate, OMPC_threadprivate)
4347CHECK_SIMPLE_CLAUSE(Threads, OMPC_threads)
4348CHECK_SIMPLE_CLAUSE(Inbranch, OMPC_inbranch)
4349CHECK_SIMPLE_CLAUSE(Link, OMPC_link)
4350CHECK_SIMPLE_CLAUSE(Indirect, OMPC_indirect)
4351CHECK_SIMPLE_CLAUSE(Mergeable, OMPC_mergeable)
4352CHECK_SIMPLE_CLAUSE(NoOpenmp, OMPC_no_openmp)
4353CHECK_SIMPLE_CLAUSE(NoOpenmpRoutines, OMPC_no_openmp_routines)
4354CHECK_SIMPLE_CLAUSE(NoOpenmpConstructs, OMPC_no_openmp_constructs)
4355CHECK_SIMPLE_CLAUSE(NoParallelism, OMPC_no_parallelism)
4356CHECK_SIMPLE_CLAUSE(Nogroup, OMPC_nogroup)
4357CHECK_SIMPLE_CLAUSE(Notinbranch, OMPC_notinbranch)
4358CHECK_SIMPLE_CLAUSE(Partial, OMPC_partial)
4359CHECK_SIMPLE_CLAUSE(ProcBind, OMPC_proc_bind)
4360CHECK_SIMPLE_CLAUSE(Simd, OMPC_simd)
4361CHECK_SIMPLE_CLAUSE(Sizes, OMPC_sizes)
4362CHECK_SIMPLE_CLAUSE(Permutation, OMPC_permutation)
4363CHECK_SIMPLE_CLAUSE(Uniform, OMPC_uniform)
4364CHECK_SIMPLE_CLAUSE(Unknown, OMPC_unknown)
4365CHECK_SIMPLE_CLAUSE(Untied, OMPC_untied)
4366CHECK_SIMPLE_CLAUSE(UsesAllocators, OMPC_uses_allocators)
4367CHECK_SIMPLE_CLAUSE(Write, OMPC_write)
4368CHECK_SIMPLE_CLAUSE(Init, OMPC_init)
4369CHECK_SIMPLE_CLAUSE(Use, OMPC_use)
4370CHECK_SIMPLE_CLAUSE(Novariants, OMPC_novariants)
4371CHECK_SIMPLE_CLAUSE(Nocontext, OMPC_nocontext)
4372CHECK_SIMPLE_CLAUSE(Severity, OMPC_severity)
4373CHECK_SIMPLE_CLAUSE(Message, OMPC_message)
4374CHECK_SIMPLE_CLAUSE(Filter, OMPC_filter)
4375CHECK_SIMPLE_CLAUSE(Otherwise, OMPC_otherwise)
4376CHECK_SIMPLE_CLAUSE(AdjustArgs, OMPC_adjust_args)
4377CHECK_SIMPLE_CLAUSE(AppendArgs, OMPC_append_args)
4378CHECK_SIMPLE_CLAUSE(MemoryOrder, OMPC_memory_order)
4379CHECK_SIMPLE_CLAUSE(Bind, OMPC_bind)
4380CHECK_SIMPLE_CLAUSE(Align, OMPC_align)
4381CHECK_SIMPLE_CLAUSE(Compare, OMPC_compare)
4382CHECK_SIMPLE_CLAUSE(OmpxAttribute, OMPC_ompx_attribute)
4383CHECK_SIMPLE_CLAUSE(Weak, OMPC_weak)
4384CHECK_SIMPLE_CLAUSE(AcqRel, OMPC_acq_rel)
4385CHECK_SIMPLE_CLAUSE(Acquire, OMPC_acquire)
4386CHECK_SIMPLE_CLAUSE(Relaxed, OMPC_relaxed)
4387CHECK_SIMPLE_CLAUSE(Release, OMPC_release)
4388CHECK_SIMPLE_CLAUSE(SeqCst, OMPC_seq_cst)
4389CHECK_SIMPLE_CLAUSE(Fail, OMPC_fail)
4390
4391CHECK_REQ_SCALAR_INT_CLAUSE(NumTeams, OMPC_num_teams)
4392CHECK_REQ_SCALAR_INT_CLAUSE(NumThreads, OMPC_num_threads)
4393CHECK_REQ_SCALAR_INT_CLAUSE(OmpxDynCgroupMem, OMPC_ompx_dyn_cgroup_mem)
4394CHECK_REQ_SCALAR_INT_CLAUSE(Priority, OMPC_priority)
4395CHECK_REQ_SCALAR_INT_CLAUSE(ThreadLimit, OMPC_thread_limit)
4396
4397CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(Collapse, OMPC_collapse)
4398CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(Safelen, OMPC_safelen)
4399CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(Simdlen, OMPC_simdlen)
4400
4401// Restrictions specific to each clause are implemented apart from the
4402// generalized restrictions.
4403
4404void OmpStructureChecker::Enter(const parser::OmpClause::Destroy &x) {
4405 CheckAllowedClause(llvm::omp::Clause::OMPC_destroy);
4406
4407 llvm::omp::Directive dir{GetContext().directive};
4408 unsigned version{context_.langOptions().OpenMPVersion};
4409 if (dir == llvm::omp::Directive::OMPD_depobj) {
4410 unsigned argSince{52}, noargDeprecatedIn{52};
4411 if (x.v) {
4412 if (version < argSince) {
4413 context_.Say(GetContext().clauseSource,
4414 "The object parameter in DESTROY clause on DEPOPJ construct is not allowed in %s, %s"_warn_en_US,
4415 ThisVersion(version), TryVersion(argSince));
4416 }
4417 } else {
4418 if (version >= noargDeprecatedIn) {
4419 context_.Say(GetContext().clauseSource,
4420 "The DESTROY clause without argument on DEPOBJ construct is deprecated in %s"_warn_en_US,
4421 ThisVersion(noargDeprecatedIn));
4422 }
4423 }
4424 }
4425}
4426
4427void OmpStructureChecker::Enter(const parser::OmpClause::Reduction &x) {
4428 CheckAllowedClause(llvm::omp::Clause::OMPC_reduction);
4429 auto &objects{std::get<parser::OmpObjectList>(x.v.t)};
4430
4431 if (OmpVerifyModifiers(x.v, llvm::omp::OMPC_reduction,
4432 GetContext().clauseSource, context_)) {
4433 auto &modifiers{OmpGetModifiers(x.v)};
4434 const auto *ident{
4435 OmpGetUniqueModifier<parser::OmpReductionIdentifier>(modifiers)};
4436 assert(ident && "reduction-identifier is a required modifier");
4437 if (CheckReductionOperator(*ident, OmpGetModifierSource(modifiers, ident),
4438 llvm::omp::OMPC_reduction)) {
4439 CheckReductionObjectTypes(objects, *ident);
4440 }
4441 using ReductionModifier = parser::OmpReductionModifier;
4442 if (auto *modifier{OmpGetUniqueModifier<ReductionModifier>(modifiers)}) {
4443 CheckReductionModifier(*modifier);
4444 }
4445 }
4446 CheckReductionObjects(objects, llvm::omp::Clause::OMPC_reduction);
4447
4448 // If this is a worksharing construct then ensure the reduction variable
4449 // is not private in the parallel region that it binds to.
4450 if (llvm::omp::nestedReduceWorkshareAllowedSet.test(GetContext().directive)) {
4451 CheckSharedBindingInOuterContext(objects);
4452 }
4453
4454 if (GetContext().directive == llvm::omp::Directive::OMPD_loop) {
4455 for (auto clause : GetContext().clauseInfo) {
4456 if (const auto *bindClause{
4457 std::get_if<parser::OmpClause::Bind>(&clause.second->u)}) {
4458 if (bindClause->v.v == parser::OmpBindClause::Binding::Teams) {
4459 context_.Say(GetContext().clauseSource,
4460 "'REDUCTION' clause not allowed with '!$OMP LOOP BIND(TEAMS)'."_err_en_US);
4461 }
4462 }
4463 }
4464 }
4465}
4466
4467void OmpStructureChecker::Enter(const parser::OmpClause::InReduction &x) {
4468 CheckAllowedClause(llvm::omp::Clause::OMPC_in_reduction);
4469 auto &objects{std::get<parser::OmpObjectList>(x.v.t)};
4470
4471 if (OmpVerifyModifiers(x.v, llvm::omp::OMPC_in_reduction,
4472 GetContext().clauseSource, context_)) {
4473 auto &modifiers{OmpGetModifiers(x.v)};
4474 const auto *ident{
4475 OmpGetUniqueModifier<parser::OmpReductionIdentifier>(modifiers)};
4476 assert(ident && "reduction-identifier is a required modifier");
4477 if (CheckReductionOperator(*ident, OmpGetModifierSource(modifiers, ident),
4478 llvm::omp::OMPC_in_reduction)) {
4479 CheckReductionObjectTypes(objects, *ident);
4480 }
4481 }
4482 CheckReductionObjects(objects, llvm::omp::Clause::OMPC_in_reduction);
4483}
4484
4485void OmpStructureChecker::Enter(const parser::OmpClause::TaskReduction &x) {
4486 CheckAllowedClause(llvm::omp::Clause::OMPC_task_reduction);
4487 auto &objects{std::get<parser::OmpObjectList>(x.v.t)};
4488
4489 if (OmpVerifyModifiers(x.v, llvm::omp::OMPC_task_reduction,
4490 GetContext().clauseSource, context_)) {
4491 auto &modifiers{OmpGetModifiers(x.v)};
4492 const auto *ident{
4493 OmpGetUniqueModifier<parser::OmpReductionIdentifier>(modifiers)};
4494 assert(ident && "reduction-identifier is a required modifier");
4495 if (CheckReductionOperator(*ident, OmpGetModifierSource(modifiers, ident),
4496 llvm::omp::OMPC_task_reduction)) {
4497 CheckReductionObjectTypes(objects, *ident);
4498 }
4499 }
4500 CheckReductionObjects(objects, llvm::omp::Clause::OMPC_task_reduction);
4501}
4502
4503bool OmpStructureChecker::CheckReductionOperator(
4504 const parser::OmpReductionIdentifier &ident, parser::CharBlock source,
4505 llvm::omp::Clause clauseId) {
4506 auto visitOperator{[&](const parser::DefinedOperator &dOpr) {
4507 if (const auto *intrinsicOp{
4508 std::get_if<parser::DefinedOperator::IntrinsicOperator>(&dOpr.u)}) {
4509 switch (*intrinsicOp) {
4510 case parser::DefinedOperator::IntrinsicOperator::Add:
4511 case parser::DefinedOperator::IntrinsicOperator::Multiply:
4512 case parser::DefinedOperator::IntrinsicOperator::AND:
4513 case parser::DefinedOperator::IntrinsicOperator::OR:
4514 case parser::DefinedOperator::IntrinsicOperator::EQV:
4515 case parser::DefinedOperator::IntrinsicOperator::NEQV:
4516 return true;
4517 case parser::DefinedOperator::IntrinsicOperator::Subtract:
4518 context_.Say(GetContext().clauseSource,
4519 "The minus reduction operator is deprecated since OpenMP 5.2 and is not supported in the REDUCTION clause."_err_en_US,
4520 ContextDirectiveAsFortran());
4521 return false;
4522 default:
4523 break;
4524 }
4525 }
4526 // User-defined operators are OK if there has been a declared reduction
4527 // for that. We mangle those names to store the user details.
4528 if (const auto *definedOp{std::get_if<parser::DefinedOpName>(&dOpr.u)}) {
4529 std::string mangled{MangleDefinedOperator(definedOp->v.symbol->name())};
4530 const Scope &scope{definedOp->v.symbol->owner()};
4531 if (const Symbol *symbol{scope.FindSymbol(mangled)}) {
4532 if (symbol->detailsIf<UserReductionDetails>()) {
4533 return true;
4534 }
4535 }
4536 }
4537 context_.Say(source, "Invalid reduction operator in %s clause."_err_en_US,
4538 parser::ToUpperCaseLetters(getClauseName(clauseId).str()));
4539 return false;
4540 }};
4541
4542 auto visitDesignator{[&](const parser::ProcedureDesignator &procD) {
4543 const parser::Name *name{std::get_if<parser::Name>(&procD.u)};
4544 bool valid{false};
4545 if (name && name->symbol) {
4546 const SourceName &realName{name->symbol->GetUltimate().name()};
4547 valid =
4548 llvm::is_contained(Set: {"max", "min", "iand", "ior", "ieor"}, Element: realName);
4549 if (!valid) {
4550 valid = name->symbol->detailsIf<UserReductionDetails>();
4551 }
4552 }
4553 if (!valid) {
4554 context_.Say(source,
4555 "Invalid reduction identifier in %s clause."_err_en_US,
4556 parser::ToUpperCaseLetters(getClauseName(clauseId).str()));
4557 }
4558 return valid;
4559 }};
4560
4561 return common::visit(
4562 common::visitors{visitOperator, visitDesignator}, ident.u);
4563}
4564
4565/// Check restrictions on objects that are common to all reduction clauses.
4566void OmpStructureChecker::CheckReductionObjects(
4567 const parser::OmpObjectList &objects, llvm::omp::Clause clauseId) {
4568 unsigned version{context_.langOptions().OpenMPVersion};
4569 SymbolSourceMap symbols;
4570 GetSymbolsInObjectList(objects, symbols);
4571
4572 // Array sections must be a contiguous storage, have non-zero length.
4573 for (const parser::OmpObject &object : objects.v) {
4574 CheckIfContiguous(object);
4575 }
4576 CheckReductionArraySection(objects, clauseId);
4577 // An object must be definable.
4578 CheckDefinableObjects(symbols, clauseId);
4579 // Procedure pointers are not allowed.
4580 CheckProcedurePointer(symbols, clauseId);
4581 // Pointers must not have INTENT(IN).
4582 CheckIntentInPointer(symbols, clauseId);
4583
4584 // Disallow common blocks.
4585 // Iterate on objects because `GetSymbolsInObjectList` expands common block
4586 // names into the lists of their members.
4587 for (const parser::OmpObject &object : objects.v) {
4588 auto *symbol{GetObjectSymbol(object)};
4589 if (symbol && IsCommonBlock(*symbol)) {
4590 auto source{GetObjectSource(object)};
4591 context_.Say(source ? *source : GetContext().clauseSource,
4592 "Common block names are not allowed in %s clause"_err_en_US,
4593 parser::ToUpperCaseLetters(getClauseName(clauseId).str()));
4594 }
4595 }
4596
4597 // Denied in all current versions of the standard because structure components
4598 // are not definable (i.e. they are expressions not variables).
4599 // Object cannot be a part of another object (except array elements).
4600 CheckStructureComponent(objects, clauseId);
4601
4602 if (version >= 50) {
4603 // If object is an array section or element, the base expression must be
4604 // a language identifier.
4605 for (const parser::OmpObject &object : objects.v) {
4606 if (auto *elem{GetArrayElementFromObj(object)}) {
4607 const parser::DataRef &base = elem->base;
4608 if (!std::holds_alternative<parser::Name>(base.u)) {
4609 auto source{GetObjectSource(object)};
4610 context_.Say(source ? *source : GetContext().clauseSource,
4611 "The base expression of an array element or section in %s clause must be an identifier"_err_en_US,
4612 parser::ToUpperCaseLetters(getClauseName(clauseId).str()));
4613 }
4614 }
4615 }
4616 // Type parameter inquiries are not allowed.
4617 for (const parser::OmpObject &object : objects.v) {
4618 if (auto *dataRef{GetDataRefFromObj(object)}) {
4619 if (IsDataRefTypeParamInquiry(dataRef)) {
4620 auto source{GetObjectSource(object)};
4621 context_.Say(source ? *source : GetContext().clauseSource,
4622 "Type parameter inquiry is not permitted in %s clause"_err_en_US,
4623 parser::ToUpperCaseLetters(getClauseName(clauseId).str()));
4624 }
4625 }
4626 }
4627 }
4628}
4629
4630static bool CheckSymbolSupportsType(const Scope &scope,
4631 const parser::CharBlock &name, const DeclTypeSpec &type) {
4632 if (const auto *symbol{scope.FindSymbol(name)}) {
4633 if (const auto *reductionDetails{
4634 symbol->detailsIf<UserReductionDetails>()}) {
4635 return reductionDetails->SupportsType(type);
4636 }
4637 }
4638 return false;
4639}
4640
4641static bool IsReductionAllowedForType(
4642 const parser::OmpReductionIdentifier &ident, const DeclTypeSpec &type,
4643 const Scope &scope, SemanticsContext &context) {
4644 auto isLogical{[](const DeclTypeSpec &type) -> bool {
4645 return type.category() == DeclTypeSpec::Logical;
4646 }};
4647 auto isCharacter{[](const DeclTypeSpec &type) -> bool {
4648 return type.category() == DeclTypeSpec::Character;
4649 }};
4650
4651 auto checkOperator{[&](const parser::DefinedOperator &dOpr) {
4652 if (const auto *intrinsicOp{
4653 std::get_if<parser::DefinedOperator::IntrinsicOperator>(&dOpr.u)}) {
4654 // OMP5.2: The type [...] of a list item that appears in a
4655 // reduction clause must be valid for the combiner expression
4656 // See F2023: Table 10.2
4657 // .LT., .LE., .GT., .GE. are handled as procedure designators
4658 // below.
4659 switch (*intrinsicOp) {
4660 case parser::DefinedOperator::IntrinsicOperator::Multiply:
4661 case parser::DefinedOperator::IntrinsicOperator::Add:
4662 case parser::DefinedOperator::IntrinsicOperator::Subtract:
4663 if (type.IsNumeric(TypeCategory::Integer) ||
4664 type.IsNumeric(TypeCategory::Real) ||
4665 type.IsNumeric(TypeCategory::Complex))
4666 return true;
4667 break;
4668
4669 case parser::DefinedOperator::IntrinsicOperator::AND:
4670 case parser::DefinedOperator::IntrinsicOperator::OR:
4671 case parser::DefinedOperator::IntrinsicOperator::EQV:
4672 case parser::DefinedOperator::IntrinsicOperator::NEQV:
4673 if (isLogical(type)) {
4674 return true;
4675 }
4676 break;
4677
4678 // Reduction identifier is not in OMP5.2 Table 5.2
4679 default:
4680 DIE("This should have been caught in CheckIntrinsicOperator");
4681 return false;
4682 }
4683 parser::CharBlock name{MakeNameFromOperator(*intrinsicOp, context)};
4684 return CheckSymbolSupportsType(scope, name, type);
4685 } else if (const auto *definedOp{
4686 std::get_if<parser::DefinedOpName>(&dOpr.u)}) {
4687 return CheckSymbolSupportsType(
4688 scope, MangleDefinedOperator(definedOp->v.symbol->name()), type);
4689 }
4690 llvm_unreachable(
4691 "A DefinedOperator is either a DefinedOpName or an IntrinsicOperator");
4692 }};
4693
4694 auto checkDesignator{[&](const parser::ProcedureDesignator &procD) {
4695 const parser::Name *name{std::get_if<parser::Name>(&procD.u)};
4696 CHECK(name && name->symbol);
4697 if (name && name->symbol) {
4698 const SourceName &realName{name->symbol->GetUltimate().name()};
4699 // OMP5.2: The type [...] of a list item that appears in a
4700 // reduction clause must be valid for the combiner expression
4701 if (realName == "iand" || realName == "ior" || realName == "ieor") {
4702 // IAND: arguments must be integers: F2023 16.9.100
4703 // IEOR: arguments must be integers: F2023 16.9.106
4704 // IOR: arguments must be integers: F2023 16.9.111
4705 if (type.IsNumeric(TypeCategory::Integer)) {
4706 return true;
4707 }
4708 } else if (realName == "max" || realName == "min") {
4709 // MAX: arguments must be integer, real, or character:
4710 // F2023 16.9.135
4711 // MIN: arguments must be integer, real, or character:
4712 // F2023 16.9.141
4713 if (type.IsNumeric(TypeCategory::Integer) ||
4714 type.IsNumeric(TypeCategory::Real) || isCharacter(type)) {
4715 return true;
4716 }
4717 }
4718
4719 // If we get here, it may be a user declared reduction, so check
4720 // if the symbol has UserReductionDetails, and if so, the type is
4721 // supported.
4722 if (const auto *reductionDetails{
4723 name->symbol->detailsIf<UserReductionDetails>()}) {
4724 return reductionDetails->SupportsType(type);
4725 }
4726
4727 // We also need to check for mangled names (max, min, iand, ieor and ior)
4728 // and then check if the type is there.
4729 parser::CharBlock mangledName{MangleSpecialFunctions(name->source)};
4730 return CheckSymbolSupportsType(scope, mangledName, type);
4731 }
4732 // Everything else is "not matching type".
4733 return false;
4734 }};
4735
4736 return common::visit(
4737 common::visitors{checkOperator, checkDesignator}, ident.u);
4738}
4739
4740void OmpStructureChecker::CheckReductionObjectTypes(
4741 const parser::OmpObjectList &objects,
4742 const parser::OmpReductionIdentifier &ident) {
4743 SymbolSourceMap symbols;
4744 GetSymbolsInObjectList(objects, symbols);
4745
4746 for (auto &[symbol, source] : symbols) {
4747 if (auto *type{symbol->GetType()}) {
4748 const auto &scope{context_.FindScope(symbol->name())};
4749 if (!IsReductionAllowedForType(ident, *type, scope, context_)) {
4750 context_.Say(source,
4751 "The type of '%s' is incompatible with the reduction operator."_err_en_US,
4752 symbol->name());
4753 }
4754 } else {
4755 assert(IsProcedurePointer(*symbol) && "Unexpected symbol properties");
4756 }
4757 }
4758}
4759
4760void OmpStructureChecker::CheckReductionModifier(
4761 const parser::OmpReductionModifier &modifier) {
4762 using ReductionModifier = parser::OmpReductionModifier;
4763 if (modifier.v == ReductionModifier::Value::Default) {
4764 // The default one is always ok.
4765 return;
4766 }
4767 const DirectiveContext &dirCtx{GetContext()};
4768 if (dirCtx.directive == llvm::omp::Directive::OMPD_loop ||
4769 dirCtx.directive == llvm::omp::Directive::OMPD_taskloop) {
4770 // [5.2:257:33-34]
4771 // If a reduction-modifier is specified in a reduction clause that
4772 // appears on the directive, then the reduction modifier must be
4773 // default.
4774 // [5.2:268:16]
4775 // The reduction-modifier must be default.
4776 context_.Say(GetContext().clauseSource,
4777 "REDUCTION modifier on %s directive must be DEFAULT"_err_en_US,
4778 parser::ToUpperCaseLetters(GetContext().directiveSource.ToString()));
4779 return;
4780 }
4781 if (modifier.v == ReductionModifier::Value::Task) {
4782 // "Task" is only allowed on worksharing or "parallel" directive.
4783 static llvm::omp::Directive worksharing[]{
4784 llvm::omp::Directive::OMPD_do, llvm::omp::Directive::OMPD_scope,
4785 llvm::omp::Directive::OMPD_sections,
4786 // There are more worksharing directives, but they do not apply:
4787 // "for" is C++ only,
4788 // "single" and "workshare" don't allow reduction clause,
4789 // "loop" has different restrictions (checked above).
4790 };
4791 if (dirCtx.directive != llvm::omp::Directive::OMPD_parallel &&
4792 !llvm::is_contained(worksharing, dirCtx.directive)) {
4793 context_.Say(GetContext().clauseSource,
4794 "Modifier 'TASK' on REDUCTION clause is only allowed with "
4795 "PARALLEL or worksharing directive"_err_en_US);
4796 }
4797 } else if (modifier.v == ReductionModifier::Value::Inscan) {
4798 // "Inscan" is only allowed on worksharing-loop, worksharing-loop simd,
4799 // or "simd" directive.
4800 // The worksharing-loop directives are OMPD_do and OMPD_for. Only the
4801 // former is allowed in Fortran.
4802 if (!llvm::omp::scanParentAllowedSet.test(dirCtx.directive)) {
4803 context_.Say(GetContext().clauseSource,
4804 "Modifier 'INSCAN' on REDUCTION clause is only allowed with "
4805 "WORKSHARING LOOP, WORKSHARING LOOP SIMD, "
4806 "or SIMD directive"_err_en_US);
4807 }
4808 } else {
4809 // Catch-all for potential future modifiers to make sure that this
4810 // function is up-to-date.
4811 context_.Say(GetContext().clauseSource,
4812 "Unexpected modifier on REDUCTION clause"_err_en_US);
4813 }
4814}
4815
4816void OmpStructureChecker::CheckReductionArraySection(
4817 const parser::OmpObjectList &ompObjectList, llvm::omp::Clause clauseId) {
4818 for (const auto &ompObject : ompObjectList.v) {
4819 if (const auto *dataRef{parser::Unwrap<parser::DataRef>(ompObject)}) {
4820 if (const auto *arrayElement{
4821 parser::Unwrap<parser::ArrayElement>(ompObject)}) {
4822 CheckArraySection(*arrayElement, GetLastName(*dataRef), clauseId);
4823 }
4824 }
4825 }
4826}
4827
4828void OmpStructureChecker::CheckSharedBindingInOuterContext(
4829 const parser::OmpObjectList &redObjectList) {
4830 // TODO: Verify the assumption here that the immediately enclosing region is
4831 // the parallel region to which the worksharing construct having reduction
4832 // binds to.
4833 if (auto *enclosingContext{GetEnclosingDirContext()}) {
4834 for (auto it : enclosingContext->clauseInfo) {
4835 llvmOmpClause type = it.first;
4836 const auto *clause = it.second;
4837 if (llvm::omp::privateReductionSet.test(type)) {
4838 if (const auto *objList{GetOmpObjectList(*clause)}) {
4839 for (const auto &ompObject : objList->v) {
4840 if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
4841 if (const auto *symbol{name->symbol}) {
4842 for (const auto &redOmpObject : redObjectList.v) {
4843 if (const auto *rname{
4844 parser::Unwrap<parser::Name>(redOmpObject)}) {
4845 if (const auto *rsymbol{rname->symbol}) {
4846 if (rsymbol->name() == symbol->name()) {
4847 context_.Say(GetContext().clauseSource,
4848 "%s variable '%s' is %s in outer context must"
4849 " be shared in the parallel regions to which any"
4850 " of the worksharing regions arising from the "
4851 "worksharing construct bind."_err_en_US,
4852 parser::ToUpperCaseLetters(
4853 getClauseName(llvm::omp::Clause::OMPC_reduction)
4854 .str()),
4855 symbol->name(),
4856 parser::ToUpperCaseLetters(
4857 getClauseName(type).str()));
4858 }
4859 }
4860 }
4861 }
4862 }
4863 }
4864 }
4865 }
4866 }
4867 }
4868 }
4869}
4870
4871void OmpStructureChecker::Enter(const parser::OmpClause::Ordered &x) {
4872 CheckAllowedClause(llvm::omp::Clause::OMPC_ordered);
4873 // the parameter of ordered clause is optional
4874 if (const auto &expr{x.v}) {
4875 RequiresConstantPositiveParameter(llvm::omp::Clause::OMPC_ordered, *expr);
4876 // 2.8.3 Loop SIMD Construct Restriction
4877 if (llvm::omp::allDoSimdSet.test(GetContext().directive)) {
4878 context_.Say(GetContext().clauseSource,
4879 "No ORDERED clause with a parameter can be specified "
4880 "on the %s directive"_err_en_US,
4881 ContextDirectiveAsFortran());
4882 }
4883 }
4884}
4885
4886void OmpStructureChecker::Enter(const parser::OmpClause::Shared &x) {
4887 CheckAllowedClause(llvm::omp::Clause::OMPC_shared);
4888 CheckVarIsNotPartOfAnotherVar(GetContext().clauseSource, x.v, "SHARED");
4889 CheckCrayPointee(x.v, "SHARED");
4890}
4891void OmpStructureChecker::Enter(const parser::OmpClause::Private &x) {
4892 SymbolSourceMap symbols;
4893 GetSymbolsInObjectList(x.v, symbols);
4894 CheckAllowedClause(llvm::omp::Clause::OMPC_private);
4895 CheckVarIsNotPartOfAnotherVar(GetContext().clauseSource, x.v, "PRIVATE");
4896 CheckIntentInPointer(symbols, llvm::omp::Clause::OMPC_private);
4897 CheckCrayPointee(x.v, "PRIVATE");
4898}
4899
4900void OmpStructureChecker::Enter(const parser::OmpClause::Nowait &x) {
4901 CheckAllowedClause(llvm::omp::Clause::OMPC_nowait);
4902}
4903
4904bool OmpStructureChecker::IsDataRefTypeParamInquiry(
4905 const parser::DataRef *dataRef) {
4906 bool dataRefIsTypeParamInquiry{false};
4907 if (const auto *structComp{
4908 parser::Unwrap<parser::StructureComponent>(dataRef)}) {
4909 if (const auto *compSymbol{structComp->component.symbol}) {
4910 if (const auto *compSymbolMiscDetails{
4911 std::get_if<MiscDetails>(&compSymbol->details())}) {
4912 const auto detailsKind = compSymbolMiscDetails->kind();
4913 dataRefIsTypeParamInquiry =
4914 (detailsKind == MiscDetails::Kind::KindParamInquiry ||
4915 detailsKind == MiscDetails::Kind::LenParamInquiry);
4916 } else if (compSymbol->has<TypeParamDetails>()) {
4917 dataRefIsTypeParamInquiry = true;
4918 }
4919 }
4920 }
4921 return dataRefIsTypeParamInquiry;
4922}
4923
4924void OmpStructureChecker::CheckVarIsNotPartOfAnotherVar(
4925 const parser::CharBlock &source, const parser::OmpObjectList &objList,
4926 llvm::StringRef clause) {
4927 for (const auto &ompObject : objList.v) {
4928 CheckVarIsNotPartOfAnotherVar(source, ompObject, clause);
4929 }
4930}
4931
4932void OmpStructureChecker::CheckVarIsNotPartOfAnotherVar(
4933 const parser::CharBlock &source, const parser::OmpObject &ompObject,
4934 llvm::StringRef clause) {
4935 common::visit(
4936 common::visitors{
4937 [&](const parser::Designator &designator) {
4938 if (const auto *dataRef{
4939 std::get_if<parser::DataRef>(&designator.u)}) {
4940 if (IsDataRefTypeParamInquiry(dataRef)) {
4941 context_.Say(source,
4942 "A type parameter inquiry cannot appear on the %s directive"_err_en_US,
4943 ContextDirectiveAsFortran());
4944 } else if (parser::Unwrap<parser::StructureComponent>(
4945 ompObject) ||
4946 parser::Unwrap<parser::ArrayElement>(ompObject)) {
4947 if (llvm::omp::nonPartialVarSet.test(GetContext().directive)) {
4948 context_.Say(source,
4949 "A variable that is part of another variable (as an array or structure element) cannot appear on the %s directive"_err_en_US,
4950 ContextDirectiveAsFortran());
4951 } else {
4952 context_.Say(source,
4953 "A variable that is part of another variable (as an array or structure element) cannot appear in a %s clause"_err_en_US,
4954 clause.data());
4955 }
4956 }
4957 }
4958 },
4959 [&](const parser::Name &name) {},
4960 },
4961 ompObject.u);
4962}
4963
4964void OmpStructureChecker::Enter(const parser::OmpClause::Firstprivate &x) {
4965 CheckAllowedClause(llvm::omp::Clause::OMPC_firstprivate);
4966
4967 CheckVarIsNotPartOfAnotherVar(GetContext().clauseSource, x.v, "FIRSTPRIVATE");
4968 CheckCrayPointee(x.v, "FIRSTPRIVATE");
4969 CheckIsLoopIvPartOfClause(llvmOmpClause::OMPC_firstprivate, x.v);
4970
4971 SymbolSourceMap currSymbols;
4972 GetSymbolsInObjectList(x.v, currSymbols);
4973 CheckCopyingPolymorphicAllocatable(
4974 currSymbols, llvm::omp::Clause::OMPC_firstprivate);
4975
4976 DirectivesClauseTriple dirClauseTriple;
4977 // Check firstprivate variables in worksharing constructs
4978 dirClauseTriple.emplace(llvm::omp::Directive::OMPD_do,
4979 std::make_pair(
4980 llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet));
4981 dirClauseTriple.emplace(llvm::omp::Directive::OMPD_sections,
4982 std::make_pair(
4983 llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet));
4984 dirClauseTriple.emplace(llvm::omp::Directive::OMPD_single,
4985 std::make_pair(
4986 llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet));
4987 // Check firstprivate variables in distribute construct
4988 dirClauseTriple.emplace(llvm::omp::Directive::OMPD_distribute,
4989 std::make_pair(
4990 llvm::omp::Directive::OMPD_teams, llvm::omp::privateReductionSet));
4991 dirClauseTriple.emplace(llvm::omp::Directive::OMPD_distribute,
4992 std::make_pair(llvm::omp::Directive::OMPD_target_teams,
4993 llvm::omp::privateReductionSet));
4994 // Check firstprivate variables in task and taskloop constructs
4995 dirClauseTriple.emplace(llvm::omp::Directive::OMPD_task,
4996 std::make_pair(llvm::omp::Directive::OMPD_parallel,
4997 OmpClauseSet{llvm::omp::Clause::OMPC_reduction}));
4998 dirClauseTriple.emplace(llvm::omp::Directive::OMPD_taskloop,
4999 std::make_pair(llvm::omp::Directive::OMPD_parallel,
5000 OmpClauseSet{llvm::omp::Clause::OMPC_reduction}));
5001
5002 CheckPrivateSymbolsInOuterCxt(
5003 currSymbols, dirClauseTriple, llvm::omp::Clause::OMPC_firstprivate);
5004}
5005
5006void OmpStructureChecker::CheckIsLoopIvPartOfClause(
5007 llvmOmpClause clause, const parser::OmpObjectList &ompObjectList) {
5008 for (const auto &ompObject : ompObjectList.v) {
5009 if (const parser::Name *name{parser::Unwrap<parser::Name>(ompObject)}) {
5010 if (name->symbol == GetContext().loopIV) {
5011 context_.Say(name->source,
5012 "DO iteration variable %s is not allowed in %s clause."_err_en_US,
5013 name->ToString(),
5014 parser::ToUpperCaseLetters(getClauseName(clause).str()));
5015 }
5016 }
5017 }
5018}
5019
5020// Restrictions specific to each clause are implemented apart from the
5021// generalized restrictions.
5022void OmpStructureChecker::Enter(const parser::OmpClause::Aligned &x) {
5023 CheckAllowedClause(llvm::omp::Clause::OMPC_aligned);
5024 if (OmpVerifyModifiers(
5025 x.v, llvm::omp::OMPC_aligned, GetContext().clauseSource, context_)) {
5026 auto &modifiers{OmpGetModifiers(x.v)};
5027 if (auto *align{OmpGetUniqueModifier<parser::OmpAlignment>(modifiers)}) {
5028 if (const auto &v{GetIntValue(align->v)}; !v || *v <= 0) {
5029 context_.Say(OmpGetModifierSource(modifiers, align),
5030 "The alignment value should be a constant positive integer"_err_en_US);
5031 }
5032 }
5033 }
5034 // 2.8.1 TODO: list-item attribute check
5035}
5036
5037void OmpStructureChecker::Enter(const parser::OmpClause::Defaultmap &x) {
5038 CheckAllowedClause(llvm::omp::Clause::OMPC_defaultmap);
5039 unsigned version{context_.langOptions().OpenMPVersion};
5040 using ImplicitBehavior = parser::OmpDefaultmapClause::ImplicitBehavior;
5041 auto behavior{std::get<ImplicitBehavior>(x.v.t)};
5042 if (version <= 45) {
5043 if (behavior != ImplicitBehavior::Tofrom) {
5044 context_.Say(GetContext().clauseSource,
5045 "%s is not allowed in %s, %s"_warn_en_US,
5046 parser::ToUpperCaseLetters(
5047 parser::OmpDefaultmapClause::EnumToString(behavior)),
5048 ThisVersion(version), TryVersion(50));
5049 }
5050 }
5051 if (!OmpVerifyModifiers(x.v, llvm::omp::OMPC_defaultmap,
5052 GetContext().clauseSource, context_)) {
5053 // If modifier verification fails, return early.
5054 return;
5055 }
5056 auto &modifiers{OmpGetModifiers(x.v)};
5057 auto *maybeCategory{
5058 OmpGetUniqueModifier<parser::OmpVariableCategory>(modifiers)};
5059 if (maybeCategory) {
5060 using VariableCategory = parser::OmpVariableCategory;
5061 VariableCategory::Value category{maybeCategory->v};
5062 unsigned tryVersion{0};
5063 if (version <= 45 && category != VariableCategory::Value::Scalar) {
5064 tryVersion = 50;
5065 }
5066 if (version < 52 && category == VariableCategory::Value::All) {
5067 tryVersion = 52;
5068 }
5069 if (tryVersion) {
5070 context_.Say(GetContext().clauseSource,
5071 "%s is not allowed in %s, %s"_warn_en_US,
5072 parser::ToUpperCaseLetters(VariableCategory::EnumToString(category)),
5073 ThisVersion(version), TryVersion(tryVersion));
5074 }
5075 }
5076}
5077
5078void OmpStructureChecker::Enter(const parser::OmpClause::If &x) {
5079 CheckAllowedClause(llvm::omp::Clause::OMPC_if);
5080 unsigned version{context_.langOptions().OpenMPVersion};
5081 llvm::omp::Directive dir{GetContext().directive};
5082
5083 auto isConstituent{[](llvm::omp::Directive dir, llvm::omp::Directive part) {
5084 using namespace llvm::omp;
5085 llvm::ArrayRef<Directive> dirLeafs{getLeafConstructsOrSelf(dir)};
5086 llvm::ArrayRef<Directive> partLeafs{getLeafConstructsOrSelf(part)};
5087 // Maybe it's sufficient to check if every leaf of `part` is also a leaf
5088 // of `dir`, but to be safe check if `partLeafs` is a sub-sequence of
5089 // `dirLeafs`.
5090 size_t dirSize{dirLeafs.size()}, partSize{partLeafs.size()};
5091 // Find the first leaf from `part` in `dir`.
5092 if (auto first = llvm::find(dirLeafs, partLeafs.front());
5093 first != dirLeafs.end()) {
5094 // A leaf can only appear once in a compound directive, so if `part`
5095 // is a subsequence of `dir`, it must start here.
5096 size_t firstPos{
5097 static_cast<size_t>(std::distance(dirLeafs.begin(), first))};
5098 llvm::ArrayRef<Directive> subSeq{
5099 first, std::min<size_t>(dirSize - firstPos, partSize)};
5100 return subSeq == partLeafs;
5101 }
5102 return false;
5103 }};
5104
5105 if (OmpVerifyModifiers(
5106 x.v, llvm::omp::OMPC_if, GetContext().clauseSource, context_)) {
5107 auto &modifiers{OmpGetModifiers(x.v)};
5108 if (auto *dnm{OmpGetUniqueModifier<parser::OmpDirectiveNameModifier>(
5109 modifiers)}) {
5110 llvm::omp::Directive sub{dnm->v};
5111 std::string subName{
5112 parser::ToUpperCaseLetters(getDirectiveName(sub).str())};
5113 std::string dirName{
5114 parser::ToUpperCaseLetters(getDirectiveName(dir).str())};
5115
5116 parser::CharBlock modifierSource{OmpGetModifierSource(modifiers, dnm)};
5117 auto desc{OmpGetDescriptor<parser::OmpDirectiveNameModifier>()};
5118 std::string modName{desc.name.str()};
5119
5120 if (!isConstituent(dir, sub)) {
5121 context_
5122 .Say(modifierSource,
5123 "%s is not a constituent of the %s directive"_err_en_US,
5124 subName, dirName)
5125 .Attach(GetContext().directiveSource,
5126 "Cannot apply to directive"_en_US);
5127 } else {
5128 static llvm::omp::Directive valid45[]{
5129 llvm::omp::OMPD_cancel, //
5130 llvm::omp::OMPD_parallel, //
5131 /* OMP 5.0+ also allows OMPD_simd */
5132 llvm::omp::OMPD_target, //
5133 llvm::omp::OMPD_target_data, //
5134 llvm::omp::OMPD_target_enter_data, //
5135 llvm::omp::OMPD_target_exit_data, //
5136 llvm::omp::OMPD_target_update, //
5137 llvm::omp::OMPD_task, //
5138 llvm::omp::OMPD_taskloop, //
5139 /* OMP 5.2+ also allows OMPD_teams */
5140 };
5141 if (version < 50 && sub == llvm::omp::OMPD_simd) {
5142 context_.Say(modifierSource,
5143 "%s is not allowed as '%s' in %s, %s"_warn_en_US, subName,
5144 modName, ThisVersion(version), TryVersion(50));
5145 } else if (version < 52 && sub == llvm::omp::OMPD_teams) {
5146 context_.Say(modifierSource,
5147 "%s is not allowed as '%s' in %s, %s"_warn_en_US, subName,
5148 modName, ThisVersion(version), TryVersion(52));
5149 } else if (!llvm::is_contained(valid45, sub) &&
5150 sub != llvm::omp::OMPD_simd && sub != llvm::omp::OMPD_teams) {
5151 context_.Say(modifierSource,
5152 "%s is not allowed as '%s' in %s"_err_en_US, subName, modName,
5153 ThisVersion(version));
5154 }
5155 }
5156 }
5157 }
5158}
5159
5160void OmpStructureChecker::Enter(const parser::OmpClause::Linear &x) {
5161 CheckAllowedClause(llvm::omp::Clause::OMPC_linear);
5162 unsigned version{context_.langOptions().OpenMPVersion};
5163 llvm::omp::Directive dir{GetContext().directive};
5164 parser::CharBlock clauseSource{GetContext().clauseSource};
5165 const parser::OmpLinearModifier *linearMod{nullptr};
5166
5167 SymbolSourceMap symbols;
5168 auto &objects{std::get<parser::OmpObjectList>(x.v.t)};
5169 CheckCrayPointee(objects, "LINEAR", false);
5170 GetSymbolsInObjectList(objects, symbols);
5171
5172 auto CheckIntegerNoRef{[&](const Symbol *symbol, parser::CharBlock source) {
5173 if (!symbol->GetType()->IsNumeric(TypeCategory::Integer)) {
5174 auto &desc{OmpGetDescriptor<parser::OmpLinearModifier>()};
5175 context_.Say(source,
5176 "The list item '%s' specified without the REF '%s' must be of INTEGER type"_err_en_US,
5177 symbol->name(), desc.name.str());
5178 }
5179 }};
5180
5181 if (OmpVerifyModifiers(x.v, llvm::omp::OMPC_linear, clauseSource, context_)) {
5182 auto &modifiers{OmpGetModifiers(x.v)};
5183 linearMod = OmpGetUniqueModifier<parser::OmpLinearModifier>(modifiers);
5184 if (linearMod) {
5185 // 2.7 Loop Construct Restriction
5186 if ((llvm::omp::allDoSet | llvm::omp::allSimdSet).test(dir)) {
5187 context_.Say(clauseSource,
5188 "A modifier may not be specified in a LINEAR clause on the %s directive"_err_en_US,
5189 ContextDirectiveAsFortran());
5190 return;
5191 }
5192
5193 auto &desc{OmpGetDescriptor<parser::OmpLinearModifier>()};
5194 for (auto &[symbol, source] : symbols) {
5195 if (linearMod->v != parser::OmpLinearModifier::Value::Ref) {
5196 CheckIntegerNoRef(symbol, source);
5197 } else {
5198 if (!IsAllocatable(*symbol) && !IsAssumedShape(*symbol) &&
5199 !IsPolymorphic(*symbol)) {
5200 context_.Say(source,
5201 "The list item `%s` specified with the REF '%s' must be polymorphic variable, assumed-shape array, or a variable with the `ALLOCATABLE` attribute"_err_en_US,
5202 symbol->name(), desc.name.str());
5203 }
5204 }
5205 if (linearMod->v == parser::OmpLinearModifier::Value::Ref ||
5206 linearMod->v == parser::OmpLinearModifier::Value::Uval) {
5207 if (!IsDummy(*symbol) || IsValue(*symbol)) {
5208 context_.Say(source,
5209 "If the `%s` is REF or UVAL, the list item '%s' must be a dummy argument without the VALUE attribute"_err_en_US,
5210 desc.name.str(), symbol->name());
5211 }
5212 }
5213 } // for (symbol, source)
5214
5215 if (version >= 52 && !std::get</*PostModified=*/bool>(x.v.t)) {
5216 context_.Say(OmpGetModifierSource(modifiers, linearMod),
5217 "The 'modifier(<list>)' syntax is deprecated in %s, use '<list> : modifier' instead"_warn_en_US,
5218 ThisVersion(version));
5219 }
5220 }
5221 }
5222
5223 // OpenMP 5.2: Ordered clause restriction
5224 if (const auto *clause{
5225 FindClause(GetContext(), llvm::omp::Clause::OMPC_ordered)}) {
5226 const auto &orderedClause{std::get<parser::OmpClause::Ordered>(clause->u)};
5227 if (orderedClause.v) {
5228 return;
5229 }
5230 }
5231
5232 // OpenMP 5.2: Linear clause Restrictions
5233 for (auto &[symbol, source] : symbols) {
5234 if (!linearMod) {
5235 // Already checked this with the modifier present.
5236 CheckIntegerNoRef(symbol, source);
5237 }
5238 if (dir == llvm::omp::Directive::OMPD_declare_simd && !IsDummy(*symbol)) {
5239 context_.Say(source,
5240 "The list item `%s` must be a dummy argument"_err_en_US,
5241 symbol->name());
5242 }
5243 if (IsPointer(*symbol) || symbol->test(Symbol::Flag::CrayPointer)) {
5244 context_.Say(source,
5245 "The list item `%s` in a LINEAR clause must not be Cray Pointer or a variable with POINTER attribute"_err_en_US,
5246 symbol->name());
5247 }
5248 if (FindCommonBlockContaining(*symbol)) {
5249 context_.Say(source,
5250 "'%s' is a common block name and must not appear in an LINEAR clause"_err_en_US,
5251 symbol->name());
5252 }
5253 }
5254}
5255
5256void OmpStructureChecker::Enter(const parser::OmpClause::Detach &x) {
5257 unsigned version{context_.langOptions().OpenMPVersion};
5258 if (version >= 52) {
5259 SetContextClauseInfo(llvm::omp::Clause::OMPC_detach);
5260 } else {
5261 // OpenMP 5.0: 2.10.1 Task construct restrictions
5262 CheckAllowedClause(llvm::omp::Clause::OMPC_detach);
5263 }
5264 // OpenMP 5.2: 12.5.2 Detach clause restrictions
5265 if (version >= 52) {
5266 CheckVarIsNotPartOfAnotherVar(GetContext().clauseSource, x.v.v, "DETACH");
5267 }
5268
5269 if (const auto *name{parser::Unwrap<parser::Name>(x.v.v)}) {
5270 if (version >= 52 && IsPointer(*name->symbol)) {
5271 context_.Say(GetContext().clauseSource,
5272 "The event-handle: `%s` must not have the POINTER attribute"_err_en_US,
5273 name->ToString());
5274 }
5275 if (!name->symbol->GetType()->IsNumeric(TypeCategory::Integer)) {
5276 context_.Say(GetContext().clauseSource,
5277 "The event-handle: `%s` must be of type integer(kind=omp_event_handle_kind)"_err_en_US,
5278 name->ToString());
5279 }
5280 }
5281}
5282
5283void OmpStructureChecker::CheckAllowedMapTypes(
5284 const parser::OmpMapType::Value &type,
5285 const std::list<parser::OmpMapType::Value> &allowedMapTypeList) {
5286 if (!llvm::is_contained(allowedMapTypeList, type)) {
5287 std::string commaSeparatedMapTypes;
5288 llvm::interleave(
5289 allowedMapTypeList.begin(), allowedMapTypeList.end(),
5290 [&](const parser::OmpMapType::Value &mapType) {
5291 commaSeparatedMapTypes.append(parser::ToUpperCaseLetters(
5292 parser::OmpMapType::EnumToString(mapType)));
5293 },
5294 [&] { commaSeparatedMapTypes.append(s: ", "); });
5295 context_.Say(GetContext().clauseSource,
5296 "Only the %s map types are permitted "
5297 "for MAP clauses on the %s directive"_err_en_US,
5298 commaSeparatedMapTypes, ContextDirectiveAsFortran());
5299 }
5300}
5301
5302void OmpStructureChecker::Enter(const parser::OmpClause::Map &x) {
5303 CheckAllowedClause(llvm::omp::Clause::OMPC_map);
5304 if (!OmpVerifyModifiers(
5305 x.v, llvm::omp::OMPC_map, GetContext().clauseSource, context_)) {
5306 return;
5307 }
5308
5309 auto &modifiers{OmpGetModifiers(x.v)};
5310 unsigned version{context_.langOptions().OpenMPVersion};
5311 if (auto commas{std::get<bool>(x.v.t)}; !commas && version >= 52) {
5312 context_.Say(GetContext().clauseSource,
5313 "The specification of modifiers without comma separators for the "
5314 "'MAP' clause has been deprecated in OpenMP 5.2"_port_en_US);
5315 }
5316 if (auto *iter{OmpGetUniqueModifier<parser::OmpIterator>(modifiers)}) {
5317 CheckIteratorModifier(*iter);
5318 }
5319 if (auto *type{OmpGetUniqueModifier<parser::OmpMapType>(modifiers)}) {
5320 using Value = parser::OmpMapType::Value;
5321 switch (GetContext().directive) {
5322 case llvm::omp::Directive::OMPD_target:
5323 case llvm::omp::Directive::OMPD_target_teams:
5324 case llvm::omp::Directive::OMPD_target_teams_distribute:
5325 case llvm::omp::Directive::OMPD_target_teams_distribute_simd:
5326 case llvm::omp::Directive::OMPD_target_teams_distribute_parallel_do:
5327 case llvm::omp::Directive::OMPD_target_teams_distribute_parallel_do_simd:
5328 case llvm::omp::Directive::OMPD_target_data:
5329 CheckAllowedMapTypes(
5330 type->v, {Value::To, Value::From, Value::Tofrom, Value::Alloc});
5331 break;
5332 case llvm::omp::Directive::OMPD_target_enter_data:
5333 CheckAllowedMapTypes(type->v, {Value::To, Value::Alloc});
5334 break;
5335 case llvm::omp::Directive::OMPD_target_exit_data:
5336 CheckAllowedMapTypes(
5337 type->v, {Value::From, Value::Release, Value::Delete});
5338 break;
5339 default:
5340 break;
5341 }
5342 }
5343
5344 auto &&typeMods{
5345 OmpGetRepeatableModifier<parser::OmpMapTypeModifier>(modifiers)};
5346 struct Less {
5347 using Iterator = decltype(typeMods.begin());
5348 bool operator()(Iterator a, Iterator b) const {
5349 const parser::OmpMapTypeModifier *pa = *a;
5350 const parser::OmpMapTypeModifier *pb = *b;
5351 return pa->v < pb->v;
5352 }
5353 };
5354 if (auto maybeIter{FindDuplicate<Less>(typeMods)}) {
5355 context_.Say(GetContext().clauseSource,
5356 "Duplicate map-type-modifier entry '%s' will be ignored"_warn_en_US,
5357 parser::ToUpperCaseLetters(
5358 parser::OmpMapTypeModifier::EnumToString((**maybeIter)->v)));
5359 }
5360}
5361
5362void OmpStructureChecker::Enter(const parser::OmpClause::Schedule &x) {
5363 CheckAllowedClause(llvm::omp::Clause::OMPC_schedule);
5364 const parser::OmpScheduleClause &scheduleClause = x.v;
5365 if (!OmpVerifyModifiers(scheduleClause, llvm::omp::OMPC_schedule,
5366 GetContext().clauseSource, context_)) {
5367 return;
5368 }
5369
5370 // 2.7 Loop Construct Restriction
5371 if (llvm::omp::allDoSet.test(GetContext().directive)) {
5372 auto &modifiers{OmpGetModifiers(scheduleClause)};
5373 auto kind{std::get<parser::OmpScheduleClause::Kind>(scheduleClause.t)};
5374 auto &chunk{
5375 std::get<std::optional<parser::ScalarIntExpr>>(scheduleClause.t)};
5376 if (chunk) {
5377 if (kind == parser::OmpScheduleClause::Kind::Runtime ||
5378 kind == parser::OmpScheduleClause::Kind::Auto) {
5379 context_.Say(GetContext().clauseSource,
5380 "When SCHEDULE clause has %s specified, "
5381 "it must not have chunk size specified"_err_en_US,
5382 parser::ToUpperCaseLetters(
5383 parser::OmpScheduleClause::EnumToString(kind)));
5384 }
5385 if (const auto &chunkExpr{std::get<std::optional<parser::ScalarIntExpr>>(
5386 scheduleClause.t)}) {
5387 RequiresPositiveParameter(
5388 llvm::omp::Clause::OMPC_schedule, *chunkExpr, "chunk size");
5389 }
5390 }
5391
5392 auto *ordering{
5393 OmpGetUniqueModifier<parser::OmpOrderingModifier>(modifiers)};
5394 if (ordering &&
5395 ordering->v == parser::OmpOrderingModifier::Value::Nonmonotonic) {
5396 if (kind != parser::OmpScheduleClause::Kind::Dynamic &&
5397 kind != parser::OmpScheduleClause::Kind::Guided) {
5398 context_.Say(GetContext().clauseSource,
5399 "The NONMONOTONIC modifier can only be specified with "
5400 "SCHEDULE(DYNAMIC) or SCHEDULE(GUIDED)"_err_en_US);
5401 }
5402 }
5403 }
5404}
5405
5406void OmpStructureChecker::Enter(const parser::OmpClause::Device &x) {
5407 CheckAllowedClause(llvm::omp::Clause::OMPC_device);
5408 const parser::OmpDeviceClause &deviceClause{x.v};
5409 const auto &device{std::get<parser::ScalarIntExpr>(deviceClause.t)};
5410 RequiresPositiveParameter(
5411 llvm::omp::Clause::OMPC_device, device, "device expression");
5412 llvm::omp::Directive dir{GetContext().directive};
5413
5414 if (OmpVerifyModifiers(deviceClause, llvm::omp::OMPC_device,
5415 GetContext().clauseSource, context_)) {
5416 auto &modifiers{OmpGetModifiers(deviceClause)};
5417
5418 if (auto *deviceMod{
5419 OmpGetUniqueModifier<parser::OmpDeviceModifier>(modifiers)}) {
5420 using Value = parser::OmpDeviceModifier::Value;
5421 if (dir != llvm::omp::OMPD_target && deviceMod->v == Value::Ancestor) {
5422 auto name{OmpGetDescriptor<parser::OmpDeviceModifier>().name};
5423 context_.Say(OmpGetModifierSource(modifiers, deviceMod),
5424 "The ANCESTOR %s must not appear on the DEVICE clause on any directive other than the TARGET construct. Found on %s construct."_err_en_US,
5425 name.str(), parser::ToUpperCaseLetters(getDirectiveName(dir)));
5426 }
5427 }
5428 }
5429}
5430
5431void OmpStructureChecker::Enter(const parser::OmpClause::Depend &x) {
5432 CheckAllowedClause(llvm::omp::Clause::OMPC_depend);
5433 llvm::omp::Directive dir{GetContext().directive};
5434 unsigned version{context_.langOptions().OpenMPVersion};
5435
5436 auto *doaDep{std::get_if<parser::OmpDoacross>(&x.v.u)};
5437 auto *taskDep{std::get_if<parser::OmpDependClause::TaskDep>(&x.v.u)};
5438 assert(((doaDep == nullptr) != (taskDep == nullptr)) &&
5439 "Unexpected alternative in update clause");
5440
5441 if (doaDep) {
5442 CheckDoacross(*doaDep);
5443 CheckDependenceType(doaDep->GetDepType());
5444 } else {
5445 using Modifier = parser::OmpDependClause::TaskDep::Modifier;
5446 auto &modifiers{std::get<std::optional<std::list<Modifier>>>(taskDep->t)};
5447 if (!modifiers) {
5448 context_.Say(GetContext().clauseSource,
5449 "A DEPEND clause on a TASK construct must have a valid task dependence type"_err_en_US);
5450 return;
5451 }
5452 CheckTaskDependenceType(taskDep->GetTaskDepType());
5453 }
5454
5455 if (dir == llvm::omp::OMPD_depobj) {
5456 // [5.0:255:11], [5.1:288:3]
5457 // A depend clause on a depobj construct must not have source, sink [or
5458 // depobj](5.0) as dependence-type.
5459 if (version >= 50) {
5460 bool invalidDep{false};
5461 if (taskDep) {
5462 if (version == 50) {
5463 invalidDep = taskDep->GetTaskDepType() ==
5464 parser::OmpTaskDependenceType::Value::Depobj;
5465 }
5466 } else {
5467 invalidDep = true;
5468 }
5469 if (invalidDep) {
5470 context_.Say(GetContext().clauseSource,
5471 "A DEPEND clause on a DEPOBJ construct must not have %s as dependence type"_err_en_US,
5472 version == 50 ? "SINK, SOURCE or DEPOBJ" : "SINK or SOURCE");
5473 }
5474 }
5475 } else if (dir != llvm::omp::OMPD_ordered) {
5476 if (doaDep) {
5477 context_.Say(GetContext().clauseSource,
5478 "The SINK and SOURCE dependence types can only be used with the ORDERED directive, used here in the %s construct"_err_en_US,
5479 parser::ToUpperCaseLetters(getDirectiveName(dir)));
5480 }
5481 }
5482 if (taskDep) {
5483 auto &objList{std::get<parser::OmpObjectList>(taskDep->t)};
5484 if (dir == llvm::omp::OMPD_depobj) {
5485 // [5.0:255:13], [5.1:288:6], [5.2:322:26]
5486 // A depend clause on a depobj construct must only specify one locator.
5487 if (objList.v.size() != 1) {
5488 context_.Say(GetContext().clauseSource,
5489 "A DEPEND clause on a DEPOBJ construct must only specify "
5490 "one locator"_err_en_US);
5491 }
5492 }
5493 for (const auto &object : objList.v) {
5494 if (const auto *name{std::get_if<parser::Name>(&object.u)}) {
5495 context_.Say(GetContext().clauseSource,
5496 "Common block name ('%s') cannot appear in a DEPEND "
5497 "clause"_err_en_US,
5498 name->ToString());
5499 } else if (auto *designator{std::get_if<parser::Designator>(&object.u)}) {
5500 if (auto *dataRef{std::get_if<parser::DataRef>(&designator->u)}) {
5501 CheckDependList(*dataRef);
5502 if (const auto *arr{
5503 std::get_if<common::Indirection<parser::ArrayElement>>(
5504 &dataRef->u)}) {
5505 CheckArraySection(arr->value(), GetLastName(*dataRef),
5506 llvm::omp::Clause::OMPC_depend);
5507 }
5508 }
5509 }
5510 }
5511 if (OmpVerifyModifiers(*taskDep, llvm::omp::OMPC_depend,
5512 GetContext().clauseSource, context_)) {
5513 auto &modifiers{OmpGetModifiers(*taskDep)};
5514 if (OmpGetUniqueModifier<parser::OmpIterator>(modifiers)) {
5515 if (dir == llvm::omp::OMPD_depobj) {
5516 context_.Say(GetContext().clauseSource,
5517 "An iterator-modifier may specify multiple locators, a DEPEND clause on a DEPOBJ construct must only specify one locator"_warn_en_US);
5518 }
5519 }
5520 }
5521 }
5522}
5523
5524void OmpStructureChecker::Enter(const parser::OmpClause::Doacross &x) {
5525 CheckAllowedClause(llvm::omp::Clause::OMPC_doacross);
5526 CheckDoacross(x.v.v);
5527}
5528
5529void OmpStructureChecker::CheckDoacross(const parser::OmpDoacross &doa) {
5530 if (std::holds_alternative<parser::OmpDoacross::Source>(doa.u)) {
5531 // Nothing to check here.
5532 return;
5533 }
5534
5535 // Process SINK dependence type. SINK may only appear in an ORDER construct,
5536 // which references a prior ORDERED(n) clause on a DO or SIMD construct
5537 // that marks the top of the loop nest.
5538
5539 auto &sink{std::get<parser::OmpDoacross::Sink>(doa.u)};
5540 const std::list<parser::OmpIteration> &vec{sink.v.v};
5541
5542 // Check if the variables in the iteration vector are unique.
5543 struct Less {
5544 using Iterator = std::list<parser::OmpIteration>::const_iterator;
5545 bool operator()(Iterator a, Iterator b) const {
5546 auto namea{std::get<parser::Name>(a->t)};
5547 auto nameb{std::get<parser::Name>(b->t)};
5548 assert(namea.symbol && nameb.symbol && "Unresolved symbols");
5549 // The non-determinism of the "<" doesn't matter, we only care about
5550 // equality, i.e. a == b <=> !(a < b) && !(b < a)
5551 return reinterpret_cast<uintptr_t>(namea.symbol) <
5552 reinterpret_cast<uintptr_t>(nameb.symbol);
5553 }
5554 };
5555 if (auto maybeIter{FindDuplicate<Less>(vec)}) {
5556 auto name{std::get<parser::Name>((*maybeIter)->t)};
5557 context_.Say(name.source,
5558 "Duplicate variable '%s' in the iteration vector"_err_en_US,
5559 name.ToString());
5560 }
5561
5562 // Check if the variables in the iteration vector are induction variables.
5563 // Ignore any mismatch between the size of the iteration vector and the
5564 // number of DO constructs on the stack. This is checked elsewhere.
5565
5566 auto GetLoopDirective{[](const parser::OpenMPLoopConstruct &x) {
5567 auto &begin{std::get<parser::OmpBeginLoopDirective>(x.t)};
5568 return std::get<parser::OmpLoopDirective>(begin.t).v;
5569 }};
5570 auto GetLoopClauses{[](const parser::OpenMPLoopConstruct &x)
5571 -> const std::list<parser::OmpClause> & {
5572 auto &begin{std::get<parser::OmpBeginLoopDirective>(x.t)};
5573 return std::get<parser::OmpClauseList>(begin.t).v;
5574 }};
5575
5576 std::set<const Symbol *> inductionVars;
5577 for (const LoopConstruct &loop : llvm::reverse(loopStack_)) {
5578 if (auto *doc{std::get_if<const parser::DoConstruct *>(&loop)}) {
5579 // Do-construct, collect the induction variable.
5580 if (auto &control{(*doc)->GetLoopControl()}) {
5581 if (auto *b{std::get_if<parser::LoopControl::Bounds>(&control->u)}) {
5582 inductionVars.insert(b->name.thing.symbol);
5583 }
5584 }
5585 } else {
5586 // Omp-loop-construct, check if it's do/simd with an ORDERED clause.
5587 auto *loopc{std::get_if<const parser::OpenMPLoopConstruct *>(&loop)};
5588 assert(loopc && "Expecting OpenMPLoopConstruct");
5589 llvm::omp::Directive loopDir{GetLoopDirective(**loopc)};
5590 if (loopDir == llvm::omp::OMPD_do || loopDir == llvm::omp::OMPD_simd) {
5591 auto IsOrdered{[](const parser::OmpClause &c) {
5592 return c.Id() == llvm::omp::OMPC_ordered;
5593 }};
5594 // If it has ORDERED clause, stop the traversal.
5595 if (llvm::any_of(GetLoopClauses(**loopc), IsOrdered)) {
5596 break;
5597 }
5598 }
5599 }
5600 }
5601 for (const parser::OmpIteration &iter : vec) {
5602 auto &name{std::get<parser::Name>(iter.t)};
5603 if (!inductionVars.count(name.symbol)) {
5604 context_.Say(name.source,
5605 "The iteration vector element '%s' is not an induction variable within the ORDERED loop nest"_err_en_US,
5606 name.ToString());
5607 }
5608 }
5609}
5610
5611void OmpStructureChecker::CheckCopyingPolymorphicAllocatable(
5612 SymbolSourceMap &symbols, const llvm::omp::Clause clause) {
5613 if (context_.ShouldWarn(common::UsageWarning::Portability)) {
5614 for (auto &[symbol, source] : symbols) {
5615 if (IsPolymorphicAllocatable(*symbol)) {
5616 context_.Warn(common::UsageWarning::Portability, source,
5617 "If a polymorphic variable with allocatable attribute '%s' is in %s clause, the behavior is unspecified"_port_en_US,
5618 symbol->name(),
5619 parser::ToUpperCaseLetters(getClauseName(clause).str()));
5620 }
5621 }
5622 }
5623}
5624
5625void OmpStructureChecker::Enter(const parser::OmpClause::Copyprivate &x) {
5626 CheckAllowedClause(llvm::omp::Clause::OMPC_copyprivate);
5627 SymbolSourceMap symbols;
5628 GetSymbolsInObjectList(x.v, symbols);
5629 CheckVariableListItem(symbols);
5630 CheckIntentInPointer(symbols, llvm::omp::Clause::OMPC_copyprivate);
5631 CheckCopyingPolymorphicAllocatable(
5632 symbols, llvm::omp::Clause::OMPC_copyprivate);
5633}
5634
5635void OmpStructureChecker::Enter(const parser::OmpClause::Lastprivate &x) {
5636 CheckAllowedClause(llvm::omp::Clause::OMPC_lastprivate);
5637
5638 const auto &objectList{std::get<parser::OmpObjectList>(x.v.t)};
5639 CheckVarIsNotPartOfAnotherVar(
5640 GetContext().clauseSource, objectList, "LASTPRIVATE");
5641 CheckCrayPointee(objectList, "LASTPRIVATE");
5642
5643 DirectivesClauseTriple dirClauseTriple;
5644 SymbolSourceMap currSymbols;
5645 GetSymbolsInObjectList(objectList, currSymbols);
5646 CheckDefinableObjects(currSymbols, llvm::omp::Clause::OMPC_lastprivate);
5647 CheckCopyingPolymorphicAllocatable(
5648 currSymbols, llvm::omp::Clause::OMPC_lastprivate);
5649
5650 // Check lastprivate variables in worksharing constructs
5651 dirClauseTriple.emplace(llvm::omp::Directive::OMPD_do,
5652 std::make_pair(
5653 llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet));
5654 dirClauseTriple.emplace(llvm::omp::Directive::OMPD_sections,
5655 std::make_pair(
5656 llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet));
5657
5658 CheckPrivateSymbolsInOuterCxt(
5659 currSymbols, dirClauseTriple, llvm::omp::Clause::OMPC_lastprivate);
5660
5661 if (OmpVerifyModifiers(x.v, llvm::omp::OMPC_lastprivate,
5662 GetContext().clauseSource, context_)) {
5663 auto &modifiers{OmpGetModifiers(x.v)};
5664 using LastprivateModifier = parser::OmpLastprivateModifier;
5665 if (auto *modifier{OmpGetUniqueModifier<LastprivateModifier>(modifiers)}) {
5666 CheckLastprivateModifier(*modifier);
5667 }
5668 }
5669}
5670
5671// Add any restrictions related to Modifiers/Directives with
5672// Lastprivate clause here:
5673void OmpStructureChecker::CheckLastprivateModifier(
5674 const parser::OmpLastprivateModifier &modifier) {
5675 using LastprivateModifier = parser::OmpLastprivateModifier;
5676 const DirectiveContext &dirCtx{GetContext()};
5677 if (modifier.v == LastprivateModifier::Value::Conditional &&
5678 dirCtx.directive == llvm::omp::Directive::OMPD_taskloop) {
5679 // [5.2:268:17]
5680 // The conditional lastprivate-modifier must not be specified.
5681 context_.Say(GetContext().clauseSource,
5682 "'CONDITIONAL' modifier on lastprivate clause with TASKLOOP "
5683 "directive is not allowed"_err_en_US);
5684 }
5685}
5686
5687void OmpStructureChecker::Enter(const parser::OmpClause::Copyin &x) {
5688 CheckAllowedClause(llvm::omp::Clause::OMPC_copyin);
5689
5690 SymbolSourceMap currSymbols;
5691 GetSymbolsInObjectList(x.v, currSymbols);
5692 CheckCopyingPolymorphicAllocatable(
5693 currSymbols, llvm::omp::Clause::OMPC_copyin);
5694}
5695
5696void OmpStructureChecker::CheckStructureComponent(
5697 const parser::OmpObjectList &objects, llvm::omp::Clause clauseId) {
5698 auto CheckComponent{[&](const parser::Designator &designator) {
5699 if (auto *dataRef{std::get_if<parser::DataRef>(&designator.u)}) {
5700 if (!IsDataRefTypeParamInquiry(dataRef)) {
5701 if (auto *comp{parser::Unwrap<parser::StructureComponent>(*dataRef)}) {
5702 context_.Say(comp->component.source,
5703 "A variable that is part of another variable cannot appear on the %s clause"_err_en_US,
5704 parser::ToUpperCaseLetters(getClauseName(clauseId).str()));
5705 }
5706 }
5707 }
5708 }};
5709
5710 for (const auto &object : objects.v) {
5711 common::visit(
5712 common::visitors{
5713 CheckComponent,
5714 [&](const parser::Name &name) {},
5715 },
5716 object.u);
5717 }
5718}
5719
5720void OmpStructureChecker::Enter(const parser::OmpClause::Update &x) {
5721 CheckAllowedClause(llvm::omp::Clause::OMPC_update);
5722 llvm::omp::Directive dir{GetContext().directive};
5723 unsigned version{context_.langOptions().OpenMPVersion};
5724
5725 const parser::OmpDependenceType *depType{nullptr};
5726 const parser::OmpTaskDependenceType *taskType{nullptr};
5727 if (auto &maybeUpdate{x.v}) {
5728 depType = std::get_if<parser::OmpDependenceType>(&maybeUpdate->u);
5729 taskType = std::get_if<parser::OmpTaskDependenceType>(&maybeUpdate->u);
5730 }
5731
5732 if (!depType && !taskType) {
5733 assert(dir == llvm::omp::Directive::OMPD_atomic &&
5734 "Unexpected alternative in update clause");
5735 return;
5736 }
5737
5738 if (depType) {
5739 CheckDependenceType(depType->v);
5740 } else if (taskType) {
5741 CheckTaskDependenceType(taskType->v);
5742 }
5743
5744 // [5.1:288:4-5]
5745 // An update clause on a depobj construct must not have source, sink or depobj
5746 // as dependence-type.
5747 // [5.2:322:3]
5748 // task-dependence-type must not be depobj.
5749 if (dir == llvm::omp::OMPD_depobj) {
5750 if (version >= 51) {
5751 bool invalidDep{false};
5752 if (taskType) {
5753 invalidDep =
5754 taskType->v == parser::OmpTaskDependenceType::Value::Depobj;
5755 } else {
5756 invalidDep = true;
5757 }
5758 if (invalidDep) {
5759 context_.Say(GetContext().clauseSource,
5760 "An UPDATE clause on a DEPOBJ construct must not have SINK, SOURCE or DEPOBJ as dependence type"_err_en_US);
5761 }
5762 }
5763 }
5764}
5765
5766void OmpStructureChecker::Enter(const parser::OmpClause::UseDevicePtr &x) {
5767 CheckStructureComponent(x.v, llvm::omp::Clause::OMPC_use_device_ptr);
5768 CheckAllowedClause(llvm::omp::Clause::OMPC_use_device_ptr);
5769 SymbolSourceMap currSymbols;
5770 GetSymbolsInObjectList(x.v, currSymbols);
5771 semantics::UnorderedSymbolSet listVars;
5772 for (auto [_, clause] : FindClauses(llvm::omp::Clause::OMPC_use_device_ptr)) {
5773 const auto &useDevicePtrClause{
5774 std::get<parser::OmpClause::UseDevicePtr>(clause->u)};
5775 const auto &useDevicePtrList{useDevicePtrClause.v};
5776 std::list<parser::Name> useDevicePtrNameList;
5777 for (const auto &ompObject : useDevicePtrList.v) {
5778 if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
5779 if (name->symbol) {
5780 if (!(IsBuiltinCPtr(*(name->symbol)))) {
5781 context_.Warn(common::UsageWarning::OpenMPUsage, clause->source,
5782 "Use of non-C_PTR type '%s' in USE_DEVICE_PTR is deprecated, use USE_DEVICE_ADDR instead"_warn_en_US,
5783 name->ToString());
5784 } else {
5785 useDevicePtrNameList.push_back(*name);
5786 }
5787 }
5788 }
5789 }
5790 CheckMultipleOccurrence(
5791 listVars, useDevicePtrNameList, clause->source, "USE_DEVICE_PTR");
5792 }
5793}
5794
5795void OmpStructureChecker::Enter(const parser::OmpClause::UseDeviceAddr &x) {
5796 CheckStructureComponent(x.v, llvm::omp::Clause::OMPC_use_device_addr);
5797 CheckAllowedClause(llvm::omp::Clause::OMPC_use_device_addr);
5798 SymbolSourceMap currSymbols;
5799 GetSymbolsInObjectList(x.v, currSymbols);
5800 semantics::UnorderedSymbolSet listVars;
5801 for (auto [_, clause] :
5802 FindClauses(llvm::omp::Clause::OMPC_use_device_addr)) {
5803 const auto &useDeviceAddrClause{
5804 std::get<parser::OmpClause::UseDeviceAddr>(clause->u)};
5805 const auto &useDeviceAddrList{useDeviceAddrClause.v};
5806 std::list<parser::Name> useDeviceAddrNameList;
5807 for (const auto &ompObject : useDeviceAddrList.v) {
5808 if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
5809 if (name->symbol) {
5810 useDeviceAddrNameList.push_back(*name);
5811 }
5812 }
5813 }
5814 CheckMultipleOccurrence(
5815 listVars, useDeviceAddrNameList, clause->source, "USE_DEVICE_ADDR");
5816 }
5817}
5818
5819void OmpStructureChecker::Enter(const parser::OmpClause::IsDevicePtr &x) {
5820 CheckAllowedClause(llvm::omp::Clause::OMPC_is_device_ptr);
5821 SymbolSourceMap currSymbols;
5822 GetSymbolsInObjectList(x.v, currSymbols);
5823 semantics::UnorderedSymbolSet listVars;
5824 for (auto [_, clause] : FindClauses(llvm::omp::Clause::OMPC_is_device_ptr)) {
5825 const auto &isDevicePtrClause{
5826 std::get<parser::OmpClause::IsDevicePtr>(clause->u)};
5827 const auto &isDevicePtrList{isDevicePtrClause.v};
5828 SymbolSourceMap currSymbols;
5829 GetSymbolsInObjectList(isDevicePtrList, currSymbols);
5830 for (auto &[symbol, source] : currSymbols) {
5831 if (!(IsBuiltinCPtr(*symbol))) {
5832 context_.Say(clause->source,
5833 "Variable '%s' in IS_DEVICE_PTR clause must be of type C_PTR"_err_en_US,
5834 source.ToString());
5835 } else if (!(IsDummy(*symbol))) {
5836 context_.Warn(common::UsageWarning::OpenMPUsage, clause->source,
5837 "Variable '%s' in IS_DEVICE_PTR clause must be a dummy argument. "
5838 "This semantic check is deprecated from OpenMP 5.2 and later."_warn_en_US,
5839 source.ToString());
5840 } else if (IsAllocatableOrPointer(*symbol) || IsValue(*symbol)) {
5841 context_.Warn(common::UsageWarning::OpenMPUsage, clause->source,
5842 "Variable '%s' in IS_DEVICE_PTR clause must be a dummy argument "
5843 "that does not have the ALLOCATABLE, POINTER or VALUE attribute. "
5844 "This semantic check is deprecated from OpenMP 5.2 and later."_warn_en_US,
5845 source.ToString());
5846 }
5847 }
5848 }
5849}
5850
5851void OmpStructureChecker::Enter(const parser::OmpClause::HasDeviceAddr &x) {
5852 CheckAllowedClause(llvm::omp::Clause::OMPC_has_device_addr);
5853 SymbolSourceMap currSymbols;
5854 GetSymbolsInObjectList(x.v, currSymbols);
5855 semantics::UnorderedSymbolSet listVars;
5856 for (auto [_, clause] :
5857 FindClauses(llvm::omp::Clause::OMPC_has_device_addr)) {
5858 const auto &hasDeviceAddrClause{
5859 std::get<parser::OmpClause::HasDeviceAddr>(clause->u)};
5860 const auto &hasDeviceAddrList{hasDeviceAddrClause.v};
5861 std::list<parser::Name> hasDeviceAddrNameList;
5862 for (const auto &ompObject : hasDeviceAddrList.v) {
5863 if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
5864 if (name->symbol) {
5865 hasDeviceAddrNameList.push_back(*name);
5866 }
5867 }
5868 }
5869 }
5870}
5871
5872void OmpStructureChecker::Enter(const parser::OmpClause::Enter &x) {
5873 CheckAllowedClause(llvm::omp::Clause::OMPC_enter);
5874 const parser::OmpObjectList &objList{x.v};
5875 SymbolSourceMap symbols;
5876 GetSymbolsInObjectList(objList, symbols);
5877 for (const auto &[symbol, source] : symbols) {
5878 if (!IsExtendedListItem(*symbol)) {
5879 context_.SayWithDecl(*symbol, source,
5880 "'%s' must be a variable or a procedure"_err_en_US, symbol->name());
5881 }
5882 }
5883}
5884
5885void OmpStructureChecker::Enter(const parser::OmpClause::From &x) {
5886 CheckAllowedClause(llvm::omp::Clause::OMPC_from);
5887 if (!OmpVerifyModifiers(
5888 x.v, llvm::omp::OMPC_from, GetContext().clauseSource, context_)) {
5889 return;
5890 }
5891
5892 auto &modifiers{OmpGetModifiers(x.v)};
5893 unsigned version{context_.langOptions().OpenMPVersion};
5894
5895 if (auto *iter{OmpGetUniqueModifier<parser::OmpIterator>(modifiers)}) {
5896 CheckIteratorModifier(*iter);
5897 }
5898
5899 const auto &objList{std::get<parser::OmpObjectList>(x.v.t)};
5900 SymbolSourceMap symbols;
5901 GetSymbolsInObjectList(objList, symbols);
5902 CheckVariableListItem(symbols);
5903
5904 // Ref: [4.5:109:19]
5905 // If a list item is an array section it must specify contiguous storage.
5906 if (version <= 45) {
5907 for (const parser::OmpObject &object : objList.v) {
5908 CheckIfContiguous(object);
5909 }
5910 }
5911}
5912
5913void OmpStructureChecker::Enter(const parser::OmpClause::To &x) {
5914 CheckAllowedClause(llvm::omp::Clause::OMPC_to);
5915 if (!OmpVerifyModifiers(
5916 x.v, llvm::omp::OMPC_to, GetContext().clauseSource, context_)) {
5917 return;
5918 }
5919
5920 auto &modifiers{OmpGetModifiers(x.v)};
5921 unsigned version{context_.langOptions().OpenMPVersion};
5922
5923 // The "to" clause is only allowed on "declare target" (pre-5.1), and
5924 // "target update". In the former case it can take an extended list item,
5925 // in the latter a variable (a locator).
5926
5927 // The "declare target" construct (and the "to" clause on it) are already
5928 // handled (in the declare-target checkers), so just look at "to" in "target
5929 // update".
5930 if (GetContext().directive == llvm::omp::OMPD_declare_target) {
5931 return;
5932 }
5933
5934 assert(GetContext().directive == llvm::omp::OMPD_target_update);
5935 if (auto *iter{OmpGetUniqueModifier<parser::OmpIterator>(modifiers)}) {
5936 CheckIteratorModifier(*iter);
5937 }
5938
5939 const auto &objList{std::get<parser::OmpObjectList>(x.v.t)};
5940 SymbolSourceMap symbols;
5941 GetSymbolsInObjectList(objList, symbols);
5942 CheckVariableListItem(symbols);
5943
5944 // Ref: [4.5:109:19]
5945 // If a list item is an array section it must specify contiguous storage.
5946 if (version <= 45) {
5947 for (const parser::OmpObject &object : objList.v) {
5948 CheckIfContiguous(object);
5949 }
5950 }
5951}
5952
5953void OmpStructureChecker::Enter(const parser::OmpClause::OmpxBare &x) {
5954 // Don't call CheckAllowedClause, because it allows "ompx_bare" on
5955 // a non-combined "target" directive (for reasons of splitting combined
5956 // directives). In source code it's only allowed on "target teams".
5957 if (GetContext().directive != llvm::omp::Directive::OMPD_target_teams) {
5958 context_.Say(GetContext().clauseSource,
5959 "%s clause is only allowed on combined TARGET TEAMS"_err_en_US,
5960 parser::ToUpperCaseLetters(getClauseName(llvm::omp::OMPC_ompx_bare)));
5961 }
5962}
5963
5964void OmpStructureChecker::Enter(const parser::OmpClause::When &x) {
5965 CheckAllowedClause(llvm::omp::Clause::OMPC_when);
5966 OmpVerifyModifiers(
5967 x.v, llvm::omp::OMPC_when, GetContext().clauseSource, context_);
5968}
5969
5970void OmpStructureChecker::Enter(const parser::OmpContextSelector &ctx) {
5971 EnterDirectiveNest(index: ContextSelectorNest);
5972
5973 using SetName = parser::OmpTraitSetSelectorName;
5974 std::map<SetName::Value, const SetName *> visited;
5975
5976 for (const parser::OmpTraitSetSelector &traitSet : ctx.v) {
5977 auto &name{std::get<SetName>(traitSet.t)};
5978 auto [prev, unique]{visited.insert(std::make_pair(name.v, &name))};
5979 if (!unique) {
5980 std::string showName{parser::ToUpperCaseLetters(name.ToString())};
5981 parser::MessageFormattedText txt(
5982 "Repeated trait set name %s in a context specifier"_err_en_US,
5983 showName);
5984 parser::Message message(name.source, txt);
5985 message.Attach(prev->second->source,
5986 "Previous trait set %s provided here"_en_US, showName);
5987 context_.Say(std::move(message));
5988 }
5989 CheckTraitSetSelector(traitSet);
5990 }
5991}
5992
5993void OmpStructureChecker::Leave(const parser::OmpContextSelector &) {
5994 ExitDirectiveNest(index: ContextSelectorNest);
5995}
5996
5997const std::list<parser::OmpTraitProperty> &
5998OmpStructureChecker::GetTraitPropertyList(
5999 const parser::OmpTraitSelector &trait) {
6000 static const std::list<parser::OmpTraitProperty> empty{};
6001 auto &[_, maybeProps]{trait.t};
6002 if (maybeProps) {
6003 using PropertyList = std::list<parser::OmpTraitProperty>;
6004 return std::get<PropertyList>(maybeProps->t);
6005 } else {
6006 return empty;
6007 }
6008}
6009
6010std::optional<llvm::omp::Clause> OmpStructureChecker::GetClauseFromProperty(
6011 const parser::OmpTraitProperty &property) {
6012 using MaybeClause = std::optional<llvm::omp::Clause>;
6013
6014 // The parser for OmpClause will only succeed if the clause was
6015 // given with all required arguments.
6016 // If this is a string or complex extension with a clause name,
6017 // treat it as a clause and let the trait checker deal with it.
6018
6019 auto getClauseFromString{[&](const std::string &s) -> MaybeClause {
6020 auto id{llvm::omp::getOpenMPClauseKind(parser::ToLowerCaseLetters(s))};
6021 if (id != llvm::omp::Clause::OMPC_unknown) {
6022 return id;
6023 } else {
6024 return std::nullopt;
6025 }
6026 }};
6027
6028 return common::visit( //
6029 common::visitors{
6030 [&](const parser::OmpTraitPropertyName &x) -> MaybeClause {
6031 return getClauseFromString(x.v);
6032 },
6033 [&](const common::Indirection<parser::OmpClause> &x) -> MaybeClause {
6034 return x.value().Id();
6035 },
6036 [&](const parser::ScalarExpr &x) -> MaybeClause {
6037 return std::nullopt;
6038 },
6039 [&](const parser::OmpTraitPropertyExtension &x) -> MaybeClause {
6040 using ExtProperty = parser::OmpTraitPropertyExtension;
6041 if (auto *name{std::get_if<parser::OmpTraitPropertyName>(&x.u)}) {
6042 return getClauseFromString(name->v);
6043 } else if (auto *cpx{std::get_if<ExtProperty::Complex>(&x.u)}) {
6044 return getClauseFromString(
6045 std::get<parser::OmpTraitPropertyName>(cpx->t).v);
6046 }
6047 return std::nullopt;
6048 },
6049 },
6050 property.u);
6051}
6052
6053void OmpStructureChecker::CheckTraitSelectorList(
6054 const std::list<parser::OmpTraitSelector> &traits) {
6055 // [6.0:322:20]
6056 // Each trait-selector-name may only be specified once in a trait selector
6057 // set.
6058
6059 // Cannot store OmpTraitSelectorName directly, because it's not copyable.
6060 using TraitName = parser::OmpTraitSelectorName;
6061 using BareName = decltype(TraitName::u);
6062 std::map<BareName, const TraitName *> visited;
6063
6064 for (const parser::OmpTraitSelector &trait : traits) {
6065 auto &name{std::get<TraitName>(trait.t)};
6066
6067 auto [prev, unique]{visited.insert(std::make_pair(name.u, &name))};
6068 if (!unique) {
6069 std::string showName{parser::ToUpperCaseLetters(name.ToString())};
6070 parser::MessageFormattedText txt(
6071 "Repeated trait name %s in a trait set"_err_en_US, showName);
6072 parser::Message message(name.source, txt);
6073 message.Attach(prev->second->source,
6074 "Previous trait %s provided here"_en_US, showName);
6075 context_.Say(std::move(message));
6076 }
6077 }
6078}
6079
6080void OmpStructureChecker::CheckTraitSetSelector(
6081 const parser::OmpTraitSetSelector &traitSet) {
6082
6083 // Trait Set | Allowed traits | D-traits | X-traits | Score |
6084 //
6085 // Construct | Simd, directive-name | Yes | No | No |
6086 // Device | Arch, Isa, Kind | No | Yes | No |
6087 // Implementation | Atomic_Default_Mem_Order | No | Yes | Yes |
6088 // | Extension, Requires | | | |
6089 // | Vendor | | | |
6090 // Target_Device | Arch, Device_Num, Isa | No | Yes | No |
6091 // | Kind, Uid | | | |
6092 // User | Condition | No | No | Yes |
6093
6094 struct TraitSetConfig {
6095 std::set<parser::OmpTraitSelectorName::Value> allowed;
6096 bool allowsDirectiveTraits;
6097 bool allowsExtensionTraits;
6098 bool allowsScore;
6099 };
6100
6101 using SName = parser::OmpTraitSetSelectorName::Value;
6102 using TName = parser::OmpTraitSelectorName::Value;
6103
6104 static const std::map<SName, TraitSetConfig> configs{
6105 {SName::Construct, //
6106 {{TName::Simd}, true, false, false}},
6107 {SName::Device, //
6108 {{TName::Arch, TName::Isa, TName::Kind}, false, true, false}},
6109 {SName::Implementation, //
6110 {{TName::Atomic_Default_Mem_Order, TName::Extension, TName::Requires,
6111 TName::Vendor},
6112 false, true, true}},
6113 {SName::Target_Device, //
6114 {{TName::Arch, TName::Device_Num, TName::Isa, TName::Kind,
6115 TName::Uid},
6116 false, true, false}},
6117 {SName::User, //
6118 {{TName::Condition}, false, false, true}},
6119 };
6120
6121 auto checkTraitSet{[&](const TraitSetConfig &config) {
6122 auto &[setName, traits]{traitSet.t};
6123 auto usn{parser::ToUpperCaseLetters(setName.ToString())};
6124
6125 // Check if there are any duplicate traits.
6126 CheckTraitSelectorList(traits);
6127
6128 for (const parser::OmpTraitSelector &trait : traits) {
6129 // Don't use structured bindings here, because they cannot be captured
6130 // before C++20.
6131 auto &traitName = std::get<parser::OmpTraitSelectorName>(trait.t);
6132 auto &maybeProps =
6133 std::get<std::optional<parser::OmpTraitSelector::Properties>>(
6134 trait.t);
6135
6136 // Check allowed traits
6137 common::visit( //
6138 common::visitors{
6139 [&](parser::OmpTraitSelectorName::Value v) {
6140 if (!config.allowed.count(v)) {
6141 context_.Say(traitName.source,
6142 "%s is not a valid trait for %s trait set"_err_en_US,
6143 parser::ToUpperCaseLetters(traitName.ToString()), usn);
6144 }
6145 },
6146 [&](llvm::omp::Directive) {
6147 if (!config.allowsDirectiveTraits) {
6148 context_.Say(traitName.source,
6149 "Directive name is not a valid trait for %s trait set"_err_en_US,
6150 usn);
6151 }
6152 },
6153 [&](const std::string &) {
6154 if (!config.allowsExtensionTraits) {
6155 context_.Say(traitName.source,
6156 "Extension traits are not valid for %s trait set"_err_en_US,
6157 usn);
6158 }
6159 },
6160 },
6161 traitName.u);
6162
6163 // Check score
6164 if (maybeProps) {
6165 auto &[maybeScore, _]{maybeProps->t};
6166 if (maybeScore) {
6167 CheckTraitScore(*maybeScore);
6168 }
6169 }
6170
6171 // Check the properties of the individual traits
6172 CheckTraitSelector(traitSet, trait);
6173 }
6174 }};
6175
6176 checkTraitSet(
6177 configs.at(std::get<parser::OmpTraitSetSelectorName>(traitSet.t).v));
6178}
6179
6180void OmpStructureChecker::CheckTraitScore(const parser::OmpTraitScore &score) {
6181 // [6.0:322:23]
6182 // A score-expression must be a non-negative constant integer expression.
6183 if (auto value{GetIntValue(score)}; !value || value < 0) {
6184 context_.Say(score.source,
6185 "SCORE expression must be a non-negative constant integer expression"_err_en_US);
6186 }
6187}
6188
6189bool OmpStructureChecker::VerifyTraitPropertyLists(
6190 const parser::OmpTraitSetSelector &traitSet,
6191 const parser::OmpTraitSelector &trait) {
6192 using TraitName = parser::OmpTraitSelectorName;
6193 using PropertyList = std::list<parser::OmpTraitProperty>;
6194 auto &[traitName, maybeProps]{trait.t};
6195
6196 auto checkPropertyList{[&](const PropertyList &properties, auto isValid,
6197 const std::string &message) {
6198 bool foundInvalid{false};
6199 for (const parser::OmpTraitProperty &prop : properties) {
6200 if (!isValid(prop)) {
6201 if (foundInvalid) {
6202 context_.Say(
6203 prop.source, "More invalid properties are present"_err_en_US);
6204 break;
6205 }
6206 context_.Say(prop.source, "%s"_err_en_US, message);
6207 foundInvalid = true;
6208 }
6209 }
6210 return !foundInvalid;
6211 }};
6212
6213 bool invalid{false};
6214
6215 if (std::holds_alternative<llvm::omp::Directive>(traitName.u)) {
6216 // Directive-name traits don't have properties.
6217 if (maybeProps) {
6218 context_.Say(trait.source,
6219 "Directive-name traits cannot have properties"_err_en_US);
6220 invalid = true;
6221 }
6222 }
6223 // Ignore properties on extension traits.
6224
6225 // See `TraitSelectorParser` in openmp-parser.cpp
6226 if (auto *v{std::get_if<TraitName::Value>(&traitName.u)}) {
6227 switch (*v) {
6228 // name-list properties
6229 case parser::OmpTraitSelectorName::Value::Arch:
6230 case parser::OmpTraitSelectorName::Value::Extension:
6231 case parser::OmpTraitSelectorName::Value::Isa:
6232 case parser::OmpTraitSelectorName::Value::Kind:
6233 case parser::OmpTraitSelectorName::Value::Uid:
6234 case parser::OmpTraitSelectorName::Value::Vendor:
6235 if (maybeProps) {
6236 auto isName{[](const parser::OmpTraitProperty &prop) {
6237 return std::holds_alternative<parser::OmpTraitPropertyName>(prop.u);
6238 }};
6239 invalid = !checkPropertyList(std::get<PropertyList>(maybeProps->t),
6240 isName, "Trait property should be a name");
6241 }
6242 break;
6243 // clause-list
6244 case parser::OmpTraitSelectorName::Value::Atomic_Default_Mem_Order:
6245 case parser::OmpTraitSelectorName::Value::Requires:
6246 case parser::OmpTraitSelectorName::Value::Simd:
6247 if (maybeProps) {
6248 auto isClause{[&](const parser::OmpTraitProperty &prop) {
6249 return GetClauseFromProperty(prop).has_value();
6250 }};
6251 invalid = !checkPropertyList(std::get<PropertyList>(maybeProps->t),
6252 isClause, "Trait property should be a clause");
6253 }
6254 break;
6255 // expr-list
6256 case parser::OmpTraitSelectorName::Value::Condition:
6257 case parser::OmpTraitSelectorName::Value::Device_Num:
6258 if (maybeProps) {
6259 auto isExpr{[](const parser::OmpTraitProperty &prop) {
6260 return std::holds_alternative<parser::ScalarExpr>(prop.u);
6261 }};
6262 invalid = !checkPropertyList(std::get<PropertyList>(maybeProps->t),
6263 isExpr, "Trait property should be a scalar expression");
6264 }
6265 break;
6266 } // switch
6267 }
6268
6269 return !invalid;
6270}
6271
6272void OmpStructureChecker::CheckTraitSelector(
6273 const parser::OmpTraitSetSelector &traitSet,
6274 const parser::OmpTraitSelector &trait) {
6275 using TraitName = parser::OmpTraitSelectorName;
6276 auto &[traitName, maybeProps]{trait.t};
6277
6278 // Only do the detailed checks if the property lists are valid.
6279 if (VerifyTraitPropertyLists(traitSet, trait)) {
6280 if (std::holds_alternative<llvm::omp::Directive>(traitName.u) ||
6281 std::holds_alternative<std::string>(traitName.u)) {
6282 // No properties here: directives don't have properties, and
6283 // we don't implement any extension traits now.
6284 return;
6285 }
6286
6287 // Specific traits we want to check.
6288 // Limitations:
6289 // (1) The properties for these traits are defined in "Additional
6290 // Definitions for the OpenMP API Specification". It's not clear how
6291 // to define them in a portable way, and how to verify their validity,
6292 // especially if they get replaced by their integer values (in case
6293 // they are defined as enums).
6294 // (2) These are entirely implementation-defined, and at the moment
6295 // there is no known schema to validate these values.
6296 auto v{std::get<TraitName::Value>(traitName.u)};
6297 switch (v) {
6298 case TraitName::Value::Arch:
6299 // Unchecked, TBD(1)
6300 break;
6301 case TraitName::Value::Atomic_Default_Mem_Order:
6302 CheckTraitADMO(traitSet, trait);
6303 break;
6304 case TraitName::Value::Condition:
6305 CheckTraitCondition(traitSet, trait);
6306 break;
6307 case TraitName::Value::Device_Num:
6308 CheckTraitDeviceNum(traitSet, trait);
6309 break;
6310 case TraitName::Value::Extension:
6311 // Ignore
6312 break;
6313 case TraitName::Value::Isa:
6314 // Unchecked, TBD(1)
6315 break;
6316 case TraitName::Value::Kind:
6317 // Unchecked, TBD(1)
6318 break;
6319 case TraitName::Value::Requires:
6320 CheckTraitRequires(traitSet, trait);
6321 break;
6322 case TraitName::Value::Simd:
6323 CheckTraitSimd(traitSet, trait);
6324 break;
6325 case TraitName::Value::Uid:
6326 // Unchecked, TBD(2)
6327 break;
6328 case TraitName::Value::Vendor:
6329 // Unchecked, TBD(1)
6330 break;
6331 }
6332 }
6333}
6334
6335void OmpStructureChecker::CheckTraitADMO(
6336 const parser::OmpTraitSetSelector &traitSet,
6337 const parser::OmpTraitSelector &trait) {
6338 auto &traitName{std::get<parser::OmpTraitSelectorName>(trait.t)};
6339 auto &properties{GetTraitPropertyList(trait)};
6340
6341 if (properties.size() != 1) {
6342 context_.Say(trait.source,
6343 "%s trait requires a single clause property"_err_en_US,
6344 parser::ToUpperCaseLetters(traitName.ToString()));
6345 } else {
6346 const parser::OmpTraitProperty &property{properties.front()};
6347 auto clauseId{*GetClauseFromProperty(property)};
6348 // Check that the clause belongs to the memory-order clause-set.
6349 // Clause sets will hopefully be autogenerated at some point.
6350 switch (clauseId) {
6351 case llvm::omp::Clause::OMPC_acq_rel:
6352 case llvm::omp::Clause::OMPC_acquire:
6353 case llvm::omp::Clause::OMPC_relaxed:
6354 case llvm::omp::Clause::OMPC_release:
6355 case llvm::omp::Clause::OMPC_seq_cst:
6356 break;
6357 default:
6358 context_.Say(property.source,
6359 "%s trait requires a clause from the memory-order clause set"_err_en_US,
6360 parser::ToUpperCaseLetters(traitName.ToString()));
6361 }
6362
6363 using ClauseProperty = common::Indirection<parser::OmpClause>;
6364 if (!std::holds_alternative<ClauseProperty>(property.u)) {
6365 context_.Say(property.source,
6366 "Invalid clause specification for %s"_err_en_US,
6367 parser::ToUpperCaseLetters(getClauseName(clauseId)));
6368 }
6369 }
6370}
6371
6372void OmpStructureChecker::CheckTraitCondition(
6373 const parser::OmpTraitSetSelector &traitSet,
6374 const parser::OmpTraitSelector &trait) {
6375 auto &traitName{std::get<parser::OmpTraitSelectorName>(trait.t)};
6376 auto &properties{GetTraitPropertyList(trait)};
6377
6378 if (properties.size() != 1) {
6379 context_.Say(trait.source,
6380 "%s trait requires a single expression property"_err_en_US,
6381 parser::ToUpperCaseLetters(traitName.ToString()));
6382 } else {
6383 const parser::OmpTraitProperty &property{properties.front()};
6384 auto &scalarExpr{std::get<parser::ScalarExpr>(property.u)};
6385
6386 auto maybeType{GetDynamicType(scalarExpr.thing.value())};
6387 if (!maybeType || maybeType->category() != TypeCategory::Logical) {
6388 context_.Say(property.source,
6389 "%s trait requires a single LOGICAL expression"_err_en_US,
6390 parser::ToUpperCaseLetters(traitName.ToString()));
6391 }
6392 }
6393}
6394
6395void OmpStructureChecker::CheckTraitDeviceNum(
6396 const parser::OmpTraitSetSelector &traitSet,
6397 const parser::OmpTraitSelector &trait) {
6398 auto &traitName{std::get<parser::OmpTraitSelectorName>(trait.t)};
6399 auto &properties{GetTraitPropertyList(trait)};
6400
6401 if (properties.size() != 1) {
6402 context_.Say(trait.source,
6403 "%s trait requires a single expression property"_err_en_US,
6404 parser::ToUpperCaseLetters(traitName.ToString()));
6405 }
6406 // No other checks at the moment.
6407}
6408
6409void OmpStructureChecker::CheckTraitRequires(
6410 const parser::OmpTraitSetSelector &traitSet,
6411 const parser::OmpTraitSelector &trait) {
6412 unsigned version{context_.langOptions().OpenMPVersion};
6413 auto &traitName{std::get<parser::OmpTraitSelectorName>(trait.t)};
6414 auto &properties{GetTraitPropertyList(trait)};
6415
6416 for (const parser::OmpTraitProperty &property : properties) {
6417 auto clauseId{*GetClauseFromProperty(property)};
6418 if (!llvm::omp::isAllowedClauseForDirective(
6419 llvm::omp::OMPD_requires, clauseId, version)) {
6420 context_.Say(property.source,
6421 "%s trait requires a clause from the requirement clause set"_err_en_US,
6422 parser::ToUpperCaseLetters(traitName.ToString()));
6423 }
6424
6425 using ClauseProperty = common::Indirection<parser::OmpClause>;
6426 if (!std::holds_alternative<ClauseProperty>(property.u)) {
6427 context_.Say(property.source,
6428 "Invalid clause specification for %s"_err_en_US,
6429 parser::ToUpperCaseLetters(getClauseName(clauseId)));
6430 }
6431 }
6432}
6433
6434void OmpStructureChecker::CheckTraitSimd(
6435 const parser::OmpTraitSetSelector &traitSet,
6436 const parser::OmpTraitSelector &trait) {
6437 unsigned version{context_.langOptions().OpenMPVersion};
6438 auto &traitName{std::get<parser::OmpTraitSelectorName>(trait.t)};
6439 auto &properties{GetTraitPropertyList(trait)};
6440
6441 for (const parser::OmpTraitProperty &property : properties) {
6442 auto clauseId{*GetClauseFromProperty(property)};
6443 if (!llvm::omp::isAllowedClauseForDirective(
6444 llvm::omp::OMPD_declare_simd, clauseId, version)) {
6445 context_.Say(property.source,
6446 "%s trait requires a clause that is allowed on the %s directive"_err_en_US,
6447 parser::ToUpperCaseLetters(traitName.ToString()),
6448 parser::ToUpperCaseLetters(
6449 getDirectiveName(llvm::omp::OMPD_declare_simd)));
6450 }
6451
6452 using ClauseProperty = common::Indirection<parser::OmpClause>;
6453 if (!std::holds_alternative<ClauseProperty>(property.u)) {
6454 context_.Say(property.source,
6455 "Invalid clause specification for %s"_err_en_US,
6456 parser::ToUpperCaseLetters(getClauseName(clauseId)));
6457 }
6458 }
6459}
6460
6461llvm::StringRef OmpStructureChecker::getClauseName(llvm::omp::Clause clause) {
6462 return llvm::omp::getOpenMPClauseName(clause);
6463}
6464
6465llvm::StringRef OmpStructureChecker::getDirectiveName(
6466 llvm::omp::Directive directive) {
6467 unsigned version{context_.langOptions().OpenMPVersion};
6468 return llvm::omp::getOpenMPDirectiveName(directive, version);
6469}
6470
6471const Symbol *OmpStructureChecker::GetObjectSymbol(
6472 const parser::OmpObject &object) {
6473 // Some symbols may be missing if the resolution failed, e.g. when an
6474 // undeclared name is used with implicit none.
6475 if (auto *name{std::get_if<parser::Name>(&object.u)}) {
6476 return name->symbol ? &name->symbol->GetUltimate() : nullptr;
6477 } else if (auto *desg{std::get_if<parser::Designator>(&object.u)}) {
6478 auto &last{GetLastName(*desg)};
6479 return last.symbol ? &GetLastName(*desg).symbol->GetUltimate() : nullptr;
6480 }
6481 return nullptr;
6482}
6483
6484const Symbol *OmpStructureChecker::GetArgumentSymbol(
6485 const parser::OmpArgument &argument) {
6486 if (auto *locator{std::get_if<parser::OmpLocator>(&argument.u)}) {
6487 if (auto *object{std::get_if<parser::OmpObject>(&locator->u)}) {
6488 return GetObjectSymbol(*object);
6489 }
6490 }
6491 return nullptr;
6492}
6493
6494std::optional<parser::CharBlock> OmpStructureChecker::GetObjectSource(
6495 const parser::OmpObject &object) {
6496 if (auto *name{std::get_if<parser::Name>(&object.u)}) {
6497 return name->source;
6498 } else if (auto *desg{std::get_if<parser::Designator>(&object.u)}) {
6499 return GetLastName(*desg).source;
6500 }
6501 return std::nullopt;
6502}
6503
6504void OmpStructureChecker::CheckDependList(const parser::DataRef &d) {
6505 common::visit(
6506 common::visitors{
6507 [&](const common::Indirection<parser::ArrayElement> &elem) {
6508 // Check if the base element is valid on Depend Clause
6509 CheckDependList(elem.value().base);
6510 },
6511 [&](const common::Indirection<parser::StructureComponent> &comp) {
6512 CheckDependList(comp.value().base);
6513 },
6514 [&](const common::Indirection<parser::CoindexedNamedObject> &) {
6515 context_.Say(GetContext().clauseSource,
6516 "Coarrays are not supported in DEPEND clause"_err_en_US);
6517 },
6518 [&](const parser::Name &) {},
6519 },
6520 d.u);
6521}
6522
6523// Called from both Reduction and Depend clause.
6524void OmpStructureChecker::CheckArraySection(
6525 const parser::ArrayElement &arrayElement, const parser::Name &name,
6526 const llvm::omp::Clause clause) {
6527 if (!arrayElement.subscripts.empty()) {
6528 for (const auto &subscript : arrayElement.subscripts) {
6529 if (const auto *triplet{
6530 std::get_if<parser::SubscriptTriplet>(&subscript.u)}) {
6531 if (std::get<0>(triplet->t) && std::get<1>(triplet->t)) {
6532 std::optional<int64_t> strideVal{std::nullopt};
6533 if (const auto &strideExpr = std::get<2>(triplet->t)) {
6534 // OpenMP 6.0 Section 5.2.5: Array Sections
6535 // Restrictions: if a stride expression is specified it must be
6536 // positive. A stride of 0 doesn't make sense.
6537 strideVal = GetIntValue(strideExpr);
6538 if (strideVal && *strideVal < 1) {
6539 context_.Say(GetContext().clauseSource,
6540 "'%s' in %s clause must have a positive stride"_err_en_US,
6541 name.ToString(),
6542 parser::ToUpperCaseLetters(getClauseName(clause).str()));
6543 }
6544 }
6545 const auto &lower{std::get<0>(triplet->t)};
6546 const auto &upper{std::get<1>(triplet->t)};
6547 if (lower && upper) {
6548 const auto lval{GetIntValue(lower)};
6549 const auto uval{GetIntValue(upper)};
6550 if (lval && uval) {
6551 int64_t sectionLen = *uval - *lval;
6552 if (strideVal) {
6553 sectionLen = sectionLen / *strideVal;
6554 }
6555
6556 if (sectionLen < 1) {
6557 context_.Say(GetContext().clauseSource,
6558 "'%s' in %s clause"
6559 " is a zero size array section"_err_en_US,
6560 name.ToString(),
6561 parser::ToUpperCaseLetters(getClauseName(clause).str()));
6562 break;
6563 }
6564 }
6565 }
6566 }
6567 }
6568 }
6569 }
6570}
6571
6572void OmpStructureChecker::CheckIntentInPointer(
6573 SymbolSourceMap &symbols, llvm::omp::Clause clauseId) {
6574 for (auto &[symbol, source] : symbols) {
6575 if (IsPointer(*symbol) && IsIntentIn(*symbol)) {
6576 context_.Say(source,
6577 "Pointer '%s' with the INTENT(IN) attribute may not appear in a %s clause"_err_en_US,
6578 symbol->name(),
6579 parser::ToUpperCaseLetters(getClauseName(clauseId).str()));
6580 }
6581 }
6582}
6583
6584void OmpStructureChecker::CheckProcedurePointer(
6585 SymbolSourceMap &symbols, llvm::omp::Clause clause) {
6586 for (const auto &[symbol, source] : symbols) {
6587 if (IsProcedurePointer(*symbol)) {
6588 context_.Say(source,
6589 "Procedure pointer '%s' may not appear in a %s clause"_err_en_US,
6590 symbol->name(),
6591 parser::ToUpperCaseLetters(getClauseName(clause).str()));
6592 }
6593 }
6594}
6595
6596void OmpStructureChecker::CheckCrayPointee(
6597 const parser::OmpObjectList &objectList, llvm::StringRef clause,
6598 bool suggestToUseCrayPointer) {
6599 SymbolSourceMap symbols;
6600 GetSymbolsInObjectList(objectList, symbols);
6601 for (auto it{symbols.begin()}; it != symbols.end(); ++it) {
6602 const auto *symbol{it->first};
6603 const auto source{it->second};
6604 if (symbol->test(Symbol::Flag::CrayPointee)) {
6605 std::string suggestionMsg = "";
6606 if (suggestToUseCrayPointer)
6607 suggestionMsg = ", use Cray Pointer '" +
6608 semantics::GetCrayPointer(*symbol).name().ToString() + "' instead";
6609 context_.Say(source,
6610 "Cray Pointee '%s' may not appear in %s clause%s"_err_en_US,
6611 symbol->name(), clause.str(), suggestionMsg);
6612 }
6613 }
6614}
6615
6616void OmpStructureChecker::GetSymbolsInObjectList(
6617 const parser::OmpObjectList &objectList, SymbolSourceMap &symbols) {
6618 for (const auto &ompObject : objectList.v) {
6619 if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
6620 if (const auto *symbol{name->symbol}) {
6621 if (const auto *commonBlockDetails{
6622 symbol->detailsIf<CommonBlockDetails>()}) {
6623 for (const auto &object : commonBlockDetails->objects()) {
6624 symbols.emplace(&object->GetUltimate(), name->source);
6625 }
6626 } else {
6627 symbols.emplace(&symbol->GetUltimate(), name->source);
6628 }
6629 }
6630 }
6631 }
6632}
6633
6634void OmpStructureChecker::CheckDefinableObjects(
6635 SymbolSourceMap &symbols, const llvm::omp::Clause clause) {
6636 for (auto &[symbol, source] : symbols) {
6637 if (auto msg{WhyNotDefinable(source, context_.FindScope(source),
6638 DefinabilityFlags{}, *symbol)}) {
6639 context_
6640 .Say(source,
6641 "Variable '%s' on the %s clause is not definable"_err_en_US,
6642 symbol->name(),
6643 parser::ToUpperCaseLetters(getClauseName(clause).str()))
6644 .Attach(std::move(msg->set_severity(parser::Severity::Because)));
6645 }
6646 }
6647}
6648
6649void OmpStructureChecker::CheckPrivateSymbolsInOuterCxt(
6650 SymbolSourceMap &currSymbols, DirectivesClauseTriple &dirClauseTriple,
6651 const llvm::omp::Clause currClause) {
6652 SymbolSourceMap enclosingSymbols;
6653 auto range{dirClauseTriple.equal_range(GetContext().directive)};
6654 for (auto dirIter{range.first}; dirIter != range.second; ++dirIter) {
6655 auto enclosingDir{dirIter->second.first};
6656 auto enclosingClauseSet{dirIter->second.second};
6657 if (auto *enclosingContext{GetEnclosingContextWithDir(enclosingDir)}) {
6658 for (auto it{enclosingContext->clauseInfo.begin()};
6659 it != enclosingContext->clauseInfo.end(); ++it) {
6660 if (enclosingClauseSet.test(it->first)) {
6661 if (const auto *ompObjectList{GetOmpObjectList(*it->second)}) {
6662 GetSymbolsInObjectList(*ompObjectList, enclosingSymbols);
6663 }
6664 }
6665 }
6666
6667 // Check if the symbols in current context are private in outer context
6668 for (auto &[symbol, source] : currSymbols) {
6669 if (enclosingSymbols.find(symbol) != enclosingSymbols.end()) {
6670 context_.Say(source,
6671 "%s variable '%s' is PRIVATE in outer context"_err_en_US,
6672 parser::ToUpperCaseLetters(getClauseName(currClause).str()),
6673 symbol->name());
6674 }
6675 }
6676 }
6677 }
6678}
6679
6680bool OmpStructureChecker::CheckTargetBlockOnlyTeams(
6681 const parser::Block &block) {
6682 bool nestedTeams{false};
6683
6684 if (!block.empty()) {
6685 auto it{block.begin()};
6686 if (const auto *ompConstruct{
6687 parser::Unwrap<parser::OpenMPConstruct>(*it)}) {
6688 if (const auto *ompBlockConstruct{
6689 std::get_if<parser::OpenMPBlockConstruct>(&ompConstruct->u)}) {
6690 const auto &beginBlockDir{
6691 std::get<parser::OmpBeginBlockDirective>(ompBlockConstruct->t)};
6692 const auto &beginDir{
6693 std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
6694 if (beginDir.v == llvm::omp::Directive::OMPD_teams) {
6695 nestedTeams = true;
6696 }
6697 }
6698 }
6699
6700 if (nestedTeams && ++it == block.end()) {
6701 return true;
6702 }
6703 }
6704
6705 return false;
6706}
6707
6708void OmpStructureChecker::CheckWorkshareBlockStmts(
6709 const parser::Block &block, parser::CharBlock source) {
6710 OmpWorkshareBlockChecker ompWorkshareBlockChecker{context_, source};
6711
6712 for (auto it{block.begin()}; it != block.end(); ++it) {
6713 if (parser::Unwrap<parser::AssignmentStmt>(*it) ||
6714 parser::Unwrap<parser::ForallStmt>(*it) ||
6715 parser::Unwrap<parser::ForallConstruct>(*it) ||
6716 parser::Unwrap<parser::WhereStmt>(*it) ||
6717 parser::Unwrap<parser::WhereConstruct>(*it)) {
6718 parser::Walk(*it, ompWorkshareBlockChecker);
6719 } else if (const auto *ompConstruct{
6720 parser::Unwrap<parser::OpenMPConstruct>(*it)}) {
6721 if (const auto *ompAtomicConstruct{
6722 std::get_if<parser::OpenMPAtomicConstruct>(&ompConstruct->u)}) {
6723 // Check if assignment statements in the enclosing OpenMP Atomic
6724 // construct are allowed in the Workshare construct
6725 parser::Walk(*ompAtomicConstruct, ompWorkshareBlockChecker);
6726 } else if (const auto *ompCriticalConstruct{
6727 std::get_if<parser::OpenMPCriticalConstruct>(
6728 &ompConstruct->u)}) {
6729 // All the restrictions on the Workshare construct apply to the
6730 // statements in the enclosing critical constructs
6731 const auto &criticalBlock{
6732 std::get<parser::Block>(ompCriticalConstruct->t)};
6733 CheckWorkshareBlockStmts(criticalBlock, source);
6734 } else {
6735 // Check if OpenMP constructs enclosed in the Workshare construct are
6736 // 'Parallel' constructs
6737 auto currentDir{llvm::omp::Directive::OMPD_unknown};
6738 if (const auto *ompBlockConstruct{
6739 std::get_if<parser::OpenMPBlockConstruct>(&ompConstruct->u)}) {
6740 const auto &beginBlockDir{
6741 std::get<parser::OmpBeginBlockDirective>(ompBlockConstruct->t)};
6742 const auto &beginDir{
6743 std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
6744 currentDir = beginDir.v;
6745 } else if (const auto *ompLoopConstruct{
6746 std::get_if<parser::OpenMPLoopConstruct>(
6747 &ompConstruct->u)}) {
6748 const auto &beginLoopDir{
6749 std::get<parser::OmpBeginLoopDirective>(ompLoopConstruct->t)};
6750 const auto &beginDir{
6751 std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
6752 currentDir = beginDir.v;
6753 } else if (const auto *ompSectionsConstruct{
6754 std::get_if<parser::OpenMPSectionsConstruct>(
6755 &ompConstruct->u)}) {
6756 const auto &beginSectionsDir{
6757 std::get<parser::OmpBeginSectionsDirective>(
6758 ompSectionsConstruct->t)};
6759 const auto &beginDir{
6760 std::get<parser::OmpSectionsDirective>(beginSectionsDir.t)};
6761 currentDir = beginDir.v;
6762 }
6763
6764 if (!llvm::omp::topParallelSet.test(currentDir)) {
6765 context_.Say(source,
6766 "OpenMP constructs enclosed in WORKSHARE construct may consist "
6767 "of ATOMIC, CRITICAL or PARALLEL constructs only"_err_en_US);
6768 }
6769 }
6770 } else {
6771 context_.Say(source,
6772 "The structured block in a WORKSHARE construct may consist of only "
6773 "SCALAR or ARRAY assignments, FORALL or WHERE statements, "
6774 "FORALL, WHERE, ATOMIC, CRITICAL or PARALLEL constructs"_err_en_US);
6775 }
6776 }
6777}
6778
6779void OmpStructureChecker::CheckIfContiguous(const parser::OmpObject &object) {
6780 if (auto contig{IsContiguous(object)}; contig && !*contig) {
6781 const parser::Name *name{GetObjectName(object)};
6782 assert(name && "Expecting name component");
6783 context_.Say(name->source,
6784 "Reference to '%s' must be a contiguous object"_err_en_US,
6785 name->ToString());
6786 }
6787}
6788
6789namespace {
6790struct NameHelper {
6791 template <typename T>
6792 static const parser::Name *Visit(const common::Indirection<T> &x) {
6793 return Visit(x.value());
6794 }
6795 static const parser::Name *Visit(const parser::Substring &x) {
6796 return Visit(std::get<parser::DataRef>(x.t));
6797 }
6798 static const parser::Name *Visit(const parser::ArrayElement &x) {
6799 return Visit(x.base);
6800 }
6801 static const parser::Name *Visit(const parser::Designator &x) {
6802 return common::visit([](auto &&s) { return Visit(s); }, x.u);
6803 }
6804 static const parser::Name *Visit(const parser::DataRef &x) {
6805 return common::visit([](auto &&s) { return Visit(s); }, x.u);
6806 }
6807 static const parser::Name *Visit(const parser::OmpObject &x) {
6808 return common::visit([](auto &&s) { return Visit(s); }, x.u);
6809 }
6810 template <typename T> static const parser::Name *Visit(T &&) {
6811 return nullptr;
6812 }
6813 static const parser::Name *Visit(const parser::Name &x) { return &x; }
6814};
6815} // namespace
6816
6817const parser::Name *OmpStructureChecker::GetObjectName(
6818 const parser::OmpObject &object) {
6819 return NameHelper::Visit(object);
6820}
6821
6822const parser::OmpObjectList *OmpStructureChecker::GetOmpObjectList(
6823 const parser::OmpClause &clause) {
6824
6825 // Clauses with OmpObjectList as its data member
6826 using MemberObjectListClauses = std::tuple<parser::OmpClause::Copyprivate,
6827 parser::OmpClause::Copyin, parser::OmpClause::Enter,
6828 parser::OmpClause::Firstprivate, parser::OmpClause::Link,
6829 parser::OmpClause::Private, parser::OmpClause::Shared,
6830 parser::OmpClause::UseDevicePtr, parser::OmpClause::UseDeviceAddr>;
6831
6832 // Clauses with OmpObjectList in the tuple
6833 using TupleObjectListClauses = std::tuple<parser::OmpClause::Aligned,
6834 parser::OmpClause::Allocate, parser::OmpClause::From,
6835 parser::OmpClause::Lastprivate, parser::OmpClause::Map,
6836 parser::OmpClause::Reduction, parser::OmpClause::To>;
6837
6838 // TODO:: Generate the tuples using TableGen.
6839 // Handle other constructs with OmpObjectList such as OpenMPThreadprivate.
6840 return common::visit(
6841 common::visitors{
6842 [&](const auto &x) -> const parser::OmpObjectList * {
6843 using Ty = std::decay_t<decltype(x)>;
6844 if constexpr (common::HasMember<Ty, MemberObjectListClauses>) {
6845 return &x.v;
6846 } else if constexpr (common::HasMember<Ty,
6847 TupleObjectListClauses>) {
6848 return &(std::get<parser::OmpObjectList>(x.v.t));
6849 } else {
6850 return nullptr;
6851 }
6852 },
6853 },
6854 clause.u);
6855}
6856
6857void OmpStructureChecker::Enter(
6858 const parser::OmpClause::AtomicDefaultMemOrder &x) {
6859 CheckAllowedRequiresClause(llvm::omp::Clause::OMPC_atomic_default_mem_order);
6860}
6861
6862void OmpStructureChecker::Enter(const parser::OmpClause::DynamicAllocators &x) {
6863 CheckAllowedRequiresClause(llvm::omp::Clause::OMPC_dynamic_allocators);
6864}
6865
6866void OmpStructureChecker::Enter(const parser::OmpClause::ReverseOffload &x) {
6867 CheckAllowedRequiresClause(llvm::omp::Clause::OMPC_reverse_offload);
6868}
6869
6870void OmpStructureChecker::Enter(const parser::OmpClause::UnifiedAddress &x) {
6871 CheckAllowedRequiresClause(llvm::omp::Clause::OMPC_unified_address);
6872}
6873
6874void OmpStructureChecker::Enter(
6875 const parser::OmpClause::UnifiedSharedMemory &x) {
6876 CheckAllowedRequiresClause(llvm::omp::Clause::OMPC_unified_shared_memory);
6877}
6878
6879void OmpStructureChecker::Enter(const parser::OmpClause::SelfMaps &x) {
6880 CheckAllowedRequiresClause(llvm::omp::Clause::OMPC_self_maps);
6881}
6882
6883void OmpStructureChecker::Enter(const parser::DoConstruct &x) {
6884 Base::Enter(x);
6885 loopStack_.push_back(&x);
6886}
6887
6888void OmpStructureChecker::Leave(const parser::DoConstruct &x) {
6889 assert(!loopStack_.empty() && "Expecting non-empty loop stack");
6890#ifndef NDEBUG
6891 const LoopConstruct &top = loopStack_.back();
6892 auto *doc{std::get_if<const parser::DoConstruct *>(&top)};
6893 assert(doc != nullptr && *doc == &x && "Mismatched loop constructs");
6894#endif
6895 loopStack_.pop_back();
6896 Base::Leave(x);
6897}
6898
6899void OmpStructureChecker::Enter(const parser::OpenMPInteropConstruct &x) {
6900 bool isDependClauseOccured{false};
6901 int targetCount{0}, targetSyncCount{0};
6902 const auto &dir{std::get<parser::OmpDirectiveName>(x.v.t)};
6903 std::set<const Symbol *> objectSymbolList;
6904 PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_interop);
6905 const auto &clauseList{std::get<std::optional<parser::OmpClauseList>>(x.v.t)};
6906 for (const auto &clause : clauseList->v) {
6907 common::visit(
6908 common::visitors{
6909 [&](const parser::OmpClause::Init &initClause) {
6910 if (OmpVerifyModifiers(initClause.v, llvm::omp::OMPC_init,
6911 GetContext().directiveSource, context_)) {
6912
6913 auto &modifiers{OmpGetModifiers(initClause.v)};
6914 auto &&interopTypeModifier{
6915 OmpGetRepeatableModifier<parser::OmpInteropType>(
6916 modifiers)};
6917 for (const auto &it : interopTypeModifier) {
6918 if (it->v == parser::OmpInteropType::Value::TargetSync) {
6919 ++targetSyncCount;
6920 } else {
6921 ++targetCount;
6922 }
6923 }
6924 }
6925 const auto &interopVar{parser::Unwrap<parser::OmpObject>(
6926 std::get<parser::OmpObject>(initClause.v.t))};
6927 const auto *name{parser::Unwrap<parser::Name>(interopVar)};
6928 const auto *objectSymbol{name->symbol};
6929 if (llvm::is_contained(objectSymbolList, objectSymbol)) {
6930 context_.Say(GetContext().directiveSource,
6931 "Each interop-var may be specified for at most one action-clause of each INTEROP construct."_err_en_US);
6932 } else {
6933 objectSymbolList.insert(objectSymbol);
6934 }
6935 },
6936 [&](const parser::OmpClause::Depend &dependClause) {
6937 isDependClauseOccured = true;
6938 },
6939 [&](const parser::OmpClause::Destroy &destroyClause) {
6940 const auto &interopVar{
6941 parser::Unwrap<parser::OmpObject>(destroyClause.v)};
6942 const auto *name{parser::Unwrap<parser::Name>(interopVar)};
6943 const auto *objectSymbol{name->symbol};
6944 if (llvm::is_contained(objectSymbolList, objectSymbol)) {
6945 context_.Say(GetContext().directiveSource,
6946 "Each interop-var may be specified for at most one action-clause of each INTEROP construct."_err_en_US);
6947 } else {
6948 objectSymbolList.insert(objectSymbol);
6949 }
6950 },
6951 [&](const parser::OmpClause::Use &useClause) {
6952 const auto &interopVar{
6953 parser::Unwrap<parser::OmpObject>(useClause.v)};
6954 const auto *name{parser::Unwrap<parser::Name>(interopVar)};
6955 const auto *objectSymbol{name->symbol};
6956 if (llvm::is_contained(objectSymbolList, objectSymbol)) {
6957 context_.Say(GetContext().directiveSource,
6958 "Each interop-var may be specified for at most one action-clause of each INTEROP construct."_err_en_US);
6959 } else {
6960 objectSymbolList.insert(objectSymbol);
6961 }
6962 },
6963 [&](const auto &) {},
6964 },
6965 clause.u);
6966 }
6967 if (targetCount > 1 || targetSyncCount > 1) {
6968 context_.Say(GetContext().directiveSource,
6969 "Each interop-type may be specified at most once."_err_en_US);
6970 }
6971 if (isDependClauseOccured && !targetSyncCount) {
6972 context_.Say(GetContext().directiveSource,
6973 "A DEPEND clause can only appear on the directive if the interop-type includes TARGETSYNC"_err_en_US);
6974 }
6975}
6976
6977void OmpStructureChecker::Leave(const parser::OpenMPInteropConstruct &) {
6978 dirContext_.pop_back();
6979}
6980
6981void OmpStructureChecker::CheckAllowedRequiresClause(llvmOmpClause clause) {
6982 CheckAllowedClause(clause);
6983
6984 if (clause != llvm::omp::Clause::OMPC_atomic_default_mem_order) {
6985 // Check that it does not appear after a device construct
6986 if (deviceConstructFound_) {
6987 context_.Say(GetContext().clauseSource,
6988 "REQUIRES directive with '%s' clause found lexically after device "
6989 "construct"_err_en_US,
6990 parser::ToUpperCaseLetters(getClauseName(clause).str()));
6991 }
6992 }
6993}
6994
6995} // namespace Fortran::semantics
6996

Provided by KDAB

Privacy Policy
Learn to use CMake with our Intro Training
Find out more

source code of flang/lib/Semantics/check-omp-structure.cpp