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