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 bool OmpStructureChecker::HasInvalidWorksharingNesting(
88     const parser::CharBlock &source, const OmpDirectiveSet &set) {
89   // set contains all the invalid closely nested directives
90   // for the given directive (`source` here)
91   if (CurrentDirectiveIsNested() && set.test(GetContext().directive)) {
92     context_.Say(source,
93         "A worksharing region may not be closely nested inside a "
94         "worksharing, explicit task, taskloop, critical, ordered, atomic, or "
95         "master region"_err_en_US);
96     return true;
97   }
98   return false;
99 }
100 
101 void OmpStructureChecker::Enter(const parser::OpenMPConstruct &) {
102   // 2.8.1 TODO: Simd Construct with Ordered Construct Nesting check
103 }
104 
105 void OmpStructureChecker::Enter(const parser::OpenMPLoopConstruct &x) {
106   const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
107   const auto &beginDir{std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
108 
109   // check matching, End directive is optional
110   if (const auto &endLoopDir{
111           std::get<std::optional<parser::OmpEndLoopDirective>>(x.t)}) {
112     const auto &endDir{
113         std::get<parser::OmpLoopDirective>(endLoopDir.value().t)};
114 
115     CheckMatching<parser::OmpLoopDirective>(beginDir, endDir);
116   }
117 
118   if (beginDir.v != llvm::omp::Directive::OMPD_do) {
119     PushContextAndClauseSets(beginDir.source, beginDir.v);
120   } else {
121     // 2.7.1 do-clause -> private-clause |
122     //                    firstprivate-clause |
123     //                    lastprivate-clause |
124     //                    linear-clause |
125     //                    reduction-clause |
126     //                    schedule-clause |
127     //                    collapse-clause |
128     //                    ordered-clause
129 
130     // nesting check
131     HasInvalidWorksharingNesting(beginDir.source,
132         {llvm::omp::Directive::OMPD_do, llvm::omp::Directive::OMPD_sections,
133             llvm::omp::Directive::OMPD_single,
134             llvm::omp::Directive::OMPD_workshare,
135             llvm::omp::Directive::OMPD_task,
136             llvm::omp::Directive::OMPD_taskloop,
137             llvm::omp::Directive::OMPD_critical,
138             llvm::omp::Directive::OMPD_ordered,
139             llvm::omp::Directive::OMPD_atomic,
140             llvm::omp::Directive::OMPD_master});
141     PushContextAndClauseSets(beginDir.source, llvm::omp::Directive::OMPD_do);
142   }
143   SetLoopInfo(x);
144 }
145 const parser::Name OmpStructureChecker::GetLoopIndex(
146     const parser::DoConstruct *x) {
147   using Bounds = parser::LoopControl::Bounds;
148   return std::get<Bounds>(x->GetLoopControl()->u).name.thing;
149 }
150 void OmpStructureChecker::SetLoopInfo(const parser::OpenMPLoopConstruct &x) {
151   if (const auto &loopConstruct{
152           std::get<std::optional<parser::DoConstruct>>(x.t)}) {
153     const parser::DoConstruct *loop{&*loopConstruct};
154     if (loop && loop->IsDoNormal()) {
155       const parser::Name &itrVal{GetLoopIndex(loop)};
156       SetLoopIv(itrVal.symbol);
157     }
158   }
159 }
160 
161 void OmpStructureChecker::Leave(const parser::OpenMPLoopConstruct &) {
162   dirContext_.pop_back();
163 }
164 
165 void OmpStructureChecker::Enter(const parser::OmpEndLoopDirective &x) {
166   const auto &dir{std::get<parser::OmpLoopDirective>(x.t)};
167   ResetPartialContext(dir.source);
168   switch (dir.v) {
169   // 2.7.1 end-do -> END DO [nowait-clause]
170   // 2.8.3 end-do-simd -> END DO SIMD [nowait-clause]
171   case llvm::omp::Directive::OMPD_do:
172   case llvm::omp::Directive::OMPD_do_simd:
173     SetClauseSets(dir.v);
174     break;
175   default:
176     // no clauses are allowed
177     break;
178   }
179 }
180 
181 void OmpStructureChecker::Enter(const parser::OpenMPBlockConstruct &x) {
182   const auto &beginBlockDir{std::get<parser::OmpBeginBlockDirective>(x.t)};
183   const auto &endBlockDir{std::get<parser::OmpEndBlockDirective>(x.t)};
184   const auto &beginDir{std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
185   const auto &endDir{std::get<parser::OmpBlockDirective>(endBlockDir.t)};
186   const parser::Block &block{std::get<parser::Block>(x.t)};
187 
188   CheckMatching<parser::OmpBlockDirective>(beginDir, endDir);
189 
190   // TODO: This check needs to be extended while implementing nesting of regions
191   // checks.
192   if (beginDir.v == llvm::omp::Directive::OMPD_single) {
193     HasInvalidWorksharingNesting(
194         beginDir.source, {llvm::omp::Directive::OMPD_do});
195   }
196 
197   PushContextAndClauseSets(beginDir.source, beginDir.v);
198   CheckNoBranching(block, beginDir.v, beginDir.source);
199 
200   switch (beginDir.v) {
201   case llvm::omp::OMPD_workshare:
202   case llvm::omp::OMPD_parallel_workshare:
203     CheckWorkshareBlockStmts(block, beginDir.source);
204     break;
205   default:
206     break;
207   }
208 }
209 
210 void OmpStructureChecker::Leave(const parser::OpenMPBlockConstruct &) {
211   dirContext_.pop_back();
212 }
213 
214 void OmpStructureChecker::Enter(const parser::OpenMPSectionsConstruct &x) {
215   const auto &beginSectionsDir{
216       std::get<parser::OmpBeginSectionsDirective>(x.t)};
217   const auto &endSectionsDir{std::get<parser::OmpEndSectionsDirective>(x.t)};
218   const auto &beginDir{
219       std::get<parser::OmpSectionsDirective>(beginSectionsDir.t)};
220   const auto &endDir{std::get<parser::OmpSectionsDirective>(endSectionsDir.t)};
221   CheckMatching<parser::OmpSectionsDirective>(beginDir, endDir);
222 
223   PushContextAndClauseSets(beginDir.source, beginDir.v);
224 }
225 
226 void OmpStructureChecker::Leave(const parser::OpenMPSectionsConstruct &) {
227   dirContext_.pop_back();
228 }
229 
230 void OmpStructureChecker::Enter(const parser::OmpEndSectionsDirective &x) {
231   const auto &dir{std::get<parser::OmpSectionsDirective>(x.t)};
232   ResetPartialContext(dir.source);
233   switch (dir.v) {
234     // 2.7.2 end-sections -> END SECTIONS [nowait-clause]
235   case llvm::omp::Directive::OMPD_sections:
236     PushContextAndClauseSets(
237         dir.source, llvm::omp::Directive::OMPD_end_sections);
238     break;
239   default:
240     // no clauses are allowed
241     break;
242   }
243 }
244 
245 void OmpStructureChecker::Enter(const parser::OpenMPDeclareSimdConstruct &x) {
246   const auto &dir{std::get<parser::Verbatim>(x.t)};
247   PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_declare_simd);
248 }
249 
250 void OmpStructureChecker::Leave(const parser::OpenMPDeclareSimdConstruct &) {
251   dirContext_.pop_back();
252 }
253 
254 void OmpStructureChecker::Enter(const parser::OpenMPDeclarativeAllocate &x) {
255   const auto &dir{std::get<parser::Verbatim>(x.t)};
256   PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_allocate);
257 }
258 
259 void OmpStructureChecker::Leave(const parser::OpenMPDeclarativeAllocate &) {
260   dirContext_.pop_back();
261 }
262 
263 void OmpStructureChecker::Enter(const parser::OpenMPDeclareTargetConstruct &x) {
264   const auto &dir{std::get<parser::Verbatim>(x.t)};
265   PushContext(dir.source, llvm::omp::Directive::OMPD_declare_target);
266   const auto &spec{std::get<parser::OmpDeclareTargetSpecifier>(x.t)};
267   if (std::holds_alternative<parser::OmpDeclareTargetWithClause>(spec.u)) {
268     SetClauseSets(llvm::omp::Directive::OMPD_declare_target);
269   }
270 }
271 
272 void OmpStructureChecker::Leave(const parser::OpenMPDeclareTargetConstruct &) {
273   dirContext_.pop_back();
274 }
275 
276 void OmpStructureChecker::Enter(const parser::OpenMPExecutableAllocate &x) {
277   const auto &dir{std::get<parser::Verbatim>(x.t)};
278   PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_allocate);
279 }
280 
281 void OmpStructureChecker::Leave(const parser::OpenMPExecutableAllocate &) {
282   dirContext_.pop_back();
283 }
284 
285 void OmpStructureChecker::Enter(
286     const parser::OpenMPSimpleStandaloneConstruct &x) {
287   const auto &dir{std::get<parser::OmpSimpleStandaloneDirective>(x.t)};
288   PushContextAndClauseSets(dir.source, dir.v);
289 }
290 
291 void OmpStructureChecker::Leave(
292     const parser::OpenMPSimpleStandaloneConstruct &) {
293   dirContext_.pop_back();
294 }
295 
296 void OmpStructureChecker::Enter(const parser::OpenMPFlushConstruct &x) {
297   const auto &dir{std::get<parser::Verbatim>(x.t)};
298   PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_flush);
299 }
300 
301 void OmpStructureChecker::Leave(const parser::OpenMPFlushConstruct &x) {
302   if (FindClause(llvm::omp::Clause::OMPC_acquire) ||
303       FindClause(llvm::omp::Clause::OMPC_release) ||
304       FindClause(llvm::omp::Clause::OMPC_acq_rel)) {
305     if (const auto &flushList{
306             std::get<std::optional<parser::OmpObjectList>>(x.t)}) {
307       context_.Say(parser::FindSourceLocation(flushList),
308           "If memory-order-clause is RELEASE, ACQUIRE, or ACQ_REL, list items "
309           "must not be specified on the FLUSH directive"_err_en_US);
310     }
311   }
312   dirContext_.pop_back();
313 }
314 
315 void OmpStructureChecker::Enter(const parser::OpenMPCancelConstruct &x) {
316   const auto &dir{std::get<parser::Verbatim>(x.t)};
317   PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_cancel);
318 }
319 
320 void OmpStructureChecker::Leave(const parser::OpenMPCancelConstruct &) {
321   dirContext_.pop_back();
322 }
323 
324 void OmpStructureChecker::Enter(const parser::OpenMPCriticalConstruct &x) {
325   const auto &dir{std::get<parser::OmpCriticalDirective>(x.t)};
326   PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_critical);
327 }
328 
329 void OmpStructureChecker::Leave(const parser::OpenMPCriticalConstruct &) {
330   dirContext_.pop_back();
331 }
332 
333 void OmpStructureChecker::Enter(
334     const parser::OpenMPCancellationPointConstruct &x) {
335   const auto &dir{std::get<parser::Verbatim>(x.t)};
336   PushContextAndClauseSets(
337       dir.source, llvm::omp::Directive::OMPD_cancellation_point);
338 }
339 
340 void OmpStructureChecker::Leave(
341     const parser::OpenMPCancellationPointConstruct &) {
342   dirContext_.pop_back();
343 }
344 
345 void OmpStructureChecker::Enter(const parser::OmpEndBlockDirective &x) {
346   const auto &dir{std::get<parser::OmpBlockDirective>(x.t)};
347   ResetPartialContext(dir.source);
348   switch (dir.v) {
349   // 2.7.3 end-single-clause -> copyprivate-clause |
350   //                            nowait-clause
351   case llvm::omp::Directive::OMPD_single:
352     PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_end_single);
353     break;
354   // 2.7.4 end-workshare -> END WORKSHARE [nowait-clause]
355   case llvm::omp::Directive::OMPD_workshare:
356     PushContextAndClauseSets(
357         dir.source, llvm::omp::Directive::OMPD_end_workshare);
358     break;
359   default:
360     // no clauses are allowed
361     break;
362   }
363 }
364 
365 void OmpStructureChecker::Enter(const parser::OpenMPAtomicConstruct &x) {
366   std::visit(
367       common::visitors{
368           [&](const auto &someAtomicConstruct) {
369             const auto &dir{std::get<parser::Verbatim>(someAtomicConstruct.t)};
370             PushContextAndClauseSets(
371                 dir.source, llvm::omp::Directive::OMPD_atomic);
372           },
373       },
374       x.u);
375 }
376 
377 void OmpStructureChecker::Leave(const parser::OpenMPAtomicConstruct &) {
378   dirContext_.pop_back();
379 }
380 
381 // Clauses
382 // Mainly categorized as
383 // 1. Checks on 'OmpClauseList' from 'parse-tree.h'.
384 // 2. Checks on clauses which fall under 'struct OmpClause' from parse-tree.h.
385 // 3. Checks on clauses which are not in 'struct OmpClause' from parse-tree.h.
386 
387 void OmpStructureChecker::Leave(const parser::OmpClauseList &) {
388   // 2.7 Loop Construct Restriction
389   if (llvm::omp::doSet.test(GetContext().directive)) {
390     if (auto *clause{FindClause(llvm::omp::Clause::OMPC_schedule)}) {
391       // only one schedule clause is allowed
392       const auto &schedClause{std::get<parser::OmpClause::Schedule>(clause->u)};
393       if (ScheduleModifierHasType(schedClause.v,
394               parser::OmpScheduleModifierType::ModType::Nonmonotonic)) {
395         if (FindClause(llvm::omp::Clause::OMPC_ordered)) {
396           context_.Say(clause->source,
397               "The NONMONOTONIC modifier cannot be specified "
398               "if an ORDERED clause is specified"_err_en_US);
399         }
400         if (ScheduleModifierHasType(schedClause.v,
401                 parser::OmpScheduleModifierType::ModType::Monotonic)) {
402           context_.Say(clause->source,
403               "The MONOTONIC and NONMONOTONIC modifiers "
404               "cannot be both specified"_err_en_US);
405         }
406       }
407     }
408 
409     if (auto *clause{FindClause(llvm::omp::Clause::OMPC_ordered)}) {
410       // only one ordered clause is allowed
411       const auto &orderedClause{
412           std::get<parser::OmpClause::Ordered>(clause->u)};
413 
414       if (orderedClause.v) {
415         CheckNotAllowedIfClause(
416             llvm::omp::Clause::OMPC_ordered, {llvm::omp::Clause::OMPC_linear});
417 
418         if (auto *clause2{FindClause(llvm::omp::Clause::OMPC_collapse)}) {
419           const auto &collapseClause{
420               std::get<parser::OmpClause::Collapse>(clause2->u)};
421           // ordered and collapse both have parameters
422           if (const auto orderedValue{GetIntValue(orderedClause.v)}) {
423             if (const auto collapseValue{GetIntValue(collapseClause.v)}) {
424               if (*orderedValue > 0 && *orderedValue < *collapseValue) {
425                 context_.Say(clause->source,
426                     "The parameter of the ORDERED clause must be "
427                     "greater than or equal to "
428                     "the parameter of the COLLAPSE clause"_err_en_US);
429               }
430             }
431           }
432         }
433       }
434 
435       // TODO: ordered region binding check (requires nesting implementation)
436     }
437   } // doSet
438 
439   // 2.8.1 Simd Construct Restriction
440   if (llvm::omp::simdSet.test(GetContext().directive)) {
441     if (auto *clause{FindClause(llvm::omp::Clause::OMPC_simdlen)}) {
442       if (auto *clause2{FindClause(llvm::omp::Clause::OMPC_safelen)}) {
443         const auto &simdlenClause{
444             std::get<parser::OmpClause::Simdlen>(clause->u)};
445         const auto &safelenClause{
446             std::get<parser::OmpClause::Safelen>(clause2->u)};
447         // simdlen and safelen both have parameters
448         if (const auto simdlenValue{GetIntValue(simdlenClause.v)}) {
449           if (const auto safelenValue{GetIntValue(safelenClause.v)}) {
450             if (*safelenValue > 0 && *simdlenValue > *safelenValue) {
451               context_.Say(clause->source,
452                   "The parameter of the SIMDLEN clause must be less than or "
453                   "equal to the parameter of the SAFELEN clause"_err_en_US);
454             }
455           }
456         }
457       }
458     }
459     // TODO: A list-item cannot appear in more than one aligned clause
460   } // SIMD
461 
462   // 2.7.3 Single Construct Restriction
463   if (GetContext().directive == llvm::omp::Directive::OMPD_end_single) {
464     CheckNotAllowedIfClause(
465         llvm::omp::Clause::OMPC_copyprivate, {llvm::omp::Clause::OMPC_nowait});
466   }
467 
468   CheckRequireAtLeastOneOf();
469 }
470 
471 void OmpStructureChecker::Enter(const parser::OmpClause &x) {
472   SetContextClause(x);
473 }
474 
475 // Following clauses do not have a seperate node in parse-tree.h.
476 // They fall under 'struct OmpClause' in parse-tree.h.
477 CHECK_SIMPLE_CLAUSE(Allocate, OMPC_allocate)
478 CHECK_SIMPLE_CLAUSE(Copyin, OMPC_copyin)
479 CHECK_SIMPLE_CLAUSE(Copyprivate, OMPC_copyprivate)
480 CHECK_SIMPLE_CLAUSE(Default, OMPC_default)
481 CHECK_SIMPLE_CLAUSE(Device, OMPC_device)
482 CHECK_SIMPLE_CLAUSE(Final, OMPC_final)
483 CHECK_SIMPLE_CLAUSE(From, OMPC_from)
484 CHECK_SIMPLE_CLAUSE(Inbranch, OMPC_inbranch)
485 CHECK_SIMPLE_CLAUSE(IsDevicePtr, OMPC_is_device_ptr)
486 CHECK_SIMPLE_CLAUSE(Lastprivate, OMPC_lastprivate)
487 CHECK_SIMPLE_CLAUSE(Link, OMPC_link)
488 CHECK_SIMPLE_CLAUSE(Mergeable, OMPC_mergeable)
489 CHECK_SIMPLE_CLAUSE(Nogroup, OMPC_nogroup)
490 CHECK_SIMPLE_CLAUSE(Notinbranch, OMPC_notinbranch)
491 CHECK_SIMPLE_CLAUSE(Nowait, OMPC_nowait)
492 CHECK_SIMPLE_CLAUSE(Reduction, OMPC_reduction)
493 CHECK_SIMPLE_CLAUSE(TaskReduction, OMPC_task_reduction)
494 CHECK_SIMPLE_CLAUSE(To, OMPC_to)
495 CHECK_SIMPLE_CLAUSE(Uniform, OMPC_uniform)
496 CHECK_SIMPLE_CLAUSE(Untied, OMPC_untied)
497 CHECK_SIMPLE_CLAUSE(UseDevicePtr, OMPC_use_device_ptr)
498 CHECK_SIMPLE_CLAUSE(AcqRel, OMPC_acq_rel)
499 CHECK_SIMPLE_CLAUSE(Acquire, OMPC_acquire)
500 CHECK_SIMPLE_CLAUSE(SeqCst, OMPC_seq_cst)
501 CHECK_SIMPLE_CLAUSE(Release, OMPC_release)
502 CHECK_SIMPLE_CLAUSE(Relaxed, OMPC_relaxed)
503 CHECK_SIMPLE_CLAUSE(Hint, OMPC_hint)
504 CHECK_SIMPLE_CLAUSE(ProcBind, OMPC_proc_bind)
505 CHECK_SIMPLE_CLAUSE(DistSchedule, OMPC_dist_schedule)
506 
507 CHECK_REQ_SCALAR_INT_CLAUSE(Allocator, OMPC_allocator)
508 CHECK_REQ_SCALAR_INT_CLAUSE(Grainsize, OMPC_grainsize)
509 CHECK_REQ_SCALAR_INT_CLAUSE(NumTasks, OMPC_num_tasks)
510 CHECK_REQ_SCALAR_INT_CLAUSE(NumTeams, OMPC_num_teams)
511 CHECK_REQ_SCALAR_INT_CLAUSE(NumThreads, OMPC_num_threads)
512 CHECK_REQ_SCALAR_INT_CLAUSE(Priority, OMPC_priority)
513 CHECK_REQ_SCALAR_INT_CLAUSE(ThreadLimit, OMPC_thread_limit)
514 
515 CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(Collapse, OMPC_collapse)
516 CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(Safelen, OMPC_safelen)
517 CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(Simdlen, OMPC_simdlen)
518 
519 // Restrictions specific to each clause are implemented apart from the
520 // generalized restrictions.
521 void OmpStructureChecker::Enter(const parser::OmpClause::Ordered &x) {
522   CheckAllowed(llvm::omp::Clause::OMPC_ordered);
523   // the parameter of ordered clause is optional
524   if (const auto &expr{x.v}) {
525     RequiresConstantPositiveParameter(llvm::omp::Clause::OMPC_ordered, *expr);
526     // 2.8.3 Loop SIMD Construct Restriction
527     if (llvm::omp::doSimdSet.test(GetContext().directive)) {
528       context_.Say(GetContext().clauseSource,
529           "No ORDERED clause with a parameter can be specified "
530           "on the %s directive"_err_en_US,
531           ContextDirectiveAsFortran());
532     }
533   }
534 }
535 
536 void OmpStructureChecker::Enter(const parser::OmpClause::Shared &x) {
537   CheckAllowed(llvm::omp::Clause::OMPC_shared);
538   CheckIsVarPartOfAnotherVar(x.v);
539 }
540 void OmpStructureChecker::Enter(const parser::OmpClause::Private &x) {
541   CheckAllowed(llvm::omp::Clause::OMPC_private);
542   CheckIsVarPartOfAnotherVar(x.v);
543   CheckIntentInPointer(x.v, llvm::omp::Clause::OMPC_private);
544 }
545 
546 void OmpStructureChecker::CheckIsVarPartOfAnotherVar(
547     const parser::OmpObjectList &objList) {
548 
549   for (const auto &ompObject : objList.v) {
550     std::visit(
551         common::visitors{
552             [&](const parser::Designator &designator) {
553               if (std::get_if<parser::DataRef>(&designator.u)) {
554                 if ((parser::Unwrap<parser::StructureComponent>(ompObject)) ||
555                     (parser::Unwrap<parser::ArrayElement>(ompObject))) {
556                   context_.Say(GetContext().clauseSource,
557                       "A variable that is part of another variable (as an "
558                       "array or structure element)"
559                       " cannot appear in a PRIVATE or SHARED clause."_err_en_US);
560                 }
561               }
562             },
563             [&](const parser::Name &name) {},
564         },
565         ompObject.u);
566   }
567 }
568 void OmpStructureChecker::Enter(const parser::OmpClause::Firstprivate &x) {
569   CheckAllowed(llvm::omp::Clause::OMPC_firstprivate);
570   CheckIsLoopIvPartOfClause(llvmOmpClause::OMPC_firstprivate, x.v);
571 }
572 void OmpStructureChecker::CheckIsLoopIvPartOfClause(
573     llvmOmpClause clause, const parser::OmpObjectList &ompObjectList) {
574   for (const auto &ompObject : ompObjectList.v) {
575     if (const parser::Name * name{parser::Unwrap<parser::Name>(ompObject)}) {
576       if (name->symbol == GetContext().loopIV) {
577         context_.Say(name->source,
578             "DO iteration variable %s is not allowed in %s clause."_err_en_US,
579             name->ToString(),
580             parser::ToUpperCaseLetters(getClauseName(clause).str()));
581       }
582     }
583   }
584 }
585 // Following clauses have a seperate node in parse-tree.h.
586 // Atomic-clause
587 CHECK_SIMPLE_PARSER_CLAUSE(OmpAtomicRead, OMPC_read)
588 CHECK_SIMPLE_PARSER_CLAUSE(OmpAtomicWrite, OMPC_write)
589 CHECK_SIMPLE_PARSER_CLAUSE(OmpAtomicUpdate, OMPC_update)
590 CHECK_SIMPLE_PARSER_CLAUSE(OmpAtomicCapture, OMPC_capture)
591 
592 void OmpStructureChecker::Leave(const parser::OmpAtomicRead &) {
593   CheckNotAllowedIfClause(llvm::omp::Clause::OMPC_read,
594       {llvm::omp::Clause::OMPC_release, llvm::omp::Clause::OMPC_acq_rel});
595 }
596 void OmpStructureChecker::Leave(const parser::OmpAtomicWrite &) {
597   CheckNotAllowedIfClause(llvm::omp::Clause::OMPC_write,
598       {llvm::omp::Clause::OMPC_acquire, llvm::omp::Clause::OMPC_acq_rel});
599 }
600 void OmpStructureChecker::Leave(const parser::OmpAtomicUpdate &) {
601   CheckNotAllowedIfClause(llvm::omp::Clause::OMPC_update,
602       {llvm::omp::Clause::OMPC_acquire, llvm::omp::Clause::OMPC_acq_rel});
603 }
604 // OmpAtomic node represents atomic directive without atomic-clause.
605 // atomic-clause - READ,WRITE,UPDATE,CAPTURE.
606 void OmpStructureChecker::Leave(const parser::OmpAtomic &) {
607   if (const auto *clause{FindClause(llvm::omp::Clause::OMPC_acquire)}) {
608     context_.Say(clause->source,
609         "Clause ACQUIRE is not allowed on the ATOMIC directive"_err_en_US);
610   }
611   if (const auto *clause{FindClause(llvm::omp::Clause::OMPC_acq_rel)}) {
612     context_.Say(clause->source,
613         "Clause ACQ_REL is not allowed on the ATOMIC directive"_err_en_US);
614   }
615 }
616 // Restrictions specific to each clause are implemented apart from the
617 // generalized restrictions.
618 void OmpStructureChecker::Enter(const parser::OmpAlignedClause &x) {
619   CheckAllowed(llvm::omp::Clause::OMPC_aligned);
620 
621   if (const auto &expr{
622           std::get<std::optional<parser::ScalarIntConstantExpr>>(x.t)}) {
623     RequiresConstantPositiveParameter(llvm::omp::Clause::OMPC_aligned, *expr);
624   }
625   // 2.8.1 TODO: list-item attribute check
626 }
627 void OmpStructureChecker::Enter(const parser::OmpDefaultmapClause &x) {
628   CheckAllowed(llvm::omp::Clause::OMPC_defaultmap);
629   using VariableCategory = parser::OmpDefaultmapClause::VariableCategory;
630   if (!std::get<std::optional<VariableCategory>>(x.t)) {
631     context_.Say(GetContext().clauseSource,
632         "The argument TOFROM:SCALAR must be specified on the DEFAULTMAP "
633         "clause"_err_en_US);
634   }
635 }
636 void OmpStructureChecker::Enter(const parser::OmpIfClause &x) {
637   CheckAllowed(llvm::omp::Clause::OMPC_if);
638 
639   using dirNameModifier = parser::OmpIfClause::DirectiveNameModifier;
640   static std::unordered_map<dirNameModifier, OmpDirectiveSet>
641       dirNameModifierMap{{dirNameModifier::Parallel, llvm::omp::parallelSet},
642           {dirNameModifier::Target, llvm::omp::targetSet},
643           {dirNameModifier::TargetEnterData,
644               {llvm::omp::Directive::OMPD_target_enter_data}},
645           {dirNameModifier::TargetExitData,
646               {llvm::omp::Directive::OMPD_target_exit_data}},
647           {dirNameModifier::TargetData,
648               {llvm::omp::Directive::OMPD_target_data}},
649           {dirNameModifier::TargetUpdate,
650               {llvm::omp::Directive::OMPD_target_update}},
651           {dirNameModifier::Task, {llvm::omp::Directive::OMPD_task}},
652           {dirNameModifier::Taskloop, llvm::omp::taskloopSet}};
653   if (const auto &directiveName{
654           std::get<std::optional<dirNameModifier>>(x.t)}) {
655     auto search{dirNameModifierMap.find(*directiveName)};
656     if (search == dirNameModifierMap.end() ||
657         !search->second.test(GetContext().directive)) {
658       context_
659           .Say(GetContext().clauseSource,
660               "Unmatched directive name modifier %s on the IF clause"_err_en_US,
661               parser::ToUpperCaseLetters(
662                   parser::OmpIfClause::EnumToString(*directiveName)))
663           .Attach(
664               GetContext().directiveSource, "Cannot apply to directive"_en_US);
665     }
666   }
667 }
668 
669 void OmpStructureChecker::Enter(const parser::OmpLinearClause &x) {
670   CheckAllowed(llvm::omp::Clause::OMPC_linear);
671 
672   // 2.7 Loop Construct Restriction
673   if ((llvm::omp::doSet | llvm::omp::simdSet).test(GetContext().directive)) {
674     if (std::holds_alternative<parser::OmpLinearClause::WithModifier>(x.u)) {
675       context_.Say(GetContext().clauseSource,
676           "A modifier may not be specified in a LINEAR clause "
677           "on the %s directive"_err_en_US,
678           ContextDirectiveAsFortran());
679     }
680   }
681 }
682 
683 void OmpStructureChecker::CheckAllowedMapTypes(
684     const parser::OmpMapType::Type &type,
685     const std::list<parser::OmpMapType::Type> &allowedMapTypeList) {
686   const auto found{std::find(
687       std::begin(allowedMapTypeList), std::end(allowedMapTypeList), type)};
688   if (found == std::end(allowedMapTypeList)) {
689     std::string commaSeperatedMapTypes;
690     llvm::interleave(
691         allowedMapTypeList.begin(), allowedMapTypeList.end(),
692         [&](const parser::OmpMapType::Type &mapType) {
693           commaSeperatedMapTypes.append(parser::ToUpperCaseLetters(
694               parser::OmpMapType::EnumToString(mapType)));
695         },
696         [&] { commaSeperatedMapTypes.append(", "); });
697     context_.Say(GetContext().clauseSource,
698         "Only the %s map types are permitted "
699         "for MAP clauses on the %s directive"_err_en_US,
700         commaSeperatedMapTypes, ContextDirectiveAsFortran());
701   }
702 }
703 
704 void OmpStructureChecker::Enter(const parser::OmpMapClause &x) {
705   CheckAllowed(llvm::omp::Clause::OMPC_map);
706   if (const auto &maptype{std::get<std::optional<parser::OmpMapType>>(x.t)}) {
707     using Type = parser::OmpMapType::Type;
708     const Type &type{std::get<Type>(maptype->t)};
709     switch (GetContext().directive) {
710     case llvm::omp::Directive::OMPD_target:
711     case llvm::omp::Directive::OMPD_target_teams:
712     case llvm::omp::Directive::OMPD_target_teams_distribute:
713     case llvm::omp::Directive::OMPD_target_teams_distribute_simd:
714     case llvm::omp::Directive::OMPD_target_teams_distribute_parallel_do:
715     case llvm::omp::Directive::OMPD_target_teams_distribute_parallel_do_simd:
716     case llvm::omp::Directive::OMPD_target_data:
717       CheckAllowedMapTypes(
718           type, {Type::To, Type::From, Type::Tofrom, Type::Alloc});
719       break;
720     case llvm::omp::Directive::OMPD_target_enter_data:
721       CheckAllowedMapTypes(type, {Type::To, Type::Alloc});
722       break;
723     case llvm::omp::Directive::OMPD_target_exit_data:
724       CheckAllowedMapTypes(type, {Type::From, Type::Release, Type::Delete});
725       break;
726     default:
727       break;
728     }
729   }
730 }
731 
732 bool OmpStructureChecker::ScheduleModifierHasType(
733     const parser::OmpScheduleClause &x,
734     const parser::OmpScheduleModifierType::ModType &type) {
735   const auto &modifier{
736       std::get<std::optional<parser::OmpScheduleModifier>>(x.t)};
737   if (modifier) {
738     const auto &modType1{
739         std::get<parser::OmpScheduleModifier::Modifier1>(modifier->t)};
740     const auto &modType2{
741         std::get<std::optional<parser::OmpScheduleModifier::Modifier2>>(
742             modifier->t)};
743     if (modType1.v.v == type || (modType2 && modType2->v.v == type)) {
744       return true;
745     }
746   }
747   return false;
748 }
749 void OmpStructureChecker::Enter(const parser::OmpScheduleClause &x) {
750   CheckAllowed(llvm::omp::Clause::OMPC_schedule);
751 
752   // 2.7 Loop Construct Restriction
753   if (llvm::omp::doSet.test(GetContext().directive)) {
754     const auto &kind{std::get<1>(x.t)};
755     const auto &chunk{std::get<2>(x.t)};
756     if (chunk) {
757       if (kind == parser::OmpScheduleClause::ScheduleType::Runtime ||
758           kind == parser::OmpScheduleClause::ScheduleType::Auto) {
759         context_.Say(GetContext().clauseSource,
760             "When SCHEDULE clause has %s specified, "
761             "it must not have chunk size specified"_err_en_US,
762             parser::ToUpperCaseLetters(
763                 parser::OmpScheduleClause::EnumToString(kind)));
764       }
765       if (const auto &chunkExpr{
766               std::get<std::optional<parser::ScalarIntExpr>>(x.t)}) {
767         RequiresPositiveParameter(
768             llvm::omp::Clause::OMPC_schedule, *chunkExpr, "chunk size");
769       }
770     }
771 
772     if (ScheduleModifierHasType(
773             x, parser::OmpScheduleModifierType::ModType::Nonmonotonic)) {
774       if (kind != parser::OmpScheduleClause::ScheduleType::Dynamic &&
775           kind != parser::OmpScheduleClause::ScheduleType::Guided) {
776         context_.Say(GetContext().clauseSource,
777             "The NONMONOTONIC modifier can only be specified with "
778             "SCHEDULE(DYNAMIC) or SCHEDULE(GUIDED)"_err_en_US);
779       }
780     }
781   }
782 }
783 
784 void OmpStructureChecker::Enter(const parser::OmpDependClause &x) {
785   CheckAllowed(llvm::omp::Clause::OMPC_depend);
786   if (const auto *inOut{std::get_if<parser::OmpDependClause::InOut>(&x.u)}) {
787     const auto &designators{std::get<std::list<parser::Designator>>(inOut->t)};
788     for (const auto &ele : designators) {
789       if (const auto *dataRef{std::get_if<parser::DataRef>(&ele.u)}) {
790         CheckDependList(*dataRef);
791         if (const auto *arr{
792                 std::get_if<common::Indirection<parser::ArrayElement>>(
793                     &dataRef->u)}) {
794           CheckDependArraySection(*arr, GetLastName(*dataRef));
795         }
796       }
797     }
798   }
799 }
800 
801 llvm::StringRef OmpStructureChecker::getClauseName(llvm::omp::Clause clause) {
802   return llvm::omp::getOpenMPClauseName(clause);
803 }
804 
805 llvm::StringRef OmpStructureChecker::getDirectiveName(
806     llvm::omp::Directive directive) {
807   return llvm::omp::getOpenMPDirectiveName(directive);
808 }
809 
810 void OmpStructureChecker::CheckDependList(const parser::DataRef &d) {
811   std::visit(
812       common::visitors{
813           [&](const common::Indirection<parser::ArrayElement> &elem) {
814             // Check if the base element is valid on Depend Clause
815             CheckDependList(elem.value().base);
816           },
817           [&](const common::Indirection<parser::StructureComponent> &) {
818             context_.Say(GetContext().clauseSource,
819                 "A variable that is part of another variable "
820                 "(such as an element of a structure) but is not an array "
821                 "element or an array section cannot appear in a DEPEND "
822                 "clause"_err_en_US);
823           },
824           [&](const common::Indirection<parser::CoindexedNamedObject> &) {
825             context_.Say(GetContext().clauseSource,
826                 "Coarrays are not supported in DEPEND clause"_err_en_US);
827           },
828           [&](const parser::Name &) { return; },
829       },
830       d.u);
831 }
832 
833 void OmpStructureChecker::CheckDependArraySection(
834     const common::Indirection<parser::ArrayElement> &arr,
835     const parser::Name &name) {
836   for (const auto &subscript : arr.value().subscripts) {
837     if (const auto *triplet{
838             std::get_if<parser::SubscriptTriplet>(&subscript.u)}) {
839       if (std::get<2>(triplet->t)) {
840         context_.Say(GetContext().clauseSource,
841             "Stride should not be specified for array section in DEPEND "
842             "clause"_err_en_US);
843       }
844       const auto &lower{std::get<0>(triplet->t)};
845       const auto &upper{std::get<1>(triplet->t)};
846       if (lower && upper) {
847         const auto lval{GetIntValue(lower)};
848         const auto uval{GetIntValue(upper)};
849         if (lval && uval && *uval < *lval) {
850           context_.Say(GetContext().clauseSource,
851               "'%s' in DEPEND clause is a zero size array section"_err_en_US,
852               name.ToString());
853           break;
854         }
855       }
856     }
857   }
858 }
859 
860 void OmpStructureChecker::CheckIntentInPointer(
861     const parser::OmpObjectList &objectList, const llvm::omp::Clause clause) {
862   std::vector<const Symbol *> symbols;
863   GetSymbolsInObjectList(objectList, symbols);
864   for (const auto *symbol : symbols) {
865     if (IsPointer(*symbol) && IsIntentIn(*symbol)) {
866       context_.Say(GetContext().clauseSource,
867           "Pointer '%s' with the INTENT(IN) attribute may not appear "
868           "in a %s clause"_err_en_US,
869           symbol->name(),
870           parser::ToUpperCaseLetters(getClauseName(clause).str()));
871     }
872   }
873 }
874 
875 void OmpStructureChecker::GetSymbolsInObjectList(
876     const parser::OmpObjectList &objectList,
877     std::vector<const Symbol *> &symbols) {
878   for (const auto &ompObject : objectList.v) {
879     if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
880       if (const auto *symbol{name->symbol}) {
881         if (const auto *commonBlockDetails{
882                 symbol->detailsIf<CommonBlockDetails>()}) {
883           for (const auto &object : commonBlockDetails->objects()) {
884             symbols.emplace_back(&object->GetUltimate());
885           }
886         } else {
887           symbols.emplace_back(&symbol->GetUltimate());
888         }
889       }
890     }
891   }
892 }
893 
894 void OmpStructureChecker::CheckWorkshareBlockStmts(
895     const parser::Block &block, parser::CharBlock source) {
896   OmpWorkshareBlockChecker ompWorkshareBlockChecker{context_, source};
897 
898   for (auto it{block.begin()}; it != block.end(); ++it) {
899     if (parser::Unwrap<parser::AssignmentStmt>(*it) ||
900         parser::Unwrap<parser::ForallStmt>(*it) ||
901         parser::Unwrap<parser::ForallConstruct>(*it) ||
902         parser::Unwrap<parser::WhereStmt>(*it) ||
903         parser::Unwrap<parser::WhereConstruct>(*it)) {
904       parser::Walk(*it, ompWorkshareBlockChecker);
905     } else if (const auto *ompConstruct{
906                    parser::Unwrap<parser::OpenMPConstruct>(*it)}) {
907       if (const auto *ompAtomicConstruct{
908               std::get_if<parser::OpenMPAtomicConstruct>(&ompConstruct->u)}) {
909         // Check if assignment statements in the enclosing OpenMP Atomic
910         // construct are allowed in the Workshare construct
911         parser::Walk(*ompAtomicConstruct, ompWorkshareBlockChecker);
912       } else if (const auto *ompCriticalConstruct{
913                      std::get_if<parser::OpenMPCriticalConstruct>(
914                          &ompConstruct->u)}) {
915         // All the restrictions on the Workshare construct apply to the
916         // statements in the enclosing critical constructs
917         const auto &criticalBlock{
918             std::get<parser::Block>(ompCriticalConstruct->t)};
919         CheckWorkshareBlockStmts(criticalBlock, source);
920       } else {
921         // Check if OpenMP constructs enclosed in the Workshare construct are
922         // 'Parallel' constructs
923         auto currentDir{llvm::omp::Directive::OMPD_unknown};
924         const OmpDirectiveSet parallelDirSet{
925             llvm::omp::Directive::OMPD_parallel,
926             llvm::omp::Directive::OMPD_parallel_do,
927             llvm::omp::Directive::OMPD_parallel_sections,
928             llvm::omp::Directive::OMPD_parallel_workshare,
929             llvm::omp::Directive::OMPD_parallel_do_simd};
930 
931         if (const auto *ompBlockConstruct{
932                 std::get_if<parser::OpenMPBlockConstruct>(&ompConstruct->u)}) {
933           const auto &beginBlockDir{
934               std::get<parser::OmpBeginBlockDirective>(ompBlockConstruct->t)};
935           const auto &beginDir{
936               std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
937           currentDir = beginDir.v;
938         } else if (const auto *ompLoopConstruct{
939                        std::get_if<parser::OpenMPLoopConstruct>(
940                            &ompConstruct->u)}) {
941           const auto &beginLoopDir{
942               std::get<parser::OmpBeginLoopDirective>(ompLoopConstruct->t)};
943           const auto &beginDir{
944               std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
945           currentDir = beginDir.v;
946         } else if (const auto *ompSectionsConstruct{
947                        std::get_if<parser::OpenMPSectionsConstruct>(
948                            &ompConstruct->u)}) {
949           const auto &beginSectionsDir{
950               std::get<parser::OmpBeginSectionsDirective>(
951                   ompSectionsConstruct->t)};
952           const auto &beginDir{
953               std::get<parser::OmpSectionsDirective>(beginSectionsDir.t)};
954           currentDir = beginDir.v;
955         }
956 
957         if (!parallelDirSet.test(currentDir)) {
958           context_.Say(source,
959               "OpenMP constructs enclosed in WORKSHARE construct may consist "
960               "of ATOMIC, CRITICAL or PARALLEL constructs only"_err_en_US);
961         }
962       }
963     } else {
964       context_.Say(source,
965           "The structured block in a WORKSHARE construct may consist of only "
966           "SCALAR or ARRAY assignments, FORALL or WHERE statements, "
967           "FORALL, WHERE, ATOMIC, CRITICAL or PARALLEL constructs"_err_en_US);
968     }
969   }
970 }
971 
972 } // namespace Fortran::semantics
973