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 
13 namespace Fortran::semantics {
14 
ContextDirectiveAsFortran()15 std::string OmpStructureChecker::ContextDirectiveAsFortran() {
16   auto dir = llvm::omp::getOpenMPDirectiveName(GetContext().directive).str();
17   std::transform(dir.begin(), dir.end(), dir.begin(),
18       [](unsigned char c) { return std::toupper(c); });
19   return dir;
20 }
21 
SayNotMatching(const parser::CharBlock & beginSource,const parser::CharBlock & endSource)22 void OmpStructureChecker::SayNotMatching(
23     const parser::CharBlock &beginSource, const parser::CharBlock &endSource) {
24   context_
25       .Say(endSource, "Unmatched %s directive"_err_en_US,
26           parser::ToUpperCaseLetters(endSource.ToString()))
27       .Attach(beginSource, "Does not match directive"_en_US);
28 }
29 
HasInvalidWorksharingNesting(const parser::CharBlock & source,const OmpDirectiveSet & set)30 bool OmpStructureChecker::HasInvalidWorksharingNesting(
31     const parser::CharBlock &source, const OmpDirectiveSet &set) {
32   // set contains all the invalid closely nested directives
33   // for the given directive (`source` here)
34   if (CurrentDirectiveIsNested() && set.test(GetContext().directive)) {
35     context_.Say(source,
36         "A worksharing region may not be closely nested inside a "
37         "worksharing, explicit task, taskloop, critical, ordered, atomic, or "
38         "master region"_err_en_US);
39     return true;
40   }
41   return false;
42 }
43 
CheckAllowed(llvm::omp::Clause type)44 void OmpStructureChecker::CheckAllowed(llvm::omp::Clause type) {
45   if (!GetContext().allowedClauses.test(type) &&
46       !GetContext().allowedOnceClauses.test(type) &&
47       !GetContext().allowedExclusiveClauses.test(type)) {
48     context_.Say(GetContext().clauseSource,
49         "%s clause is not allowed on the %s directive"_err_en_US,
50         parser::ToUpperCaseLetters(llvm::omp::getOpenMPClauseName(type).str()),
51         parser::ToUpperCaseLetters(GetContext().directiveSource.ToString()));
52     return;
53   }
54   if ((GetContext().allowedOnceClauses.test(type) ||
55           GetContext().allowedExclusiveClauses.test(type)) &&
56       FindClause(type)) {
57     context_.Say(GetContext().clauseSource,
58         "At most one %s clause can appear on the %s directive"_err_en_US,
59         parser::ToUpperCaseLetters(llvm::omp::getOpenMPClauseName(type).str()),
60         parser::ToUpperCaseLetters(GetContext().directiveSource.ToString()));
61     return;
62   }
63   if (GetContext().allowedExclusiveClauses.test(type)) {
64     std::vector<llvm::omp::Clause> others;
65     GetContext().allowedExclusiveClauses.IterateOverMembers(
66         [&](llvm::omp::Clause o) {
67           if (FindClause(o)) {
68             others.emplace_back(o);
69           }
70         });
71     for (const auto &e : others) {
72       context_.Say(GetContext().clauseSource,
73           "%s and %s are mutually exclusive and may not appear on the "
74           "same %s directive"_err_en_US,
75           parser::ToUpperCaseLetters(
76               llvm::omp::getOpenMPClauseName(type).str()),
77           parser::ToUpperCaseLetters(llvm::omp::getOpenMPClauseName(e).str()),
78           parser::ToUpperCaseLetters(GetContext().directiveSource.ToString()));
79     }
80     if (!others.empty()) {
81       return;
82     }
83   }
84   SetContextClauseInfo(type);
85 }
86 
CheckRequired(llvm::omp::Clause c)87 void OmpStructureChecker::CheckRequired(llvm::omp::Clause c) {
88   if (!FindClause(c)) {
89     context_.Say(GetContext().directiveSource,
90         "At least one %s clause must appear on the %s directive"_err_en_US,
91         parser::ToUpperCaseLetters(llvm::omp::getOpenMPClauseName(c).str()),
92         ContextDirectiveAsFortran());
93   }
94 }
95 
RequiresConstantPositiveParameter(const llvm::omp::Clause & clause,const parser::ScalarIntConstantExpr & i)96 void OmpStructureChecker::RequiresConstantPositiveParameter(
97     const llvm::omp::Clause &clause, const parser::ScalarIntConstantExpr &i) {
98   if (const auto v{GetIntValue(i)}) {
99     if (*v <= 0) {
100       context_.Say(GetContext().clauseSource,
101           "The parameter of the %s clause must be "
102           "a constant positive integer expression"_err_en_US,
103           parser::ToUpperCaseLetters(
104               llvm::omp::getOpenMPClauseName(clause).str()));
105     }
106   }
107 }
108 
RequiresPositiveParameter(const llvm::omp::Clause & clause,const parser::ScalarIntExpr & i)109 void OmpStructureChecker::RequiresPositiveParameter(
110     const llvm::omp::Clause &clause, const parser::ScalarIntExpr &i) {
111   if (const auto v{GetIntValue(i)}) {
112     if (*v <= 0) {
113       context_.Say(GetContext().clauseSource,
114           "The parameter of the %s clause must be "
115           "a positive integer expression"_err_en_US,
116           parser::ToUpperCaseLetters(
117               llvm::omp::getOpenMPClauseName(clause).str()));
118     }
119   }
120 }
121 
Enter(const parser::OpenMPConstruct &)122 void OmpStructureChecker::Enter(const parser::OpenMPConstruct &) {
123   // 2.8.1 TODO: Simd Construct with Ordered Construct Nesting check
124 }
125 
Enter(const parser::OpenMPLoopConstruct & x)126 void OmpStructureChecker::Enter(const parser::OpenMPLoopConstruct &x) {
127   const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
128   const auto &beginDir{std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
129 
130   // check matching, End directive is optional
131   if (const auto &endLoopDir{
132           std::get<std::optional<parser::OmpEndLoopDirective>>(x.t)}) {
133     CheckMatching<parser::OmpLoopDirective>(beginLoopDir, *endLoopDir);
134   }
135 
136   if (beginDir.v != llvm::omp::Directive::OMPD_do) {
137     PushContextAndClauseSets(beginDir.source, beginDir.v);
138   } else {
139     // 2.7.1 do-clause -> private-clause |
140     //                    firstprivate-clause |
141     //                    lastprivate-clause |
142     //                    linear-clause |
143     //                    reduction-clause |
144     //                    schedule-clause |
145     //                    collapse-clause |
146     //                    ordered-clause
147 
148     // nesting check
149     HasInvalidWorksharingNesting(beginDir.source,
150         {llvm::omp::Directive::OMPD_do, llvm::omp::Directive::OMPD_sections,
151             llvm::omp::Directive::OMPD_single,
152             llvm::omp::Directive::OMPD_workshare,
153             llvm::omp::Directive::OMPD_task,
154             llvm::omp::Directive::OMPD_taskloop,
155             llvm::omp::Directive::OMPD_critical,
156             llvm::omp::Directive::OMPD_ordered,
157             llvm::omp::Directive::OMPD_atomic,
158             llvm::omp::Directive::OMPD_master});
159     PushContextAndClauseSets(beginDir.source, llvm::omp::Directive::OMPD_do);
160   }
161 }
162 
Leave(const parser::OpenMPLoopConstruct &)163 void OmpStructureChecker::Leave(const parser::OpenMPLoopConstruct &) {
164   ompContext_.pop_back();
165 }
166 
Enter(const parser::OmpEndLoopDirective & x)167 void OmpStructureChecker::Enter(const parser::OmpEndLoopDirective &x) {
168   const auto &dir{std::get<parser::OmpLoopDirective>(x.t)};
169   ResetPartialContext(dir.source);
170   switch (dir.v) {
171   // 2.7.1 end-do -> END DO [nowait-clause]
172   // 2.8.3 end-do-simd -> END DO SIMD [nowait-clause]
173   case llvm::omp::Directive::OMPD_do:
174   case llvm::omp::Directive::OMPD_do_simd:
175     SetClauseSets(dir.v);
176     break;
177   default:
178     // no clauses are allowed
179     break;
180   }
181 }
182 
Enter(const parser::OpenMPBlockConstruct & x)183 void OmpStructureChecker::Enter(const parser::OpenMPBlockConstruct &x) {
184   const auto &beginBlockDir{std::get<parser::OmpBeginBlockDirective>(x.t)};
185   const auto &endBlockDir{std::get<parser::OmpEndBlockDirective>(x.t)};
186   const auto &beginDir{
187       CheckMatching<parser::OmpBlockDirective>(beginBlockDir, endBlockDir)};
188 
189   PushContextAndClauseSets(beginDir.source, beginDir.v);
190 }
191 
Leave(const parser::OpenMPBlockConstruct &)192 void OmpStructureChecker::Leave(const parser::OpenMPBlockConstruct &) {
193   ompContext_.pop_back();
194 }
195 
Enter(const parser::OpenMPSectionsConstruct & x)196 void OmpStructureChecker::Enter(const parser::OpenMPSectionsConstruct &x) {
197   const auto &beginSectionsDir{
198       std::get<parser::OmpBeginSectionsDirective>(x.t)};
199   const auto &endSectionsDir{std::get<parser::OmpEndSectionsDirective>(x.t)};
200   const auto &beginDir{CheckMatching<parser::OmpSectionsDirective>(
201       beginSectionsDir, endSectionsDir)};
202 
203   PushContextAndClauseSets(beginDir.source, beginDir.v);
204 }
205 
Leave(const parser::OpenMPSectionsConstruct &)206 void OmpStructureChecker::Leave(const parser::OpenMPSectionsConstruct &) {
207   ompContext_.pop_back();
208 }
209 
Enter(const parser::OmpEndSectionsDirective & x)210 void OmpStructureChecker::Enter(const parser::OmpEndSectionsDirective &x) {
211   const auto &dir{std::get<parser::OmpSectionsDirective>(x.t)};
212   ResetPartialContext(dir.source);
213   switch (dir.v) {
214     // 2.7.2 end-sections -> END SECTIONS [nowait-clause]
215   case llvm::omp::Directive::OMPD_sections:
216     SetContextDirectiveEnum(llvm::omp::Directive::OMPD_end_sections);
217     SetContextAllowed(OmpClauseSet{llvm::omp::Clause::OMPC_nowait});
218     break;
219   default:
220     // no clauses are allowed
221     break;
222   }
223 }
224 
Enter(const parser::OpenMPDeclareSimdConstruct & x)225 void OmpStructureChecker::Enter(const parser::OpenMPDeclareSimdConstruct &x) {
226   const auto &dir{std::get<parser::Verbatim>(x.t)};
227   PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_declare_simd);
228 }
229 
Leave(const parser::OpenMPDeclareSimdConstruct &)230 void OmpStructureChecker::Leave(const parser::OpenMPDeclareSimdConstruct &) {
231   ompContext_.pop_back();
232 }
233 
Enter(const parser::OpenMPDeclareTargetConstruct & x)234 void OmpStructureChecker::Enter(const parser::OpenMPDeclareTargetConstruct &x) {
235   const auto &dir{std::get<parser::Verbatim>(x.t)};
236   PushContext(dir.source, llvm::omp::Directive::OMPD_declare_target);
237   const auto &spec{std::get<parser::OmpDeclareTargetSpecifier>(x.t)};
238   if (std::holds_alternative<parser::OmpDeclareTargetWithClause>(spec.u)) {
239     SetContextAllowed(
240         OmpClauseSet{llvm::omp::Clause::OMPC_to, llvm::omp::Clause::OMPC_link});
241   }
242 }
243 
Leave(const parser::OpenMPDeclareTargetConstruct &)244 void OmpStructureChecker::Leave(const parser::OpenMPDeclareTargetConstruct &) {
245   ompContext_.pop_back();
246 }
247 
Enter(const parser::OpenMPSimpleStandaloneConstruct & x)248 void OmpStructureChecker::Enter(
249     const parser::OpenMPSimpleStandaloneConstruct &x) {
250   const auto &dir{std::get<parser::OmpSimpleStandaloneDirective>(x.t)};
251   PushContextAndClauseSets(dir.source, dir.v);
252 }
253 
Leave(const parser::OpenMPSimpleStandaloneConstruct &)254 void OmpStructureChecker::Leave(
255     const parser::OpenMPSimpleStandaloneConstruct &) {
256   ompContext_.pop_back();
257 }
258 
Enter(const parser::OpenMPFlushConstruct & x)259 void OmpStructureChecker::Enter(const parser::OpenMPFlushConstruct &x) {
260   const auto &dir{std::get<parser::Verbatim>(x.t)};
261   PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_flush);
262 }
263 
Leave(const parser::OpenMPFlushConstruct &)264 void OmpStructureChecker::Leave(const parser::OpenMPFlushConstruct &) {
265   ompContext_.pop_back();
266 }
267 
Enter(const parser::OpenMPCancelConstruct & x)268 void OmpStructureChecker::Enter(const parser::OpenMPCancelConstruct &x) {
269   const auto &dir{std::get<parser::Verbatim>(x.t)};
270   PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_cancel);
271 }
272 
Leave(const parser::OpenMPCancelConstruct &)273 void OmpStructureChecker::Leave(const parser::OpenMPCancelConstruct &) {
274   ompContext_.pop_back();
275 }
276 
Enter(const parser::OpenMPCancellationPointConstruct & x)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 
Leave(const parser::OpenMPCancellationPointConstruct &)284 void OmpStructureChecker::Leave(
285     const parser::OpenMPCancellationPointConstruct &) {
286   ompContext_.pop_back();
287 }
288 
Enter(const parser::OmpEndBlockDirective & x)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     SetContextDirectiveEnum(llvm::omp::Directive::OMPD_end_single);
297     OmpClauseSet allowed{llvm::omp::Clause::OMPC_copyprivate};
298     SetContextAllowed(allowed);
299     OmpClauseSet allowedOnce{llvm::omp::Clause::OMPC_nowait};
300     SetContextAllowedOnce(allowedOnce);
301   } break;
302   // 2.7.4 end-workshare -> END WORKSHARE [nowait-clause]
303   case llvm::omp::Directive::OMPD_workshare:
304     SetContextDirectiveEnum(llvm::omp::Directive::OMPD_end_workshare);
305     SetContextAllowed(OmpClauseSet{llvm::omp::Clause::OMPC_nowait});
306     break;
307   default:
308     // no clauses are allowed
309     break;
310   }
311 }
312 
Leave(const parser::OmpClauseList &)313 void OmpStructureChecker::Leave(const parser::OmpClauseList &) {
314   // 2.7 Loop Construct Restriction
315   if (llvm::omp::doSet.test(GetContext().directive)) {
316     if (auto *clause{FindClause(llvm::omp::Clause::OMPC_schedule)}) {
317       // only one schedule clause is allowed
318       const auto &schedClause{std::get<parser::OmpScheduleClause>(clause->u)};
319       if (ScheduleModifierHasType(schedClause,
320               parser::OmpScheduleModifierType::ModType::Nonmonotonic)) {
321         if (FindClause(llvm::omp::Clause::OMPC_ordered)) {
322           context_.Say(clause->source,
323               "The NONMONOTONIC modifier cannot be specified "
324               "if an ORDERED clause is specified"_err_en_US);
325         }
326         if (ScheduleModifierHasType(schedClause,
327                 parser::OmpScheduleModifierType::ModType::Monotonic)) {
328           context_.Say(clause->source,
329               "The MONOTONIC and NONMONOTONIC modifiers "
330               "cannot be both specified"_err_en_US);
331         }
332       }
333     }
334 
335     if (auto *clause{FindClause(llvm::omp::Clause::OMPC_ordered)}) {
336       // only one ordered clause is allowed
337       const auto &orderedClause{
338           std::get<parser::OmpClause::Ordered>(clause->u)};
339 
340       if (orderedClause.v) {
341         if (FindClause(llvm::omp::Clause::OMPC_linear)) {
342           context_.Say(clause->source,
343               "A loop directive may not have both a LINEAR clause and "
344               "an ORDERED clause with a parameter"_err_en_US);
345         }
346 
347         if (auto *clause2{FindClause(llvm::omp::Clause::OMPC_collapse)}) {
348           const auto &collapseClause{
349               std::get<parser::OmpClause::Collapse>(clause2->u)};
350           // ordered and collapse both have parameters
351           if (const auto orderedValue{GetIntValue(orderedClause.v)}) {
352             if (const auto collapseValue{GetIntValue(collapseClause.v)}) {
353               if (*orderedValue > 0 && *orderedValue < *collapseValue) {
354                 context_.Say(clause->source,
355                     "The parameter of the ORDERED clause must be "
356                     "greater than or equal to "
357                     "the parameter of the COLLAPSE clause"_err_en_US);
358               }
359             }
360           }
361         }
362       }
363 
364       // TODO: ordered region binding check (requires nesting implementation)
365     }
366   } // doSet
367 
368   // 2.8.1 Simd Construct Restriction
369   if (llvm::omp::simdSet.test(GetContext().directive)) {
370     if (auto *clause{FindClause(llvm::omp::Clause::OMPC_simdlen)}) {
371       if (auto *clause2{FindClause(llvm::omp::Clause::OMPC_safelen)}) {
372         const auto &simdlenClause{
373             std::get<parser::OmpClause::Simdlen>(clause->u)};
374         const auto &safelenClause{
375             std::get<parser::OmpClause::Safelen>(clause2->u)};
376         // simdlen and safelen both have parameters
377         if (const auto simdlenValue{GetIntValue(simdlenClause.v)}) {
378           if (const auto safelenValue{GetIntValue(safelenClause.v)}) {
379             if (*safelenValue > 0 && *simdlenValue > *safelenValue) {
380               context_.Say(clause->source,
381                   "The parameter of the SIMDLEN clause must be less than or "
382                   "equal to the parameter of the SAFELEN clause"_err_en_US);
383             }
384           }
385         }
386       }
387     }
388 
389     // TODO: A list-item cannot appear in more than one aligned clause
390   } // SIMD
391 
392   // 2.7.3 Single Construct Restriction
393   if (GetContext().directive == llvm::omp::Directive::OMPD_end_single) {
394     if (auto *clause{FindClause(llvm::omp::Clause::OMPC_copyprivate)}) {
395       if (FindClause(llvm::omp::Clause::OMPC_nowait)) {
396         context_.Say(clause->source,
397             "The COPYPRIVATE clause must not be used with "
398             "the NOWAIT clause"_err_en_US);
399       }
400     }
401   }
402 
403   GetContext().requiredClauses.IterateOverMembers(
404       [this](llvm::omp::Clause c) { CheckRequired(c); });
405 }
406 
Enter(const parser::OmpClause & x)407 void OmpStructureChecker::Enter(const parser::OmpClause &x) {
408   SetContextClause(x);
409 }
410 
Enter(const parser::OmpNowait &)411 void OmpStructureChecker::Enter(const parser::OmpNowait &) {
412   CheckAllowed(llvm::omp::Clause::OMPC_nowait);
413 }
Enter(const parser::OmpClause::Inbranch &)414 void OmpStructureChecker::Enter(const parser::OmpClause::Inbranch &) {
415   CheckAllowed(llvm::omp::Clause::OMPC_inbranch);
416 }
Enter(const parser::OmpClause::Mergeable &)417 void OmpStructureChecker::Enter(const parser::OmpClause::Mergeable &) {
418   CheckAllowed(llvm::omp::Clause::OMPC_mergeable);
419 }
Enter(const parser::OmpClause::Nogroup &)420 void OmpStructureChecker::Enter(const parser::OmpClause::Nogroup &) {
421   CheckAllowed(llvm::omp::Clause::OMPC_nogroup);
422 }
Enter(const parser::OmpClause::Notinbranch &)423 void OmpStructureChecker::Enter(const parser::OmpClause::Notinbranch &) {
424   CheckAllowed(llvm::omp::Clause::OMPC_notinbranch);
425 }
Enter(const parser::OmpClause::Untied &)426 void OmpStructureChecker::Enter(const parser::OmpClause::Untied &) {
427   CheckAllowed(llvm::omp::Clause::OMPC_untied);
428 }
429 
Enter(const parser::OmpClause::Collapse & x)430 void OmpStructureChecker::Enter(const parser::OmpClause::Collapse &x) {
431   CheckAllowed(llvm::omp::Clause::OMPC_collapse);
432   // collapse clause must have a parameter
433   RequiresConstantPositiveParameter(llvm::omp::Clause::OMPC_collapse, x.v);
434 }
435 
Enter(const parser::OmpClause::Copyin &)436 void OmpStructureChecker::Enter(const parser::OmpClause::Copyin &) {
437   CheckAllowed(llvm::omp::Clause::OMPC_copyin);
438 }
Enter(const parser::OmpClause::Copyprivate &)439 void OmpStructureChecker::Enter(const parser::OmpClause::Copyprivate &) {
440   CheckAllowed(llvm::omp::Clause::OMPC_copyprivate);
441 }
Enter(const parser::OmpClause::Device &)442 void OmpStructureChecker::Enter(const parser::OmpClause::Device &) {
443   CheckAllowed(llvm::omp::Clause::OMPC_device);
444 }
Enter(const parser::OmpClause::DistSchedule &)445 void OmpStructureChecker::Enter(const parser::OmpClause::DistSchedule &) {
446   CheckAllowed(llvm::omp::Clause::OMPC_dist_schedule);
447 }
Enter(const parser::OmpClause::Final &)448 void OmpStructureChecker::Enter(const parser::OmpClause::Final &) {
449   CheckAllowed(llvm::omp::Clause::OMPC_final);
450 }
Enter(const parser::OmpClause::Firstprivate &)451 void OmpStructureChecker::Enter(const parser::OmpClause::Firstprivate &) {
452   CheckAllowed(llvm::omp::Clause::OMPC_firstprivate);
453 }
Enter(const parser::OmpClause::From &)454 void OmpStructureChecker::Enter(const parser::OmpClause::From &) {
455   CheckAllowed(llvm::omp::Clause::OMPC_from);
456 }
Enter(const parser::OmpClause::Grainsize & x)457 void OmpStructureChecker::Enter(const parser::OmpClause::Grainsize &x) {
458   CheckAllowed(llvm::omp::Clause::OMPC_grainsize);
459   RequiresPositiveParameter(llvm::omp::Clause::OMPC_grainsize, x.v);
460 }
Enter(const parser::OmpClause::Lastprivate &)461 void OmpStructureChecker::Enter(const parser::OmpClause::Lastprivate &) {
462   CheckAllowed(llvm::omp::Clause::OMPC_lastprivate);
463 }
Enter(const parser::OmpClause::NumTasks & x)464 void OmpStructureChecker::Enter(const parser::OmpClause::NumTasks &x) {
465   CheckAllowed(llvm::omp::Clause::OMPC_num_tasks);
466   RequiresPositiveParameter(llvm::omp::Clause::OMPC_num_tasks, x.v);
467 }
Enter(const parser::OmpClause::NumTeams & x)468 void OmpStructureChecker::Enter(const parser::OmpClause::NumTeams &x) {
469   CheckAllowed(llvm::omp::Clause::OMPC_num_teams);
470   RequiresPositiveParameter(llvm::omp::Clause::OMPC_num_teams, x.v);
471 }
Enter(const parser::OmpClause::NumThreads & x)472 void OmpStructureChecker::Enter(const parser::OmpClause::NumThreads &x) {
473   CheckAllowed(llvm::omp::Clause::OMPC_num_threads);
474   RequiresPositiveParameter(llvm::omp::Clause::OMPC_num_threads, x.v);
475   // if parameter is variable, defer to Expression Analysis
476 }
477 
Enter(const parser::OmpClause::Ordered & x)478 void OmpStructureChecker::Enter(const parser::OmpClause::Ordered &x) {
479   CheckAllowed(llvm::omp::Clause::OMPC_ordered);
480   // the parameter of ordered clause is optional
481   if (const auto &expr{x.v}) {
482     RequiresConstantPositiveParameter(llvm::omp::Clause::OMPC_ordered, *expr);
483 
484     // 2.8.3 Loop SIMD Construct Restriction
485     if (llvm::omp::doSimdSet.test(GetContext().directive)) {
486       context_.Say(GetContext().clauseSource,
487           "No ORDERED clause with a parameter can be specified "
488           "on the %s directive"_err_en_US,
489           ContextDirectiveAsFortran());
490     }
491   }
492 }
Enter(const parser::OmpClause::Priority & x)493 void OmpStructureChecker::Enter(const parser::OmpClause::Priority &x) {
494   CheckAllowed(llvm::omp::Clause::OMPC_priority);
495   RequiresPositiveParameter(llvm::omp::Clause::OMPC_priority, x.v);
496 }
Enter(const parser::OmpClause::Private &)497 void OmpStructureChecker::Enter(const parser::OmpClause::Private &) {
498   CheckAllowed(llvm::omp::Clause::OMPC_private);
499 }
Enter(const parser::OmpClause::Safelen & x)500 void OmpStructureChecker::Enter(const parser::OmpClause::Safelen &x) {
501   CheckAllowed(llvm::omp::Clause::OMPC_safelen);
502   RequiresConstantPositiveParameter(llvm::omp::Clause::OMPC_safelen, x.v);
503 }
Enter(const parser::OmpClause::Shared &)504 void OmpStructureChecker::Enter(const parser::OmpClause::Shared &) {
505   CheckAllowed(llvm::omp::Clause::OMPC_shared);
506 }
Enter(const parser::OmpClause::Simdlen & x)507 void OmpStructureChecker::Enter(const parser::OmpClause::Simdlen &x) {
508   CheckAllowed(llvm::omp::Clause::OMPC_simdlen);
509   RequiresConstantPositiveParameter(llvm::omp::Clause::OMPC_simdlen, x.v);
510 }
Enter(const parser::OmpClause::ThreadLimit & x)511 void OmpStructureChecker::Enter(const parser::OmpClause::ThreadLimit &x) {
512   CheckAllowed(llvm::omp::Clause::OMPC_thread_limit);
513   RequiresPositiveParameter(llvm::omp::Clause::OMPC_thread_limit, x.v);
514 }
Enter(const parser::OmpClause::To &)515 void OmpStructureChecker::Enter(const parser::OmpClause::To &) {
516   CheckAllowed(llvm::omp::Clause::OMPC_to);
517 }
Enter(const parser::OmpClause::Link &)518 void OmpStructureChecker::Enter(const parser::OmpClause::Link &) {
519   CheckAllowed(llvm::omp::Clause::OMPC_link);
520 }
Enter(const parser::OmpClause::Uniform &)521 void OmpStructureChecker::Enter(const parser::OmpClause::Uniform &) {
522   CheckAllowed(llvm::omp::Clause::OMPC_uniform);
523 }
Enter(const parser::OmpClause::UseDevicePtr &)524 void OmpStructureChecker::Enter(const parser::OmpClause::UseDevicePtr &) {
525   CheckAllowed(llvm::omp::Clause::OMPC_use_device_ptr);
526 }
Enter(const parser::OmpClause::IsDevicePtr &)527 void OmpStructureChecker::Enter(const parser::OmpClause::IsDevicePtr &) {
528   CheckAllowed(llvm::omp::Clause::OMPC_is_device_ptr);
529 }
530 
Enter(const parser::OmpAlignedClause & x)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     if (const auto v{GetIntValue(*expr)}) {
537       if (*v <= 0) {
538         context_.Say(GetContext().clauseSource,
539             "The ALIGNMENT parameter of the ALIGNED clause must be "
540             "a constant positive integer expression"_err_en_US);
541       }
542     }
543   }
544   // 2.8.1 TODO: list-item attribute check
545 }
Enter(const parser::OmpDefaultClause &)546 void OmpStructureChecker::Enter(const parser::OmpDefaultClause &) {
547   CheckAllowed(llvm::omp::Clause::OMPC_default);
548 }
Enter(const parser::OmpDefaultmapClause & x)549 void OmpStructureChecker::Enter(const parser::OmpDefaultmapClause &x) {
550   CheckAllowed(llvm::omp::Clause::OMPC_defaultmap);
551   using VariableCategory = parser::OmpDefaultmapClause::VariableCategory;
552   if (!std::get<std::optional<VariableCategory>>(x.t)) {
553     context_.Say(GetContext().clauseSource,
554         "The argument TOFROM:SCALAR must be specified on the DEFAULTMAP "
555         "clause"_err_en_US);
556   }
557 }
Enter(const parser::OmpDependClause &)558 void OmpStructureChecker::Enter(const parser::OmpDependClause &) {
559   CheckAllowed(llvm::omp::Clause::OMPC_depend);
560 }
561 
Enter(const parser::OmpIfClause & x)562 void OmpStructureChecker::Enter(const parser::OmpIfClause &x) {
563   CheckAllowed(llvm::omp::Clause::OMPC_if);
564 
565   using dirNameModifier = parser::OmpIfClause::DirectiveNameModifier;
566   static std::unordered_map<dirNameModifier, OmpDirectiveSet>
567       dirNameModifierMap{{dirNameModifier::Parallel, llvm::omp::parallelSet},
568           {dirNameModifier::Target, llvm::omp::targetSet},
569           {dirNameModifier::TargetEnterData,
570               {llvm::omp::Directive::OMPD_target_enter_data}},
571           {dirNameModifier::TargetExitData,
572               {llvm::omp::Directive::OMPD_target_exit_data}},
573           {dirNameModifier::TargetData,
574               {llvm::omp::Directive::OMPD_target_data}},
575           {dirNameModifier::TargetUpdate,
576               {llvm::omp::Directive::OMPD_target_update}},
577           {dirNameModifier::Task, {llvm::omp::Directive::OMPD_task}},
578           {dirNameModifier::Taskloop, llvm::omp::taskloopSet}};
579   if (const auto &directiveName{
580           std::get<std::optional<dirNameModifier>>(x.t)}) {
581     auto search{dirNameModifierMap.find(*directiveName)};
582     if (search == dirNameModifierMap.end() ||
583         !search->second.test(GetContext().directive)) {
584       context_
585           .Say(GetContext().clauseSource,
586               "Unmatched directive name modifier %s on the IF clause"_err_en_US,
587               parser::ToUpperCaseLetters(
588                   parser::OmpIfClause::EnumToString(*directiveName)))
589           .Attach(
590               GetContext().directiveSource, "Cannot apply to directive"_en_US);
591     }
592   }
593 }
594 
Enter(const parser::OmpLinearClause & x)595 void OmpStructureChecker::Enter(const parser::OmpLinearClause &x) {
596   CheckAllowed(llvm::omp::Clause::OMPC_linear);
597 
598   // 2.7 Loop Construct Restriction
599   if ((llvm::omp::doSet | llvm::omp::simdSet).test(GetContext().directive)) {
600     if (std::holds_alternative<parser::OmpLinearClause::WithModifier>(x.u)) {
601       context_.Say(GetContext().clauseSource,
602           "A modifier may not be specified in a LINEAR clause "
603           "on the %s directive"_err_en_US,
604           ContextDirectiveAsFortran());
605     }
606   }
607 }
Enter(const parser::OmpMapClause & x)608 void OmpStructureChecker::Enter(const parser::OmpMapClause &x) {
609   CheckAllowed(llvm::omp::Clause::OMPC_map);
610   if (const auto &maptype{std::get<std::optional<parser::OmpMapType>>(x.t)}) {
611     using Type = parser::OmpMapType::Type;
612     const Type &type{std::get<Type>(maptype->t)};
613     switch (GetContext().directive) {
614     case llvm::omp::Directive::OMPD_target:
615     case llvm::omp::Directive::OMPD_target_teams:
616     case llvm::omp::Directive::OMPD_target_teams_distribute:
617     case llvm::omp::Directive::OMPD_target_teams_distribute_simd:
618     case llvm::omp::Directive::OMPD_target_teams_distribute_parallel_do:
619     case llvm::omp::Directive::OMPD_target_teams_distribute_parallel_do_simd:
620     case llvm::omp::Directive::OMPD_target_data: {
621       if (type != Type::To && type != Type::From && type != Type::Tofrom &&
622           type != Type::Alloc) {
623         context_.Say(GetContext().clauseSource,
624             "Only the TO, FROM, TOFROM, or ALLOC map types are permitted "
625             "for MAP clauses on the %s directive"_err_en_US,
626             ContextDirectiveAsFortran());
627       }
628     } break;
629     case llvm::omp::Directive::OMPD_target_enter_data: {
630       if (type != Type::To && type != Type::Alloc) {
631         context_.Say(GetContext().clauseSource,
632             "Only the TO or ALLOC map types are permitted "
633             "for MAP clauses on the %s directive"_err_en_US,
634             ContextDirectiveAsFortran());
635       }
636     } break;
637     case llvm::omp::Directive::OMPD_target_exit_data: {
638       if (type != Type::Delete && type != Type::Release && type != Type::From) {
639         context_.Say(GetContext().clauseSource,
640             "Only the FROM, RELEASE, or DELETE map types are permitted "
641             "for MAP clauses on the %s directive"_err_en_US,
642             ContextDirectiveAsFortran());
643       }
644     } break;
645     default:
646       break;
647     }
648   }
649 }
Enter(const parser::OmpProcBindClause &)650 void OmpStructureChecker::Enter(const parser::OmpProcBindClause &) {
651   CheckAllowed(llvm::omp::Clause::OMPC_proc_bind);
652 }
Enter(const parser::OmpReductionClause &)653 void OmpStructureChecker::Enter(const parser::OmpReductionClause &) {
654   CheckAllowed(llvm::omp::Clause::OMPC_reduction);
655 }
656 
ScheduleModifierHasType(const parser::OmpScheduleClause & x,const parser::OmpScheduleModifierType::ModType & type)657 bool OmpStructureChecker::ScheduleModifierHasType(
658     const parser::OmpScheduleClause &x,
659     const parser::OmpScheduleModifierType::ModType &type) {
660   const auto &modifier{
661       std::get<std::optional<parser::OmpScheduleModifier>>(x.t)};
662   if (modifier) {
663     const auto &modType1{
664         std::get<parser::OmpScheduleModifier::Modifier1>(modifier->t)};
665     const auto &modType2{
666         std::get<std::optional<parser::OmpScheduleModifier::Modifier2>>(
667             modifier->t)};
668     if (modType1.v.v == type || (modType2 && modType2->v.v == type)) {
669       return true;
670     }
671   }
672   return false;
673 }
Enter(const parser::OmpScheduleClause & x)674 void OmpStructureChecker::Enter(const parser::OmpScheduleClause &x) {
675   CheckAllowed(llvm::omp::Clause::OMPC_schedule);
676 
677   // 2.7 Loop Construct Restriction
678   if (llvm::omp::doSet.test(GetContext().directive)) {
679     const auto &kind{std::get<1>(x.t)};
680     const auto &chunk{std::get<2>(x.t)};
681     if (chunk) {
682       if (kind == parser::OmpScheduleClause::ScheduleType::Runtime ||
683           kind == parser::OmpScheduleClause::ScheduleType::Auto) {
684         context_.Say(GetContext().clauseSource,
685             "When SCHEDULE clause has %s specified, "
686             "it must not have chunk size specified"_err_en_US,
687             parser::ToUpperCaseLetters(
688                 parser::OmpScheduleClause::EnumToString(kind)));
689       }
690     }
691 
692     if (ScheduleModifierHasType(
693             x, parser::OmpScheduleModifierType::ModType::Nonmonotonic)) {
694       if (kind != parser::OmpScheduleClause::ScheduleType::Dynamic &&
695           kind != parser::OmpScheduleClause::ScheduleType::Guided) {
696         context_.Say(GetContext().clauseSource,
697             "The NONMONOTONIC modifier can only be specified with "
698             "SCHEDULE(DYNAMIC) or SCHEDULE(GUIDED)"_err_en_US);
699       }
700     }
701   }
702 }
703 } // namespace Fortran::semantics
704