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