1 //===-- lib/Semantics/check-omp-structure.cpp -----------------------------===//
2 //
3 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
4 // See https://llvm.org/LICENSE.txt for license information.
5 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
6 //
7 //===----------------------------------------------------------------------===//
8 
9 #include "check-omp-structure.h"
10 #include "flang/Parser/parse-tree.h"
11 #include "flang/Semantics/tools.h"
12 #include <algorithm>
13 
14 namespace Fortran::semantics {
15 
16 // Use when clause falls under 'struct OmpClause' in 'parse-tree.h'.
17 #define CHECK_SIMPLE_CLAUSE(X, Y) \
18   void OmpStructureChecker::Enter(const parser::OmpClause::X &) { \
19     CheckAllowed(llvm::omp::Clause::Y); \
20   }
21 
22 #define CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(X, Y) \
23   void OmpStructureChecker::Enter(const parser::OmpClause::X &c) { \
24     CheckAllowed(llvm::omp::Clause::Y); \
25     RequiresConstantPositiveParameter(llvm::omp::Clause::Y, c.v); \
26   }
27 
28 #define CHECK_REQ_SCALAR_INT_CLAUSE(X, Y) \
29   void OmpStructureChecker::Enter(const parser::OmpClause::X &c) { \
30     CheckAllowed(llvm::omp::Clause::Y); \
31     RequiresPositiveParameter(llvm::omp::Clause::Y, c.v); \
32   }
33 
34 // Use when clause don't falls under 'struct OmpClause' in 'parse-tree.h'.
35 #define CHECK_SIMPLE_PARSER_CLAUSE(X, Y) \
36   void OmpStructureChecker::Enter(const parser::X &) { \
37     CheckAllowed(llvm::omp::Y); \
38   }
39 
40 // 'OmpWorkshareBlockChecker' is used to check the validity of the assignment
41 // statements and the expressions enclosed in an OpenMP Workshare construct
42 class OmpWorkshareBlockChecker {
43 public:
OmpWorkshareBlockChecker(SemanticsContext & context,parser::CharBlock source)44   OmpWorkshareBlockChecker(SemanticsContext &context, parser::CharBlock source)
45       : context_{context}, source_{source} {}
46 
Pre(const T &)47   template <typename T> bool Pre(const T &) { return true; }
Post(const T &)48   template <typename T> void Post(const T &) {}
49 
Pre(const parser::AssignmentStmt & assignment)50   bool Pre(const parser::AssignmentStmt &assignment) {
51     const auto &var{std::get<parser::Variable>(assignment.t)};
52     const auto &expr{std::get<parser::Expr>(assignment.t)};
53     const auto *lhs{GetExpr(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 
Pre(const parser::Expr & expr)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:
OmpCycleChecker(SemanticsContext & context,std::int64_t cycleLevel)91   OmpCycleChecker(SemanticsContext &context, std::int64_t cycleLevel)
92       : context_{context}, cycleLevel_{cycleLevel} {}
93 
Pre(const T &)94   template <typename T> bool Pre(const T &) { return true; }
Post(const T &)95   template <typename T> void Post(const T &) {}
96 
Pre(const parser::DoConstruct & dc)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 
Pre(const parser::CycleStmt & cyclestmt)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 
Pre(const parser::Statement<parser::ActionStmt> & actionstmt)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 
IsCloselyNestedRegion(const OmpDirectiveSet & set)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 
HasInvalidWorksharingNesting(const parser::CharBlock & source,const OmpDirectiveSet & set)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 
HasInvalidDistributeNesting(const parser::OpenMPLoopConstruct & x)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 
HasInvalidTeamsNesting(const llvm::omp::Directive & dir,const parser::CharBlock & source)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 
CheckPredefinedAllocatorRestriction(const parser::CharBlock & source,const parser::Name & name)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 
CheckPredefinedAllocatorRestriction(const parser::CharBlock & source,const parser::OmpObjectList & ompObjectList)261 void OmpStructureChecker::CheckPredefinedAllocatorRestriction(
262     const parser::CharBlock &source,
263     const parser::OmpObjectList &ompObjectList) {
264   for (const auto &ompObject : ompObjectList.v) {
265     std::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 
Enter(const parser::OpenMPConstruct & x)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 
Enter(const parser::OpenMPLoopConstruct & x)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 }
GetLoopIndex(const parser::DoConstruct * x)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 }
SetLoopInfo(const parser::OpenMPLoopConstruct & x)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 }
CheckDoWhile(const parser::OpenMPLoopConstruct & x)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 
CheckLoopItrVariableIsInt(const parser::OpenMPLoopConstruct & x)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 
CheckSIMDNest(const parser::OpenMPConstruct & c)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   std::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{std::get<parser::OmpClauseList>(c.t)};
446                      for (const auto &clause : clauses.v) {
447                        if (std::get_if<parser::OmpClause::Simd>(&clause.u)) {
448                          eligibleSIMD = true;
449                          break;
450                        }
451                      }
452                    }
453                  },
454                  // Allowing SIMD construct
455                  [&](const parser::OpenMPLoopConstruct &c) {
456                    const auto &beginLoopDir{
457                        std::get<parser::OmpBeginLoopDirective>(c.t)};
458                    const auto &beginDir{
459                        std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
460                    if ((beginDir.v == llvm::omp::Directive::OMPD_simd) ||
461                        (beginDir.v == llvm::omp::Directive::OMPD_do_simd)) {
462                      eligibleSIMD = true;
463                    }
464                  },
465                  [&](const parser::OpenMPAtomicConstruct &c) {
466                    // Allow `!$OMP ATOMIC`
467                    eligibleSIMD = true;
468                  },
469                  [&](const auto &c) {},
470              },
471       c.u);
472   if (!eligibleSIMD) {
473     context_.Say(parser::FindSourceLocation(c),
474         "The only OpenMP constructs that can be encountered during execution "
475         "of a 'SIMD'"
476         " region are the `ATOMIC` construct, the `LOOP` construct, the `SIMD`"
477         " construct and the `ORDERED` construct with the `SIMD` clause."_err_en_US);
478   }
479 }
480 
CheckTargetNest(const parser::OpenMPConstruct & c)481 void OmpStructureChecker::CheckTargetNest(const parser::OpenMPConstruct &c) {
482   // 2.12.5 Target Construct Restriction
483   bool eligibleTarget{true};
484   llvm::omp::Directive ineligibleTargetDir;
485   std::visit(
486       common::visitors{
487           [&](const parser::OpenMPBlockConstruct &c) {
488             const auto &beginBlockDir{
489                 std::get<parser::OmpBeginBlockDirective>(c.t)};
490             const auto &beginDir{
491                 std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
492             if (beginDir.v == llvm::omp::Directive::OMPD_target_data) {
493               eligibleTarget = false;
494               ineligibleTargetDir = beginDir.v;
495             }
496           },
497           [&](const parser::OpenMPStandaloneConstruct &c) {
498             std::visit(
499                 common::visitors{
500                     [&](const parser::OpenMPSimpleStandaloneConstruct &c) {
501                       const auto &dir{
502                           std::get<parser::OmpSimpleStandaloneDirective>(c.t)};
503                       if (dir.v == llvm::omp::Directive::OMPD_target_update ||
504                           dir.v ==
505                               llvm::omp::Directive::OMPD_target_enter_data ||
506                           dir.v ==
507                               llvm::omp::Directive::OMPD_target_exit_data) {
508                         eligibleTarget = false;
509                         ineligibleTargetDir = dir.v;
510                       }
511                     },
512                     [&](const auto &c) {},
513                 },
514                 c.u);
515           },
516           [&](const auto &c) {},
517       },
518       c.u);
519   if (!eligibleTarget) {
520     context_.Say(parser::FindSourceLocation(c),
521         "If %s directive is nested inside TARGET region, the behaviour "
522         "is unspecified"_en_US,
523         parser::ToUpperCaseLetters(
524             getDirectiveName(ineligibleTargetDir).str()));
525   }
526 }
527 
GetOrdCollapseLevel(const parser::OpenMPLoopConstruct & x)528 std::int64_t OmpStructureChecker::GetOrdCollapseLevel(
529     const parser::OpenMPLoopConstruct &x) {
530   const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
531   const auto &clauseList{std::get<parser::OmpClauseList>(beginLoopDir.t)};
532   std::int64_t orderedCollapseLevel{1};
533   std::int64_t orderedLevel{0};
534   std::int64_t collapseLevel{0};
535 
536   for (const auto &clause : clauseList.v) {
537     if (const auto *collapseClause{
538             std::get_if<parser::OmpClause::Collapse>(&clause.u)}) {
539       if (const auto v{GetIntValue(collapseClause->v)}) {
540         collapseLevel = *v;
541       }
542     }
543     if (const auto *orderedClause{
544             std::get_if<parser::OmpClause::Ordered>(&clause.u)}) {
545       if (const auto v{GetIntValue(orderedClause->v)}) {
546         orderedLevel = *v;
547       }
548     }
549   }
550   if (orderedLevel >= collapseLevel) {
551     orderedCollapseLevel = orderedLevel;
552   } else {
553     orderedCollapseLevel = collapseLevel;
554   }
555   return orderedCollapseLevel;
556 }
557 
CheckCycleConstraints(const parser::OpenMPLoopConstruct & x)558 void OmpStructureChecker::CheckCycleConstraints(
559     const parser::OpenMPLoopConstruct &x) {
560   std::int64_t ordCollapseLevel{GetOrdCollapseLevel(x)};
561   OmpCycleChecker ompCycleChecker{context_, ordCollapseLevel};
562   parser::Walk(x, ompCycleChecker);
563 }
564 
CheckDistLinear(const parser::OpenMPLoopConstruct & x)565 void OmpStructureChecker::CheckDistLinear(
566     const parser::OpenMPLoopConstruct &x) {
567 
568   const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
569   const auto &clauses{std::get<parser::OmpClauseList>(beginLoopDir.t)};
570 
571   semantics::UnorderedSymbolSet indexVars;
572 
573   // Collect symbols of all the variables from linear clauses
574   for (const auto &clause : clauses.v) {
575     if (const auto *linearClause{
576             std::get_if<parser::OmpClause::Linear>(&clause.u)}) {
577 
578       std::list<parser::Name> values;
579       // Get the variant type
580       if (std::holds_alternative<parser::OmpLinearClause::WithModifier>(
581               linearClause->v.u)) {
582         const auto &withM{
583             std::get<parser::OmpLinearClause::WithModifier>(linearClause->v.u)};
584         values = withM.names;
585       } else {
586         const auto &withOutM{std::get<parser::OmpLinearClause::WithoutModifier>(
587             linearClause->v.u)};
588         values = withOutM.names;
589       }
590       for (auto const &v : values) {
591         indexVars.insert(*(v.symbol));
592       }
593     }
594   }
595 
596   if (!indexVars.empty()) {
597     // Get collapse level, if given, to find which loops are "associated."
598     std::int64_t collapseVal{GetOrdCollapseLevel(x)};
599     // Include the top loop if no collapse is specified
600     if (collapseVal == 0) {
601       collapseVal = 1;
602     }
603 
604     // Match the loop index variables with the collected symbols from linear
605     // clauses.
606     if (const auto &loopConstruct{
607             std::get<std::optional<parser::DoConstruct>>(x.t)}) {
608       for (const parser::DoConstruct *loop{&*loopConstruct}; loop;) {
609         if (loop->IsDoNormal()) {
610           const parser::Name &itrVal{GetLoopIndex(loop)};
611           if (itrVal.symbol) {
612             // Remove the symbol from the collcted set
613             indexVars.erase(*(itrVal.symbol));
614           }
615           collapseVal--;
616           if (collapseVal == 0) {
617             break;
618           }
619         }
620         // Get the next DoConstruct if block is not empty.
621         const auto &block{std::get<parser::Block>(loop->t)};
622         const auto it{block.begin()};
623         loop = it != block.end() ? parser::Unwrap<parser::DoConstruct>(*it)
624                                  : nullptr;
625       }
626     }
627 
628     // Show error for the remaining variables
629     for (auto var : indexVars) {
630       const Symbol &root{GetAssociationRoot(var)};
631       context_.Say(parser::FindSourceLocation(x),
632           "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,
633           root.name());
634     }
635   }
636 }
637 
Leave(const parser::OpenMPLoopConstruct &)638 void OmpStructureChecker::Leave(const parser::OpenMPLoopConstruct &) {
639   if (llvm::omp::simdSet.test(GetContext().directive)) {
640     ExitDirectiveNest(SIMDNest);
641   }
642   dirContext_.pop_back();
643 }
644 
Enter(const parser::OmpEndLoopDirective & x)645 void OmpStructureChecker::Enter(const parser::OmpEndLoopDirective &x) {
646   const auto &dir{std::get<parser::OmpLoopDirective>(x.t)};
647   ResetPartialContext(dir.source);
648   switch (dir.v) {
649   // 2.7.1 end-do -> END DO [nowait-clause]
650   // 2.8.3 end-do-simd -> END DO SIMD [nowait-clause]
651   case llvm::omp::Directive::OMPD_do:
652   case llvm::omp::Directive::OMPD_do_simd:
653     SetClauseSets(dir.v);
654     break;
655   default:
656     // no clauses are allowed
657     break;
658   }
659 }
660 
Enter(const parser::OpenMPBlockConstruct & x)661 void OmpStructureChecker::Enter(const parser::OpenMPBlockConstruct &x) {
662   const auto &beginBlockDir{std::get<parser::OmpBeginBlockDirective>(x.t)};
663   const auto &endBlockDir{std::get<parser::OmpEndBlockDirective>(x.t)};
664   const auto &beginDir{std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
665   const auto &endDir{std::get<parser::OmpBlockDirective>(endBlockDir.t)};
666   const parser::Block &block{std::get<parser::Block>(x.t)};
667 
668   CheckMatching<parser::OmpBlockDirective>(beginDir, endDir);
669 
670   PushContextAndClauseSets(beginDir.source, beginDir.v);
671   if (GetContext().directive == llvm::omp::Directive::OMPD_target) {
672     EnterDirectiveNest(TargetNest);
673   }
674 
675   if (CurrentDirectiveIsNested()) {
676     CheckIfDoOrderedClause(beginDir);
677     if (llvm::omp::teamSet.test(GetContextParent().directive)) {
678       HasInvalidTeamsNesting(beginDir.v, beginDir.source);
679     }
680     if (GetContext().directive == llvm::omp::Directive::OMPD_master) {
681       CheckMasterNesting(x);
682     }
683     // A teams region can only be strictly nested within the implicit parallel
684     // region or a target region.
685     if (GetContext().directive == llvm::omp::Directive::OMPD_teams &&
686         GetContextParent().directive != llvm::omp::Directive::OMPD_target) {
687       context_.Say(parser::FindSourceLocation(x),
688           "%s region can only be strictly nested within the implicit parallel "
689           "region or TARGET region"_err_en_US,
690           ContextDirectiveAsFortran());
691     }
692     // If a teams construct is nested within a target construct, that target
693     // construct must contain no statements, declarations or directives outside
694     // of the teams construct.
695     if (GetContext().directive == llvm::omp::Directive::OMPD_teams &&
696         GetContextParent().directive == llvm::omp::Directive::OMPD_target &&
697         !GetDirectiveNest(TargetBlockOnlyTeams)) {
698       context_.Say(GetContextParent().directiveSource,
699           "TARGET construct with nested TEAMS region contains statements or "
700           "directives outside of the TEAMS construct"_err_en_US);
701     }
702   }
703 
704   CheckNoBranching(block, beginDir.v, beginDir.source);
705 
706   switch (beginDir.v) {
707   case llvm::omp::Directive::OMPD_target:
708     if (CheckTargetBlockOnlyTeams(block)) {
709       EnterDirectiveNest(TargetBlockOnlyTeams);
710     }
711     break;
712   case llvm::omp::OMPD_workshare:
713   case llvm::omp::OMPD_parallel_workshare:
714     CheckWorkshareBlockStmts(block, beginDir.source);
715     HasInvalidWorksharingNesting(
716         beginDir.source, llvm::omp::nestedWorkshareErrSet);
717     break;
718   case llvm::omp::Directive::OMPD_single:
719     // TODO: This check needs to be extended while implementing nesting of
720     // regions checks.
721     HasInvalidWorksharingNesting(
722         beginDir.source, llvm::omp::nestedWorkshareErrSet);
723     break;
724   default:
725     break;
726   }
727 }
728 
CheckMasterNesting(const parser::OpenMPBlockConstruct & x)729 void OmpStructureChecker::CheckMasterNesting(
730     const parser::OpenMPBlockConstruct &x) {
731   // A MASTER region may not be `closely nested` inside a worksharing, loop,
732   // task, taskloop, or atomic region.
733   // TODO:  Expand the check to include `LOOP` construct as well when it is
734   // supported.
735   if (IsCloselyNestedRegion(llvm::omp::nestedMasterErrSet)) {
736     context_.Say(parser::FindSourceLocation(x),
737         "`MASTER` region may not be closely nested inside of `WORKSHARING`, "
738         "`LOOP`, `TASK`, `TASKLOOP`,"
739         " or `ATOMIC` region."_err_en_US);
740   }
741 }
742 
CheckIfDoOrderedClause(const parser::OmpBlockDirective & blkDirective)743 void OmpStructureChecker::CheckIfDoOrderedClause(
744     const parser::OmpBlockDirective &blkDirective) {
745   if (blkDirective.v == llvm::omp::OMPD_ordered) {
746     // Loops
747     if (llvm::omp::doSet.test(GetContextParent().directive) &&
748         !FindClauseParent(llvm::omp::Clause::OMPC_ordered)) {
749       context_.Say(blkDirective.source,
750           "The ORDERED clause must be present on the loop"
751           " construct if any ORDERED region ever binds"
752           " to a loop region arising from the loop construct."_err_en_US);
753     }
754     // Other disallowed nestings, these directives do not support
755     // ordered clause in them, so no need to check
756     else if (IsCloselyNestedRegion(llvm::omp::nestedOrderedErrSet)) {
757       context_.Say(blkDirective.source,
758           "`ORDERED` region may not be closely nested inside of "
759           "`CRITICAL`, `ORDERED`, explicit `TASK` or `TASKLOOP` region."_err_en_US);
760     }
761   }
762 }
763 
Leave(const parser::OpenMPBlockConstruct &)764 void OmpStructureChecker::Leave(const parser::OpenMPBlockConstruct &) {
765   if (GetDirectiveNest(TargetBlockOnlyTeams)) {
766     ExitDirectiveNest(TargetBlockOnlyTeams);
767   }
768   if (GetContext().directive == llvm::omp::Directive::OMPD_target) {
769     ExitDirectiveNest(TargetNest);
770   }
771   dirContext_.pop_back();
772 }
773 
ChecksOnOrderedAsBlock()774 void OmpStructureChecker::ChecksOnOrderedAsBlock() {
775   if (FindClause(llvm::omp::Clause::OMPC_depend)) {
776     context_.Say(GetContext().clauseSource,
777         "DEPEND(*) clauses are not allowed when ORDERED construct is a block"
778         " construct with an ORDERED region"_err_en_US);
779   }
780 }
781 
Leave(const parser::OmpBeginBlockDirective &)782 void OmpStructureChecker::Leave(const parser::OmpBeginBlockDirective &) {
783   switch (GetContext().directive) {
784   case llvm::omp::Directive::OMPD_ordered:
785     // [5.1] 2.19.9 Ordered Construct Restriction
786     ChecksOnOrderedAsBlock();
787     break;
788   default:
789     break;
790   }
791 }
792 
Enter(const parser::OpenMPSectionsConstruct & x)793 void OmpStructureChecker::Enter(const parser::OpenMPSectionsConstruct &x) {
794   const auto &beginSectionsDir{
795       std::get<parser::OmpBeginSectionsDirective>(x.t)};
796   const auto &endSectionsDir{std::get<parser::OmpEndSectionsDirective>(x.t)};
797   const auto &beginDir{
798       std::get<parser::OmpSectionsDirective>(beginSectionsDir.t)};
799   const auto &endDir{std::get<parser::OmpSectionsDirective>(endSectionsDir.t)};
800   CheckMatching<parser::OmpSectionsDirective>(beginDir, endDir);
801 
802   PushContextAndClauseSets(beginDir.source, beginDir.v);
803   const auto &sectionBlocks{std::get<parser::OmpSectionBlocks>(x.t)};
804   for (const auto &block : sectionBlocks.v) {
805     CheckNoBranching(block, beginDir.v, beginDir.source);
806   }
807   HasInvalidWorksharingNesting(
808       beginDir.source, llvm::omp::nestedWorkshareErrSet);
809 }
810 
Leave(const parser::OpenMPSectionsConstruct &)811 void OmpStructureChecker::Leave(const parser::OpenMPSectionsConstruct &) {
812   dirContext_.pop_back();
813 }
814 
Enter(const parser::OmpEndSectionsDirective & x)815 void OmpStructureChecker::Enter(const parser::OmpEndSectionsDirective &x) {
816   const auto &dir{std::get<parser::OmpSectionsDirective>(x.t)};
817   ResetPartialContext(dir.source);
818   switch (dir.v) {
819     // 2.7.2 end-sections -> END SECTIONS [nowait-clause]
820   case llvm::omp::Directive::OMPD_sections:
821     PushContextAndClauseSets(
822         dir.source, llvm::omp::Directive::OMPD_end_sections);
823     break;
824   default:
825     // no clauses are allowed
826     break;
827   }
828 }
829 
830 // TODO: Verify the popping of dirContext requirement after nowait
831 // implementation, as there is an implicit barrier at the end of the worksharing
832 // constructs unless a nowait clause is specified. Only OMPD_end_sections is
833 // popped becuase it is pushed while entering the EndSectionsDirective.
Leave(const parser::OmpEndSectionsDirective & x)834 void OmpStructureChecker::Leave(const parser::OmpEndSectionsDirective &x) {
835   if (GetContext().directive == llvm::omp::Directive::OMPD_end_sections) {
836     dirContext_.pop_back();
837   }
838 }
839 
Enter(const parser::OpenMPThreadprivate & c)840 void OmpStructureChecker::Enter(const parser::OpenMPThreadprivate &c) {
841   const auto &dir{std::get<parser::Verbatim>(c.t)};
842   PushContextAndClauseSets(
843       dir.source, llvm::omp::Directive::OMPD_threadprivate);
844 }
845 
Leave(const parser::OpenMPThreadprivate & c)846 void OmpStructureChecker::Leave(const parser::OpenMPThreadprivate &c) {
847   const auto &dir{std::get<parser::Verbatim>(c.t)};
848   const auto &objectList{std::get<parser::OmpObjectList>(c.t)};
849   CheckIsVarPartOfAnotherVar(dir.source, objectList);
850   dirContext_.pop_back();
851 }
852 
Enter(const parser::OpenMPDeclareSimdConstruct & x)853 void OmpStructureChecker::Enter(const parser::OpenMPDeclareSimdConstruct &x) {
854   const auto &dir{std::get<parser::Verbatim>(x.t)};
855   PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_declare_simd);
856 }
857 
Leave(const parser::OpenMPDeclareSimdConstruct &)858 void OmpStructureChecker::Leave(const parser::OpenMPDeclareSimdConstruct &) {
859   dirContext_.pop_back();
860 }
861 
Enter(const parser::OpenMPDeclarativeAllocate & x)862 void OmpStructureChecker::Enter(const parser::OpenMPDeclarativeAllocate &x) {
863   isPredefinedAllocator = true;
864   const auto &dir{std::get<parser::Verbatim>(x.t)};
865   const auto &objectList{std::get<parser::OmpObjectList>(x.t)};
866   PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_allocate);
867   CheckIsVarPartOfAnotherVar(dir.source, objectList);
868 }
869 
Leave(const parser::OpenMPDeclarativeAllocate & x)870 void OmpStructureChecker::Leave(const parser::OpenMPDeclarativeAllocate &x) {
871   const auto &dir{std::get<parser::Verbatim>(x.t)};
872   const auto &objectList{std::get<parser::OmpObjectList>(x.t)};
873   CheckPredefinedAllocatorRestriction(dir.source, objectList);
874   dirContext_.pop_back();
875 }
876 
Enter(const parser::OmpClause::Allocator & x)877 void OmpStructureChecker::Enter(const parser::OmpClause::Allocator &x) {
878   CheckAllowed(llvm::omp::Clause::OMPC_allocator);
879   // Note: Predefined allocators are stored in ScalarExpr as numbers
880   //   whereas custom allocators are stored as strings, so if the ScalarExpr
881   //   actually has an int value, then it must be a predefined allocator
882   isPredefinedAllocator = GetIntValue(x.v).has_value();
883   RequiresPositiveParameter(llvm::omp::Clause::OMPC_allocator, x.v);
884 }
885 
Enter(const parser::OpenMPDeclareTargetConstruct & x)886 void OmpStructureChecker::Enter(const parser::OpenMPDeclareTargetConstruct &x) {
887   const auto &dir{std::get<parser::Verbatim>(x.t)};
888   PushContext(dir.source, llvm::omp::Directive::OMPD_declare_target);
889   const auto &spec{std::get<parser::OmpDeclareTargetSpecifier>(x.t)};
890   if (std::holds_alternative<parser::OmpDeclareTargetWithClause>(spec.u)) {
891     SetClauseSets(llvm::omp::Directive::OMPD_declare_target);
892   }
893 }
894 
Leave(const parser::OpenMPDeclareTargetConstruct &)895 void OmpStructureChecker::Leave(const parser::OpenMPDeclareTargetConstruct &) {
896   dirContext_.pop_back();
897 }
898 
Enter(const parser::OpenMPExecutableAllocate & x)899 void OmpStructureChecker::Enter(const parser::OpenMPExecutableAllocate &x) {
900   isPredefinedAllocator = true;
901   const auto &dir{std::get<parser::Verbatim>(x.t)};
902   const auto &objectList{std::get<std::optional<parser::OmpObjectList>>(x.t)};
903   PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_allocate);
904   if (objectList) {
905     CheckIsVarPartOfAnotherVar(dir.source, *objectList);
906   }
907 }
908 
Leave(const parser::OpenMPExecutableAllocate & x)909 void OmpStructureChecker::Leave(const parser::OpenMPExecutableAllocate &x) {
910   const auto &dir{std::get<parser::Verbatim>(x.t)};
911   const auto &objectList{std::get<std::optional<parser::OmpObjectList>>(x.t)};
912   if (objectList)
913     CheckPredefinedAllocatorRestriction(dir.source, *objectList);
914   dirContext_.pop_back();
915 }
916 
CheckBarrierNesting(const parser::OpenMPSimpleStandaloneConstruct & x)917 void OmpStructureChecker::CheckBarrierNesting(
918     const parser::OpenMPSimpleStandaloneConstruct &x) {
919   // A barrier region may not be `closely nested` inside a worksharing, loop,
920   // task, taskloop, critical, ordered, atomic, or master region.
921   // TODO:  Expand the check to include `LOOP` construct as well when it is
922   // supported.
923   if (GetContext().directive == llvm::omp::Directive::OMPD_barrier) {
924     if (IsCloselyNestedRegion(llvm::omp::nestedBarrierErrSet)) {
925       context_.Say(parser::FindSourceLocation(x),
926           "`BARRIER` region may not be closely nested inside of `WORKSHARING`, "
927           "`LOOP`, `TASK`, `TASKLOOP`,"
928           "`CRITICAL`, `ORDERED`, `ATOMIC` or `MASTER` region."_err_en_US);
929     }
930   }
931 }
932 
ChecksOnOrderedAsStandalone()933 void OmpStructureChecker::ChecksOnOrderedAsStandalone() {
934   if (FindClause(llvm::omp::Clause::OMPC_threads) ||
935       FindClause(llvm::omp::Clause::OMPC_simd)) {
936     context_.Say(GetContext().clauseSource,
937         "THREADS, SIMD clauses are not allowed when ORDERED construct is a "
938         "standalone construct with no ORDERED region"_err_en_US);
939   }
940 
941   bool isSinkPresent{false};
942   int dependSourceCount{0};
943   auto clauseAll = FindClauses(llvm::omp::Clause::OMPC_depend);
944   for (auto itr = clauseAll.first; itr != clauseAll.second; ++itr) {
945     const auto &dependClause{
946         std::get<parser::OmpClause::Depend>(itr->second->u)};
947     if (std::get_if<parser::OmpDependClause::Source>(&dependClause.v.u)) {
948       dependSourceCount++;
949       if (isSinkPresent) {
950         context_.Say(itr->second->source,
951             "DEPEND(SOURCE) is not allowed when DEPEND(SINK: vec) is present "
952             "on ORDERED directive"_err_en_US);
953       }
954       if (dependSourceCount > 1) {
955         context_.Say(itr->second->source,
956             "At most one DEPEND(SOURCE) clause can appear on the ORDERED "
957             "directive"_err_en_US);
958       }
959     } else if (std::get_if<parser::OmpDependClause::Sink>(&dependClause.v.u)) {
960       isSinkPresent = true;
961       if (dependSourceCount > 0) {
962         context_.Say(itr->second->source,
963             "DEPEND(SINK: vec) is not allowed when DEPEND(SOURCE) is present "
964             "on ORDERED directive"_err_en_US);
965       }
966     } else {
967       context_.Say(itr->second->source,
968           "Only DEPEND(SOURCE) or DEPEND(SINK: vec) are allowed when ORDERED "
969           "construct is a standalone construct with no ORDERED "
970           "region"_err_en_US);
971     }
972   }
973 }
974 
Enter(const parser::OpenMPSimpleStandaloneConstruct & x)975 void OmpStructureChecker::Enter(
976     const parser::OpenMPSimpleStandaloneConstruct &x) {
977   const auto &dir{std::get<parser::OmpSimpleStandaloneDirective>(x.t)};
978   PushContextAndClauseSets(dir.source, dir.v);
979   CheckBarrierNesting(x);
980 }
981 
Leave(const parser::OpenMPSimpleStandaloneConstruct &)982 void OmpStructureChecker::Leave(
983     const parser::OpenMPSimpleStandaloneConstruct &) {
984   switch (GetContext().directive) {
985   case llvm::omp::Directive::OMPD_ordered:
986     // [5.1] 2.19.9 Ordered Construct Restriction
987     ChecksOnOrderedAsStandalone();
988     break;
989   default:
990     break;
991   }
992   dirContext_.pop_back();
993 }
994 
Enter(const parser::OpenMPFlushConstruct & x)995 void OmpStructureChecker::Enter(const parser::OpenMPFlushConstruct &x) {
996   const auto &dir{std::get<parser::Verbatim>(x.t)};
997   PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_flush);
998 }
999 
Leave(const parser::OpenMPFlushConstruct & x)1000 void OmpStructureChecker::Leave(const parser::OpenMPFlushConstruct &x) {
1001   if (FindClause(llvm::omp::Clause::OMPC_acquire) ||
1002       FindClause(llvm::omp::Clause::OMPC_release) ||
1003       FindClause(llvm::omp::Clause::OMPC_acq_rel)) {
1004     if (const auto &flushList{
1005             std::get<std::optional<parser::OmpObjectList>>(x.t)}) {
1006       context_.Say(parser::FindSourceLocation(flushList),
1007           "If memory-order-clause is RELEASE, ACQUIRE, or ACQ_REL, list items "
1008           "must not be specified on the FLUSH directive"_err_en_US);
1009     }
1010   }
1011   dirContext_.pop_back();
1012 }
1013 
Enter(const parser::OpenMPCancelConstruct & x)1014 void OmpStructureChecker::Enter(const parser::OpenMPCancelConstruct &x) {
1015   const auto &dir{std::get<parser::Verbatim>(x.t)};
1016   const auto &type{std::get<parser::OmpCancelType>(x.t)};
1017   PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_cancel);
1018   CheckCancellationNest(dir.source, type.v);
1019 }
1020 
Leave(const parser::OpenMPCancelConstruct &)1021 void OmpStructureChecker::Leave(const parser::OpenMPCancelConstruct &) {
1022   dirContext_.pop_back();
1023 }
1024 
Enter(const parser::OpenMPCriticalConstruct & x)1025 void OmpStructureChecker::Enter(const parser::OpenMPCriticalConstruct &x) {
1026   const auto &dir{std::get<parser::OmpCriticalDirective>(x.t)};
1027   PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_critical);
1028   const auto &block{std::get<parser::Block>(x.t)};
1029   CheckNoBranching(block, llvm::omp::Directive::OMPD_critical, dir.source);
1030 }
1031 
Leave(const parser::OpenMPCriticalConstruct &)1032 void OmpStructureChecker::Leave(const parser::OpenMPCriticalConstruct &) {
1033   dirContext_.pop_back();
1034 }
1035 
Enter(const parser::OpenMPCancellationPointConstruct & x)1036 void OmpStructureChecker::Enter(
1037     const parser::OpenMPCancellationPointConstruct &x) {
1038   const auto &dir{std::get<parser::Verbatim>(x.t)};
1039   const auto &type{std::get<parser::OmpCancelType>(x.t)};
1040   PushContextAndClauseSets(
1041       dir.source, llvm::omp::Directive::OMPD_cancellation_point);
1042   CheckCancellationNest(dir.source, type.v);
1043 }
1044 
Leave(const parser::OpenMPCancellationPointConstruct &)1045 void OmpStructureChecker::Leave(
1046     const parser::OpenMPCancellationPointConstruct &) {
1047   dirContext_.pop_back();
1048 }
1049 
CheckCancellationNest(const parser::CharBlock & source,const parser::OmpCancelType::Type & type)1050 void OmpStructureChecker::CheckCancellationNest(
1051     const parser::CharBlock &source, const parser::OmpCancelType::Type &type) {
1052   if (CurrentDirectiveIsNested()) {
1053     // If construct-type-clause is taskgroup, the cancellation construct must be
1054     // closely nested inside a task or a taskloop construct and the cancellation
1055     // region must be closely nested inside a taskgroup region. If
1056     // construct-type-clause is sections, the cancellation construct must be
1057     // closely nested inside a sections or section construct. Otherwise, the
1058     // cancellation construct must be closely nested inside an OpenMP construct
1059     // that matches the type specified in construct-type-clause of the
1060     // cancellation construct.
1061 
1062     OmpDirectiveSet allowedTaskgroupSet{
1063         llvm::omp::Directive::OMPD_task, llvm::omp::Directive::OMPD_taskloop};
1064     OmpDirectiveSet allowedSectionsSet{llvm::omp::Directive::OMPD_sections,
1065         llvm::omp::Directive::OMPD_parallel_sections};
1066     OmpDirectiveSet allowedDoSet{llvm::omp::Directive::OMPD_do,
1067         llvm::omp::Directive::OMPD_distribute_parallel_do,
1068         llvm::omp::Directive::OMPD_parallel_do,
1069         llvm::omp::Directive::OMPD_target_parallel_do,
1070         llvm::omp::Directive::OMPD_target_teams_distribute_parallel_do,
1071         llvm::omp::Directive::OMPD_teams_distribute_parallel_do};
1072     OmpDirectiveSet allowedParallelSet{llvm::omp::Directive::OMPD_parallel,
1073         llvm::omp::Directive::OMPD_target_parallel};
1074 
1075     bool eligibleCancellation{false};
1076     switch (type) {
1077     case parser::OmpCancelType::Type::Taskgroup:
1078       if (allowedTaskgroupSet.test(GetContextParent().directive)) {
1079         eligibleCancellation = true;
1080         if (dirContext_.size() >= 3) {
1081           // Check if the cancellation region is closely nested inside a
1082           // taskgroup region when there are more than two levels of directives
1083           // in the directive context stack.
1084           if (GetContextParent().directive == llvm::omp::Directive::OMPD_task ||
1085               FindClauseParent(llvm::omp::Clause::OMPC_nogroup)) {
1086             for (int i = dirContext_.size() - 3; i >= 0; i--) {
1087               if (dirContext_[i].directive ==
1088                   llvm::omp::Directive::OMPD_taskgroup) {
1089                 break;
1090               }
1091               if (allowedParallelSet.test(dirContext_[i].directive)) {
1092                 eligibleCancellation = false;
1093                 break;
1094               }
1095             }
1096           }
1097         }
1098       }
1099       if (!eligibleCancellation) {
1100         context_.Say(source,
1101             "With %s clause, %s construct must be closely nested inside TASK "
1102             "or TASKLOOP construct and %s region must be closely nested inside "
1103             "TASKGROUP region"_err_en_US,
1104             parser::ToUpperCaseLetters(
1105                 parser::OmpCancelType::EnumToString(type)),
1106             ContextDirectiveAsFortran(), ContextDirectiveAsFortran());
1107       }
1108       return;
1109     case parser::OmpCancelType::Type::Sections:
1110       if (allowedSectionsSet.test(GetContextParent().directive)) {
1111         eligibleCancellation = true;
1112       }
1113       break;
1114     case Fortran::parser::OmpCancelType::Type::Do:
1115       if (allowedDoSet.test(GetContextParent().directive)) {
1116         eligibleCancellation = true;
1117       }
1118       break;
1119     case parser::OmpCancelType::Type::Parallel:
1120       if (allowedParallelSet.test(GetContextParent().directive)) {
1121         eligibleCancellation = true;
1122       }
1123       break;
1124     }
1125     if (!eligibleCancellation) {
1126       context_.Say(source,
1127           "With %s clause, %s construct cannot be closely nested inside %s "
1128           "construct"_err_en_US,
1129           parser::ToUpperCaseLetters(parser::OmpCancelType::EnumToString(type)),
1130           ContextDirectiveAsFortran(),
1131           parser::ToUpperCaseLetters(
1132               getDirectiveName(GetContextParent().directive).str()));
1133     }
1134   } else {
1135     // The cancellation directive cannot be orphaned.
1136     switch (type) {
1137     case parser::OmpCancelType::Type::Taskgroup:
1138       context_.Say(source,
1139           "%s %s directive is not closely nested inside "
1140           "TASK or TASKLOOP"_err_en_US,
1141           ContextDirectiveAsFortran(),
1142           parser::ToUpperCaseLetters(
1143               parser::OmpCancelType::EnumToString(type)));
1144       break;
1145     case parser::OmpCancelType::Type::Sections:
1146       context_.Say(source,
1147           "%s %s directive is not closely nested inside "
1148           "SECTION or SECTIONS"_err_en_US,
1149           ContextDirectiveAsFortran(),
1150           parser::ToUpperCaseLetters(
1151               parser::OmpCancelType::EnumToString(type)));
1152       break;
1153     case Fortran::parser::OmpCancelType::Type::Do:
1154       context_.Say(source,
1155           "%s %s directive is not closely nested inside "
1156           "the construct that matches the DO clause type"_err_en_US,
1157           ContextDirectiveAsFortran(),
1158           parser::ToUpperCaseLetters(
1159               parser::OmpCancelType::EnumToString(type)));
1160       break;
1161     case parser::OmpCancelType::Type::Parallel:
1162       context_.Say(source,
1163           "%s %s directive is not closely nested inside "
1164           "the construct that matches the PARALLEL clause type"_err_en_US,
1165           ContextDirectiveAsFortran(),
1166           parser::ToUpperCaseLetters(
1167               parser::OmpCancelType::EnumToString(type)));
1168       break;
1169     }
1170   }
1171 }
1172 
Enter(const parser::OmpEndBlockDirective & x)1173 void OmpStructureChecker::Enter(const parser::OmpEndBlockDirective &x) {
1174   const auto &dir{std::get<parser::OmpBlockDirective>(x.t)};
1175   ResetPartialContext(dir.source);
1176   switch (dir.v) {
1177   // 2.7.3 end-single-clause -> copyprivate-clause |
1178   //                            nowait-clause
1179   case llvm::omp::Directive::OMPD_single:
1180     PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_end_single);
1181     break;
1182   // 2.7.4 end-workshare -> END WORKSHARE [nowait-clause]
1183   case llvm::omp::Directive::OMPD_workshare:
1184     PushContextAndClauseSets(
1185         dir.source, llvm::omp::Directive::OMPD_end_workshare);
1186     break;
1187   default:
1188     // no clauses are allowed
1189     break;
1190   }
1191 }
1192 
1193 // TODO: Verify the popping of dirContext requirement after nowait
1194 // implementation, as there is an implicit barrier at the end of the worksharing
1195 // constructs unless a nowait clause is specified. Only OMPD_end_single and
1196 // end_workshareare popped as they are pushed while entering the
1197 // EndBlockDirective.
Leave(const parser::OmpEndBlockDirective & x)1198 void OmpStructureChecker::Leave(const parser::OmpEndBlockDirective &x) {
1199   if ((GetContext().directive == llvm::omp::Directive::OMPD_end_single) ||
1200       (GetContext().directive == llvm::omp::Directive::OMPD_end_workshare)) {
1201     dirContext_.pop_back();
1202   }
1203 }
1204 
Enter(const parser::OpenMPAtomicConstruct & x)1205 void OmpStructureChecker::Enter(const parser::OpenMPAtomicConstruct &x) {
1206   std::visit(
1207       common::visitors{
1208           [&](const auto &someAtomicConstruct) {
1209             const auto &dir{std::get<parser::Verbatim>(someAtomicConstruct.t)};
1210             PushContextAndClauseSets(
1211                 dir.source, llvm::omp::Directive::OMPD_atomic);
1212           },
1213       },
1214       x.u);
1215 }
1216 
Leave(const parser::OpenMPAtomicConstruct &)1217 void OmpStructureChecker::Leave(const parser::OpenMPAtomicConstruct &) {
1218   dirContext_.pop_back();
1219 }
1220 
1221 // Clauses
1222 // Mainly categorized as
1223 // 1. Checks on 'OmpClauseList' from 'parse-tree.h'.
1224 // 2. Checks on clauses which fall under 'struct OmpClause' from parse-tree.h.
1225 // 3. Checks on clauses which are not in 'struct OmpClause' from parse-tree.h.
1226 
Leave(const parser::OmpClauseList &)1227 void OmpStructureChecker::Leave(const parser::OmpClauseList &) {
1228   // 2.7.1 Loop Construct Restriction
1229   if (llvm::omp::doSet.test(GetContext().directive)) {
1230     if (auto *clause{FindClause(llvm::omp::Clause::OMPC_schedule)}) {
1231       // only one schedule clause is allowed
1232       const auto &schedClause{std::get<parser::OmpClause::Schedule>(clause->u)};
1233       if (ScheduleModifierHasType(schedClause.v,
1234               parser::OmpScheduleModifierType::ModType::Nonmonotonic)) {
1235         if (FindClause(llvm::omp::Clause::OMPC_ordered)) {
1236           context_.Say(clause->source,
1237               "The NONMONOTONIC modifier cannot be specified "
1238               "if an ORDERED clause is specified"_err_en_US);
1239         }
1240         if (ScheduleModifierHasType(schedClause.v,
1241                 parser::OmpScheduleModifierType::ModType::Monotonic)) {
1242           context_.Say(clause->source,
1243               "The MONOTONIC and NONMONOTONIC modifiers "
1244               "cannot be both specified"_err_en_US);
1245         }
1246       }
1247     }
1248 
1249     if (auto *clause{FindClause(llvm::omp::Clause::OMPC_ordered)}) {
1250       // only one ordered clause is allowed
1251       const auto &orderedClause{
1252           std::get<parser::OmpClause::Ordered>(clause->u)};
1253 
1254       if (orderedClause.v) {
1255         CheckNotAllowedIfClause(
1256             llvm::omp::Clause::OMPC_ordered, {llvm::omp::Clause::OMPC_linear});
1257 
1258         if (auto *clause2{FindClause(llvm::omp::Clause::OMPC_collapse)}) {
1259           const auto &collapseClause{
1260               std::get<parser::OmpClause::Collapse>(clause2->u)};
1261           // ordered and collapse both have parameters
1262           if (const auto orderedValue{GetIntValue(orderedClause.v)}) {
1263             if (const auto collapseValue{GetIntValue(collapseClause.v)}) {
1264               if (*orderedValue > 0 && *orderedValue < *collapseValue) {
1265                 context_.Say(clause->source,
1266                     "The parameter of the ORDERED clause must be "
1267                     "greater than or equal to "
1268                     "the parameter of the COLLAPSE clause"_err_en_US);
1269               }
1270             }
1271           }
1272         }
1273       }
1274 
1275       // TODO: ordered region binding check (requires nesting implementation)
1276     }
1277   } // doSet
1278 
1279   // 2.8.1 Simd Construct Restriction
1280   if (llvm::omp::simdSet.test(GetContext().directive)) {
1281     if (auto *clause{FindClause(llvm::omp::Clause::OMPC_simdlen)}) {
1282       if (auto *clause2{FindClause(llvm::omp::Clause::OMPC_safelen)}) {
1283         const auto &simdlenClause{
1284             std::get<parser::OmpClause::Simdlen>(clause->u)};
1285         const auto &safelenClause{
1286             std::get<parser::OmpClause::Safelen>(clause2->u)};
1287         // simdlen and safelen both have parameters
1288         if (const auto simdlenValue{GetIntValue(simdlenClause.v)}) {
1289           if (const auto safelenValue{GetIntValue(safelenClause.v)}) {
1290             if (*safelenValue > 0 && *simdlenValue > *safelenValue) {
1291               context_.Say(clause->source,
1292                   "The parameter of the SIMDLEN clause must be less than or "
1293                   "equal to the parameter of the SAFELEN clause"_err_en_US);
1294             }
1295           }
1296         }
1297       }
1298     }
1299     // A list-item cannot appear in more than one aligned clause
1300     semantics::UnorderedSymbolSet alignedVars;
1301     auto clauseAll = FindClauses(llvm::omp::Clause::OMPC_aligned);
1302     for (auto itr = clauseAll.first; itr != clauseAll.second; ++itr) {
1303       const auto &alignedClause{
1304           std::get<parser::OmpClause::Aligned>(itr->second->u)};
1305       const auto &alignedNameList{
1306           std::get<std::list<parser::Name>>(alignedClause.v.t)};
1307       for (auto const &var : alignedNameList) {
1308         if (alignedVars.count(*(var.symbol)) == 1) {
1309           context_.Say(itr->second->source,
1310               "List item '%s' present at multiple ALIGNED clauses"_err_en_US,
1311               var.ToString());
1312           break;
1313         }
1314         alignedVars.insert(*(var.symbol));
1315       }
1316     }
1317   } // SIMD
1318 
1319   // 2.7.3 Single Construct Restriction
1320   if (GetContext().directive == llvm::omp::Directive::OMPD_end_single) {
1321     CheckNotAllowedIfClause(
1322         llvm::omp::Clause::OMPC_copyprivate, {llvm::omp::Clause::OMPC_nowait});
1323   }
1324 
1325   CheckRequireAtLeastOneOf();
1326 }
1327 
Enter(const parser::OmpClause & x)1328 void OmpStructureChecker::Enter(const parser::OmpClause &x) {
1329   SetContextClause(x);
1330 }
1331 
1332 // Following clauses do not have a separate node in parse-tree.h.
CHECK_SIMPLE_CLAUSE(AcqRel,OMPC_acq_rel)1333 CHECK_SIMPLE_CLAUSE(AcqRel, OMPC_acq_rel)
1334 CHECK_SIMPLE_CLAUSE(Acquire, OMPC_acquire)
1335 CHECK_SIMPLE_CLAUSE(AtomicDefaultMemOrder, OMPC_atomic_default_mem_order)
1336 CHECK_SIMPLE_CLAUSE(Affinity, OMPC_affinity)
1337 CHECK_SIMPLE_CLAUSE(Allocate, OMPC_allocate)
1338 CHECK_SIMPLE_CLAUSE(Capture, OMPC_capture)
1339 CHECK_SIMPLE_CLAUSE(Copyin, OMPC_copyin)
1340 CHECK_SIMPLE_CLAUSE(Default, OMPC_default)
1341 CHECK_SIMPLE_CLAUSE(Depobj, OMPC_depobj)
1342 CHECK_SIMPLE_CLAUSE(Destroy, OMPC_destroy)
1343 CHECK_SIMPLE_CLAUSE(Detach, OMPC_detach)
1344 CHECK_SIMPLE_CLAUSE(Device, OMPC_device)
1345 CHECK_SIMPLE_CLAUSE(DeviceType, OMPC_device_type)
1346 CHECK_SIMPLE_CLAUSE(DistSchedule, OMPC_dist_schedule)
1347 CHECK_SIMPLE_CLAUSE(DynamicAllocators, OMPC_dynamic_allocators)
1348 CHECK_SIMPLE_CLAUSE(Exclusive, OMPC_exclusive)
1349 CHECK_SIMPLE_CLAUSE(Final, OMPC_final)
1350 CHECK_SIMPLE_CLAUSE(Flush, OMPC_flush)
1351 CHECK_SIMPLE_CLAUSE(From, OMPC_from)
1352 CHECK_SIMPLE_CLAUSE(Full, OMPC_full)
1353 CHECK_SIMPLE_CLAUSE(Hint, OMPC_hint)
1354 CHECK_SIMPLE_CLAUSE(InReduction, OMPC_in_reduction)
1355 CHECK_SIMPLE_CLAUSE(Inclusive, OMPC_inclusive)
1356 CHECK_SIMPLE_CLAUSE(Match, OMPC_match)
1357 CHECK_SIMPLE_CLAUSE(Nontemporal, OMPC_nontemporal)
1358 CHECK_SIMPLE_CLAUSE(Order, OMPC_order)
1359 CHECK_SIMPLE_CLAUSE(Read, OMPC_read)
1360 CHECK_SIMPLE_CLAUSE(ReverseOffload, OMPC_reverse_offload)
1361 CHECK_SIMPLE_CLAUSE(Threadprivate, OMPC_threadprivate)
1362 CHECK_SIMPLE_CLAUSE(Threads, OMPC_threads)
1363 CHECK_SIMPLE_CLAUSE(Inbranch, OMPC_inbranch)
1364 CHECK_SIMPLE_CLAUSE(IsDevicePtr, OMPC_is_device_ptr)
1365 CHECK_SIMPLE_CLAUSE(Link, OMPC_link)
1366 CHECK_SIMPLE_CLAUSE(Mergeable, OMPC_mergeable)
1367 CHECK_SIMPLE_CLAUSE(Nogroup, OMPC_nogroup)
1368 CHECK_SIMPLE_CLAUSE(Notinbranch, OMPC_notinbranch)
1369 CHECK_SIMPLE_CLAUSE(Nowait, OMPC_nowait)
1370 CHECK_SIMPLE_CLAUSE(Partial, OMPC_partial)
1371 CHECK_SIMPLE_CLAUSE(ProcBind, OMPC_proc_bind)
1372 CHECK_SIMPLE_CLAUSE(Release, OMPC_release)
1373 CHECK_SIMPLE_CLAUSE(Relaxed, OMPC_relaxed)
1374 CHECK_SIMPLE_CLAUSE(SeqCst, OMPC_seq_cst)
1375 CHECK_SIMPLE_CLAUSE(Simd, OMPC_simd)
1376 CHECK_SIMPLE_CLAUSE(Sizes, OMPC_sizes)
1377 CHECK_SIMPLE_CLAUSE(TaskReduction, OMPC_task_reduction)
1378 CHECK_SIMPLE_CLAUSE(To, OMPC_to)
1379 CHECK_SIMPLE_CLAUSE(UnifiedAddress, OMPC_unified_address)
1380 CHECK_SIMPLE_CLAUSE(UnifiedSharedMemory, OMPC_unified_shared_memory)
1381 CHECK_SIMPLE_CLAUSE(Uniform, OMPC_uniform)
1382 CHECK_SIMPLE_CLAUSE(Unknown, OMPC_unknown)
1383 CHECK_SIMPLE_CLAUSE(Untied, OMPC_untied)
1384 CHECK_SIMPLE_CLAUSE(UseDevicePtr, OMPC_use_device_ptr)
1385 CHECK_SIMPLE_CLAUSE(UsesAllocators, OMPC_uses_allocators)
1386 CHECK_SIMPLE_CLAUSE(Update, OMPC_update)
1387 CHECK_SIMPLE_CLAUSE(UseDeviceAddr, OMPC_use_device_addr)
1388 CHECK_SIMPLE_CLAUSE(Write, OMPC_write)
1389 CHECK_SIMPLE_CLAUSE(Init, OMPC_init)
1390 CHECK_SIMPLE_CLAUSE(Use, OMPC_use)
1391 CHECK_SIMPLE_CLAUSE(Novariants, OMPC_novariants)
1392 CHECK_SIMPLE_CLAUSE(Nocontext, OMPC_nocontext)
1393 CHECK_SIMPLE_CLAUSE(Filter, OMPC_filter)
1394 CHECK_SIMPLE_CLAUSE(When, OMPC_when)
1395 
1396 CHECK_REQ_SCALAR_INT_CLAUSE(Grainsize, OMPC_grainsize)
1397 CHECK_REQ_SCALAR_INT_CLAUSE(NumTasks, OMPC_num_tasks)
1398 CHECK_REQ_SCALAR_INT_CLAUSE(NumTeams, OMPC_num_teams)
1399 CHECK_REQ_SCALAR_INT_CLAUSE(NumThreads, OMPC_num_threads)
1400 CHECK_REQ_SCALAR_INT_CLAUSE(Priority, OMPC_priority)
1401 CHECK_REQ_SCALAR_INT_CLAUSE(ThreadLimit, OMPC_thread_limit)
1402 
1403 CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(Collapse, OMPC_collapse)
1404 CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(Safelen, OMPC_safelen)
1405 CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(Simdlen, OMPC_simdlen)
1406 
1407 // Restrictions specific to each clause are implemented apart from the
1408 // generalized restrictions.
1409 void OmpStructureChecker::Enter(const parser::OmpClause::Reduction &x) {
1410   CheckAllowed(llvm::omp::Clause::OMPC_reduction);
1411   if (CheckReductionOperators(x)) {
1412     CheckReductionTypeList(x);
1413   }
1414 }
CheckReductionOperators(const parser::OmpClause::Reduction & x)1415 bool OmpStructureChecker::CheckReductionOperators(
1416     const parser::OmpClause::Reduction &x) {
1417 
1418   const auto &definedOp{std::get<0>(x.v.t)};
1419   bool ok = false;
1420   std::visit(
1421       common::visitors{
1422           [&](const parser::DefinedOperator &dOpr) {
1423             const auto &intrinsicOp{
1424                 std::get<parser::DefinedOperator::IntrinsicOperator>(dOpr.u)};
1425             ok = CheckIntrinsicOperator(intrinsicOp);
1426           },
1427           [&](const parser::ProcedureDesignator &procD) {
1428             const parser::Name *name{std::get_if<parser::Name>(&procD.u)};
1429             if (name) {
1430               if (name->source == "max" || name->source == "min" ||
1431                   name->source == "iand" || name->source == "ior" ||
1432                   name->source == "ieor") {
1433                 ok = true;
1434               } else {
1435                 context_.Say(GetContext().clauseSource,
1436                     "Invalid reduction identifier in REDUCTION clause."_err_en_US,
1437                     ContextDirectiveAsFortran());
1438               }
1439             }
1440           },
1441       },
1442       definedOp.u);
1443 
1444   return ok;
1445 }
CheckIntrinsicOperator(const parser::DefinedOperator::IntrinsicOperator & op)1446 bool OmpStructureChecker::CheckIntrinsicOperator(
1447     const parser::DefinedOperator::IntrinsicOperator &op) {
1448 
1449   switch (op) {
1450   case parser::DefinedOperator::IntrinsicOperator::Add:
1451   case parser::DefinedOperator::IntrinsicOperator::Subtract:
1452   case parser::DefinedOperator::IntrinsicOperator::Multiply:
1453   case parser::DefinedOperator::IntrinsicOperator::AND:
1454   case parser::DefinedOperator::IntrinsicOperator::OR:
1455   case parser::DefinedOperator::IntrinsicOperator::EQV:
1456   case parser::DefinedOperator::IntrinsicOperator::NEQV:
1457     return true;
1458   default:
1459     context_.Say(GetContext().clauseSource,
1460         "Invalid reduction operator in REDUCTION clause."_err_en_US,
1461         ContextDirectiveAsFortran());
1462   }
1463   return false;
1464 }
1465 
CheckReductionTypeList(const parser::OmpClause::Reduction & x)1466 void OmpStructureChecker::CheckReductionTypeList(
1467     const parser::OmpClause::Reduction &x) {
1468   const auto &ompObjectList{std::get<parser::OmpObjectList>(x.v.t)};
1469   CheckIntentInPointerAndDefinable(
1470       ompObjectList, llvm::omp::Clause::OMPC_reduction);
1471   CheckReductionArraySection(ompObjectList);
1472   CheckMultipleAppearanceAcrossContext(ompObjectList);
1473 }
1474 
CheckIntentInPointerAndDefinable(const parser::OmpObjectList & objectList,const llvm::omp::Clause clause)1475 void OmpStructureChecker::CheckIntentInPointerAndDefinable(
1476     const parser::OmpObjectList &objectList, const llvm::omp::Clause clause) {
1477   for (const auto &ompObject : objectList.v) {
1478     if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
1479       if (const auto *symbol{name->symbol}) {
1480         if (IsPointer(symbol->GetUltimate()) &&
1481             IsIntentIn(symbol->GetUltimate())) {
1482           context_.Say(GetContext().clauseSource,
1483               "Pointer '%s' with the INTENT(IN) attribute may not appear "
1484               "in a %s clause"_err_en_US,
1485               symbol->name(),
1486               parser::ToUpperCaseLetters(getClauseName(clause).str()));
1487         }
1488         if (auto msg{
1489                 WhyNotModifiable(*symbol, context_.FindScope(name->source))}) {
1490           context_.Say(GetContext().clauseSource,
1491               "Variable '%s' on the %s clause is not definable"_err_en_US,
1492               symbol->name(),
1493               parser::ToUpperCaseLetters(getClauseName(clause).str()));
1494         }
1495       }
1496     }
1497   }
1498 }
1499 
CheckReductionArraySection(const parser::OmpObjectList & ompObjectList)1500 void OmpStructureChecker::CheckReductionArraySection(
1501     const parser::OmpObjectList &ompObjectList) {
1502   for (const auto &ompObject : ompObjectList.v) {
1503     if (const auto *dataRef{parser::Unwrap<parser::DataRef>(ompObject)}) {
1504       if (const auto *arrayElement{
1505               parser::Unwrap<parser::ArrayElement>(ompObject)}) {
1506         if (arrayElement) {
1507           CheckArraySection(*arrayElement, GetLastName(*dataRef),
1508               llvm::omp::Clause::OMPC_reduction);
1509         }
1510       }
1511     }
1512   }
1513 }
1514 
CheckMultipleAppearanceAcrossContext(const parser::OmpObjectList & redObjectList)1515 void OmpStructureChecker::CheckMultipleAppearanceAcrossContext(
1516     const parser::OmpObjectList &redObjectList) {
1517   //  TODO: Verify the assumption here that the immediately enclosing region is
1518   //  the parallel region to which the worksharing construct having reduction
1519   //  binds to.
1520   if (auto *enclosingContext{GetEnclosingDirContext()}) {
1521     for (auto it : enclosingContext->clauseInfo) {
1522       llvmOmpClause type = it.first;
1523       const auto *clause = it.second;
1524       if (llvm::omp::privateReductionSet.test(type)) {
1525         if (const auto *objList{GetOmpObjectList(*clause)}) {
1526           for (const auto &ompObject : objList->v) {
1527             if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
1528               if (const auto *symbol{name->symbol}) {
1529                 for (const auto &redOmpObject : redObjectList.v) {
1530                   if (const auto *rname{
1531                           parser::Unwrap<parser::Name>(redOmpObject)}) {
1532                     if (const auto *rsymbol{rname->symbol}) {
1533                       if (rsymbol->name() == symbol->name()) {
1534                         context_.Say(GetContext().clauseSource,
1535                             "%s variable '%s' is %s in outer context must"
1536                             " be shared in the parallel regions to which any"
1537                             " of the worksharing regions arising from the "
1538                             "worksharing"
1539                             " construct bind."_err_en_US,
1540                             parser::ToUpperCaseLetters(
1541                                 getClauseName(llvm::omp::Clause::OMPC_reduction)
1542                                     .str()),
1543                             symbol->name(),
1544                             parser::ToUpperCaseLetters(
1545                                 getClauseName(type).str()));
1546                       }
1547                     }
1548                   }
1549                 }
1550               }
1551             }
1552           }
1553         }
1554       }
1555     }
1556   }
1557 }
1558 
Enter(const parser::OmpClause::Ordered & x)1559 void OmpStructureChecker::Enter(const parser::OmpClause::Ordered &x) {
1560   CheckAllowed(llvm::omp::Clause::OMPC_ordered);
1561   // the parameter of ordered clause is optional
1562   if (const auto &expr{x.v}) {
1563     RequiresConstantPositiveParameter(llvm::omp::Clause::OMPC_ordered, *expr);
1564     // 2.8.3 Loop SIMD Construct Restriction
1565     if (llvm::omp::doSimdSet.test(GetContext().directive)) {
1566       context_.Say(GetContext().clauseSource,
1567           "No ORDERED clause with a parameter can be specified "
1568           "on the %s directive"_err_en_US,
1569           ContextDirectiveAsFortran());
1570     }
1571   }
1572 }
1573 
Enter(const parser::OmpClause::Shared & x)1574 void OmpStructureChecker::Enter(const parser::OmpClause::Shared &x) {
1575   CheckAllowed(llvm::omp::Clause::OMPC_shared);
1576   CheckIsVarPartOfAnotherVar(GetContext().clauseSource, x.v);
1577 }
Enter(const parser::OmpClause::Private & x)1578 void OmpStructureChecker::Enter(const parser::OmpClause::Private &x) {
1579   CheckAllowed(llvm::omp::Clause::OMPC_private);
1580   CheckIsVarPartOfAnotherVar(GetContext().clauseSource, x.v);
1581   CheckIntentInPointer(x.v, llvm::omp::Clause::OMPC_private);
1582 }
1583 
IsDataRefTypeParamInquiry(const parser::DataRef * dataRef)1584 bool OmpStructureChecker::IsDataRefTypeParamInquiry(
1585     const parser::DataRef *dataRef) {
1586   bool dataRefIsTypeParamInquiry{false};
1587   if (const auto *structComp{
1588           parser::Unwrap<parser::StructureComponent>(dataRef)}) {
1589     if (const auto *compSymbol{structComp->component.symbol}) {
1590       if (const auto *compSymbolMiscDetails{
1591               std::get_if<MiscDetails>(&compSymbol->details())}) {
1592         const auto detailsKind = compSymbolMiscDetails->kind();
1593         dataRefIsTypeParamInquiry =
1594             (detailsKind == MiscDetails::Kind::KindParamInquiry ||
1595                 detailsKind == MiscDetails::Kind::LenParamInquiry);
1596       } else if (compSymbol->has<TypeParamDetails>()) {
1597         dataRefIsTypeParamInquiry = true;
1598       }
1599     }
1600   }
1601   return dataRefIsTypeParamInquiry;
1602 }
1603 
CheckIsVarPartOfAnotherVar(const parser::CharBlock & source,const parser::OmpObjectList & objList)1604 void OmpStructureChecker::CheckIsVarPartOfAnotherVar(
1605     const parser::CharBlock &source, const parser::OmpObjectList &objList) {
1606   OmpDirectiveSet nonPartialVarSet{llvm::omp::Directive::OMPD_allocate,
1607       llvm::omp::Directive::OMPD_threadprivate};
1608   for (const auto &ompObject : objList.v) {
1609     std::visit(
1610         common::visitors{
1611             [&](const parser::Designator &designator) {
1612               if (const auto *dataRef{
1613                       std::get_if<parser::DataRef>(&designator.u)}) {
1614                 if (IsDataRefTypeParamInquiry(dataRef)) {
1615                   context_.Say(source,
1616                       "A type parameter inquiry cannot appear on the %s "
1617                       "directive"_err_en_US,
1618                       ContextDirectiveAsFortran());
1619                 } else if (parser::Unwrap<parser::StructureComponent>(
1620                                ompObject) ||
1621                     parser::Unwrap<parser::ArrayElement>(ompObject)) {
1622                   if (nonPartialVarSet.test(GetContext().directive)) {
1623                     context_.Say(source,
1624                         "A variable that is part of another variable (as an "
1625                         "array or structure element) cannot appear on the %s "
1626                         "directive"_err_en_US,
1627                         ContextDirectiveAsFortran());
1628                   } else {
1629                     context_.Say(source,
1630                         "A variable that is part of another variable (as an "
1631                         "array or structure element) cannot appear in a "
1632                         "PRIVATE or SHARED clause"_err_en_US);
1633                   }
1634                 }
1635               }
1636             },
1637             [&](const parser::Name &name) {},
1638         },
1639         ompObject.u);
1640   }
1641 }
1642 
Enter(const parser::OmpClause::Firstprivate & x)1643 void OmpStructureChecker::Enter(const parser::OmpClause::Firstprivate &x) {
1644   CheckAllowed(llvm::omp::Clause::OMPC_firstprivate);
1645   CheckIsLoopIvPartOfClause(llvmOmpClause::OMPC_firstprivate, x.v);
1646 
1647   SymbolSourceMap currSymbols;
1648   GetSymbolsInObjectList(x.v, currSymbols);
1649 
1650   DirectivesClauseTriple dirClauseTriple;
1651   // Check firstprivate variables in worksharing constructs
1652   dirClauseTriple.emplace(llvm::omp::Directive::OMPD_do,
1653       std::make_pair(
1654           llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet));
1655   dirClauseTriple.emplace(llvm::omp::Directive::OMPD_sections,
1656       std::make_pair(
1657           llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet));
1658   dirClauseTriple.emplace(llvm::omp::Directive::OMPD_single,
1659       std::make_pair(
1660           llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet));
1661   // Check firstprivate variables in distribute construct
1662   dirClauseTriple.emplace(llvm::omp::Directive::OMPD_distribute,
1663       std::make_pair(
1664           llvm::omp::Directive::OMPD_teams, llvm::omp::privateReductionSet));
1665   dirClauseTriple.emplace(llvm::omp::Directive::OMPD_distribute,
1666       std::make_pair(llvm::omp::Directive::OMPD_target_teams,
1667           llvm::omp::privateReductionSet));
1668   // Check firstprivate variables in task and taskloop constructs
1669   dirClauseTriple.emplace(llvm::omp::Directive::OMPD_task,
1670       std::make_pair(llvm::omp::Directive::OMPD_parallel,
1671           OmpClauseSet{llvm::omp::Clause::OMPC_reduction}));
1672   dirClauseTriple.emplace(llvm::omp::Directive::OMPD_taskloop,
1673       std::make_pair(llvm::omp::Directive::OMPD_parallel,
1674           OmpClauseSet{llvm::omp::Clause::OMPC_reduction}));
1675 
1676   CheckPrivateSymbolsInOuterCxt(
1677       currSymbols, dirClauseTriple, llvm::omp::Clause::OMPC_firstprivate);
1678 }
1679 
CheckIsLoopIvPartOfClause(llvmOmpClause clause,const parser::OmpObjectList & ompObjectList)1680 void OmpStructureChecker::CheckIsLoopIvPartOfClause(
1681     llvmOmpClause clause, const parser::OmpObjectList &ompObjectList) {
1682   for (const auto &ompObject : ompObjectList.v) {
1683     if (const parser::Name * name{parser::Unwrap<parser::Name>(ompObject)}) {
1684       if (name->symbol == GetContext().loopIV) {
1685         context_.Say(name->source,
1686             "DO iteration variable %s is not allowed in %s clause."_err_en_US,
1687             name->ToString(),
1688             parser::ToUpperCaseLetters(getClauseName(clause).str()));
1689       }
1690     }
1691   }
1692 }
1693 // Following clauses have a seperate node in parse-tree.h.
1694 // Atomic-clause
CHECK_SIMPLE_PARSER_CLAUSE(OmpAtomicRead,OMPC_read)1695 CHECK_SIMPLE_PARSER_CLAUSE(OmpAtomicRead, OMPC_read)
1696 CHECK_SIMPLE_PARSER_CLAUSE(OmpAtomicWrite, OMPC_write)
1697 CHECK_SIMPLE_PARSER_CLAUSE(OmpAtomicUpdate, OMPC_update)
1698 CHECK_SIMPLE_PARSER_CLAUSE(OmpAtomicCapture, OMPC_capture)
1699 
1700 void OmpStructureChecker::Leave(const parser::OmpAtomicRead &) {
1701   CheckNotAllowedIfClause(llvm::omp::Clause::OMPC_read,
1702       {llvm::omp::Clause::OMPC_release, llvm::omp::Clause::OMPC_acq_rel});
1703 }
Leave(const parser::OmpAtomicWrite &)1704 void OmpStructureChecker::Leave(const parser::OmpAtomicWrite &) {
1705   CheckNotAllowedIfClause(llvm::omp::Clause::OMPC_write,
1706       {llvm::omp::Clause::OMPC_acquire, llvm::omp::Clause::OMPC_acq_rel});
1707 }
Leave(const parser::OmpAtomicUpdate &)1708 void OmpStructureChecker::Leave(const parser::OmpAtomicUpdate &) {
1709   CheckNotAllowedIfClause(llvm::omp::Clause::OMPC_update,
1710       {llvm::omp::Clause::OMPC_acquire, llvm::omp::Clause::OMPC_acq_rel});
1711 }
1712 // OmpAtomic node represents atomic directive without atomic-clause.
1713 // atomic-clause - READ,WRITE,UPDATE,CAPTURE.
Leave(const parser::OmpAtomic &)1714 void OmpStructureChecker::Leave(const parser::OmpAtomic &) {
1715   if (const auto *clause{FindClause(llvm::omp::Clause::OMPC_acquire)}) {
1716     context_.Say(clause->source,
1717         "Clause ACQUIRE is not allowed on the ATOMIC directive"_err_en_US);
1718   }
1719   if (const auto *clause{FindClause(llvm::omp::Clause::OMPC_acq_rel)}) {
1720     context_.Say(clause->source,
1721         "Clause ACQ_REL is not allowed on the ATOMIC directive"_err_en_US);
1722   }
1723 }
1724 // Restrictions specific to each clause are implemented apart from the
1725 // generalized restrictions.
Enter(const parser::OmpClause::Aligned & x)1726 void OmpStructureChecker::Enter(const parser::OmpClause::Aligned &x) {
1727   CheckAllowed(llvm::omp::Clause::OMPC_aligned);
1728 
1729   if (const auto &expr{
1730           std::get<std::optional<parser::ScalarIntConstantExpr>>(x.v.t)}) {
1731     RequiresConstantPositiveParameter(llvm::omp::Clause::OMPC_aligned, *expr);
1732   }
1733   // 2.8.1 TODO: list-item attribute check
1734 }
Enter(const parser::OmpClause::Defaultmap & x)1735 void OmpStructureChecker::Enter(const parser::OmpClause::Defaultmap &x) {
1736   CheckAllowed(llvm::omp::Clause::OMPC_defaultmap);
1737   using VariableCategory = parser::OmpDefaultmapClause::VariableCategory;
1738   if (!std::get<std::optional<VariableCategory>>(x.v.t)) {
1739     context_.Say(GetContext().clauseSource,
1740         "The argument TOFROM:SCALAR must be specified on the DEFAULTMAP "
1741         "clause"_err_en_US);
1742   }
1743 }
Enter(const parser::OmpClause::If & x)1744 void OmpStructureChecker::Enter(const parser::OmpClause::If &x) {
1745   CheckAllowed(llvm::omp::Clause::OMPC_if);
1746   using dirNameModifier = parser::OmpIfClause::DirectiveNameModifier;
1747   static std::unordered_map<dirNameModifier, OmpDirectiveSet>
1748       dirNameModifierMap{{dirNameModifier::Parallel, llvm::omp::parallelSet},
1749           {dirNameModifier::Target, llvm::omp::targetSet},
1750           {dirNameModifier::TargetEnterData,
1751               {llvm::omp::Directive::OMPD_target_enter_data}},
1752           {dirNameModifier::TargetExitData,
1753               {llvm::omp::Directive::OMPD_target_exit_data}},
1754           {dirNameModifier::TargetData,
1755               {llvm::omp::Directive::OMPD_target_data}},
1756           {dirNameModifier::TargetUpdate,
1757               {llvm::omp::Directive::OMPD_target_update}},
1758           {dirNameModifier::Task, {llvm::omp::Directive::OMPD_task}},
1759           {dirNameModifier::Taskloop, llvm::omp::taskloopSet}};
1760   if (const auto &directiveName{
1761           std::get<std::optional<dirNameModifier>>(x.v.t)}) {
1762     auto search{dirNameModifierMap.find(*directiveName)};
1763     if (search == dirNameModifierMap.end() ||
1764         !search->second.test(GetContext().directive)) {
1765       context_
1766           .Say(GetContext().clauseSource,
1767               "Unmatched directive name modifier %s on the IF clause"_err_en_US,
1768               parser::ToUpperCaseLetters(
1769                   parser::OmpIfClause::EnumToString(*directiveName)))
1770           .Attach(
1771               GetContext().directiveSource, "Cannot apply to directive"_en_US);
1772     }
1773   }
1774 }
1775 
Enter(const parser::OmpClause::Linear & x)1776 void OmpStructureChecker::Enter(const parser::OmpClause::Linear &x) {
1777   CheckAllowed(llvm::omp::Clause::OMPC_linear);
1778 
1779   // 2.7 Loop Construct Restriction
1780   if ((llvm::omp::doSet | llvm::omp::simdSet).test(GetContext().directive)) {
1781     if (std::holds_alternative<parser::OmpLinearClause::WithModifier>(x.v.u)) {
1782       context_.Say(GetContext().clauseSource,
1783           "A modifier may not be specified in a LINEAR clause "
1784           "on the %s directive"_err_en_US,
1785           ContextDirectiveAsFortran());
1786     }
1787   }
1788 }
1789 
CheckAllowedMapTypes(const parser::OmpMapType::Type & type,const std::list<parser::OmpMapType::Type> & allowedMapTypeList)1790 void OmpStructureChecker::CheckAllowedMapTypes(
1791     const parser::OmpMapType::Type &type,
1792     const std::list<parser::OmpMapType::Type> &allowedMapTypeList) {
1793   const auto found{std::find(
1794       std::begin(allowedMapTypeList), std::end(allowedMapTypeList), type)};
1795   if (found == std::end(allowedMapTypeList)) {
1796     std::string commaSeperatedMapTypes;
1797     llvm::interleave(
1798         allowedMapTypeList.begin(), allowedMapTypeList.end(),
1799         [&](const parser::OmpMapType::Type &mapType) {
1800           commaSeperatedMapTypes.append(parser::ToUpperCaseLetters(
1801               parser::OmpMapType::EnumToString(mapType)));
1802         },
1803         [&] { commaSeperatedMapTypes.append(", "); });
1804     context_.Say(GetContext().clauseSource,
1805         "Only the %s map types are permitted "
1806         "for MAP clauses on the %s directive"_err_en_US,
1807         commaSeperatedMapTypes, ContextDirectiveAsFortran());
1808   }
1809 }
1810 
Enter(const parser::OmpClause::Map & x)1811 void OmpStructureChecker::Enter(const parser::OmpClause::Map &x) {
1812   CheckAllowed(llvm::omp::Clause::OMPC_map);
1813 
1814   if (const auto &maptype{std::get<std::optional<parser::OmpMapType>>(x.v.t)}) {
1815     using Type = parser::OmpMapType::Type;
1816     const Type &type{std::get<Type>(maptype->t)};
1817     switch (GetContext().directive) {
1818     case llvm::omp::Directive::OMPD_target:
1819     case llvm::omp::Directive::OMPD_target_teams:
1820     case llvm::omp::Directive::OMPD_target_teams_distribute:
1821     case llvm::omp::Directive::OMPD_target_teams_distribute_simd:
1822     case llvm::omp::Directive::OMPD_target_teams_distribute_parallel_do:
1823     case llvm::omp::Directive::OMPD_target_teams_distribute_parallel_do_simd:
1824     case llvm::omp::Directive::OMPD_target_data:
1825       CheckAllowedMapTypes(
1826           type, {Type::To, Type::From, Type::Tofrom, Type::Alloc});
1827       break;
1828     case llvm::omp::Directive::OMPD_target_enter_data:
1829       CheckAllowedMapTypes(type, {Type::To, Type::Alloc});
1830       break;
1831     case llvm::omp::Directive::OMPD_target_exit_data:
1832       CheckAllowedMapTypes(type, {Type::From, Type::Release, Type::Delete});
1833       break;
1834     default:
1835       break;
1836     }
1837   }
1838 }
1839 
ScheduleModifierHasType(const parser::OmpScheduleClause & x,const parser::OmpScheduleModifierType::ModType & type)1840 bool OmpStructureChecker::ScheduleModifierHasType(
1841     const parser::OmpScheduleClause &x,
1842     const parser::OmpScheduleModifierType::ModType &type) {
1843   const auto &modifier{
1844       std::get<std::optional<parser::OmpScheduleModifier>>(x.t)};
1845   if (modifier) {
1846     const auto &modType1{
1847         std::get<parser::OmpScheduleModifier::Modifier1>(modifier->t)};
1848     const auto &modType2{
1849         std::get<std::optional<parser::OmpScheduleModifier::Modifier2>>(
1850             modifier->t)};
1851     if (modType1.v.v == type || (modType2 && modType2->v.v == type)) {
1852       return true;
1853     }
1854   }
1855   return false;
1856 }
Enter(const parser::OmpClause::Schedule & x)1857 void OmpStructureChecker::Enter(const parser::OmpClause::Schedule &x) {
1858   CheckAllowed(llvm::omp::Clause::OMPC_schedule);
1859   const parser::OmpScheduleClause &scheduleClause = x.v;
1860 
1861   // 2.7 Loop Construct Restriction
1862   if (llvm::omp::doSet.test(GetContext().directive)) {
1863     const auto &kind{std::get<1>(scheduleClause.t)};
1864     const auto &chunk{std::get<2>(scheduleClause.t)};
1865     if (chunk) {
1866       if (kind == parser::OmpScheduleClause::ScheduleType::Runtime ||
1867           kind == parser::OmpScheduleClause::ScheduleType::Auto) {
1868         context_.Say(GetContext().clauseSource,
1869             "When SCHEDULE clause has %s specified, "
1870             "it must not have chunk size specified"_err_en_US,
1871             parser::ToUpperCaseLetters(
1872                 parser::OmpScheduleClause::EnumToString(kind)));
1873       }
1874       if (const auto &chunkExpr{std::get<std::optional<parser::ScalarIntExpr>>(
1875               scheduleClause.t)}) {
1876         RequiresPositiveParameter(
1877             llvm::omp::Clause::OMPC_schedule, *chunkExpr, "chunk size");
1878       }
1879     }
1880 
1881     if (ScheduleModifierHasType(scheduleClause,
1882             parser::OmpScheduleModifierType::ModType::Nonmonotonic)) {
1883       if (kind != parser::OmpScheduleClause::ScheduleType::Dynamic &&
1884           kind != parser::OmpScheduleClause::ScheduleType::Guided) {
1885         context_.Say(GetContext().clauseSource,
1886             "The NONMONOTONIC modifier can only be specified with "
1887             "SCHEDULE(DYNAMIC) or SCHEDULE(GUIDED)"_err_en_US);
1888       }
1889     }
1890   }
1891 }
1892 
Enter(const parser::OmpClause::Depend & x)1893 void OmpStructureChecker::Enter(const parser::OmpClause::Depend &x) {
1894   CheckAllowed(llvm::omp::Clause::OMPC_depend);
1895   if (const auto *inOut{std::get_if<parser::OmpDependClause::InOut>(&x.v.u)}) {
1896     const auto &designators{std::get<std::list<parser::Designator>>(inOut->t)};
1897     for (const auto &ele : designators) {
1898       if (const auto *dataRef{std::get_if<parser::DataRef>(&ele.u)}) {
1899         CheckDependList(*dataRef);
1900         if (const auto *arr{
1901                 std::get_if<common::Indirection<parser::ArrayElement>>(
1902                     &dataRef->u)}) {
1903           CheckArraySection(arr->value(), GetLastName(*dataRef),
1904               llvm::omp::Clause::OMPC_depend);
1905         }
1906       }
1907     }
1908   }
1909 }
1910 
Enter(const parser::OmpClause::Copyprivate & x)1911 void OmpStructureChecker::Enter(const parser::OmpClause::Copyprivate &x) {
1912   CheckAllowed(llvm::omp::Clause::OMPC_copyprivate);
1913   CheckIntentInPointer(x.v, llvm::omp::Clause::OMPC_copyprivate);
1914 }
1915 
Enter(const parser::OmpClause::Lastprivate & x)1916 void OmpStructureChecker::Enter(const parser::OmpClause::Lastprivate &x) {
1917   CheckAllowed(llvm::omp::Clause::OMPC_lastprivate);
1918 
1919   DirectivesClauseTriple dirClauseTriple;
1920   SymbolSourceMap currSymbols;
1921   GetSymbolsInObjectList(x.v, currSymbols);
1922   CheckDefinableObjects(currSymbols, GetClauseKindForParserClass(x));
1923 
1924   // Check lastprivate variables in worksharing constructs
1925   dirClauseTriple.emplace(llvm::omp::Directive::OMPD_do,
1926       std::make_pair(
1927           llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet));
1928   dirClauseTriple.emplace(llvm::omp::Directive::OMPD_sections,
1929       std::make_pair(
1930           llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet));
1931 
1932   CheckPrivateSymbolsInOuterCxt(
1933       currSymbols, dirClauseTriple, GetClauseKindForParserClass(x));
1934 }
1935 
getClauseName(llvm::omp::Clause clause)1936 llvm::StringRef OmpStructureChecker::getClauseName(llvm::omp::Clause clause) {
1937   return llvm::omp::getOpenMPClauseName(clause);
1938 }
1939 
getDirectiveName(llvm::omp::Directive directive)1940 llvm::StringRef OmpStructureChecker::getDirectiveName(
1941     llvm::omp::Directive directive) {
1942   return llvm::omp::getOpenMPDirectiveName(directive);
1943 }
1944 
CheckDependList(const parser::DataRef & d)1945 void OmpStructureChecker::CheckDependList(const parser::DataRef &d) {
1946   std::visit(
1947       common::visitors{
1948           [&](const common::Indirection<parser::ArrayElement> &elem) {
1949             // Check if the base element is valid on Depend Clause
1950             CheckDependList(elem.value().base);
1951           },
1952           [&](const common::Indirection<parser::StructureComponent> &) {
1953             context_.Say(GetContext().clauseSource,
1954                 "A variable that is part of another variable "
1955                 "(such as an element of a structure) but is not an array "
1956                 "element or an array section cannot appear in a DEPEND "
1957                 "clause"_err_en_US);
1958           },
1959           [&](const common::Indirection<parser::CoindexedNamedObject> &) {
1960             context_.Say(GetContext().clauseSource,
1961                 "Coarrays are not supported in DEPEND clause"_err_en_US);
1962           },
1963           [&](const parser::Name &) { return; },
1964       },
1965       d.u);
1966 }
1967 
1968 // Called from both Reduction and Depend clause.
CheckArraySection(const parser::ArrayElement & arrayElement,const parser::Name & name,const llvm::omp::Clause clause)1969 void OmpStructureChecker::CheckArraySection(
1970     const parser::ArrayElement &arrayElement, const parser::Name &name,
1971     const llvm::omp::Clause clause) {
1972   if (!arrayElement.subscripts.empty()) {
1973     for (const auto &subscript : arrayElement.subscripts) {
1974       if (const auto *triplet{
1975               std::get_if<parser::SubscriptTriplet>(&subscript.u)}) {
1976         if (std::get<0>(triplet->t) && std::get<1>(triplet->t)) {
1977           const auto &lower{std::get<0>(triplet->t)};
1978           const auto &upper{std::get<1>(triplet->t)};
1979           if (lower && upper) {
1980             const auto lval{GetIntValue(lower)};
1981             const auto uval{GetIntValue(upper)};
1982             if (lval && uval && *uval < *lval) {
1983               context_.Say(GetContext().clauseSource,
1984                   "'%s' in %s clause"
1985                   " is a zero size array section"_err_en_US,
1986                   name.ToString(),
1987                   parser::ToUpperCaseLetters(getClauseName(clause).str()));
1988               break;
1989             } else if (std::get<2>(triplet->t)) {
1990               const auto &strideExpr{std::get<2>(triplet->t)};
1991               if (strideExpr) {
1992                 if (clause == llvm::omp::Clause::OMPC_depend) {
1993                   context_.Say(GetContext().clauseSource,
1994                       "Stride should not be specified for array section in "
1995                       "DEPEND "
1996                       "clause"_err_en_US);
1997                 }
1998                 const auto stride{GetIntValue(strideExpr)};
1999                 if ((stride && stride != 1)) {
2000                   context_.Say(GetContext().clauseSource,
2001                       "A list item that appears in a REDUCTION clause"
2002                       " should have a contiguous storage array section."_err_en_US,
2003                       ContextDirectiveAsFortran());
2004                   break;
2005                 }
2006               }
2007             }
2008           }
2009         }
2010       }
2011     }
2012   }
2013 }
2014 
CheckIntentInPointer(const parser::OmpObjectList & objectList,const llvm::omp::Clause clause)2015 void OmpStructureChecker::CheckIntentInPointer(
2016     const parser::OmpObjectList &objectList, const llvm::omp::Clause clause) {
2017   SymbolSourceMap symbols;
2018   GetSymbolsInObjectList(objectList, symbols);
2019   for (auto it{symbols.begin()}; it != symbols.end(); ++it) {
2020     const auto *symbol{it->first};
2021     const auto source{it->second};
2022     if (IsPointer(*symbol) && IsIntentIn(*symbol)) {
2023       context_.Say(source,
2024           "Pointer '%s' with the INTENT(IN) attribute may not appear "
2025           "in a %s clause"_err_en_US,
2026           symbol->name(),
2027           parser::ToUpperCaseLetters(getClauseName(clause).str()));
2028     }
2029   }
2030 }
2031 
GetSymbolsInObjectList(const parser::OmpObjectList & objectList,SymbolSourceMap & symbols)2032 void OmpStructureChecker::GetSymbolsInObjectList(
2033     const parser::OmpObjectList &objectList, SymbolSourceMap &symbols) {
2034   for (const auto &ompObject : objectList.v) {
2035     if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
2036       if (const auto *symbol{name->symbol}) {
2037         if (const auto *commonBlockDetails{
2038                 symbol->detailsIf<CommonBlockDetails>()}) {
2039           for (const auto &object : commonBlockDetails->objects()) {
2040             symbols.emplace(&object->GetUltimate(), name->source);
2041           }
2042         } else {
2043           symbols.emplace(&symbol->GetUltimate(), name->source);
2044         }
2045       }
2046     }
2047   }
2048 }
2049 
CheckDefinableObjects(SymbolSourceMap & symbols,const llvm::omp::Clause clause)2050 void OmpStructureChecker::CheckDefinableObjects(
2051     SymbolSourceMap &symbols, const llvm::omp::Clause clause) {
2052   for (auto it{symbols.begin()}; it != symbols.end(); ++it) {
2053     const auto *symbol{it->first};
2054     const auto source{it->second};
2055     if (auto msg{WhyNotModifiable(*symbol, context_.FindScope(source))}) {
2056       context_
2057           .Say(source,
2058               "Variable '%s' on the %s clause is not definable"_err_en_US,
2059               symbol->name(),
2060               parser::ToUpperCaseLetters(getClauseName(clause).str()))
2061           .Attach(source, std::move(*msg), symbol->name());
2062     }
2063   }
2064 }
2065 
CheckPrivateSymbolsInOuterCxt(SymbolSourceMap & currSymbols,DirectivesClauseTriple & dirClauseTriple,const llvm::omp::Clause currClause)2066 void OmpStructureChecker::CheckPrivateSymbolsInOuterCxt(
2067     SymbolSourceMap &currSymbols, DirectivesClauseTriple &dirClauseTriple,
2068     const llvm::omp::Clause currClause) {
2069   SymbolSourceMap enclosingSymbols;
2070   auto range{dirClauseTriple.equal_range(GetContext().directive)};
2071   for (auto dirIter{range.first}; dirIter != range.second; ++dirIter) {
2072     auto enclosingDir{dirIter->second.first};
2073     auto enclosingClauseSet{dirIter->second.second};
2074     if (auto *enclosingContext{GetEnclosingContextWithDir(enclosingDir)}) {
2075       for (auto it{enclosingContext->clauseInfo.begin()};
2076            it != enclosingContext->clauseInfo.end(); ++it) {
2077         if (enclosingClauseSet.test(it->first)) {
2078           if (const auto *ompObjectList{GetOmpObjectList(*it->second)}) {
2079             GetSymbolsInObjectList(*ompObjectList, enclosingSymbols);
2080           }
2081         }
2082       }
2083 
2084       // Check if the symbols in current context are private in outer context
2085       for (auto iter{currSymbols.begin()}; iter != currSymbols.end(); ++iter) {
2086         const auto *symbol{iter->first};
2087         const auto source{iter->second};
2088         if (enclosingSymbols.find(symbol) != enclosingSymbols.end()) {
2089           context_.Say(source,
2090               "%s variable '%s' is PRIVATE in outer context"_err_en_US,
2091               parser::ToUpperCaseLetters(getClauseName(currClause).str()),
2092               symbol->name());
2093         }
2094       }
2095     }
2096   }
2097 }
2098 
CheckTargetBlockOnlyTeams(const parser::Block & block)2099 bool OmpStructureChecker::CheckTargetBlockOnlyTeams(
2100     const parser::Block &block) {
2101   bool nestedTeams{false};
2102   auto it{block.begin()};
2103 
2104   if (const auto *ompConstruct{parser::Unwrap<parser::OpenMPConstruct>(*it)}) {
2105     if (const auto *ompBlockConstruct{
2106             std::get_if<parser::OpenMPBlockConstruct>(&ompConstruct->u)}) {
2107       const auto &beginBlockDir{
2108           std::get<parser::OmpBeginBlockDirective>(ompBlockConstruct->t)};
2109       const auto &beginDir{
2110           std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
2111       if (beginDir.v == llvm::omp::Directive::OMPD_teams) {
2112         nestedTeams = true;
2113       }
2114     }
2115   }
2116 
2117   if (nestedTeams && ++it == block.end()) {
2118     return true;
2119   }
2120   return false;
2121 }
2122 
CheckWorkshareBlockStmts(const parser::Block & block,parser::CharBlock source)2123 void OmpStructureChecker::CheckWorkshareBlockStmts(
2124     const parser::Block &block, parser::CharBlock source) {
2125   OmpWorkshareBlockChecker ompWorkshareBlockChecker{context_, source};
2126 
2127   for (auto it{block.begin()}; it != block.end(); ++it) {
2128     if (parser::Unwrap<parser::AssignmentStmt>(*it) ||
2129         parser::Unwrap<parser::ForallStmt>(*it) ||
2130         parser::Unwrap<parser::ForallConstruct>(*it) ||
2131         parser::Unwrap<parser::WhereStmt>(*it) ||
2132         parser::Unwrap<parser::WhereConstruct>(*it)) {
2133       parser::Walk(*it, ompWorkshareBlockChecker);
2134     } else if (const auto *ompConstruct{
2135                    parser::Unwrap<parser::OpenMPConstruct>(*it)}) {
2136       if (const auto *ompAtomicConstruct{
2137               std::get_if<parser::OpenMPAtomicConstruct>(&ompConstruct->u)}) {
2138         // Check if assignment statements in the enclosing OpenMP Atomic
2139         // construct are allowed in the Workshare construct
2140         parser::Walk(*ompAtomicConstruct, ompWorkshareBlockChecker);
2141       } else if (const auto *ompCriticalConstruct{
2142                      std::get_if<parser::OpenMPCriticalConstruct>(
2143                          &ompConstruct->u)}) {
2144         // All the restrictions on the Workshare construct apply to the
2145         // statements in the enclosing critical constructs
2146         const auto &criticalBlock{
2147             std::get<parser::Block>(ompCriticalConstruct->t)};
2148         CheckWorkshareBlockStmts(criticalBlock, source);
2149       } else {
2150         // Check if OpenMP constructs enclosed in the Workshare construct are
2151         // 'Parallel' constructs
2152         auto currentDir{llvm::omp::Directive::OMPD_unknown};
2153         const OmpDirectiveSet parallelDirSet{
2154             llvm::omp::Directive::OMPD_parallel,
2155             llvm::omp::Directive::OMPD_parallel_do,
2156             llvm::omp::Directive::OMPD_parallel_sections,
2157             llvm::omp::Directive::OMPD_parallel_workshare,
2158             llvm::omp::Directive::OMPD_parallel_do_simd};
2159 
2160         if (const auto *ompBlockConstruct{
2161                 std::get_if<parser::OpenMPBlockConstruct>(&ompConstruct->u)}) {
2162           const auto &beginBlockDir{
2163               std::get<parser::OmpBeginBlockDirective>(ompBlockConstruct->t)};
2164           const auto &beginDir{
2165               std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
2166           currentDir = beginDir.v;
2167         } else if (const auto *ompLoopConstruct{
2168                        std::get_if<parser::OpenMPLoopConstruct>(
2169                            &ompConstruct->u)}) {
2170           const auto &beginLoopDir{
2171               std::get<parser::OmpBeginLoopDirective>(ompLoopConstruct->t)};
2172           const auto &beginDir{
2173               std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
2174           currentDir = beginDir.v;
2175         } else if (const auto *ompSectionsConstruct{
2176                        std::get_if<parser::OpenMPSectionsConstruct>(
2177                            &ompConstruct->u)}) {
2178           const auto &beginSectionsDir{
2179               std::get<parser::OmpBeginSectionsDirective>(
2180                   ompSectionsConstruct->t)};
2181           const auto &beginDir{
2182               std::get<parser::OmpSectionsDirective>(beginSectionsDir.t)};
2183           currentDir = beginDir.v;
2184         }
2185 
2186         if (!parallelDirSet.test(currentDir)) {
2187           context_.Say(source,
2188               "OpenMP constructs enclosed in WORKSHARE construct may consist "
2189               "of ATOMIC, CRITICAL or PARALLEL constructs only"_err_en_US);
2190         }
2191       }
2192     } else {
2193       context_.Say(source,
2194           "The structured block in a WORKSHARE construct may consist of only "
2195           "SCALAR or ARRAY assignments, FORALL or WHERE statements, "
2196           "FORALL, WHERE, ATOMIC, CRITICAL or PARALLEL constructs"_err_en_US);
2197     }
2198   }
2199 }
2200 
GetOmpObjectList(const parser::OmpClause & clause)2201 const parser::OmpObjectList *OmpStructureChecker::GetOmpObjectList(
2202     const parser::OmpClause &clause) {
2203 
2204   // Clauses with OmpObjectList as its data member
2205   using MemberObjectListClauses = std::tuple<parser::OmpClause::Copyprivate,
2206       parser::OmpClause::Copyin, parser::OmpClause::Firstprivate,
2207       parser::OmpClause::From, parser::OmpClause::Lastprivate,
2208       parser::OmpClause::Link, parser::OmpClause::Private,
2209       parser::OmpClause::Shared, parser::OmpClause::To>;
2210 
2211   // Clauses with OmpObjectList in the tuple
2212   using TupleObjectListClauses = std::tuple<parser::OmpClause::Allocate,
2213       parser::OmpClause::Map, parser::OmpClause::Reduction>;
2214 
2215   // TODO:: Generate the tuples using TableGen.
2216   // Handle other constructs with OmpObjectList such as OpenMPThreadprivate.
2217   return std::visit(
2218       common::visitors{
2219           [&](const auto &x) -> const parser::OmpObjectList * {
2220             using Ty = std::decay_t<decltype(x)>;
2221             if constexpr (common::HasMember<Ty, MemberObjectListClauses>) {
2222               return &x.v;
2223             } else if constexpr (common::HasMember<Ty,
2224                                      TupleObjectListClauses>) {
2225               return &(std::get<parser::OmpObjectList>(x.v.t));
2226             } else {
2227               return nullptr;
2228             }
2229           },
2230       },
2231       clause.u);
2232 }
2233 
2234 } // namespace Fortran::semantics
2235