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