1 //===-- lib/Semantics/check-omp-structure.cpp -----------------------------===//
2 //
3 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
4 // See https://llvm.org/LICENSE.txt for license information.
5 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
6 //
7 //===----------------------------------------------------------------------===//
8 
9 #include "check-omp-structure.h"
10 #include "flang/Parser/parse-tree.h"
11 #include "flang/Semantics/tools.h"
12 #include <algorithm>
13 
14 namespace Fortran::semantics {
15 
16 // Use when clause falls under 'struct OmpClause' in 'parse-tree.h'.
17 #define CHECK_SIMPLE_CLAUSE(X, Y) \
18   void OmpStructureChecker::Enter(const parser::OmpClause::X &) { \
19     CheckAllowed(llvm::omp::Clause::Y); \
20   }
21 
22 #define CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(X, Y) \
23   void OmpStructureChecker::Enter(const parser::OmpClause::X &c) { \
24     CheckAllowed(llvm::omp::Clause::Y); \
25     RequiresConstantPositiveParameter(llvm::omp::Clause::Y, c.v); \
26   }
27 
28 #define CHECK_REQ_SCALAR_INT_CLAUSE(X, Y) \
29   void OmpStructureChecker::Enter(const parser::OmpClause::X &c) { \
30     CheckAllowed(llvm::omp::Clause::Y); \
31     RequiresPositiveParameter(llvm::omp::Clause::Y, c.v); \
32   }
33 
34 // Use when clause don't falls under 'struct OmpClause' in 'parse-tree.h'.
35 #define CHECK_SIMPLE_PARSER_CLAUSE(X, Y) \
36   void OmpStructureChecker::Enter(const parser::X &) { \
37     CheckAllowed(llvm::omp::Y); \
38   }
39 
40 // 'OmpWorkshareBlockChecker' is used to check the validity of the assignment
41 // statements and the expressions enclosed in an OpenMP Workshare construct
42 class OmpWorkshareBlockChecker {
43 public:
44   OmpWorkshareBlockChecker(SemanticsContext &context, parser::CharBlock source)
45       : context_{context}, source_{source} {}
46 
47   template <typename T> bool Pre(const T &) { return true; }
48   template <typename T> void Post(const T &) {}
49 
50   bool Pre(const parser::AssignmentStmt &assignment) {
51     const auto &var{std::get<parser::Variable>(assignment.t)};
52     const auto &expr{std::get<parser::Expr>(assignment.t)};
53     const auto *lhs{GetExpr(var)};
54     const auto *rhs{GetExpr(expr)};
55     Tristate isDefined{semantics::IsDefinedAssignment(
56         lhs->GetType(), lhs->Rank(), rhs->GetType(), rhs->Rank())};
57     if (isDefined == Tristate::Yes) {
58       context_.Say(expr.source,
59           "Defined assignment statement is not "
60           "allowed in a WORKSHARE construct"_err_en_US);
61     }
62     return true;
63   }
64 
65   bool Pre(const parser::Expr &expr) {
66     if (const auto *e{GetExpr(expr)}) {
67       for (const Symbol &symbol : evaluate::CollectSymbols(*e)) {
68         const Symbol &root{GetAssociationRoot(symbol)};
69         if (IsFunction(root) &&
70             !(root.attrs().test(Attr::ELEMENTAL) ||
71                 root.attrs().test(Attr::INTRINSIC))) {
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:
89   OmpCycleChecker(SemanticsContext &context, std::int64_t cycleLevel)
90       : context_{context}, cycleLevel_{cycleLevel} {}
91 
92   template <typename T> bool Pre(const T &) { return true; }
93   template <typename T> void Post(const T &) {}
94 
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 
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 
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 
130 bool OmpStructureChecker::HasInvalidWorksharingNesting(
131     const parser::CharBlock &source, const OmpDirectiveSet &set) {
132   // set contains all the invalid closely nested directives
133   // for the given directive (`source` here)
134   if (CurrentDirectiveIsNested() && set.test(GetContextParent().directive)) {
135     context_.Say(source,
136         "A worksharing region may not be closely nested inside a "
137         "worksharing, explicit task, taskloop, critical, ordered, atomic, or "
138         "master region"_err_en_US);
139     return true;
140   }
141   return false;
142 }
143 
144 void OmpStructureChecker::Enter(const parser::OpenMPConstruct &) {
145   // 2.8.1 TODO: Simd Construct with Ordered Construct Nesting check
146 }
147 
148 void OmpStructureChecker::Enter(const parser::OpenMPLoopConstruct &x) {
149   const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
150   const auto &beginDir{std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
151 
152   // check matching, End directive is optional
153   if (const auto &endLoopDir{
154           std::get<std::optional<parser::OmpEndLoopDirective>>(x.t)}) {
155     const auto &endDir{
156         std::get<parser::OmpLoopDirective>(endLoopDir.value().t)};
157 
158     CheckMatching<parser::OmpLoopDirective>(beginDir, endDir);
159   }
160 
161   PushContextAndClauseSets(beginDir.source, beginDir.v);
162 
163   if (beginDir.v == llvm::omp::Directive::OMPD_do) {
164     // 2.7.1 do-clause -> private-clause |
165     //                    firstprivate-clause |
166     //                    lastprivate-clause |
167     //                    linear-clause |
168     //                    reduction-clause |
169     //                    schedule-clause |
170     //                    collapse-clause |
171     //                    ordered-clause
172 
173     // nesting check
174     HasInvalidWorksharingNesting(beginDir.source,
175         {llvm::omp::Directive::OMPD_do, llvm::omp::Directive::OMPD_sections,
176             llvm::omp::Directive::OMPD_single,
177             llvm::omp::Directive::OMPD_workshare,
178             llvm::omp::Directive::OMPD_task,
179             llvm::omp::Directive::OMPD_taskloop,
180             llvm::omp::Directive::OMPD_critical,
181             llvm::omp::Directive::OMPD_ordered,
182             llvm::omp::Directive::OMPD_atomic,
183             llvm::omp::Directive::OMPD_master});
184   }
185   SetLoopInfo(x);
186 
187   if (const auto &doConstruct{
188           std::get<std::optional<parser::DoConstruct>>(x.t)}) {
189     const auto &doBlock{std::get<parser::Block>(doConstruct->t)};
190     CheckNoBranching(doBlock, beginDir.v, beginDir.source);
191   }
192   CheckDoWhile(x);
193   CheckLoopItrVariableIsInt(x);
194   CheckCycleConstraints(x);
195 }
196 const parser::Name OmpStructureChecker::GetLoopIndex(
197     const parser::DoConstruct *x) {
198   using Bounds = parser::LoopControl::Bounds;
199   return std::get<Bounds>(x->GetLoopControl()->u).name.thing;
200 }
201 void OmpStructureChecker::SetLoopInfo(const parser::OpenMPLoopConstruct &x) {
202   if (const auto &loopConstruct{
203           std::get<std::optional<parser::DoConstruct>>(x.t)}) {
204     const parser::DoConstruct *loop{&*loopConstruct};
205     if (loop && loop->IsDoNormal()) {
206       const parser::Name &itrVal{GetLoopIndex(loop)};
207       SetLoopIv(itrVal.symbol);
208     }
209   }
210 }
211 void OmpStructureChecker::CheckDoWhile(const parser::OpenMPLoopConstruct &x) {
212   const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
213   const auto &beginDir{std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
214   if (beginDir.v == llvm::omp::Directive::OMPD_do) {
215     if (const auto &doConstruct{
216             std::get<std::optional<parser::DoConstruct>>(x.t)}) {
217       if (doConstruct.value().IsDoWhile()) {
218         const auto &doStmt{std::get<parser::Statement<parser::NonLabelDoStmt>>(
219             doConstruct.value().t)};
220         context_.Say(doStmt.source,
221             "The DO loop cannot be a DO WHILE with DO directive."_err_en_US);
222       }
223     }
224   }
225 }
226 
227 void OmpStructureChecker::CheckLoopItrVariableIsInt(
228     const parser::OpenMPLoopConstruct &x) {
229   if (const auto &loopConstruct{
230           std::get<std::optional<parser::DoConstruct>>(x.t)}) {
231 
232     for (const parser::DoConstruct *loop{&*loopConstruct}; loop;) {
233       if (loop->IsDoNormal()) {
234         const parser::Name &itrVal{GetLoopIndex(loop)};
235         if (itrVal.symbol) {
236           const auto *type{itrVal.symbol->GetType()};
237           if (!type->IsNumeric(TypeCategory::Integer)) {
238             context_.Say(itrVal.source,
239                 "The DO loop iteration"
240                 " variable must be of the type integer."_err_en_US,
241                 itrVal.ToString());
242           }
243         }
244       }
245       // Get the next DoConstruct if block is not empty.
246       const auto &block{std::get<parser::Block>(loop->t)};
247       const auto it{block.begin()};
248       loop = it != block.end() ? parser::Unwrap<parser::DoConstruct>(*it)
249                                : nullptr;
250     }
251   }
252 }
253 
254 std::int64_t OmpStructureChecker::GetOrdCollapseLevel(
255     const parser::OpenMPLoopConstruct &x) {
256   const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
257   const auto &clauseList{std::get<parser::OmpClauseList>(beginLoopDir.t)};
258   std::int64_t orderedCollapseLevel{1};
259   std::int64_t orderedLevel{0};
260   std::int64_t collapseLevel{0};
261 
262   for (const auto &clause : clauseList.v) {
263     if (const auto *collapseClause{
264             std::get_if<parser::OmpClause::Collapse>(&clause.u)}) {
265       if (const auto v{GetIntValue(collapseClause->v)}) {
266         collapseLevel = *v;
267       }
268     }
269     if (const auto *orderedClause{
270             std::get_if<parser::OmpClause::Ordered>(&clause.u)}) {
271       if (const auto v{GetIntValue(orderedClause->v)}) {
272         orderedLevel = *v;
273       }
274     }
275   }
276   if (orderedLevel >= collapseLevel) {
277     orderedCollapseLevel = orderedLevel;
278   } else {
279     orderedCollapseLevel = collapseLevel;
280   }
281   return orderedCollapseLevel;
282 }
283 
284 void OmpStructureChecker::CheckCycleConstraints(
285     const parser::OpenMPLoopConstruct &x) {
286   std::int64_t ordCollapseLevel{GetOrdCollapseLevel(x)};
287   OmpCycleChecker ompCycleChecker{context_, ordCollapseLevel};
288   parser::Walk(x, ompCycleChecker);
289 }
290 
291 void OmpStructureChecker::Leave(const parser::OpenMPLoopConstruct &) {
292   dirContext_.pop_back();
293 }
294 
295 void OmpStructureChecker::Enter(const parser::OmpEndLoopDirective &x) {
296   const auto &dir{std::get<parser::OmpLoopDirective>(x.t)};
297   ResetPartialContext(dir.source);
298   switch (dir.v) {
299   // 2.7.1 end-do -> END DO [nowait-clause]
300   // 2.8.3 end-do-simd -> END DO SIMD [nowait-clause]
301   case llvm::omp::Directive::OMPD_do:
302   case llvm::omp::Directive::OMPD_do_simd:
303     SetClauseSets(dir.v);
304     break;
305   default:
306     // no clauses are allowed
307     break;
308   }
309 }
310 
311 void OmpStructureChecker::Enter(const parser::OpenMPBlockConstruct &x) {
312   const auto &beginBlockDir{std::get<parser::OmpBeginBlockDirective>(x.t)};
313   const auto &endBlockDir{std::get<parser::OmpEndBlockDirective>(x.t)};
314   const auto &beginDir{std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
315   const auto &endDir{std::get<parser::OmpBlockDirective>(endBlockDir.t)};
316   const parser::Block &block{std::get<parser::Block>(x.t)};
317 
318   CheckMatching<parser::OmpBlockDirective>(beginDir, endDir);
319 
320   PushContextAndClauseSets(beginDir.source, beginDir.v);
321 
322   // TODO: This check needs to be extended while implementing nesting of regions
323   // checks.
324   if (beginDir.v == llvm::omp::Directive::OMPD_single) {
325     HasInvalidWorksharingNesting(
326         beginDir.source, {llvm::omp::Directive::OMPD_do});
327   }
328   if (CurrentDirectiveIsNested())
329     CheckIfDoOrderedClause(beginDir);
330 
331   CheckNoBranching(block, beginDir.v, beginDir.source);
332 
333   switch (beginDir.v) {
334   case llvm::omp::OMPD_workshare:
335   case llvm::omp::OMPD_parallel_workshare:
336     CheckWorkshareBlockStmts(block, beginDir.source);
337     break;
338   default:
339     break;
340   }
341 }
342 
343 void OmpStructureChecker::CheckIfDoOrderedClause(
344     const parser::OmpBlockDirective &blkDirective) {
345   if (blkDirective.v == llvm::omp::OMPD_ordered) {
346     // Loops
347     if (llvm::omp::doSet.test(GetContextParent().directive) &&
348         !FindClauseParent(llvm::omp::Clause::OMPC_ordered)) {
349       context_.Say(blkDirective.source,
350           "The ORDERED clause must be present on the loop"
351           " construct if any ORDERED region ever binds"
352           " to a loop region arising from the loop construct."_err_en_US);
353     }
354     // Other disallowed nestings, these directives do not support
355     // ordered clause in them, so no need to check
356     else if (llvm::omp::nestedOrderedErrSet.test(
357                  GetContextParent().directive)) {
358       context_.Say(blkDirective.source,
359           "`ORDERED` region may not be closely nested inside of "
360           "`CRITICAL`, `ORDERED`, explicit `TASK` or `TASKLOOP` region."_err_en_US);
361     }
362   }
363 }
364 
365 void OmpStructureChecker::Leave(const parser::OpenMPBlockConstruct &) {
366   dirContext_.pop_back();
367 }
368 
369 void OmpStructureChecker::Enter(const parser::OpenMPSectionsConstruct &x) {
370   const auto &beginSectionsDir{
371       std::get<parser::OmpBeginSectionsDirective>(x.t)};
372   const auto &endSectionsDir{std::get<parser::OmpEndSectionsDirective>(x.t)};
373   const auto &beginDir{
374       std::get<parser::OmpSectionsDirective>(beginSectionsDir.t)};
375   const auto &endDir{std::get<parser::OmpSectionsDirective>(endSectionsDir.t)};
376   CheckMatching<parser::OmpSectionsDirective>(beginDir, endDir);
377 
378   PushContextAndClauseSets(beginDir.source, beginDir.v);
379   const auto &sectionBlocks{std::get<parser::OmpSectionBlocks>(x.t)};
380   for (const auto &block : sectionBlocks.v) {
381     CheckNoBranching(block, beginDir.v, beginDir.source);
382   }
383 }
384 
385 void OmpStructureChecker::Leave(const parser::OpenMPSectionsConstruct &) {
386   dirContext_.pop_back();
387 }
388 
389 void OmpStructureChecker::Enter(const parser::OmpEndSectionsDirective &x) {
390   const auto &dir{std::get<parser::OmpSectionsDirective>(x.t)};
391   ResetPartialContext(dir.source);
392   switch (dir.v) {
393     // 2.7.2 end-sections -> END SECTIONS [nowait-clause]
394   case llvm::omp::Directive::OMPD_sections:
395     PushContextAndClauseSets(
396         dir.source, llvm::omp::Directive::OMPD_end_sections);
397     break;
398   default:
399     // no clauses are allowed
400     break;
401   }
402 }
403 
404 // TODO: Verify the popping of dirContext requirement after nowait
405 // implementation, as there is an implicit barrier at the end of the worksharing
406 // constructs unless a nowait clause is specified. Only OMPD_end_sections is
407 // popped becuase it is pushed while entering the EndSectionsDirective.
408 void OmpStructureChecker::Leave(const parser::OmpEndSectionsDirective &x) {
409   if (GetContext().directive == llvm::omp::Directive::OMPD_end_sections) {
410     dirContext_.pop_back();
411   }
412 }
413 
414 void OmpStructureChecker::Enter(const parser::OpenMPDeclareSimdConstruct &x) {
415   const auto &dir{std::get<parser::Verbatim>(x.t)};
416   PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_declare_simd);
417 }
418 
419 void OmpStructureChecker::Leave(const parser::OpenMPDeclareSimdConstruct &) {
420   dirContext_.pop_back();
421 }
422 
423 void OmpStructureChecker::Enter(const parser::OpenMPDeclarativeAllocate &x) {
424   const auto &dir{std::get<parser::Verbatim>(x.t)};
425   PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_allocate);
426 }
427 
428 void OmpStructureChecker::Leave(const parser::OpenMPDeclarativeAllocate &) {
429   dirContext_.pop_back();
430 }
431 
432 void OmpStructureChecker::Enter(const parser::OpenMPDeclareTargetConstruct &x) {
433   const auto &dir{std::get<parser::Verbatim>(x.t)};
434   PushContext(dir.source, llvm::omp::Directive::OMPD_declare_target);
435   const auto &spec{std::get<parser::OmpDeclareTargetSpecifier>(x.t)};
436   if (std::holds_alternative<parser::OmpDeclareTargetWithClause>(spec.u)) {
437     SetClauseSets(llvm::omp::Directive::OMPD_declare_target);
438   }
439 }
440 
441 void OmpStructureChecker::Leave(const parser::OpenMPDeclareTargetConstruct &) {
442   dirContext_.pop_back();
443 }
444 
445 void OmpStructureChecker::Enter(const parser::OpenMPExecutableAllocate &x) {
446   const auto &dir{std::get<parser::Verbatim>(x.t)};
447   PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_allocate);
448 }
449 
450 void OmpStructureChecker::Leave(const parser::OpenMPExecutableAllocate &) {
451   dirContext_.pop_back();
452 }
453 
454 void OmpStructureChecker::Enter(
455     const parser::OpenMPSimpleStandaloneConstruct &x) {
456   const auto &dir{std::get<parser::OmpSimpleStandaloneDirective>(x.t)};
457   PushContextAndClauseSets(dir.source, dir.v);
458 }
459 
460 void OmpStructureChecker::Leave(
461     const parser::OpenMPSimpleStandaloneConstruct &) {
462   dirContext_.pop_back();
463 }
464 
465 void OmpStructureChecker::Enter(const parser::OpenMPFlushConstruct &x) {
466   const auto &dir{std::get<parser::Verbatim>(x.t)};
467   PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_flush);
468 }
469 
470 void OmpStructureChecker::Leave(const parser::OpenMPFlushConstruct &x) {
471   if (FindClause(llvm::omp::Clause::OMPC_acquire) ||
472       FindClause(llvm::omp::Clause::OMPC_release) ||
473       FindClause(llvm::omp::Clause::OMPC_acq_rel)) {
474     if (const auto &flushList{
475             std::get<std::optional<parser::OmpObjectList>>(x.t)}) {
476       context_.Say(parser::FindSourceLocation(flushList),
477           "If memory-order-clause is RELEASE, ACQUIRE, or ACQ_REL, list items "
478           "must not be specified on the FLUSH directive"_err_en_US);
479     }
480   }
481   dirContext_.pop_back();
482 }
483 
484 void OmpStructureChecker::Enter(const parser::OpenMPCancelConstruct &x) {
485   const auto &dir{std::get<parser::Verbatim>(x.t)};
486   PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_cancel);
487 }
488 
489 void OmpStructureChecker::Leave(const parser::OpenMPCancelConstruct &) {
490   dirContext_.pop_back();
491 }
492 
493 void OmpStructureChecker::Enter(const parser::OpenMPCriticalConstruct &x) {
494   const auto &dir{std::get<parser::OmpCriticalDirective>(x.t)};
495   PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_critical);
496   const auto &block{std::get<parser::Block>(x.t)};
497   CheckNoBranching(block, llvm::omp::Directive::OMPD_critical, dir.source);
498 }
499 
500 void OmpStructureChecker::Leave(const parser::OpenMPCriticalConstruct &) {
501   dirContext_.pop_back();
502 }
503 
504 void OmpStructureChecker::Enter(
505     const parser::OpenMPCancellationPointConstruct &x) {
506   const auto &dir{std::get<parser::Verbatim>(x.t)};
507   PushContextAndClauseSets(
508       dir.source, llvm::omp::Directive::OMPD_cancellation_point);
509 }
510 
511 void OmpStructureChecker::Leave(
512     const parser::OpenMPCancellationPointConstruct &) {
513   dirContext_.pop_back();
514 }
515 
516 void OmpStructureChecker::Enter(const parser::OmpEndBlockDirective &x) {
517   const auto &dir{std::get<parser::OmpBlockDirective>(x.t)};
518   ResetPartialContext(dir.source);
519   switch (dir.v) {
520   // 2.7.3 end-single-clause -> copyprivate-clause |
521   //                            nowait-clause
522   case llvm::omp::Directive::OMPD_single:
523     PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_end_single);
524     break;
525   // 2.7.4 end-workshare -> END WORKSHARE [nowait-clause]
526   case llvm::omp::Directive::OMPD_workshare:
527     PushContextAndClauseSets(
528         dir.source, llvm::omp::Directive::OMPD_end_workshare);
529     break;
530   default:
531     // no clauses are allowed
532     break;
533   }
534 }
535 
536 // TODO: Verify the popping of dirContext requirement after nowait
537 // implementation, as there is an implicit barrier at the end of the worksharing
538 // constructs unless a nowait clause is specified. Only OMPD_end_single and
539 // end_workshareare popped as they are pushed while entering the
540 // EndBlockDirective.
541 void OmpStructureChecker::Leave(const parser::OmpEndBlockDirective &x) {
542   if ((GetContext().directive == llvm::omp::Directive::OMPD_end_single) ||
543       (GetContext().directive == llvm::omp::Directive::OMPD_end_workshare)) {
544     dirContext_.pop_back();
545   }
546 }
547 
548 void OmpStructureChecker::Enter(const parser::OpenMPAtomicConstruct &x) {
549   std::visit(
550       common::visitors{
551           [&](const auto &someAtomicConstruct) {
552             const auto &dir{std::get<parser::Verbatim>(someAtomicConstruct.t)};
553             PushContextAndClauseSets(
554                 dir.source, llvm::omp::Directive::OMPD_atomic);
555           },
556       },
557       x.u);
558 }
559 
560 void OmpStructureChecker::Leave(const parser::OpenMPAtomicConstruct &) {
561   dirContext_.pop_back();
562 }
563 
564 // Clauses
565 // Mainly categorized as
566 // 1. Checks on 'OmpClauseList' from 'parse-tree.h'.
567 // 2. Checks on clauses which fall under 'struct OmpClause' from parse-tree.h.
568 // 3. Checks on clauses which are not in 'struct OmpClause' from parse-tree.h.
569 
570 void OmpStructureChecker::Leave(const parser::OmpClauseList &) {
571   // 2.7 Loop Construct Restriction
572   if (llvm::omp::doSet.test(GetContext().directive)) {
573     if (auto *clause{FindClause(llvm::omp::Clause::OMPC_schedule)}) {
574       // only one schedule clause is allowed
575       const auto &schedClause{std::get<parser::OmpClause::Schedule>(clause->u)};
576       if (ScheduleModifierHasType(schedClause.v,
577               parser::OmpScheduleModifierType::ModType::Nonmonotonic)) {
578         if (FindClause(llvm::omp::Clause::OMPC_ordered)) {
579           context_.Say(clause->source,
580               "The NONMONOTONIC modifier cannot be specified "
581               "if an ORDERED clause is specified"_err_en_US);
582         }
583         if (ScheduleModifierHasType(schedClause.v,
584                 parser::OmpScheduleModifierType::ModType::Monotonic)) {
585           context_.Say(clause->source,
586               "The MONOTONIC and NONMONOTONIC modifiers "
587               "cannot be both specified"_err_en_US);
588         }
589       }
590     }
591 
592     if (auto *clause{FindClause(llvm::omp::Clause::OMPC_ordered)}) {
593       // only one ordered clause is allowed
594       const auto &orderedClause{
595           std::get<parser::OmpClause::Ordered>(clause->u)};
596 
597       if (orderedClause.v) {
598         CheckNotAllowedIfClause(
599             llvm::omp::Clause::OMPC_ordered, {llvm::omp::Clause::OMPC_linear});
600 
601         if (auto *clause2{FindClause(llvm::omp::Clause::OMPC_collapse)}) {
602           const auto &collapseClause{
603               std::get<parser::OmpClause::Collapse>(clause2->u)};
604           // ordered and collapse both have parameters
605           if (const auto orderedValue{GetIntValue(orderedClause.v)}) {
606             if (const auto collapseValue{GetIntValue(collapseClause.v)}) {
607               if (*orderedValue > 0 && *orderedValue < *collapseValue) {
608                 context_.Say(clause->source,
609                     "The parameter of the ORDERED clause must be "
610                     "greater than or equal to "
611                     "the parameter of the COLLAPSE clause"_err_en_US);
612               }
613             }
614           }
615         }
616       }
617 
618       // TODO: ordered region binding check (requires nesting implementation)
619     }
620   } // doSet
621 
622   // 2.8.1 Simd Construct Restriction
623   if (llvm::omp::simdSet.test(GetContext().directive)) {
624     if (auto *clause{FindClause(llvm::omp::Clause::OMPC_simdlen)}) {
625       if (auto *clause2{FindClause(llvm::omp::Clause::OMPC_safelen)}) {
626         const auto &simdlenClause{
627             std::get<parser::OmpClause::Simdlen>(clause->u)};
628         const auto &safelenClause{
629             std::get<parser::OmpClause::Safelen>(clause2->u)};
630         // simdlen and safelen both have parameters
631         if (const auto simdlenValue{GetIntValue(simdlenClause.v)}) {
632           if (const auto safelenValue{GetIntValue(safelenClause.v)}) {
633             if (*safelenValue > 0 && *simdlenValue > *safelenValue) {
634               context_.Say(clause->source,
635                   "The parameter of the SIMDLEN clause must be less than or "
636                   "equal to the parameter of the SAFELEN clause"_err_en_US);
637             }
638           }
639         }
640       }
641     }
642     // A list-item cannot appear in more than one aligned clause
643     semantics::UnorderedSymbolSet alignedVars;
644     auto clauseAll = FindClauses(llvm::omp::Clause::OMPC_aligned);
645     for (auto itr = clauseAll.first; itr != clauseAll.second; ++itr) {
646       const auto &alignedClause{
647           std::get<parser::OmpClause::Aligned>(itr->second->u)};
648       const auto &alignedNameList{
649           std::get<std::list<parser::Name>>(alignedClause.v.t)};
650       for (auto const &var : alignedNameList) {
651         if (alignedVars.count(*(var.symbol)) == 1) {
652           context_.Say(itr->second->source,
653               "List item '%s' present at multiple ALIGNED clauses"_err_en_US,
654               var.ToString());
655           break;
656         }
657         alignedVars.insert(*(var.symbol));
658       }
659     }
660   } // SIMD
661 
662   // 2.7.3 Single Construct Restriction
663   if (GetContext().directive == llvm::omp::Directive::OMPD_end_single) {
664     CheckNotAllowedIfClause(
665         llvm::omp::Clause::OMPC_copyprivate, {llvm::omp::Clause::OMPC_nowait});
666   }
667 
668   CheckRequireAtLeastOneOf();
669 }
670 
671 void OmpStructureChecker::Enter(const parser::OmpClause &x) {
672   SetContextClause(x);
673 }
674 
675 // Following clauses do not have a separate node in parse-tree.h.
676 CHECK_SIMPLE_CLAUSE(AcqRel, OMPC_acq_rel)
677 CHECK_SIMPLE_CLAUSE(Acquire, OMPC_acquire)
678 CHECK_SIMPLE_CLAUSE(AtomicDefaultMemOrder, OMPC_atomic_default_mem_order)
679 CHECK_SIMPLE_CLAUSE(Affinity, OMPC_affinity)
680 CHECK_SIMPLE_CLAUSE(Allocate, OMPC_allocate)
681 CHECK_SIMPLE_CLAUSE(Capture, OMPC_capture)
682 CHECK_SIMPLE_CLAUSE(Copyin, OMPC_copyin)
683 CHECK_SIMPLE_CLAUSE(Default, OMPC_default)
684 CHECK_SIMPLE_CLAUSE(Depobj, OMPC_depobj)
685 CHECK_SIMPLE_CLAUSE(Destroy, OMPC_destroy)
686 CHECK_SIMPLE_CLAUSE(Detach, OMPC_detach)
687 CHECK_SIMPLE_CLAUSE(Device, OMPC_device)
688 CHECK_SIMPLE_CLAUSE(DeviceType, OMPC_device_type)
689 CHECK_SIMPLE_CLAUSE(DistSchedule, OMPC_dist_schedule)
690 CHECK_SIMPLE_CLAUSE(DynamicAllocators, OMPC_dynamic_allocators)
691 CHECK_SIMPLE_CLAUSE(Exclusive, OMPC_exclusive)
692 CHECK_SIMPLE_CLAUSE(Final, OMPC_final)
693 CHECK_SIMPLE_CLAUSE(Flush, OMPC_flush)
694 CHECK_SIMPLE_CLAUSE(From, OMPC_from)
695 CHECK_SIMPLE_CLAUSE(Hint, OMPC_hint)
696 CHECK_SIMPLE_CLAUSE(InReduction, OMPC_in_reduction)
697 CHECK_SIMPLE_CLAUSE(Inclusive, OMPC_inclusive)
698 CHECK_SIMPLE_CLAUSE(Match, OMPC_match)
699 CHECK_SIMPLE_CLAUSE(Nontemporal, OMPC_nontemporal)
700 CHECK_SIMPLE_CLAUSE(Order, OMPC_order)
701 CHECK_SIMPLE_CLAUSE(Read, OMPC_read)
702 CHECK_SIMPLE_CLAUSE(ReverseOffload, OMPC_reverse_offload)
703 CHECK_SIMPLE_CLAUSE(Threadprivate, OMPC_threadprivate)
704 CHECK_SIMPLE_CLAUSE(Threads, OMPC_threads)
705 CHECK_SIMPLE_CLAUSE(Inbranch, OMPC_inbranch)
706 CHECK_SIMPLE_CLAUSE(IsDevicePtr, OMPC_is_device_ptr)
707 CHECK_SIMPLE_CLAUSE(Link, OMPC_link)
708 CHECK_SIMPLE_CLAUSE(Mergeable, OMPC_mergeable)
709 CHECK_SIMPLE_CLAUSE(Nogroup, OMPC_nogroup)
710 CHECK_SIMPLE_CLAUSE(Notinbranch, OMPC_notinbranch)
711 CHECK_SIMPLE_CLAUSE(Nowait, OMPC_nowait)
712 CHECK_SIMPLE_CLAUSE(ProcBind, OMPC_proc_bind)
713 CHECK_SIMPLE_CLAUSE(Release, OMPC_release)
714 CHECK_SIMPLE_CLAUSE(Relaxed, OMPC_relaxed)
715 CHECK_SIMPLE_CLAUSE(SeqCst, OMPC_seq_cst)
716 CHECK_SIMPLE_CLAUSE(Simd, OMPC_simd)
717 CHECK_SIMPLE_CLAUSE(Sizes, OMPC_sizes)
718 CHECK_SIMPLE_CLAUSE(TaskReduction, OMPC_task_reduction)
719 CHECK_SIMPLE_CLAUSE(To, OMPC_to)
720 CHECK_SIMPLE_CLAUSE(UnifiedAddress, OMPC_unified_address)
721 CHECK_SIMPLE_CLAUSE(UnifiedSharedMemory, OMPC_unified_shared_memory)
722 CHECK_SIMPLE_CLAUSE(Uniform, OMPC_uniform)
723 CHECK_SIMPLE_CLAUSE(Unknown, OMPC_unknown)
724 CHECK_SIMPLE_CLAUSE(Untied, OMPC_untied)
725 CHECK_SIMPLE_CLAUSE(UseDevicePtr, OMPC_use_device_ptr)
726 CHECK_SIMPLE_CLAUSE(UsesAllocators, OMPC_uses_allocators)
727 CHECK_SIMPLE_CLAUSE(Update, OMPC_update)
728 CHECK_SIMPLE_CLAUSE(UseDeviceAddr, OMPC_use_device_addr)
729 CHECK_SIMPLE_CLAUSE(Write, OMPC_write)
730 CHECK_SIMPLE_CLAUSE(Init, OMPC_init)
731 CHECK_SIMPLE_CLAUSE(Use, OMPC_use)
732 CHECK_SIMPLE_CLAUSE(Novariants, OMPC_novariants)
733 CHECK_SIMPLE_CLAUSE(Nocontext, OMPC_nocontext)
734 
735 CHECK_REQ_SCALAR_INT_CLAUSE(Allocator, OMPC_allocator)
736 CHECK_REQ_SCALAR_INT_CLAUSE(Grainsize, OMPC_grainsize)
737 CHECK_REQ_SCALAR_INT_CLAUSE(NumTasks, OMPC_num_tasks)
738 CHECK_REQ_SCALAR_INT_CLAUSE(NumTeams, OMPC_num_teams)
739 CHECK_REQ_SCALAR_INT_CLAUSE(NumThreads, OMPC_num_threads)
740 CHECK_REQ_SCALAR_INT_CLAUSE(Priority, OMPC_priority)
741 CHECK_REQ_SCALAR_INT_CLAUSE(ThreadLimit, OMPC_thread_limit)
742 
743 CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(Collapse, OMPC_collapse)
744 CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(Safelen, OMPC_safelen)
745 CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(Simdlen, OMPC_simdlen)
746 
747 // Restrictions specific to each clause are implemented apart from the
748 // generalized restrictions.
749 void OmpStructureChecker::Enter(const parser::OmpClause::Reduction &x) {
750   CheckAllowed(llvm::omp::Clause::OMPC_reduction);
751   if (CheckReductionOperators(x)) {
752     CheckReductionTypeList(x);
753   }
754 }
755 bool OmpStructureChecker::CheckReductionOperators(
756     const parser::OmpClause::Reduction &x) {
757 
758   const auto &definedOp{std::get<0>(x.v.t)};
759   bool ok = false;
760   std::visit(
761       common::visitors{
762           [&](const parser::DefinedOperator &dOpr) {
763             const auto &intrinsicOp{
764                 std::get<parser::DefinedOperator::IntrinsicOperator>(dOpr.u)};
765             ok = CheckIntrinsicOperator(intrinsicOp);
766           },
767           [&](const parser::ProcedureDesignator &procD) {
768             const parser::Name *name{std::get_if<parser::Name>(&procD.u)};
769             if (name) {
770               if (name->source == "max" || name->source == "min" ||
771                   name->source == "iand" || name->source == "ior" ||
772                   name->source == "ieor") {
773                 ok = true;
774               } else {
775                 context_.Say(GetContext().clauseSource,
776                     "Invalid reduction identifier in REDUCTION clause."_err_en_US,
777                     ContextDirectiveAsFortran());
778               }
779             }
780           },
781       },
782       definedOp.u);
783 
784   return ok;
785 }
786 bool OmpStructureChecker::CheckIntrinsicOperator(
787     const parser::DefinedOperator::IntrinsicOperator &op) {
788 
789   switch (op) {
790   case parser::DefinedOperator::IntrinsicOperator::Add:
791   case parser::DefinedOperator::IntrinsicOperator::Subtract:
792   case parser::DefinedOperator::IntrinsicOperator::Multiply:
793   case parser::DefinedOperator::IntrinsicOperator::AND:
794   case parser::DefinedOperator::IntrinsicOperator::OR:
795   case parser::DefinedOperator::IntrinsicOperator::EQV:
796   case parser::DefinedOperator::IntrinsicOperator::NEQV:
797     return true;
798   default:
799     context_.Say(GetContext().clauseSource,
800         "Invalid reduction operator in REDUCTION clause."_err_en_US,
801         ContextDirectiveAsFortran());
802   }
803   return false;
804 }
805 
806 void OmpStructureChecker::CheckReductionTypeList(
807     const parser::OmpClause::Reduction &x) {
808   const auto &ompObjectList{std::get<parser::OmpObjectList>(x.v.t)};
809   CheckIntentInPointerAndDefinable(
810       ompObjectList, llvm::omp::Clause::OMPC_reduction);
811   CheckReductionArraySection(ompObjectList);
812   CheckMultipleAppearanceAcrossContext(ompObjectList);
813 }
814 
815 void OmpStructureChecker::CheckIntentInPointerAndDefinable(
816     const parser::OmpObjectList &objectList, const llvm::omp::Clause clause) {
817   for (const auto &ompObject : objectList.v) {
818     if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
819       if (const auto *symbol{name->symbol}) {
820         if (IsPointer(symbol->GetUltimate()) &&
821             IsIntentIn(symbol->GetUltimate())) {
822           context_.Say(GetContext().clauseSource,
823               "Pointer '%s' with the INTENT(IN) attribute may not appear "
824               "in a %s clause"_err_en_US,
825               symbol->name(),
826               parser::ToUpperCaseLetters(getClauseName(clause).str()));
827         }
828         if (auto msg{
829                 WhyNotModifiable(*symbol, context_.FindScope(name->source))}) {
830           context_.Say(GetContext().clauseSource,
831               "Variable '%s' on the %s clause is not definable"_err_en_US,
832               symbol->name(),
833               parser::ToUpperCaseLetters(getClauseName(clause).str()));
834         }
835       }
836     }
837   }
838 }
839 
840 void OmpStructureChecker::CheckReductionArraySection(
841     const parser::OmpObjectList &ompObjectList) {
842   for (const auto &ompObject : ompObjectList.v) {
843     if (const auto *dataRef{parser::Unwrap<parser::DataRef>(ompObject)}) {
844       if (const auto *arrayElement{
845               parser::Unwrap<parser::ArrayElement>(ompObject)}) {
846         if (arrayElement) {
847           CheckArraySection(*arrayElement, GetLastName(*dataRef),
848               llvm::omp::Clause::OMPC_reduction);
849         }
850       }
851     }
852   }
853 }
854 
855 void OmpStructureChecker::CheckMultipleAppearanceAcrossContext(
856     const parser::OmpObjectList &redObjectList) {
857   //  TODO: Verify the assumption here that the immediately enclosing region is
858   //  the parallel region to which the worksharing construct having reduction
859   //  binds to.
860   if (auto *enclosingContext{GetEnclosingDirContext()}) {
861     for (auto it : enclosingContext->clauseInfo) {
862       llvmOmpClause type = it.first;
863       const auto *clause = it.second;
864       if (llvm::omp::privateReductionSet.test(type)) {
865         if (const auto *objList{GetOmpObjectList(*clause)}) {
866           for (const auto &ompObject : objList->v) {
867             if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
868               if (const auto *symbol{name->symbol}) {
869                 for (const auto &redOmpObject : redObjectList.v) {
870                   if (const auto *rname{
871                           parser::Unwrap<parser::Name>(redOmpObject)}) {
872                     if (const auto *rsymbol{rname->symbol}) {
873                       if (rsymbol->name() == symbol->name()) {
874                         context_.Say(GetContext().clauseSource,
875                             "%s variable '%s' is %s in outer context must"
876                             " be shared in the parallel regions to which any"
877                             " of the worksharing regions arising from the "
878                             "worksharing"
879                             " construct bind."_err_en_US,
880                             parser::ToUpperCaseLetters(
881                                 getClauseName(llvm::omp::Clause::OMPC_reduction)
882                                     .str()),
883                             symbol->name(),
884                             parser::ToUpperCaseLetters(
885                                 getClauseName(type).str()));
886                       }
887                     }
888                   }
889                 }
890               }
891             }
892           }
893         }
894       }
895     }
896   }
897 }
898 
899 void OmpStructureChecker::Enter(const parser::OmpClause::Ordered &x) {
900   CheckAllowed(llvm::omp::Clause::OMPC_ordered);
901   // the parameter of ordered clause is optional
902   if (const auto &expr{x.v}) {
903     RequiresConstantPositiveParameter(llvm::omp::Clause::OMPC_ordered, *expr);
904     // 2.8.3 Loop SIMD Construct Restriction
905     if (llvm::omp::doSimdSet.test(GetContext().directive)) {
906       context_.Say(GetContext().clauseSource,
907           "No ORDERED clause with a parameter can be specified "
908           "on the %s directive"_err_en_US,
909           ContextDirectiveAsFortran());
910     }
911   }
912 }
913 
914 void OmpStructureChecker::Enter(const parser::OmpClause::Shared &x) {
915   CheckAllowed(llvm::omp::Clause::OMPC_shared);
916   CheckIsVarPartOfAnotherVar(x.v);
917 }
918 void OmpStructureChecker::Enter(const parser::OmpClause::Private &x) {
919   CheckAllowed(llvm::omp::Clause::OMPC_private);
920   CheckIsVarPartOfAnotherVar(x.v);
921   CheckIntentInPointer(x.v, llvm::omp::Clause::OMPC_private);
922 }
923 
924 void OmpStructureChecker::CheckIsVarPartOfAnotherVar(
925     const parser::OmpObjectList &objList) {
926   for (const auto &ompObject : objList.v) {
927     if ((parser::Unwrap<parser::StructureComponent>(ompObject)) ||
928         (parser::Unwrap<parser::ArrayElement>(ompObject))) {
929       context_.Say(GetContext().clauseSource,
930           "A variable that is part of another variable (as an "
931           "array or structure element)"
932           " cannot appear in a PRIVATE or SHARED clause."_err_en_US);
933     }
934   }
935 }
936 void OmpStructureChecker::Enter(const parser::OmpClause::Firstprivate &x) {
937   CheckAllowed(llvm::omp::Clause::OMPC_firstprivate);
938   CheckIsLoopIvPartOfClause(llvmOmpClause::OMPC_firstprivate, x.v);
939 
940   SymbolSourceMap currSymbols;
941   GetSymbolsInObjectList(x.v, currSymbols);
942 
943   DirectivesClauseTriple dirClauseTriple;
944   // Check firstprivate variables in worksharing constructs
945   dirClauseTriple.emplace(llvm::omp::Directive::OMPD_do,
946       std::make_pair(
947           llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet));
948   dirClauseTriple.emplace(llvm::omp::Directive::OMPD_sections,
949       std::make_pair(
950           llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet));
951   dirClauseTriple.emplace(llvm::omp::Directive::OMPD_single,
952       std::make_pair(
953           llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet));
954   // Check firstprivate variables in distribute construct
955   dirClauseTriple.emplace(llvm::omp::Directive::OMPD_distribute,
956       std::make_pair(
957           llvm::omp::Directive::OMPD_teams, llvm::omp::privateReductionSet));
958   dirClauseTriple.emplace(llvm::omp::Directive::OMPD_distribute,
959       std::make_pair(llvm::omp::Directive::OMPD_target_teams,
960           llvm::omp::privateReductionSet));
961   // Check firstprivate variables in task and taskloop constructs
962   dirClauseTriple.emplace(llvm::omp::Directive::OMPD_task,
963       std::make_pair(llvm::omp::Directive::OMPD_parallel,
964           OmpClauseSet{llvm::omp::Clause::OMPC_reduction}));
965   dirClauseTriple.emplace(llvm::omp::Directive::OMPD_taskloop,
966       std::make_pair(llvm::omp::Directive::OMPD_parallel,
967           OmpClauseSet{llvm::omp::Clause::OMPC_reduction}));
968 
969   CheckPrivateSymbolsInOuterCxt(
970       currSymbols, dirClauseTriple, llvm::omp::Clause::OMPC_firstprivate);
971 }
972 
973 void OmpStructureChecker::CheckIsLoopIvPartOfClause(
974     llvmOmpClause clause, const parser::OmpObjectList &ompObjectList) {
975   for (const auto &ompObject : ompObjectList.v) {
976     if (const parser::Name * name{parser::Unwrap<parser::Name>(ompObject)}) {
977       if (name->symbol == GetContext().loopIV) {
978         context_.Say(name->source,
979             "DO iteration variable %s is not allowed in %s clause."_err_en_US,
980             name->ToString(),
981             parser::ToUpperCaseLetters(getClauseName(clause).str()));
982       }
983     }
984   }
985 }
986 // Following clauses have a seperate node in parse-tree.h.
987 // Atomic-clause
988 CHECK_SIMPLE_PARSER_CLAUSE(OmpAtomicRead, OMPC_read)
989 CHECK_SIMPLE_PARSER_CLAUSE(OmpAtomicWrite, OMPC_write)
990 CHECK_SIMPLE_PARSER_CLAUSE(OmpAtomicUpdate, OMPC_update)
991 CHECK_SIMPLE_PARSER_CLAUSE(OmpAtomicCapture, OMPC_capture)
992 
993 void OmpStructureChecker::Leave(const parser::OmpAtomicRead &) {
994   CheckNotAllowedIfClause(llvm::omp::Clause::OMPC_read,
995       {llvm::omp::Clause::OMPC_release, llvm::omp::Clause::OMPC_acq_rel});
996 }
997 void OmpStructureChecker::Leave(const parser::OmpAtomicWrite &) {
998   CheckNotAllowedIfClause(llvm::omp::Clause::OMPC_write,
999       {llvm::omp::Clause::OMPC_acquire, llvm::omp::Clause::OMPC_acq_rel});
1000 }
1001 void OmpStructureChecker::Leave(const parser::OmpAtomicUpdate &) {
1002   CheckNotAllowedIfClause(llvm::omp::Clause::OMPC_update,
1003       {llvm::omp::Clause::OMPC_acquire, llvm::omp::Clause::OMPC_acq_rel});
1004 }
1005 // OmpAtomic node represents atomic directive without atomic-clause.
1006 // atomic-clause - READ,WRITE,UPDATE,CAPTURE.
1007 void OmpStructureChecker::Leave(const parser::OmpAtomic &) {
1008   if (const auto *clause{FindClause(llvm::omp::Clause::OMPC_acquire)}) {
1009     context_.Say(clause->source,
1010         "Clause ACQUIRE is not allowed on the ATOMIC directive"_err_en_US);
1011   }
1012   if (const auto *clause{FindClause(llvm::omp::Clause::OMPC_acq_rel)}) {
1013     context_.Say(clause->source,
1014         "Clause ACQ_REL is not allowed on the ATOMIC directive"_err_en_US);
1015   }
1016 }
1017 // Restrictions specific to each clause are implemented apart from the
1018 // generalized restrictions.
1019 void OmpStructureChecker::Enter(const parser::OmpClause::Aligned &x) {
1020   CheckAllowed(llvm::omp::Clause::OMPC_aligned);
1021 
1022   if (const auto &expr{
1023           std::get<std::optional<parser::ScalarIntConstantExpr>>(x.v.t)}) {
1024     RequiresConstantPositiveParameter(llvm::omp::Clause::OMPC_aligned, *expr);
1025   }
1026   // 2.8.1 TODO: list-item attribute check
1027 }
1028 void OmpStructureChecker::Enter(const parser::OmpClause::Defaultmap &x) {
1029   CheckAllowed(llvm::omp::Clause::OMPC_defaultmap);
1030   using VariableCategory = parser::OmpDefaultmapClause::VariableCategory;
1031   if (!std::get<std::optional<VariableCategory>>(x.v.t)) {
1032     context_.Say(GetContext().clauseSource,
1033         "The argument TOFROM:SCALAR must be specified on the DEFAULTMAP "
1034         "clause"_err_en_US);
1035   }
1036 }
1037 void OmpStructureChecker::Enter(const parser::OmpClause::If &x) {
1038   CheckAllowed(llvm::omp::Clause::OMPC_if);
1039   using dirNameModifier = parser::OmpIfClause::DirectiveNameModifier;
1040   static std::unordered_map<dirNameModifier, OmpDirectiveSet>
1041       dirNameModifierMap{{dirNameModifier::Parallel, llvm::omp::parallelSet},
1042           {dirNameModifier::Target, llvm::omp::targetSet},
1043           {dirNameModifier::TargetEnterData,
1044               {llvm::omp::Directive::OMPD_target_enter_data}},
1045           {dirNameModifier::TargetExitData,
1046               {llvm::omp::Directive::OMPD_target_exit_data}},
1047           {dirNameModifier::TargetData,
1048               {llvm::omp::Directive::OMPD_target_data}},
1049           {dirNameModifier::TargetUpdate,
1050               {llvm::omp::Directive::OMPD_target_update}},
1051           {dirNameModifier::Task, {llvm::omp::Directive::OMPD_task}},
1052           {dirNameModifier::Taskloop, llvm::omp::taskloopSet}};
1053   if (const auto &directiveName{
1054           std::get<std::optional<dirNameModifier>>(x.v.t)}) {
1055     auto search{dirNameModifierMap.find(*directiveName)};
1056     if (search == dirNameModifierMap.end() ||
1057         !search->second.test(GetContext().directive)) {
1058       context_
1059           .Say(GetContext().clauseSource,
1060               "Unmatched directive name modifier %s on the IF clause"_err_en_US,
1061               parser::ToUpperCaseLetters(
1062                   parser::OmpIfClause::EnumToString(*directiveName)))
1063           .Attach(
1064               GetContext().directiveSource, "Cannot apply to directive"_en_US);
1065     }
1066   }
1067 }
1068 
1069 void OmpStructureChecker::Enter(const parser::OmpClause::Linear &x) {
1070   CheckAllowed(llvm::omp::Clause::OMPC_linear);
1071 
1072   // 2.7 Loop Construct Restriction
1073   if ((llvm::omp::doSet | llvm::omp::simdSet).test(GetContext().directive)) {
1074     if (std::holds_alternative<parser::OmpLinearClause::WithModifier>(x.v.u)) {
1075       context_.Say(GetContext().clauseSource,
1076           "A modifier may not be specified in a LINEAR clause "
1077           "on the %s directive"_err_en_US,
1078           ContextDirectiveAsFortran());
1079     }
1080   }
1081 }
1082 
1083 void OmpStructureChecker::CheckAllowedMapTypes(
1084     const parser::OmpMapType::Type &type,
1085     const std::list<parser::OmpMapType::Type> &allowedMapTypeList) {
1086   const auto found{std::find(
1087       std::begin(allowedMapTypeList), std::end(allowedMapTypeList), type)};
1088   if (found == std::end(allowedMapTypeList)) {
1089     std::string commaSeperatedMapTypes;
1090     llvm::interleave(
1091         allowedMapTypeList.begin(), allowedMapTypeList.end(),
1092         [&](const parser::OmpMapType::Type &mapType) {
1093           commaSeperatedMapTypes.append(parser::ToUpperCaseLetters(
1094               parser::OmpMapType::EnumToString(mapType)));
1095         },
1096         [&] { commaSeperatedMapTypes.append(", "); });
1097     context_.Say(GetContext().clauseSource,
1098         "Only the %s map types are permitted "
1099         "for MAP clauses on the %s directive"_err_en_US,
1100         commaSeperatedMapTypes, ContextDirectiveAsFortran());
1101   }
1102 }
1103 
1104 void OmpStructureChecker::Enter(const parser::OmpClause::Map &x) {
1105   CheckAllowed(llvm::omp::Clause::OMPC_map);
1106 
1107   if (const auto &maptype{std::get<std::optional<parser::OmpMapType>>(x.v.t)}) {
1108     using Type = parser::OmpMapType::Type;
1109     const Type &type{std::get<Type>(maptype->t)};
1110     switch (GetContext().directive) {
1111     case llvm::omp::Directive::OMPD_target:
1112     case llvm::omp::Directive::OMPD_target_teams:
1113     case llvm::omp::Directive::OMPD_target_teams_distribute:
1114     case llvm::omp::Directive::OMPD_target_teams_distribute_simd:
1115     case llvm::omp::Directive::OMPD_target_teams_distribute_parallel_do:
1116     case llvm::omp::Directive::OMPD_target_teams_distribute_parallel_do_simd:
1117     case llvm::omp::Directive::OMPD_target_data:
1118       CheckAllowedMapTypes(
1119           type, {Type::To, Type::From, Type::Tofrom, Type::Alloc});
1120       break;
1121     case llvm::omp::Directive::OMPD_target_enter_data:
1122       CheckAllowedMapTypes(type, {Type::To, Type::Alloc});
1123       break;
1124     case llvm::omp::Directive::OMPD_target_exit_data:
1125       CheckAllowedMapTypes(type, {Type::From, Type::Release, Type::Delete});
1126       break;
1127     default:
1128       break;
1129     }
1130   }
1131 }
1132 
1133 bool OmpStructureChecker::ScheduleModifierHasType(
1134     const parser::OmpScheduleClause &x,
1135     const parser::OmpScheduleModifierType::ModType &type) {
1136   const auto &modifier{
1137       std::get<std::optional<parser::OmpScheduleModifier>>(x.t)};
1138   if (modifier) {
1139     const auto &modType1{
1140         std::get<parser::OmpScheduleModifier::Modifier1>(modifier->t)};
1141     const auto &modType2{
1142         std::get<std::optional<parser::OmpScheduleModifier::Modifier2>>(
1143             modifier->t)};
1144     if (modType1.v.v == type || (modType2 && modType2->v.v == type)) {
1145       return true;
1146     }
1147   }
1148   return false;
1149 }
1150 void OmpStructureChecker::Enter(const parser::OmpClause::Schedule &x) {
1151   CheckAllowed(llvm::omp::Clause::OMPC_schedule);
1152   const parser::OmpScheduleClause &scheduleClause = x.v;
1153 
1154   // 2.7 Loop Construct Restriction
1155   if (llvm::omp::doSet.test(GetContext().directive)) {
1156     const auto &kind{std::get<1>(scheduleClause.t)};
1157     const auto &chunk{std::get<2>(scheduleClause.t)};
1158     if (chunk) {
1159       if (kind == parser::OmpScheduleClause::ScheduleType::Runtime ||
1160           kind == parser::OmpScheduleClause::ScheduleType::Auto) {
1161         context_.Say(GetContext().clauseSource,
1162             "When SCHEDULE clause has %s specified, "
1163             "it must not have chunk size specified"_err_en_US,
1164             parser::ToUpperCaseLetters(
1165                 parser::OmpScheduleClause::EnumToString(kind)));
1166       }
1167       if (const auto &chunkExpr{std::get<std::optional<parser::ScalarIntExpr>>(
1168               scheduleClause.t)}) {
1169         RequiresPositiveParameter(
1170             llvm::omp::Clause::OMPC_schedule, *chunkExpr, "chunk size");
1171       }
1172     }
1173 
1174     if (ScheduleModifierHasType(scheduleClause,
1175             parser::OmpScheduleModifierType::ModType::Nonmonotonic)) {
1176       if (kind != parser::OmpScheduleClause::ScheduleType::Dynamic &&
1177           kind != parser::OmpScheduleClause::ScheduleType::Guided) {
1178         context_.Say(GetContext().clauseSource,
1179             "The NONMONOTONIC modifier can only be specified with "
1180             "SCHEDULE(DYNAMIC) or SCHEDULE(GUIDED)"_err_en_US);
1181       }
1182     }
1183   }
1184 }
1185 
1186 void OmpStructureChecker::Enter(const parser::OmpClause::Depend &x) {
1187   CheckAllowed(llvm::omp::Clause::OMPC_depend);
1188   if (const auto *inOut{std::get_if<parser::OmpDependClause::InOut>(&x.v.u)}) {
1189     const auto &designators{std::get<std::list<parser::Designator>>(inOut->t)};
1190     for (const auto &ele : designators) {
1191       if (const auto *dataRef{std::get_if<parser::DataRef>(&ele.u)}) {
1192         CheckDependList(*dataRef);
1193         if (const auto *arr{
1194                 std::get_if<common::Indirection<parser::ArrayElement>>(
1195                     &dataRef->u)}) {
1196           CheckArraySection(arr->value(), GetLastName(*dataRef),
1197               llvm::omp::Clause::OMPC_depend);
1198         }
1199       }
1200     }
1201   }
1202 }
1203 
1204 void OmpStructureChecker::Enter(const parser::OmpClause::Copyprivate &x) {
1205   CheckAllowed(llvm::omp::Clause::OMPC_copyprivate);
1206   CheckIntentInPointer(x.v, llvm::omp::Clause::OMPC_copyprivate);
1207 }
1208 
1209 void OmpStructureChecker::Enter(const parser::OmpClause::Lastprivate &x) {
1210   CheckAllowed(llvm::omp::Clause::OMPC_lastprivate);
1211 
1212   DirectivesClauseTriple dirClauseTriple;
1213   SymbolSourceMap currSymbols;
1214   GetSymbolsInObjectList(x.v, currSymbols);
1215   CheckDefinableObjects(currSymbols, GetClauseKindForParserClass(x));
1216 
1217   // Check lastprivate variables in worksharing constructs
1218   dirClauseTriple.emplace(llvm::omp::Directive::OMPD_do,
1219       std::make_pair(
1220           llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet));
1221   dirClauseTriple.emplace(llvm::omp::Directive::OMPD_sections,
1222       std::make_pair(
1223           llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet));
1224 
1225   CheckPrivateSymbolsInOuterCxt(
1226       currSymbols, dirClauseTriple, GetClauseKindForParserClass(x));
1227 }
1228 
1229 llvm::StringRef OmpStructureChecker::getClauseName(llvm::omp::Clause clause) {
1230   return llvm::omp::getOpenMPClauseName(clause);
1231 }
1232 
1233 llvm::StringRef OmpStructureChecker::getDirectiveName(
1234     llvm::omp::Directive directive) {
1235   return llvm::omp::getOpenMPDirectiveName(directive);
1236 }
1237 
1238 void OmpStructureChecker::CheckDependList(const parser::DataRef &d) {
1239   std::visit(
1240       common::visitors{
1241           [&](const common::Indirection<parser::ArrayElement> &elem) {
1242             // Check if the base element is valid on Depend Clause
1243             CheckDependList(elem.value().base);
1244           },
1245           [&](const common::Indirection<parser::StructureComponent> &) {
1246             context_.Say(GetContext().clauseSource,
1247                 "A variable that is part of another variable "
1248                 "(such as an element of a structure) but is not an array "
1249                 "element or an array section cannot appear in a DEPEND "
1250                 "clause"_err_en_US);
1251           },
1252           [&](const common::Indirection<parser::CoindexedNamedObject> &) {
1253             context_.Say(GetContext().clauseSource,
1254                 "Coarrays are not supported in DEPEND clause"_err_en_US);
1255           },
1256           [&](const parser::Name &) { return; },
1257       },
1258       d.u);
1259 }
1260 
1261 // Called from both Reduction and Depend clause.
1262 void OmpStructureChecker::CheckArraySection(
1263     const parser::ArrayElement &arrayElement, const parser::Name &name,
1264     const llvm::omp::Clause clause) {
1265   if (!arrayElement.subscripts.empty()) {
1266     for (const auto &subscript : arrayElement.subscripts) {
1267       if (const auto *triplet{
1268               std::get_if<parser::SubscriptTriplet>(&subscript.u)}) {
1269         if (std::get<0>(triplet->t) && std::get<1>(triplet->t)) {
1270           const auto &lower{std::get<0>(triplet->t)};
1271           const auto &upper{std::get<1>(triplet->t)};
1272           if (lower && upper) {
1273             const auto lval{GetIntValue(lower)};
1274             const auto uval{GetIntValue(upper)};
1275             if (lval && uval && *uval < *lval) {
1276               context_.Say(GetContext().clauseSource,
1277                   "'%s' in %s clause"
1278                   " is a zero size array section"_err_en_US,
1279                   name.ToString(),
1280                   parser::ToUpperCaseLetters(getClauseName(clause).str()));
1281               break;
1282             } else if (std::get<2>(triplet->t)) {
1283               const auto &strideExpr{std::get<2>(triplet->t)};
1284               if (strideExpr) {
1285                 if (clause == llvm::omp::Clause::OMPC_depend) {
1286                   context_.Say(GetContext().clauseSource,
1287                       "Stride should not be specified for array section in "
1288                       "DEPEND "
1289                       "clause"_err_en_US);
1290                 }
1291                 const auto stride{GetIntValue(strideExpr)};
1292                 if ((stride && stride != 1)) {
1293                   context_.Say(GetContext().clauseSource,
1294                       "A list item that appears in a REDUCTION clause"
1295                       " should have a contiguous storage array section."_err_en_US,
1296                       ContextDirectiveAsFortran());
1297                   break;
1298                 }
1299               }
1300             }
1301           }
1302         }
1303       }
1304     }
1305   }
1306 }
1307 
1308 void OmpStructureChecker::CheckIntentInPointer(
1309     const parser::OmpObjectList &objectList, const llvm::omp::Clause clause) {
1310   SymbolSourceMap symbols;
1311   GetSymbolsInObjectList(objectList, symbols);
1312   for (auto it{symbols.begin()}; it != symbols.end(); ++it) {
1313     const auto *symbol{it->first};
1314     const auto source{it->second};
1315     if (IsPointer(*symbol) && IsIntentIn(*symbol)) {
1316       context_.Say(source,
1317           "Pointer '%s' with the INTENT(IN) attribute may not appear "
1318           "in a %s clause"_err_en_US,
1319           symbol->name(),
1320           parser::ToUpperCaseLetters(getClauseName(clause).str()));
1321     }
1322   }
1323 }
1324 
1325 void OmpStructureChecker::GetSymbolsInObjectList(
1326     const parser::OmpObjectList &objectList, SymbolSourceMap &symbols) {
1327   for (const auto &ompObject : objectList.v) {
1328     if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
1329       if (const auto *symbol{name->symbol}) {
1330         if (const auto *commonBlockDetails{
1331                 symbol->detailsIf<CommonBlockDetails>()}) {
1332           for (const auto &object : commonBlockDetails->objects()) {
1333             symbols.emplace(&object->GetUltimate(), name->source);
1334           }
1335         } else {
1336           symbols.emplace(&symbol->GetUltimate(), name->source);
1337         }
1338       }
1339     }
1340   }
1341 }
1342 
1343 void OmpStructureChecker::CheckDefinableObjects(
1344     SymbolSourceMap &symbols, const llvm::omp::Clause clause) {
1345   for (auto it{symbols.begin()}; it != symbols.end(); ++it) {
1346     const auto *symbol{it->first};
1347     const auto source{it->second};
1348     if (auto msg{WhyNotModifiable(*symbol, context_.FindScope(source))}) {
1349       context_
1350           .Say(source,
1351               "Variable '%s' on the %s clause is not definable"_err_en_US,
1352               symbol->name(),
1353               parser::ToUpperCaseLetters(getClauseName(clause).str()))
1354           .Attach(source, std::move(*msg), symbol->name());
1355     }
1356   }
1357 }
1358 
1359 void OmpStructureChecker::CheckPrivateSymbolsInOuterCxt(
1360     SymbolSourceMap &currSymbols, DirectivesClauseTriple &dirClauseTriple,
1361     const llvm::omp::Clause currClause) {
1362   SymbolSourceMap enclosingSymbols;
1363   auto range{dirClauseTriple.equal_range(GetContext().directive)};
1364   for (auto dirIter{range.first}; dirIter != range.second; ++dirIter) {
1365     auto enclosingDir{dirIter->second.first};
1366     auto enclosingClauseSet{dirIter->second.second};
1367     if (auto *enclosingContext{GetEnclosingContextWithDir(enclosingDir)}) {
1368       for (auto it{enclosingContext->clauseInfo.begin()};
1369            it != enclosingContext->clauseInfo.end(); ++it) {
1370         if (enclosingClauseSet.test(it->first)) {
1371           if (const auto *ompObjectList{GetOmpObjectList(*it->second)}) {
1372             GetSymbolsInObjectList(*ompObjectList, enclosingSymbols);
1373           }
1374         }
1375       }
1376 
1377       // Check if the symbols in current context are private in outer context
1378       for (auto iter{currSymbols.begin()}; iter != currSymbols.end(); ++iter) {
1379         const auto *symbol{iter->first};
1380         const auto source{iter->second};
1381         if (enclosingSymbols.find(symbol) != enclosingSymbols.end()) {
1382           context_.Say(source,
1383               "%s variable '%s' is PRIVATE in outer context"_err_en_US,
1384               parser::ToUpperCaseLetters(getClauseName(currClause).str()),
1385               symbol->name());
1386         }
1387       }
1388     }
1389   }
1390 }
1391 
1392 void OmpStructureChecker::CheckWorkshareBlockStmts(
1393     const parser::Block &block, parser::CharBlock source) {
1394   OmpWorkshareBlockChecker ompWorkshareBlockChecker{context_, source};
1395 
1396   for (auto it{block.begin()}; it != block.end(); ++it) {
1397     if (parser::Unwrap<parser::AssignmentStmt>(*it) ||
1398         parser::Unwrap<parser::ForallStmt>(*it) ||
1399         parser::Unwrap<parser::ForallConstruct>(*it) ||
1400         parser::Unwrap<parser::WhereStmt>(*it) ||
1401         parser::Unwrap<parser::WhereConstruct>(*it)) {
1402       parser::Walk(*it, ompWorkshareBlockChecker);
1403     } else if (const auto *ompConstruct{
1404                    parser::Unwrap<parser::OpenMPConstruct>(*it)}) {
1405       if (const auto *ompAtomicConstruct{
1406               std::get_if<parser::OpenMPAtomicConstruct>(&ompConstruct->u)}) {
1407         // Check if assignment statements in the enclosing OpenMP Atomic
1408         // construct are allowed in the Workshare construct
1409         parser::Walk(*ompAtomicConstruct, ompWorkshareBlockChecker);
1410       } else if (const auto *ompCriticalConstruct{
1411                      std::get_if<parser::OpenMPCriticalConstruct>(
1412                          &ompConstruct->u)}) {
1413         // All the restrictions on the Workshare construct apply to the
1414         // statements in the enclosing critical constructs
1415         const auto &criticalBlock{
1416             std::get<parser::Block>(ompCriticalConstruct->t)};
1417         CheckWorkshareBlockStmts(criticalBlock, source);
1418       } else {
1419         // Check if OpenMP constructs enclosed in the Workshare construct are
1420         // 'Parallel' constructs
1421         auto currentDir{llvm::omp::Directive::OMPD_unknown};
1422         const OmpDirectiveSet parallelDirSet{
1423             llvm::omp::Directive::OMPD_parallel,
1424             llvm::omp::Directive::OMPD_parallel_do,
1425             llvm::omp::Directive::OMPD_parallel_sections,
1426             llvm::omp::Directive::OMPD_parallel_workshare,
1427             llvm::omp::Directive::OMPD_parallel_do_simd};
1428 
1429         if (const auto *ompBlockConstruct{
1430                 std::get_if<parser::OpenMPBlockConstruct>(&ompConstruct->u)}) {
1431           const auto &beginBlockDir{
1432               std::get<parser::OmpBeginBlockDirective>(ompBlockConstruct->t)};
1433           const auto &beginDir{
1434               std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
1435           currentDir = beginDir.v;
1436         } else if (const auto *ompLoopConstruct{
1437                        std::get_if<parser::OpenMPLoopConstruct>(
1438                            &ompConstruct->u)}) {
1439           const auto &beginLoopDir{
1440               std::get<parser::OmpBeginLoopDirective>(ompLoopConstruct->t)};
1441           const auto &beginDir{
1442               std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
1443           currentDir = beginDir.v;
1444         } else if (const auto *ompSectionsConstruct{
1445                        std::get_if<parser::OpenMPSectionsConstruct>(
1446                            &ompConstruct->u)}) {
1447           const auto &beginSectionsDir{
1448               std::get<parser::OmpBeginSectionsDirective>(
1449                   ompSectionsConstruct->t)};
1450           const auto &beginDir{
1451               std::get<parser::OmpSectionsDirective>(beginSectionsDir.t)};
1452           currentDir = beginDir.v;
1453         }
1454 
1455         if (!parallelDirSet.test(currentDir)) {
1456           context_.Say(source,
1457               "OpenMP constructs enclosed in WORKSHARE construct may consist "
1458               "of ATOMIC, CRITICAL or PARALLEL constructs only"_err_en_US);
1459         }
1460       }
1461     } else {
1462       context_.Say(source,
1463           "The structured block in a WORKSHARE construct may consist of only "
1464           "SCALAR or ARRAY assignments, FORALL or WHERE statements, "
1465           "FORALL, WHERE, ATOMIC, CRITICAL or PARALLEL constructs"_err_en_US);
1466     }
1467   }
1468 }
1469 
1470 const parser::OmpObjectList *OmpStructureChecker::GetOmpObjectList(
1471     const parser::OmpClause &clause) {
1472 
1473   // Clauses with OmpObjectList as its data member
1474   using MemberObjectListClauses = std::tuple<parser::OmpClause::Copyprivate,
1475       parser::OmpClause::Copyin, parser::OmpClause::Firstprivate,
1476       parser::OmpClause::From, parser::OmpClause::Lastprivate,
1477       parser::OmpClause::Link, parser::OmpClause::Private,
1478       parser::OmpClause::Shared, parser::OmpClause::To>;
1479 
1480   // Clauses with OmpObjectList in the tuple
1481   using TupleObjectListClauses = std::tuple<parser::OmpClause::Allocate,
1482       parser::OmpClause::Map, parser::OmpClause::Reduction>;
1483 
1484   // TODO:: Generate the tuples using TableGen.
1485   // Handle other constructs with OmpObjectList such as OpenMPThreadprivate.
1486   return std::visit(
1487       common::visitors{
1488           [&](const auto &x) -> const parser::OmpObjectList * {
1489             using Ty = std::decay_t<decltype(x)>;
1490             if constexpr (common::HasMember<Ty, MemberObjectListClauses>) {
1491               return &x.v;
1492             } else if constexpr (common::HasMember<Ty,
1493                                      TupleObjectListClauses>) {
1494               return &(std::get<parser::OmpObjectList>(x.v.t));
1495             } else {
1496               return nullptr;
1497             }
1498           },
1499       },
1500       clause.u);
1501 }
1502 
1503 } // namespace Fortran::semantics
1504