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