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