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 
733 CHECK_REQ_SCALAR_INT_CLAUSE(Allocator, OMPC_allocator)
734 CHECK_REQ_SCALAR_INT_CLAUSE(Grainsize, OMPC_grainsize)
735 CHECK_REQ_SCALAR_INT_CLAUSE(NumTasks, OMPC_num_tasks)
736 CHECK_REQ_SCALAR_INT_CLAUSE(NumTeams, OMPC_num_teams)
737 CHECK_REQ_SCALAR_INT_CLAUSE(NumThreads, OMPC_num_threads)
738 CHECK_REQ_SCALAR_INT_CLAUSE(Priority, OMPC_priority)
739 CHECK_REQ_SCALAR_INT_CLAUSE(ThreadLimit, OMPC_thread_limit)
740 
741 CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(Collapse, OMPC_collapse)
742 CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(Safelen, OMPC_safelen)
743 CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(Simdlen, OMPC_simdlen)
744 
745 // Restrictions specific to each clause are implemented apart from the
746 // generalized restrictions.
747 void OmpStructureChecker::Enter(const parser::OmpClause::Reduction &x) {
748   CheckAllowed(llvm::omp::Clause::OMPC_reduction);
749   if (CheckReductionOperators(x)) {
750     CheckReductionTypeList(x);
751   }
752 }
753 bool OmpStructureChecker::CheckReductionOperators(
754     const parser::OmpClause::Reduction &x) {
755 
756   const auto &definedOp{std::get<0>(x.v.t)};
757   bool ok = false;
758   std::visit(
759       common::visitors{
760           [&](const parser::DefinedOperator &dOpr) {
761             const auto &intrinsicOp{
762                 std::get<parser::DefinedOperator::IntrinsicOperator>(dOpr.u)};
763             ok = CheckIntrinsicOperator(intrinsicOp);
764           },
765           [&](const parser::ProcedureDesignator &procD) {
766             const parser::Name *name{std::get_if<parser::Name>(&procD.u)};
767             if (name) {
768               if (name->source == "max" || name->source == "min" ||
769                   name->source == "iand" || name->source == "ior" ||
770                   name->source == "ieor") {
771                 ok = true;
772               } else {
773                 context_.Say(GetContext().clauseSource,
774                     "Invalid reduction identifier in REDUCTION clause."_err_en_US,
775                     ContextDirectiveAsFortran());
776               }
777             }
778           },
779       },
780       definedOp.u);
781 
782   return ok;
783 }
784 bool OmpStructureChecker::CheckIntrinsicOperator(
785     const parser::DefinedOperator::IntrinsicOperator &op) {
786 
787   switch (op) {
788   case parser::DefinedOperator::IntrinsicOperator::Add:
789   case parser::DefinedOperator::IntrinsicOperator::Subtract:
790   case parser::DefinedOperator::IntrinsicOperator::Multiply:
791   case parser::DefinedOperator::IntrinsicOperator::AND:
792   case parser::DefinedOperator::IntrinsicOperator::OR:
793   case parser::DefinedOperator::IntrinsicOperator::EQV:
794   case parser::DefinedOperator::IntrinsicOperator::NEQV:
795     return true;
796   default:
797     context_.Say(GetContext().clauseSource,
798         "Invalid reduction operator in REDUCTION clause."_err_en_US,
799         ContextDirectiveAsFortran());
800   }
801   return false;
802 }
803 
804 void OmpStructureChecker::CheckReductionTypeList(
805     const parser::OmpClause::Reduction &x) {
806   const auto &ompObjectList{std::get<parser::OmpObjectList>(x.v.t)};
807   CheckIntentInPointerAndDefinable(
808       ompObjectList, llvm::omp::Clause::OMPC_reduction);
809   CheckReductionArraySection(ompObjectList);
810   CheckMultipleAppearanceAcrossContext(ompObjectList);
811 }
812 
813 void OmpStructureChecker::CheckIntentInPointerAndDefinable(
814     const parser::OmpObjectList &objectList, const llvm::omp::Clause clause) {
815   for (const auto &ompObject : objectList.v) {
816     if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
817       if (const auto *symbol{name->symbol}) {
818         if (IsPointer(symbol->GetUltimate()) &&
819             IsIntentIn(symbol->GetUltimate())) {
820           context_.Say(GetContext().clauseSource,
821               "Pointer '%s' with the INTENT(IN) attribute may not appear "
822               "in a %s clause"_err_en_US,
823               symbol->name(),
824               parser::ToUpperCaseLetters(getClauseName(clause).str()));
825         }
826         if (auto msg{
827                 WhyNotModifiable(*symbol, context_.FindScope(name->source))}) {
828           context_.Say(GetContext().clauseSource,
829               "Variable '%s' on the %s clause is not definable"_err_en_US,
830               symbol->name(),
831               parser::ToUpperCaseLetters(getClauseName(clause).str()));
832         }
833       }
834     }
835   }
836 }
837 
838 void OmpStructureChecker::CheckReductionArraySection(
839     const parser::OmpObjectList &ompObjectList) {
840   for (const auto &ompObject : ompObjectList.v) {
841     if (const auto *dataRef{parser::Unwrap<parser::DataRef>(ompObject)}) {
842       if (const auto *arrayElement{
843               parser::Unwrap<parser::ArrayElement>(ompObject)}) {
844         if (arrayElement) {
845           CheckArraySection(*arrayElement, GetLastName(*dataRef),
846               llvm::omp::Clause::OMPC_reduction);
847         }
848       }
849     }
850   }
851 }
852 
853 void OmpStructureChecker::CheckMultipleAppearanceAcrossContext(
854     const parser::OmpObjectList &redObjectList) {
855   //  TODO: Verify the assumption here that the immediately enclosing region is
856   //  the parallel region to which the worksharing construct having reduction
857   //  binds to.
858   if (auto *enclosingContext{GetEnclosingDirContext()}) {
859     for (auto it : enclosingContext->clauseInfo) {
860       llvmOmpClause type = it.first;
861       const auto *clause = it.second;
862       if (llvm::omp::privateReductionSet.test(type)) {
863         if (const auto *objList{GetOmpObjectList(*clause)}) {
864           for (const auto &ompObject : objList->v) {
865             if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
866               if (const auto *symbol{name->symbol}) {
867                 for (const auto &redOmpObject : redObjectList.v) {
868                   if (const auto *rname{
869                           parser::Unwrap<parser::Name>(redOmpObject)}) {
870                     if (const auto *rsymbol{rname->symbol}) {
871                       if (rsymbol->name() == symbol->name()) {
872                         context_.Say(GetContext().clauseSource,
873                             "%s variable '%s' is %s in outer context must"
874                             " be shared in the parallel regions to which any"
875                             " of the worksharing regions arising from the "
876                             "worksharing"
877                             " construct bind."_err_en_US,
878                             parser::ToUpperCaseLetters(
879                                 getClauseName(llvm::omp::Clause::OMPC_reduction)
880                                     .str()),
881                             symbol->name(),
882                             parser::ToUpperCaseLetters(
883                                 getClauseName(type).str()));
884                       }
885                     }
886                   }
887                 }
888               }
889             }
890           }
891         }
892       }
893     }
894   }
895 }
896 
897 void OmpStructureChecker::Enter(const parser::OmpClause::Ordered &x) {
898   CheckAllowed(llvm::omp::Clause::OMPC_ordered);
899   // the parameter of ordered clause is optional
900   if (const auto &expr{x.v}) {
901     RequiresConstantPositiveParameter(llvm::omp::Clause::OMPC_ordered, *expr);
902     // 2.8.3 Loop SIMD Construct Restriction
903     if (llvm::omp::doSimdSet.test(GetContext().directive)) {
904       context_.Say(GetContext().clauseSource,
905           "No ORDERED clause with a parameter can be specified "
906           "on the %s directive"_err_en_US,
907           ContextDirectiveAsFortran());
908     }
909   }
910 }
911 
912 void OmpStructureChecker::Enter(const parser::OmpClause::Shared &x) {
913   CheckAllowed(llvm::omp::Clause::OMPC_shared);
914   CheckIsVarPartOfAnotherVar(x.v);
915 }
916 void OmpStructureChecker::Enter(const parser::OmpClause::Private &x) {
917   CheckAllowed(llvm::omp::Clause::OMPC_private);
918   CheckIsVarPartOfAnotherVar(x.v);
919   CheckIntentInPointer(x.v, llvm::omp::Clause::OMPC_private);
920 }
921 
922 void OmpStructureChecker::CheckIsVarPartOfAnotherVar(
923     const parser::OmpObjectList &objList) {
924   for (const auto &ompObject : objList.v) {
925     if ((parser::Unwrap<parser::StructureComponent>(ompObject)) ||
926         (parser::Unwrap<parser::ArrayElement>(ompObject))) {
927       context_.Say(GetContext().clauseSource,
928           "A variable that is part of another variable (as an "
929           "array or structure element)"
930           " cannot appear in a PRIVATE or SHARED clause."_err_en_US);
931     }
932   }
933 }
934 void OmpStructureChecker::Enter(const parser::OmpClause::Firstprivate &x) {
935   CheckAllowed(llvm::omp::Clause::OMPC_firstprivate);
936   CheckIsLoopIvPartOfClause(llvmOmpClause::OMPC_firstprivate, x.v);
937 
938   SymbolSourceMap currSymbols;
939   GetSymbolsInObjectList(x.v, currSymbols);
940 
941   DirectivesClauseTriple dirClauseTriple;
942   // Check firstprivate variables in worksharing constructs
943   dirClauseTriple.emplace(llvm::omp::Directive::OMPD_do,
944       std::make_pair(
945           llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet));
946   dirClauseTriple.emplace(llvm::omp::Directive::OMPD_sections,
947       std::make_pair(
948           llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet));
949   dirClauseTriple.emplace(llvm::omp::Directive::OMPD_single,
950       std::make_pair(
951           llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet));
952   // Check firstprivate variables in distribute construct
953   dirClauseTriple.emplace(llvm::omp::Directive::OMPD_distribute,
954       std::make_pair(
955           llvm::omp::Directive::OMPD_teams, llvm::omp::privateReductionSet));
956   dirClauseTriple.emplace(llvm::omp::Directive::OMPD_distribute,
957       std::make_pair(llvm::omp::Directive::OMPD_target_teams,
958           llvm::omp::privateReductionSet));
959   // Check firstprivate variables in task and taskloop constructs
960   dirClauseTriple.emplace(llvm::omp::Directive::OMPD_task,
961       std::make_pair(llvm::omp::Directive::OMPD_parallel,
962           OmpClauseSet{llvm::omp::Clause::OMPC_reduction}));
963   dirClauseTriple.emplace(llvm::omp::Directive::OMPD_taskloop,
964       std::make_pair(llvm::omp::Directive::OMPD_parallel,
965           OmpClauseSet{llvm::omp::Clause::OMPC_reduction}));
966 
967   CheckPrivateSymbolsInOuterCxt(
968       currSymbols, dirClauseTriple, llvm::omp::Clause::OMPC_firstprivate);
969 }
970 
971 void OmpStructureChecker::CheckIsLoopIvPartOfClause(
972     llvmOmpClause clause, const parser::OmpObjectList &ompObjectList) {
973   for (const auto &ompObject : ompObjectList.v) {
974     if (const parser::Name * name{parser::Unwrap<parser::Name>(ompObject)}) {
975       if (name->symbol == GetContext().loopIV) {
976         context_.Say(name->source,
977             "DO iteration variable %s is not allowed in %s clause."_err_en_US,
978             name->ToString(),
979             parser::ToUpperCaseLetters(getClauseName(clause).str()));
980       }
981     }
982   }
983 }
984 // Following clauses have a seperate node in parse-tree.h.
985 // Atomic-clause
986 CHECK_SIMPLE_PARSER_CLAUSE(OmpAtomicRead, OMPC_read)
987 CHECK_SIMPLE_PARSER_CLAUSE(OmpAtomicWrite, OMPC_write)
988 CHECK_SIMPLE_PARSER_CLAUSE(OmpAtomicUpdate, OMPC_update)
989 CHECK_SIMPLE_PARSER_CLAUSE(OmpAtomicCapture, OMPC_capture)
990 
991 void OmpStructureChecker::Leave(const parser::OmpAtomicRead &) {
992   CheckNotAllowedIfClause(llvm::omp::Clause::OMPC_read,
993       {llvm::omp::Clause::OMPC_release, llvm::omp::Clause::OMPC_acq_rel});
994 }
995 void OmpStructureChecker::Leave(const parser::OmpAtomicWrite &) {
996   CheckNotAllowedIfClause(llvm::omp::Clause::OMPC_write,
997       {llvm::omp::Clause::OMPC_acquire, llvm::omp::Clause::OMPC_acq_rel});
998 }
999 void OmpStructureChecker::Leave(const parser::OmpAtomicUpdate &) {
1000   CheckNotAllowedIfClause(llvm::omp::Clause::OMPC_update,
1001       {llvm::omp::Clause::OMPC_acquire, llvm::omp::Clause::OMPC_acq_rel});
1002 }
1003 // OmpAtomic node represents atomic directive without atomic-clause.
1004 // atomic-clause - READ,WRITE,UPDATE,CAPTURE.
1005 void OmpStructureChecker::Leave(const parser::OmpAtomic &) {
1006   if (const auto *clause{FindClause(llvm::omp::Clause::OMPC_acquire)}) {
1007     context_.Say(clause->source,
1008         "Clause ACQUIRE is not allowed on the ATOMIC directive"_err_en_US);
1009   }
1010   if (const auto *clause{FindClause(llvm::omp::Clause::OMPC_acq_rel)}) {
1011     context_.Say(clause->source,
1012         "Clause ACQ_REL is not allowed on the ATOMIC directive"_err_en_US);
1013   }
1014 }
1015 // Restrictions specific to each clause are implemented apart from the
1016 // generalized restrictions.
1017 void OmpStructureChecker::Enter(const parser::OmpClause::Aligned &x) {
1018   CheckAllowed(llvm::omp::Clause::OMPC_aligned);
1019 
1020   if (const auto &expr{
1021           std::get<std::optional<parser::ScalarIntConstantExpr>>(x.v.t)}) {
1022     RequiresConstantPositiveParameter(llvm::omp::Clause::OMPC_aligned, *expr);
1023   }
1024   // 2.8.1 TODO: list-item attribute check
1025 }
1026 void OmpStructureChecker::Enter(const parser::OmpClause::Defaultmap &x) {
1027   CheckAllowed(llvm::omp::Clause::OMPC_defaultmap);
1028   using VariableCategory = parser::OmpDefaultmapClause::VariableCategory;
1029   if (!std::get<std::optional<VariableCategory>>(x.v.t)) {
1030     context_.Say(GetContext().clauseSource,
1031         "The argument TOFROM:SCALAR must be specified on the DEFAULTMAP "
1032         "clause"_err_en_US);
1033   }
1034 }
1035 void OmpStructureChecker::Enter(const parser::OmpClause::If &x) {
1036   CheckAllowed(llvm::omp::Clause::OMPC_if);
1037   using dirNameModifier = parser::OmpIfClause::DirectiveNameModifier;
1038   static std::unordered_map<dirNameModifier, OmpDirectiveSet>
1039       dirNameModifierMap{{dirNameModifier::Parallel, llvm::omp::parallelSet},
1040           {dirNameModifier::Target, llvm::omp::targetSet},
1041           {dirNameModifier::TargetEnterData,
1042               {llvm::omp::Directive::OMPD_target_enter_data}},
1043           {dirNameModifier::TargetExitData,
1044               {llvm::omp::Directive::OMPD_target_exit_data}},
1045           {dirNameModifier::TargetData,
1046               {llvm::omp::Directive::OMPD_target_data}},
1047           {dirNameModifier::TargetUpdate,
1048               {llvm::omp::Directive::OMPD_target_update}},
1049           {dirNameModifier::Task, {llvm::omp::Directive::OMPD_task}},
1050           {dirNameModifier::Taskloop, llvm::omp::taskloopSet}};
1051   if (const auto &directiveName{
1052           std::get<std::optional<dirNameModifier>>(x.v.t)}) {
1053     auto search{dirNameModifierMap.find(*directiveName)};
1054     if (search == dirNameModifierMap.end() ||
1055         !search->second.test(GetContext().directive)) {
1056       context_
1057           .Say(GetContext().clauseSource,
1058               "Unmatched directive name modifier %s on the IF clause"_err_en_US,
1059               parser::ToUpperCaseLetters(
1060                   parser::OmpIfClause::EnumToString(*directiveName)))
1061           .Attach(
1062               GetContext().directiveSource, "Cannot apply to directive"_en_US);
1063     }
1064   }
1065 }
1066 
1067 void OmpStructureChecker::Enter(const parser::OmpClause::Linear &x) {
1068   CheckAllowed(llvm::omp::Clause::OMPC_linear);
1069 
1070   // 2.7 Loop Construct Restriction
1071   if ((llvm::omp::doSet | llvm::omp::simdSet).test(GetContext().directive)) {
1072     if (std::holds_alternative<parser::OmpLinearClause::WithModifier>(x.v.u)) {
1073       context_.Say(GetContext().clauseSource,
1074           "A modifier may not be specified in a LINEAR clause "
1075           "on the %s directive"_err_en_US,
1076           ContextDirectiveAsFortran());
1077     }
1078   }
1079 }
1080 
1081 void OmpStructureChecker::CheckAllowedMapTypes(
1082     const parser::OmpMapType::Type &type,
1083     const std::list<parser::OmpMapType::Type> &allowedMapTypeList) {
1084   const auto found{std::find(
1085       std::begin(allowedMapTypeList), std::end(allowedMapTypeList), type)};
1086   if (found == std::end(allowedMapTypeList)) {
1087     std::string commaSeperatedMapTypes;
1088     llvm::interleave(
1089         allowedMapTypeList.begin(), allowedMapTypeList.end(),
1090         [&](const parser::OmpMapType::Type &mapType) {
1091           commaSeperatedMapTypes.append(parser::ToUpperCaseLetters(
1092               parser::OmpMapType::EnumToString(mapType)));
1093         },
1094         [&] { commaSeperatedMapTypes.append(", "); });
1095     context_.Say(GetContext().clauseSource,
1096         "Only the %s map types are permitted "
1097         "for MAP clauses on the %s directive"_err_en_US,
1098         commaSeperatedMapTypes, ContextDirectiveAsFortran());
1099   }
1100 }
1101 
1102 void OmpStructureChecker::Enter(const parser::OmpClause::Map &x) {
1103   CheckAllowed(llvm::omp::Clause::OMPC_map);
1104 
1105   if (const auto &maptype{std::get<std::optional<parser::OmpMapType>>(x.v.t)}) {
1106     using Type = parser::OmpMapType::Type;
1107     const Type &type{std::get<Type>(maptype->t)};
1108     switch (GetContext().directive) {
1109     case llvm::omp::Directive::OMPD_target:
1110     case llvm::omp::Directive::OMPD_target_teams:
1111     case llvm::omp::Directive::OMPD_target_teams_distribute:
1112     case llvm::omp::Directive::OMPD_target_teams_distribute_simd:
1113     case llvm::omp::Directive::OMPD_target_teams_distribute_parallel_do:
1114     case llvm::omp::Directive::OMPD_target_teams_distribute_parallel_do_simd:
1115     case llvm::omp::Directive::OMPD_target_data:
1116       CheckAllowedMapTypes(
1117           type, {Type::To, Type::From, Type::Tofrom, Type::Alloc});
1118       break;
1119     case llvm::omp::Directive::OMPD_target_enter_data:
1120       CheckAllowedMapTypes(type, {Type::To, Type::Alloc});
1121       break;
1122     case llvm::omp::Directive::OMPD_target_exit_data:
1123       CheckAllowedMapTypes(type, {Type::From, Type::Release, Type::Delete});
1124       break;
1125     default:
1126       break;
1127     }
1128   }
1129 }
1130 
1131 bool OmpStructureChecker::ScheduleModifierHasType(
1132     const parser::OmpScheduleClause &x,
1133     const parser::OmpScheduleModifierType::ModType &type) {
1134   const auto &modifier{
1135       std::get<std::optional<parser::OmpScheduleModifier>>(x.t)};
1136   if (modifier) {
1137     const auto &modType1{
1138         std::get<parser::OmpScheduleModifier::Modifier1>(modifier->t)};
1139     const auto &modType2{
1140         std::get<std::optional<parser::OmpScheduleModifier::Modifier2>>(
1141             modifier->t)};
1142     if (modType1.v.v == type || (modType2 && modType2->v.v == type)) {
1143       return true;
1144     }
1145   }
1146   return false;
1147 }
1148 void OmpStructureChecker::Enter(const parser::OmpClause::Schedule &x) {
1149   CheckAllowed(llvm::omp::Clause::OMPC_schedule);
1150   const parser::OmpScheduleClause &scheduleClause = x.v;
1151 
1152   // 2.7 Loop Construct Restriction
1153   if (llvm::omp::doSet.test(GetContext().directive)) {
1154     const auto &kind{std::get<1>(scheduleClause.t)};
1155     const auto &chunk{std::get<2>(scheduleClause.t)};
1156     if (chunk) {
1157       if (kind == parser::OmpScheduleClause::ScheduleType::Runtime ||
1158           kind == parser::OmpScheduleClause::ScheduleType::Auto) {
1159         context_.Say(GetContext().clauseSource,
1160             "When SCHEDULE clause has %s specified, "
1161             "it must not have chunk size specified"_err_en_US,
1162             parser::ToUpperCaseLetters(
1163                 parser::OmpScheduleClause::EnumToString(kind)));
1164       }
1165       if (const auto &chunkExpr{std::get<std::optional<parser::ScalarIntExpr>>(
1166               scheduleClause.t)}) {
1167         RequiresPositiveParameter(
1168             llvm::omp::Clause::OMPC_schedule, *chunkExpr, "chunk size");
1169       }
1170     }
1171 
1172     if (ScheduleModifierHasType(scheduleClause,
1173             parser::OmpScheduleModifierType::ModType::Nonmonotonic)) {
1174       if (kind != parser::OmpScheduleClause::ScheduleType::Dynamic &&
1175           kind != parser::OmpScheduleClause::ScheduleType::Guided) {
1176         context_.Say(GetContext().clauseSource,
1177             "The NONMONOTONIC modifier can only be specified with "
1178             "SCHEDULE(DYNAMIC) or SCHEDULE(GUIDED)"_err_en_US);
1179       }
1180     }
1181   }
1182 }
1183 
1184 void OmpStructureChecker::Enter(const parser::OmpClause::Depend &x) {
1185   CheckAllowed(llvm::omp::Clause::OMPC_depend);
1186   if (const auto *inOut{std::get_if<parser::OmpDependClause::InOut>(&x.v.u)}) {
1187     const auto &designators{std::get<std::list<parser::Designator>>(inOut->t)};
1188     for (const auto &ele : designators) {
1189       if (const auto *dataRef{std::get_if<parser::DataRef>(&ele.u)}) {
1190         CheckDependList(*dataRef);
1191         if (const auto *arr{
1192                 std::get_if<common::Indirection<parser::ArrayElement>>(
1193                     &dataRef->u)}) {
1194           CheckArraySection(arr->value(), GetLastName(*dataRef),
1195               llvm::omp::Clause::OMPC_depend);
1196         }
1197       }
1198     }
1199   }
1200 }
1201 
1202 void OmpStructureChecker::Enter(const parser::OmpClause::Copyprivate &x) {
1203   CheckAllowed(llvm::omp::Clause::OMPC_copyprivate);
1204   CheckIntentInPointer(x.v, llvm::omp::Clause::OMPC_copyprivate);
1205 }
1206 
1207 void OmpStructureChecker::Enter(const parser::OmpClause::Lastprivate &x) {
1208   CheckAllowed(llvm::omp::Clause::OMPC_lastprivate);
1209 
1210   DirectivesClauseTriple dirClauseTriple;
1211   SymbolSourceMap currSymbols;
1212   GetSymbolsInObjectList(x.v, currSymbols);
1213   CheckDefinableObjects(currSymbols, GetClauseKindForParserClass(x));
1214 
1215   // Check lastprivate variables in worksharing constructs
1216   dirClauseTriple.emplace(llvm::omp::Directive::OMPD_do,
1217       std::make_pair(
1218           llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet));
1219   dirClauseTriple.emplace(llvm::omp::Directive::OMPD_sections,
1220       std::make_pair(
1221           llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet));
1222 
1223   CheckPrivateSymbolsInOuterCxt(
1224       currSymbols, dirClauseTriple, GetClauseKindForParserClass(x));
1225 }
1226 
1227 llvm::StringRef OmpStructureChecker::getClauseName(llvm::omp::Clause clause) {
1228   return llvm::omp::getOpenMPClauseName(clause);
1229 }
1230 
1231 llvm::StringRef OmpStructureChecker::getDirectiveName(
1232     llvm::omp::Directive directive) {
1233   return llvm::omp::getOpenMPDirectiveName(directive);
1234 }
1235 
1236 void OmpStructureChecker::CheckDependList(const parser::DataRef &d) {
1237   std::visit(
1238       common::visitors{
1239           [&](const common::Indirection<parser::ArrayElement> &elem) {
1240             // Check if the base element is valid on Depend Clause
1241             CheckDependList(elem.value().base);
1242           },
1243           [&](const common::Indirection<parser::StructureComponent> &) {
1244             context_.Say(GetContext().clauseSource,
1245                 "A variable that is part of another variable "
1246                 "(such as an element of a structure) but is not an array "
1247                 "element or an array section cannot appear in a DEPEND "
1248                 "clause"_err_en_US);
1249           },
1250           [&](const common::Indirection<parser::CoindexedNamedObject> &) {
1251             context_.Say(GetContext().clauseSource,
1252                 "Coarrays are not supported in DEPEND clause"_err_en_US);
1253           },
1254           [&](const parser::Name &) { return; },
1255       },
1256       d.u);
1257 }
1258 
1259 // Called from both Reduction and Depend clause.
1260 void OmpStructureChecker::CheckArraySection(
1261     const parser::ArrayElement &arrayElement, const parser::Name &name,
1262     const llvm::omp::Clause clause) {
1263   if (!arrayElement.subscripts.empty()) {
1264     for (const auto &subscript : arrayElement.subscripts) {
1265       if (const auto *triplet{
1266               std::get_if<parser::SubscriptTriplet>(&subscript.u)}) {
1267         if (std::get<0>(triplet->t) && std::get<1>(triplet->t)) {
1268           const auto &lower{std::get<0>(triplet->t)};
1269           const auto &upper{std::get<1>(triplet->t)};
1270           if (lower && upper) {
1271             const auto lval{GetIntValue(lower)};
1272             const auto uval{GetIntValue(upper)};
1273             if (lval && uval && *uval < *lval) {
1274               context_.Say(GetContext().clauseSource,
1275                   "'%s' in %s clause"
1276                   " is a zero size array section"_err_en_US,
1277                   name.ToString(),
1278                   parser::ToUpperCaseLetters(getClauseName(clause).str()));
1279               break;
1280             } else if (std::get<2>(triplet->t)) {
1281               const auto &strideExpr{std::get<2>(triplet->t)};
1282               if (strideExpr) {
1283                 if (clause == llvm::omp::Clause::OMPC_depend) {
1284                   context_.Say(GetContext().clauseSource,
1285                       "Stride should not be specified for array section in "
1286                       "DEPEND "
1287                       "clause"_err_en_US);
1288                 }
1289                 const auto stride{GetIntValue(strideExpr)};
1290                 if ((stride && stride != 1)) {
1291                   context_.Say(GetContext().clauseSource,
1292                       "A list item that appears in a REDUCTION clause"
1293                       " should have a contiguous storage array section."_err_en_US,
1294                       ContextDirectiveAsFortran());
1295                   break;
1296                 }
1297               }
1298             }
1299           }
1300         }
1301       }
1302     }
1303   }
1304 }
1305 
1306 void OmpStructureChecker::CheckIntentInPointer(
1307     const parser::OmpObjectList &objectList, const llvm::omp::Clause clause) {
1308   SymbolSourceMap symbols;
1309   GetSymbolsInObjectList(objectList, symbols);
1310   for (auto it{symbols.begin()}; it != symbols.end(); ++it) {
1311     const auto *symbol{it->first};
1312     const auto source{it->second};
1313     if (IsPointer(*symbol) && IsIntentIn(*symbol)) {
1314       context_.Say(source,
1315           "Pointer '%s' with the INTENT(IN) attribute may not appear "
1316           "in a %s clause"_err_en_US,
1317           symbol->name(),
1318           parser::ToUpperCaseLetters(getClauseName(clause).str()));
1319     }
1320   }
1321 }
1322 
1323 void OmpStructureChecker::GetSymbolsInObjectList(
1324     const parser::OmpObjectList &objectList, SymbolSourceMap &symbols) {
1325   for (const auto &ompObject : objectList.v) {
1326     if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
1327       if (const auto *symbol{name->symbol}) {
1328         if (const auto *commonBlockDetails{
1329                 symbol->detailsIf<CommonBlockDetails>()}) {
1330           for (const auto &object : commonBlockDetails->objects()) {
1331             symbols.emplace(&object->GetUltimate(), name->source);
1332           }
1333         } else {
1334           symbols.emplace(&symbol->GetUltimate(), name->source);
1335         }
1336       }
1337     }
1338   }
1339 }
1340 
1341 void OmpStructureChecker::CheckDefinableObjects(
1342     SymbolSourceMap &symbols, const llvm::omp::Clause clause) {
1343   for (auto it{symbols.begin()}; it != symbols.end(); ++it) {
1344     const auto *symbol{it->first};
1345     const auto source{it->second};
1346     if (auto msg{WhyNotModifiable(*symbol, context_.FindScope(source))}) {
1347       context_
1348           .Say(source,
1349               "Variable '%s' on the %s clause is not definable"_err_en_US,
1350               symbol->name(),
1351               parser::ToUpperCaseLetters(getClauseName(clause).str()))
1352           .Attach(source, std::move(*msg), symbol->name());
1353     }
1354   }
1355 }
1356 
1357 void OmpStructureChecker::CheckPrivateSymbolsInOuterCxt(
1358     SymbolSourceMap &currSymbols, DirectivesClauseTriple &dirClauseTriple,
1359     const llvm::omp::Clause currClause) {
1360   SymbolSourceMap enclosingSymbols;
1361   auto range{dirClauseTriple.equal_range(GetContext().directive)};
1362   for (auto dirIter{range.first}; dirIter != range.second; ++dirIter) {
1363     auto enclosingDir{dirIter->second.first};
1364     auto enclosingClauseSet{dirIter->second.second};
1365     if (auto *enclosingContext{GetEnclosingContextWithDir(enclosingDir)}) {
1366       for (auto it{enclosingContext->clauseInfo.begin()};
1367            it != enclosingContext->clauseInfo.end(); ++it) {
1368         if (enclosingClauseSet.test(it->first)) {
1369           if (const auto *ompObjectList{GetOmpObjectList(*it->second)}) {
1370             GetSymbolsInObjectList(*ompObjectList, enclosingSymbols);
1371           }
1372         }
1373       }
1374 
1375       // Check if the symbols in current context are private in outer context
1376       for (auto iter{currSymbols.begin()}; iter != currSymbols.end(); ++iter) {
1377         const auto *symbol{iter->first};
1378         const auto source{iter->second};
1379         if (enclosingSymbols.find(symbol) != enclosingSymbols.end()) {
1380           context_.Say(source,
1381               "%s variable '%s' is PRIVATE in outer context"_err_en_US,
1382               parser::ToUpperCaseLetters(getClauseName(currClause).str()),
1383               symbol->name());
1384         }
1385       }
1386     }
1387   }
1388 }
1389 
1390 void OmpStructureChecker::CheckWorkshareBlockStmts(
1391     const parser::Block &block, parser::CharBlock source) {
1392   OmpWorkshareBlockChecker ompWorkshareBlockChecker{context_, source};
1393 
1394   for (auto it{block.begin()}; it != block.end(); ++it) {
1395     if (parser::Unwrap<parser::AssignmentStmt>(*it) ||
1396         parser::Unwrap<parser::ForallStmt>(*it) ||
1397         parser::Unwrap<parser::ForallConstruct>(*it) ||
1398         parser::Unwrap<parser::WhereStmt>(*it) ||
1399         parser::Unwrap<parser::WhereConstruct>(*it)) {
1400       parser::Walk(*it, ompWorkshareBlockChecker);
1401     } else if (const auto *ompConstruct{
1402                    parser::Unwrap<parser::OpenMPConstruct>(*it)}) {
1403       if (const auto *ompAtomicConstruct{
1404               std::get_if<parser::OpenMPAtomicConstruct>(&ompConstruct->u)}) {
1405         // Check if assignment statements in the enclosing OpenMP Atomic
1406         // construct are allowed in the Workshare construct
1407         parser::Walk(*ompAtomicConstruct, ompWorkshareBlockChecker);
1408       } else if (const auto *ompCriticalConstruct{
1409                      std::get_if<parser::OpenMPCriticalConstruct>(
1410                          &ompConstruct->u)}) {
1411         // All the restrictions on the Workshare construct apply to the
1412         // statements in the enclosing critical constructs
1413         const auto &criticalBlock{
1414             std::get<parser::Block>(ompCriticalConstruct->t)};
1415         CheckWorkshareBlockStmts(criticalBlock, source);
1416       } else {
1417         // Check if OpenMP constructs enclosed in the Workshare construct are
1418         // 'Parallel' constructs
1419         auto currentDir{llvm::omp::Directive::OMPD_unknown};
1420         const OmpDirectiveSet parallelDirSet{
1421             llvm::omp::Directive::OMPD_parallel,
1422             llvm::omp::Directive::OMPD_parallel_do,
1423             llvm::omp::Directive::OMPD_parallel_sections,
1424             llvm::omp::Directive::OMPD_parallel_workshare,
1425             llvm::omp::Directive::OMPD_parallel_do_simd};
1426 
1427         if (const auto *ompBlockConstruct{
1428                 std::get_if<parser::OpenMPBlockConstruct>(&ompConstruct->u)}) {
1429           const auto &beginBlockDir{
1430               std::get<parser::OmpBeginBlockDirective>(ompBlockConstruct->t)};
1431           const auto &beginDir{
1432               std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
1433           currentDir = beginDir.v;
1434         } else if (const auto *ompLoopConstruct{
1435                        std::get_if<parser::OpenMPLoopConstruct>(
1436                            &ompConstruct->u)}) {
1437           const auto &beginLoopDir{
1438               std::get<parser::OmpBeginLoopDirective>(ompLoopConstruct->t)};
1439           const auto &beginDir{
1440               std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
1441           currentDir = beginDir.v;
1442         } else if (const auto *ompSectionsConstruct{
1443                        std::get_if<parser::OpenMPSectionsConstruct>(
1444                            &ompConstruct->u)}) {
1445           const auto &beginSectionsDir{
1446               std::get<parser::OmpBeginSectionsDirective>(
1447                   ompSectionsConstruct->t)};
1448           const auto &beginDir{
1449               std::get<parser::OmpSectionsDirective>(beginSectionsDir.t)};
1450           currentDir = beginDir.v;
1451         }
1452 
1453         if (!parallelDirSet.test(currentDir)) {
1454           context_.Say(source,
1455               "OpenMP constructs enclosed in WORKSHARE construct may consist "
1456               "of ATOMIC, CRITICAL or PARALLEL constructs only"_err_en_US);
1457         }
1458       }
1459     } else {
1460       context_.Say(source,
1461           "The structured block in a WORKSHARE construct may consist of only "
1462           "SCALAR or ARRAY assignments, FORALL or WHERE statements, "
1463           "FORALL, WHERE, ATOMIC, CRITICAL or PARALLEL constructs"_err_en_US);
1464     }
1465   }
1466 }
1467 
1468 const parser::OmpObjectList *OmpStructureChecker::GetOmpObjectList(
1469     const parser::OmpClause &clause) {
1470 
1471   // Clauses with OmpObjectList as its data member
1472   using MemberObjectListClauses = std::tuple<parser::OmpClause::Copyprivate,
1473       parser::OmpClause::Copyin, parser::OmpClause::Firstprivate,
1474       parser::OmpClause::From, parser::OmpClause::Lastprivate,
1475       parser::OmpClause::Link, parser::OmpClause::Private,
1476       parser::OmpClause::Shared, parser::OmpClause::To>;
1477 
1478   // Clauses with OmpObjectList in the tuple
1479   using TupleObjectListClauses = std::tuple<parser::OmpClause::Allocate,
1480       parser::OmpClause::Map, parser::OmpClause::Reduction>;
1481 
1482   // TODO:: Generate the tuples using TableGen.
1483   // Handle other constructs with OmpObjectList such as OpenMPThreadprivate.
1484   return std::visit(
1485       common::visitors{
1486           [&](const auto &x) -> const parser::OmpObjectList * {
1487             using Ty = std::decay_t<decltype(x)>;
1488             if constexpr (common::HasMember<Ty, MemberObjectListClauses>) {
1489               return &x.v;
1490             } else if constexpr (common::HasMember<Ty,
1491                                      TupleObjectListClauses>) {
1492               return &(std::get<parser::OmpObjectList>(x.v.t));
1493             } else {
1494               return nullptr;
1495             }
1496           },
1497       },
1498       clause.u);
1499 }
1500 
1501 } // namespace Fortran::semantics
1502