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