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