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

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