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