1//===-- lib/Semantics/check-directive-structure.h ---------------*- C++ -*-===//
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// Directive structure validity checks common to OpenMP, OpenACC and other
10// directive language.
11
12#ifndef FORTRAN_SEMANTICS_CHECK_DIRECTIVE_STRUCTURE_H_
13#define FORTRAN_SEMANTICS_CHECK_DIRECTIVE_STRUCTURE_H_
14
15#include "flang/Common/enum-set.h"
16#include "flang/Semantics/semantics.h"
17#include "flang/Semantics/tools.h"
18#include <unordered_map>
19
20namespace Fortran::semantics {
21
22template <typename C, std::size_t ClauseEnumSize> struct DirectiveClauses {
23 const common::EnumSet<C, ClauseEnumSize> allowed;
24 const common::EnumSet<C, ClauseEnumSize> allowedOnce;
25 const common::EnumSet<C, ClauseEnumSize> allowedExclusive;
26 const common::EnumSet<C, ClauseEnumSize> requiredOneOf;
27};
28
29// Generic branching checker for invalid branching out of OpenMP/OpenACC
30// directive.
31// typename D is the directive enumeration.
32template <typename D> class NoBranchingEnforce {
33public:
34 NoBranchingEnforce(SemanticsContext &context,
35 parser::CharBlock sourcePosition, D directive,
36 std::string &&upperCaseDirName)
37 : context_{context}, sourcePosition_{sourcePosition},
38 upperCaseDirName_{std::move(upperCaseDirName)},
39 currentDirective_{directive}, numDoConstruct_{0} {}
40 template <typename T> bool Pre(const T &) { return true; }
41 template <typename T> void Post(const T &) {}
42
43 template <typename T> bool Pre(const parser::Statement<T> &statement) {
44 currentStatementSourcePosition_ = statement.source;
45 return true;
46 }
47
48 bool Pre(const parser::DoConstruct &) {
49 numDoConstruct_++;
50 return true;
51 }
52 void Post(const parser::DoConstruct &) { numDoConstruct_--; }
53 void Post(const parser::ReturnStmt &) { EmitBranchOutError(stmt: "RETURN"); }
54 void Post(const parser::ExitStmt &exitStmt) {
55 if (const auto &exitName{exitStmt.v}) {
56 CheckConstructNameBranching(stmt: "EXIT", exitName.value());
57 } else {
58 CheckConstructNameBranching(stmt: "EXIT");
59 }
60 }
61 void Post(const parser::CycleStmt &cycleStmt) {
62 if (const auto &cycleName{cycleStmt.v}) {
63 CheckConstructNameBranching(stmt: "CYCLE", cycleName.value());
64 } else {
65 if constexpr (std::is_same_v<D, llvm::omp::Directive>) {
66 switch ((llvm::omp::Directive)currentDirective_) {
67 // exclude directives which do not need a check for unlabelled CYCLES
68 case llvm::omp::Directive::OMPD_do:
69 case llvm::omp::Directive::OMPD_simd:
70 case llvm::omp::Directive::OMPD_parallel_do:
71 case llvm::omp::Directive::OMPD_parallel_do_simd:
72 case llvm::omp::Directive::OMPD_distribute_parallel_do:
73 case llvm::omp::Directive::OMPD_distribute_parallel_do_simd:
74 case llvm::omp::Directive::OMPD_distribute_parallel_for:
75 case llvm::omp::Directive::OMPD_distribute_simd:
76 case llvm::omp::Directive::OMPD_distribute_parallel_for_simd:
77 return;
78 default:
79 break;
80 }
81 } else if constexpr (std::is_same_v<D, llvm::acc::Directive>) {
82 switch ((llvm::acc::Directive)currentDirective_) {
83 // exclude loop directives which do not need a check for unlabelled
84 // CYCLES
85 case llvm::acc::Directive::ACCD_loop:
86 case llvm::acc::Directive::ACCD_kernels_loop:
87 case llvm::acc::Directive::ACCD_parallel_loop:
88 case llvm::acc::Directive::ACCD_serial_loop:
89 return;
90 default:
91 break;
92 }
93 }
94 CheckConstructNameBranching(stmt: "CYCLE");
95 }
96 }
97
98private:
99 parser::MessageFormattedText GetEnclosingMsg() const {
100 return {"Enclosing %s construct"_en_US, upperCaseDirName_};
101 }
102
103 void EmitBranchOutError(const char *stmt) const {
104 context_
105 .Say(currentStatementSourcePosition_,
106 "%s statement is not allowed in a %s construct"_err_en_US, stmt,
107 upperCaseDirName_)
108 .Attach(sourcePosition_, GetEnclosingMsg());
109 }
110
111 inline void EmitUnlabelledBranchOutError(const char *stmt) {
112 context_
113 .Say(currentStatementSourcePosition_,
114 "%s to construct outside of %s construct is not allowed"_err_en_US,
115 stmt, upperCaseDirName_)
116 .Attach(sourcePosition_, GetEnclosingMsg());
117 }
118
119 void EmitBranchOutErrorWithName(
120 const char *stmt, const parser::Name &toName) const {
121 const std::string branchingToName{toName.ToString()};
122 context_
123 .Say(currentStatementSourcePosition_,
124 "%s to construct '%s' outside of %s construct is not allowed"_err_en_US,
125 stmt, branchingToName, upperCaseDirName_)
126 .Attach(sourcePosition_, GetEnclosingMsg());
127 }
128
129 // Current semantic checker is not following OpenACC/OpenMP constructs as they
130 // are not Fortran constructs. Hence the ConstructStack doesn't capture
131 // OpenACC/OpenMP constructs. Apply an inverse way to figure out if a
132 // construct-name is branching out of an OpenACC/OpenMP construct. The control
133 // flow goes out of an OpenACC/OpenMP construct, if a construct-name from
134 // statement is found in ConstructStack.
135 void CheckConstructNameBranching(
136 const char *stmt, const parser::Name &stmtName) {
137 const ConstructStack &stack{context_.constructStack()};
138 for (auto iter{stack.cend()}; iter-- != stack.cbegin();) {
139 const ConstructNode &construct{*iter};
140 const auto &constructName{MaybeGetNodeName(construct)};
141 if (constructName) {
142 if (stmtName.source == constructName->source) {
143 EmitBranchOutErrorWithName(stmt, stmtName);
144 return;
145 }
146 }
147 }
148 }
149
150 // Check branching for unlabelled CYCLES and EXITs
151 void CheckConstructNameBranching(const char *stmt) {
152 // found an enclosing looping construct for the unlabelled EXIT/CYCLE
153 if (numDoConstruct_ > 0) {
154 return;
155 }
156 // did not found an enclosing looping construct within the OpenMP/OpenACC
157 // directive
158 EmitUnlabelledBranchOutError(stmt);
159 }
160
161 SemanticsContext &context_;
162 parser::CharBlock currentStatementSourcePosition_;
163 parser::CharBlock sourcePosition_;
164 std::string upperCaseDirName_;
165 D currentDirective_;
166 int numDoConstruct_; // tracks number of DoConstruct found AFTER encountering
167 // an OpenMP/OpenACC directive
168};
169
170// Generic structure checker for directives/clauses language such as OpenMP
171// and OpenACC.
172// typename D is the directive enumeration.
173// typename C is the clause enumeration.
174// typename PC is the parser class defined in parse-tree.h for the clauses.
175template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
176class DirectiveStructureChecker : public virtual BaseChecker {
177protected:
178 DirectiveStructureChecker(SemanticsContext &context,
179 const std::unordered_map<D, DirectiveClauses<C, ClauseEnumSize>>
180 &directiveClausesMap)
181 : context_{context}, directiveClausesMap_(directiveClausesMap) {}
182 virtual ~DirectiveStructureChecker() {}
183
184 using ClauseMapTy = std::multimap<C, const PC *>;
185 struct DirectiveContext {
186 DirectiveContext(parser::CharBlock source, D d)
187 : directiveSource{source}, directive{d} {}
188
189 parser::CharBlock directiveSource{nullptr};
190 parser::CharBlock clauseSource{nullptr};
191 D directive;
192 common::EnumSet<C, ClauseEnumSize> allowedClauses{};
193 common::EnumSet<C, ClauseEnumSize> allowedOnceClauses{};
194 common::EnumSet<C, ClauseEnumSize> allowedExclusiveClauses{};
195 common::EnumSet<C, ClauseEnumSize> requiredClauses{};
196
197 const PC *clause{nullptr};
198 ClauseMapTy clauseInfo;
199 std::list<C> actualClauses;
200 std::list<C> crtGroup;
201 Symbol *loopIV{nullptr};
202 };
203
204 void SetLoopIv(Symbol *symbol) { GetContext().loopIV = symbol; }
205
206 // back() is the top of the stack
207 DirectiveContext &GetContext() {
208 CHECK(!dirContext_.empty());
209 return dirContext_.back();
210 }
211
212 DirectiveContext &GetContextParent() {
213 CHECK(dirContext_.size() >= 2);
214 return dirContext_[dirContext_.size() - 2];
215 }
216
217 void SetContextClause(const PC &clause) {
218 GetContext().clauseSource = clause.source;
219 GetContext().clause = &clause;
220 }
221
222 void ResetPartialContext(const parser::CharBlock &source) {
223 CHECK(!dirContext_.empty());
224 SetContextDirectiveSource(source);
225 GetContext().allowedClauses = {};
226 GetContext().allowedOnceClauses = {};
227 GetContext().allowedExclusiveClauses = {};
228 GetContext().requiredClauses = {};
229 GetContext().clauseInfo = {};
230 GetContext().loopIV = {nullptr};
231 }
232
233 void SetContextDirectiveSource(const parser::CharBlock &directive) {
234 GetContext().directiveSource = directive;
235 }
236
237 void SetContextDirectiveEnum(D dir) { GetContext().directive = dir; }
238
239 void SetContextAllowed(const common::EnumSet<C, ClauseEnumSize> &allowed) {
240 GetContext().allowedClauses = allowed;
241 }
242
243 void SetContextAllowedOnce(
244 const common::EnumSet<C, ClauseEnumSize> &allowedOnce) {
245 GetContext().allowedOnceClauses = allowedOnce;
246 }
247
248 void SetContextAllowedExclusive(
249 const common::EnumSet<C, ClauseEnumSize> &allowedExclusive) {
250 GetContext().allowedExclusiveClauses = allowedExclusive;
251 }
252
253 void SetContextRequired(const common::EnumSet<C, ClauseEnumSize> &required) {
254 GetContext().requiredClauses = required;
255 }
256
257 void SetContextClauseInfo(C type) {
258 GetContext().clauseInfo.emplace(type, GetContext().clause);
259 }
260
261 void AddClauseToCrtContext(C type) {
262 GetContext().actualClauses.push_back(type);
263 }
264
265 void AddClauseToCrtGroupInContext(C type) {
266 GetContext().crtGroup.push_back(type);
267 }
268
269 void ResetCrtGroup() { GetContext().crtGroup.clear(); }
270
271 // Check if the given clause is present in the current context
272 const PC *FindClause(C type) { return FindClause(GetContext(), type); }
273
274 // Check if the given clause is present in the given context
275 const PC *FindClause(DirectiveContext &context, C type) {
276 auto it{context.clauseInfo.find(type)};
277 if (it != context.clauseInfo.end()) {
278 return it->second;
279 }
280 return nullptr;
281 }
282
283 // Check if the given clause is present in the parent context
284 const PC *FindClauseParent(C type) {
285 auto it{GetContextParent().clauseInfo.find(type)};
286 if (it != GetContextParent().clauseInfo.end()) {
287 return it->second;
288 }
289 return nullptr;
290 }
291
292 std::pair<typename ClauseMapTy::iterator, typename ClauseMapTy::iterator>
293 FindClauses(C type) {
294 auto it{GetContext().clauseInfo.equal_range(type)};
295 return it;
296 }
297
298 DirectiveContext *GetEnclosingDirContext() {
299 CHECK(!dirContext_.empty());
300 auto it{dirContext_.rbegin()};
301 if (++it != dirContext_.rend()) {
302 return &(*it);
303 }
304 return nullptr;
305 }
306
307 void PushContext(const parser::CharBlock &source, D dir) {
308 dirContext_.emplace_back(source, dir);
309 }
310
311 DirectiveContext *GetEnclosingContextWithDir(D dir) {
312 CHECK(!dirContext_.empty());
313 auto it{dirContext_.rbegin()};
314 while (++it != dirContext_.rend()) {
315 if (it->directive == dir) {
316 return &(*it);
317 }
318 }
319 return nullptr;
320 }
321
322 bool CurrentDirectiveIsNested() { return dirContext_.size() > 1; };
323
324 void SetClauseSets(D dir) {
325 dirContext_.back().allowedClauses = directiveClausesMap_[dir].allowed;
326 dirContext_.back().allowedOnceClauses =
327 directiveClausesMap_[dir].allowedOnce;
328 dirContext_.back().allowedExclusiveClauses =
329 directiveClausesMap_[dir].allowedExclusive;
330 dirContext_.back().requiredClauses =
331 directiveClausesMap_[dir].requiredOneOf;
332 }
333 void PushContextAndClauseSets(const parser::CharBlock &source, D dir) {
334 PushContext(source, dir);
335 SetClauseSets(dir);
336 }
337
338 void SayNotMatching(const parser::CharBlock &, const parser::CharBlock &);
339
340 template <typename B> void CheckMatching(const B &beginDir, const B &endDir) {
341 const auto &begin{beginDir.v};
342 const auto &end{endDir.v};
343 if (begin != end) {
344 SayNotMatching(beginDir.source, endDir.source);
345 }
346 }
347 // Check illegal branching out of `Parser::Block` for `Parser::Name` based
348 // nodes (example `Parser::ExitStmt`)
349 void CheckNoBranching(const parser::Block &block, D directive,
350 const parser::CharBlock &directiveSource);
351
352 // Check that only clauses in set are after the specific clauses.
353 void CheckOnlyAllowedAfter(C clause, common::EnumSet<C, ClauseEnumSize> set);
354
355 void CheckRequireAtLeastOneOf(bool warnInsteadOfError = false);
356
357 void CheckAllowed(C clause, bool warnInsteadOfError = false);
358
359 // Check that the clause appears only once. The counter is reset when the
360 // separator clause appears.
361 void CheckAllowedOncePerGroup(C clause, C separator);
362
363 void CheckMutuallyExclusivePerGroup(
364 C clause, C separator, common::EnumSet<C, ClauseEnumSize> set);
365
366 void CheckAtLeastOneClause();
367
368 void CheckNotAllowedIfClause(
369 C clause, common::EnumSet<C, ClauseEnumSize> set);
370
371 std::string ContextDirectiveAsFortran();
372
373 void RequiresConstantPositiveParameter(
374 const C &clause, const parser::ScalarIntConstantExpr &i);
375
376 void RequiresPositiveParameter(const C &clause,
377 const parser::ScalarIntExpr &i, llvm::StringRef paramName = "parameter");
378
379 void OptionalConstantPositiveParameter(
380 const C &clause, const std::optional<parser::ScalarIntConstantExpr> &o);
381
382 virtual llvm::StringRef getClauseName(C clause) { return ""; };
383
384 virtual llvm::StringRef getDirectiveName(D directive) { return ""; };
385
386 SemanticsContext &context_;
387 std::vector<DirectiveContext> dirContext_; // used as a stack
388 std::unordered_map<D, DirectiveClauses<C, ClauseEnumSize>>
389 directiveClausesMap_;
390
391 std::string ClauseSetToString(const common::EnumSet<C, ClauseEnumSize> set);
392};
393
394template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
395void DirectiveStructureChecker<D, C, PC, ClauseEnumSize>::CheckNoBranching(
396 const parser::Block &block, D directive,
397 const parser::CharBlock &directiveSource) {
398 NoBranchingEnforce<D> noBranchingEnforce{
399 context_, directiveSource, directive, ContextDirectiveAsFortran()};
400 parser::Walk(block, noBranchingEnforce);
401}
402
403// Check that only clauses included in the given set are present after the given
404// clause.
405template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
406void DirectiveStructureChecker<D, C, PC, ClauseEnumSize>::CheckOnlyAllowedAfter(
407 C clause, common::EnumSet<C, ClauseEnumSize> set) {
408 bool enforceCheck = false;
409 for (auto cl : GetContext().actualClauses) {
410 if (cl == clause) {
411 enforceCheck = true;
412 continue;
413 } else if (enforceCheck && !set.test(cl)) {
414 auto parserClause = GetContext().clauseInfo.find(cl);
415 context_.Say(parserClause->second->source,
416 "Clause %s is not allowed after clause %s on the %s "
417 "directive"_err_en_US,
418 parser::ToUpperCaseLetters(getClauseName(cl).str()),
419 parser::ToUpperCaseLetters(getClauseName(clause).str()),
420 ContextDirectiveAsFortran());
421 }
422 }
423}
424
425// Check that at least one clause is attached to the directive.
426template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
427void DirectiveStructureChecker<D, C, PC,
428 ClauseEnumSize>::CheckAtLeastOneClause() {
429 if (GetContext().actualClauses.empty()) {
430 context_.Say(GetContext().directiveSource,
431 "At least one clause is required on the %s directive"_err_en_US,
432 ContextDirectiveAsFortran());
433 }
434}
435
436template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
437std::string
438DirectiveStructureChecker<D, C, PC, ClauseEnumSize>::ClauseSetToString(
439 const common::EnumSet<C, ClauseEnumSize> set) {
440 std::string list;
441 set.IterateOverMembers([&](C o) {
442 if (!list.empty())
443 list.append(", ");
444 list.append(parser::ToUpperCaseLetters(getClauseName(o).str()));
445 });
446 return list;
447}
448
449// Check that at least one clause in the required set is present on the
450// directive.
451template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
452void DirectiveStructureChecker<D, C, PC,
453 ClauseEnumSize>::CheckRequireAtLeastOneOf(bool warnInsteadOfError) {
454 if (GetContext().requiredClauses.empty()) {
455 return;
456 }
457 for (auto cl : GetContext().actualClauses) {
458 if (GetContext().requiredClauses.test(cl)) {
459 return;
460 }
461 }
462 // No clause matched in the actual clauses list
463 if (warnInsteadOfError) {
464 if (context_.ShouldWarn(common::UsageWarning::Portability)) {
465 context_.Say(GetContext().directiveSource,
466 "At least one of %s clause should appear on the %s directive"_port_en_US,
467 ClauseSetToString(GetContext().requiredClauses),
468 ContextDirectiveAsFortran());
469 }
470 } else {
471 context_.Say(GetContext().directiveSource,
472 "At least one of %s clause must appear on the %s directive"_err_en_US,
473 ClauseSetToString(GetContext().requiredClauses),
474 ContextDirectiveAsFortran());
475 }
476}
477
478template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
479std::string DirectiveStructureChecker<D, C, PC,
480 ClauseEnumSize>::ContextDirectiveAsFortran() {
481 return parser::ToUpperCaseLetters(
482 getDirectiveName(GetContext().directive).str());
483}
484
485// Check that clauses present on the directive are allowed clauses.
486template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
487void DirectiveStructureChecker<D, C, PC, ClauseEnumSize>::CheckAllowed(
488 C clause, bool warnInsteadOfError) {
489 if (!GetContext().allowedClauses.test(clause) &&
490 !GetContext().allowedOnceClauses.test(clause) &&
491 !GetContext().allowedExclusiveClauses.test(clause) &&
492 !GetContext().requiredClauses.test(clause)) {
493 if (warnInsteadOfError) {
494 if (context_.ShouldWarn(common::UsageWarning::Portability)) {
495 context_.Say(GetContext().clauseSource,
496 "%s clause is not allowed on the %s directive and will be ignored"_port_en_US,
497 parser::ToUpperCaseLetters(getClauseName(clause).str()),
498 parser::ToUpperCaseLetters(
499 GetContext().directiveSource.ToString()));
500 }
501 } else {
502 context_.Say(GetContext().clauseSource,
503 "%s clause is not allowed on the %s directive"_err_en_US,
504 parser::ToUpperCaseLetters(getClauseName(clause).str()),
505 parser::ToUpperCaseLetters(GetContext().directiveSource.ToString()));
506 }
507 return;
508 }
509 if ((GetContext().allowedOnceClauses.test(clause) ||
510 GetContext().allowedExclusiveClauses.test(clause)) &&
511 FindClause(clause)) {
512 context_.Say(GetContext().clauseSource,
513 "At most one %s clause can appear on the %s directive"_err_en_US,
514 parser::ToUpperCaseLetters(getClauseName(clause).str()),
515 parser::ToUpperCaseLetters(GetContext().directiveSource.ToString()));
516 return;
517 }
518 if (GetContext().allowedExclusiveClauses.test(clause)) {
519 std::vector<C> others;
520 GetContext().allowedExclusiveClauses.IterateOverMembers([&](C o) {
521 if (FindClause(o)) {
522 others.emplace_back(o);
523 }
524 });
525 for (const auto &e : others) {
526 context_.Say(GetContext().clauseSource,
527 "%s and %s clauses are mutually exclusive and may not appear on the "
528 "same %s directive"_err_en_US,
529 parser::ToUpperCaseLetters(getClauseName(clause).str()),
530 parser::ToUpperCaseLetters(getClauseName(e).str()),
531 parser::ToUpperCaseLetters(GetContext().directiveSource.ToString()));
532 }
533 if (!others.empty()) {
534 return;
535 }
536 }
537 SetContextClauseInfo(clause);
538 AddClauseToCrtContext(type: clause);
539 AddClauseToCrtGroupInContext(type: clause);
540}
541
542// Enforce restriction where clauses in the given set are not allowed if the
543// given clause appears.
544template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
545void DirectiveStructureChecker<D, C, PC,
546 ClauseEnumSize>::CheckNotAllowedIfClause(C clause,
547 common::EnumSet<C, ClauseEnumSize> set) {
548 if (!llvm::is_contained(GetContext().actualClauses, clause)) {
549 return; // Clause is not present
550 }
551
552 for (auto cl : GetContext().actualClauses) {
553 if (set.test(cl)) {
554 context_.Say(GetContext().directiveSource,
555 "Clause %s is not allowed if clause %s appears on the %s directive"_err_en_US,
556 parser::ToUpperCaseLetters(getClauseName(cl).str()),
557 parser::ToUpperCaseLetters(getClauseName(clause).str()),
558 ContextDirectiveAsFortran());
559 }
560 }
561}
562
563template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
564void DirectiveStructureChecker<D, C, PC,
565 ClauseEnumSize>::CheckAllowedOncePerGroup(C clause, C separator) {
566 bool clauseIsPresent = false;
567 for (auto cl : GetContext().actualClauses) {
568 if (cl == clause) {
569 if (clauseIsPresent) {
570 context_.Say(GetContext().clauseSource,
571 "At most one %s clause can appear on the %s directive or in group separated by the %s clause"_err_en_US,
572 parser::ToUpperCaseLetters(getClauseName(clause).str()),
573 parser::ToUpperCaseLetters(GetContext().directiveSource.ToString()),
574 parser::ToUpperCaseLetters(getClauseName(separator).str()));
575 } else {
576 clauseIsPresent = true;
577 }
578 }
579 if (cl == separator)
580 clauseIsPresent = false;
581 }
582}
583
584template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
585void DirectiveStructureChecker<D, C, PC,
586 ClauseEnumSize>::CheckMutuallyExclusivePerGroup(C clause, C separator,
587 common::EnumSet<C, ClauseEnumSize> set) {
588
589 // Checking of there is any offending clauses before the first separator.
590 for (auto cl : GetContext().actualClauses) {
591 if (cl == separator) {
592 break;
593 }
594 if (set.test(cl)) {
595 context_.Say(GetContext().directiveSource,
596 "Clause %s is not allowed if clause %s appears on the %s directive"_err_en_US,
597 parser::ToUpperCaseLetters(getClauseName(clause).str()),
598 parser::ToUpperCaseLetters(getClauseName(cl).str()),
599 ContextDirectiveAsFortran());
600 }
601 }
602
603 // Checking for mutually exclusive clauses in the current group.
604 for (auto cl : GetContext().crtGroup) {
605 if (set.test(cl)) {
606 context_.Say(GetContext().directiveSource,
607 "Clause %s is not allowed if clause %s appears on the %s directive"_err_en_US,
608 parser::ToUpperCaseLetters(getClauseName(clause).str()),
609 parser::ToUpperCaseLetters(getClauseName(cl).str()),
610 ContextDirectiveAsFortran());
611 }
612 }
613}
614
615// Check the value of the clause is a constant positive integer.
616template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
617void DirectiveStructureChecker<D, C, PC,
618 ClauseEnumSize>::RequiresConstantPositiveParameter(const C &clause,
619 const parser::ScalarIntConstantExpr &i) {
620 if (const auto v{GetIntValue(i)}) {
621 if (*v <= 0) {
622 context_.Say(GetContext().clauseSource,
623 "The parameter of the %s clause must be "
624 "a constant positive integer expression"_err_en_US,
625 parser::ToUpperCaseLetters(getClauseName(clause).str()));
626 }
627 }
628}
629
630// Check the value of the clause is a constant positive parameter.
631template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
632void DirectiveStructureChecker<D, C, PC,
633 ClauseEnumSize>::OptionalConstantPositiveParameter(const C &clause,
634 const std::optional<parser::ScalarIntConstantExpr> &o) {
635 if (o != std::nullopt) {
636 RequiresConstantPositiveParameter(clause, o.value());
637 }
638}
639
640template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
641void DirectiveStructureChecker<D, C, PC, ClauseEnumSize>::SayNotMatching(
642 const parser::CharBlock &beginSource, const parser::CharBlock &endSource) {
643 context_
644 .Say(endSource, "Unmatched %s directive"_err_en_US,
645 parser::ToUpperCaseLetters(endSource.ToString()))
646 .Attach(beginSource, "Does not match directive"_en_US);
647}
648
649// Check the value of the clause is a positive parameter.
650template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
651void DirectiveStructureChecker<D, C, PC,
652 ClauseEnumSize>::RequiresPositiveParameter(const C &clause,
653 const parser::ScalarIntExpr &i, llvm::StringRef paramName) {
654 if (const auto v{GetIntValue(i)}) {
655 if (*v < 0) {
656 context_.Say(GetContext().clauseSource,
657 "The %s of the %s clause must be "
658 "a positive integer expression"_err_en_US,
659 paramName.str(),
660 parser::ToUpperCaseLetters(getClauseName(clause).str()));
661 }
662 }
663}
664
665} // namespace Fortran::semantics
666
667#endif // FORTRAN_SEMANTICS_CHECK_DIRECTIVE_STRUCTURE_H_
668

source code of flang/lib/Semantics/check-directive-structure.h