FLANG
check-directive-structure.h
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 {
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:
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("RETURN"); }
56 void Post(const parser::ExitStmt &exitStmt) {
57 if (const auto &exitName{exitStmt.v}) {
58 CheckConstructNameBranching("EXIT", exitName.value());
59 } else {
60 CheckConstructNameBranching("EXIT");
61 }
62 }
63 void Post(const parser::CycleStmt &cycleStmt) {
64 if (const auto &cycleName{cycleStmt.v}) {
65 CheckConstructNameBranching("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("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>
182protected:
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 *>;
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> crtGroup;
206 Symbol *loopIV{nullptr};
207 };
208
209 void SetLoopIv(Symbol *symbol) { GetContext().loopIV = symbol; }
210
211 // back() is the top of the stack
212 DirectiveContext &GetContext() {
213 CHECK(!dirContext_.empty());
214 return dirContext_.back();
215 }
216
217 DirectiveContext &GetContextParent() {
218 CHECK(dirContext_.size() >= 2);
219 return dirContext_[dirContext_.size() - 2];
220 }
221
222 void SetContextClause(const PC &clause) {
223 GetContext().clauseSource = clause.source;
224 GetContext().clause = &clause;
225 }
226
227 void ResetPartialContext(const parser::CharBlock &source) {
228 CHECK(!dirContext_.empty());
229 SetContextDirectiveSource(source);
230 GetContext().allowedClauses = {};
231 GetContext().allowedOnceClauses = {};
232 GetContext().allowedExclusiveClauses = {};
233 GetContext().requiredClauses = {};
234 GetContext().clauseInfo = {};
235 GetContext().loopIV = {nullptr};
236 }
237
238 void SetContextDirectiveSource(const parser::CharBlock &directive) {
239 GetContext().directiveSource = directive;
240 }
241
242 void SetContextDirectiveEnum(D dir) { GetContext().directive = dir; }
243
244 void SetContextAllowed(const common::EnumSet<C, ClauseEnumSize> &allowed) {
245 GetContext().allowedClauses = allowed;
246 }
247
248 void SetContextAllowedOnce(
249 const common::EnumSet<C, ClauseEnumSize> &allowedOnce) {
250 GetContext().allowedOnceClauses = allowedOnce;
251 }
252
253 void SetContextAllowedExclusive(
254 const common::EnumSet<C, ClauseEnumSize> &allowedExclusive) {
255 GetContext().allowedExclusiveClauses = allowedExclusive;
256 }
257
258 void SetContextRequired(const common::EnumSet<C, ClauseEnumSize> &required) {
259 GetContext().requiredClauses = required;
260 }
261
262 void SetContextClauseInfo(C type) {
263 GetContext().clauseInfo.emplace(type, GetContext().clause);
264 }
265
266 void AddClauseToCrtContext(C type) {
267 GetContext().actualClauses.push_back(type);
268 }
269
270 void AddClauseToCrtGroupInContext(C type) {
271 GetContext().crtGroup.push_back(type);
272 }
273
274 void ResetCrtGroup() { GetContext().crtGroup.clear(); }
275
276 // Check if the given clause is present in the current context
277 const PC *FindClause(C type) { return FindClause(GetContext(), type); }
278
279 // Check if the given clause is present in the given context
280 const PC *FindClause(DirectiveContext &context, C type) {
281 auto it{context.clauseInfo.find(type)};
282 if (it != context.clauseInfo.end()) {
283 return it->second;
284 }
285 return nullptr;
286 }
287
288 // Check if the given clause is present in the parent context
289 const PC *FindClauseParent(C type) {
290 auto it{GetContextParent().clauseInfo.find(type)};
291 if (it != GetContextParent().clauseInfo.end()) {
292 return it->second;
293 }
294 return nullptr;
295 }
296
297 llvm::iterator_range<typename ClauseMapTy::iterator> FindClauses(C type) {
298 auto it{GetContext().clauseInfo.equal_range(type)};
299 return llvm::make_range(it);
300 }
301
302 DirectiveContext *GetEnclosingDirContext() {
303 CHECK(!dirContext_.empty());
304 auto it{dirContext_.rbegin()};
305 if (++it != dirContext_.rend()) {
306 return &(*it);
307 }
308 return nullptr;
309 }
310
311 void PushContext(const parser::CharBlock &source, D dir) {
312 dirContext_.emplace_back(source, dir);
313 }
314
315 DirectiveContext *GetEnclosingContextWithDir(D dir) {
316 CHECK(!dirContext_.empty());
317 auto it{dirContext_.rbegin()};
318 while (++it != dirContext_.rend()) {
319 if (it->directive == dir) {
320 return &(*it);
321 }
322 }
323 return nullptr;
324 }
325
326 bool CurrentDirectiveIsNested() { return dirContext_.size() > 1; };
327
328 void SetClauseSets(D dir) {
329 dirContext_.back().allowedClauses = directiveClausesMap_[dir].allowed;
330 dirContext_.back().allowedOnceClauses =
331 directiveClausesMap_[dir].allowedOnce;
332 dirContext_.back().allowedExclusiveClauses =
333 directiveClausesMap_[dir].allowedExclusive;
334 dirContext_.back().requiredClauses =
335 directiveClausesMap_[dir].requiredOneOf;
336 }
337 void PushContextAndClauseSets(const parser::CharBlock &source, D dir) {
338 PushContext(source, dir);
339 SetClauseSets(dir);
340 }
341
342 void SayNotMatching(const parser::CharBlock &, const parser::CharBlock &);
343
344 template <typename B> void CheckMatching(const B &beginDir, const B &endDir) {
345 const auto &begin{beginDir.v};
346 const auto &end{endDir.v};
347 if (begin != end) {
348 SayNotMatching(beginDir.source, endDir.source);
349 }
350 }
351 // Check illegal branching out of `Parser::Block` for `Parser::Name` based
352 // nodes (example `Parser::ExitStmt`)
353 void CheckNoBranching(const parser::Block &block, D directive,
354 const parser::CharBlock &directiveSource);
355
356 // Check that only clauses in set are after the specific clauses.
357 void CheckOnlyAllowedAfter(C clause, common::EnumSet<C, ClauseEnumSize> set);
358
359 void CheckRequireAtLeastOneOf(bool warnInsteadOfError = false);
360
361 // Check if a clause is allowed on a directive. Returns true if is and
362 // false otherwise.
363 bool CheckAllowed(C clause, bool warnInsteadOfError = false);
364
365 // Check that the clause appears only once. The counter is reset when the
366 // separator clause appears.
367 void CheckAllowedOncePerGroup(C clause, C separator);
368
369 void CheckMutuallyExclusivePerGroup(
370 C clause, C separator, common::EnumSet<C, ClauseEnumSize> set);
371
372 void CheckAtLeastOneClause();
373
374 void CheckNotAllowedIfClause(
375 C clause, common::EnumSet<C, ClauseEnumSize> set);
376
377 std::string ContextDirectiveAsFortran();
378
379 void RequiresConstantPositiveParameter(
380 const C &clause, const parser::ScalarIntConstantExpr &i);
381
382 void RequiresPositiveParameter(const C &clause,
383 const parser::ScalarIntExpr &i, llvm::StringRef paramName = "parameter");
384
385 void OptionalConstantPositiveParameter(
386 const C &clause, const std::optional<parser::ScalarIntConstantExpr> &o);
387
388 virtual llvm::StringRef getClauseName(C clause) { return ""; };
389
390 virtual llvm::StringRef getDirectiveName(D directive) { return ""; };
391
392 SemanticsContext &context_;
393 std::vector<DirectiveContext> dirContext_; // used as a stack
394 std::unordered_map<D, DirectiveClauses<C, ClauseEnumSize>>
395 directiveClausesMap_;
396
397 std::string ClauseSetToString(const common::EnumSet<C, ClauseEnumSize> set);
398};
399
400template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
401void DirectiveStructureChecker<D, C, PC, ClauseEnumSize>::CheckNoBranching(
402 const parser::Block &block, D directive,
403 const parser::CharBlock &directiveSource) {
404 NoBranchingEnforce<D> noBranchingEnforce{
405 context_, directiveSource, directive, ContextDirectiveAsFortran()};
406 parser::Walk(block, noBranchingEnforce);
407}
408
409// Check that only clauses included in the given set are present after the given
410// clause.
411template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
412void DirectiveStructureChecker<D, C, PC, ClauseEnumSize>::CheckOnlyAllowedAfter(
413 C clause, common::EnumSet<C, ClauseEnumSize> set) {
414 bool enforceCheck = false;
415 for (auto cl : GetContext().actualClauses) {
416 if (cl == clause) {
417 enforceCheck = true;
418 continue;
419 } else if (enforceCheck && !set.test(cl)) {
420 auto parserClause = GetContext().clauseInfo.find(cl);
421 context_.Say(parserClause->second->source,
422 "Clause %s is not allowed after clause %s on the %s "
423 "directive"_err_en_US,
424 parser::ToUpperCaseLetters(getClauseName(cl).str()),
425 parser::ToUpperCaseLetters(getClauseName(clause).str()),
426 ContextDirectiveAsFortran());
427 }
428 }
429}
430
431// Check that at least one clause is attached to the directive.
432template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
433void DirectiveStructureChecker<D, C, PC,
434 ClauseEnumSize>::CheckAtLeastOneClause() {
435 if (GetContext().actualClauses.empty()) {
436 context_.Say(GetContext().directiveSource,
437 "At least one clause is required on the %s directive"_err_en_US,
438 ContextDirectiveAsFortran());
439 }
440}
441
442template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
443std::string
444DirectiveStructureChecker<D, C, PC, ClauseEnumSize>::ClauseSetToString(
445 const common::EnumSet<C, ClauseEnumSize> set) {
446 std::string list;
447 set.IterateOverMembers([&](C o) {
448 if (!list.empty())
449 list.append(", ");
450 list.append(parser::ToUpperCaseLetters(getClauseName(o).str()));
451 });
452 return list;
453}
454
455// Check that at least one clause in the required set is present on the
456// directive.
457template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
458void DirectiveStructureChecker<D, C, PC,
459 ClauseEnumSize>::CheckRequireAtLeastOneOf(bool warnInsteadOfError) {
460 if (GetContext().requiredClauses.empty()) {
461 return;
462 }
463 for (auto cl : GetContext().actualClauses) {
464 if (GetContext().requiredClauses.test(cl)) {
465 return;
466 }
467 }
468 // No clause matched in the actual clauses list
469 if (warnInsteadOfError) {
470 context_.Warn(common::UsageWarning::Portability,
471 GetContext().directiveSource,
472 "At least one of %s clause should appear on the %s directive"_port_en_US,
473 ClauseSetToString(GetContext().requiredClauses),
474 ContextDirectiveAsFortran());
475 } else {
476 context_.Say(GetContext().directiveSource,
477 "At least one of %s clause must appear on the %s directive"_err_en_US,
478 ClauseSetToString(GetContext().requiredClauses),
479 ContextDirectiveAsFortran());
480 }
481}
482
483template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
484std::string DirectiveStructureChecker<D, C, PC,
485 ClauseEnumSize>::ContextDirectiveAsFortran() {
486 return parser::ToUpperCaseLetters(
487 getDirectiveName(GetContext().directive).str());
488}
489
490// Check that clauses present on the directive are allowed clauses.
491template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
492bool DirectiveStructureChecker<D, C, PC, ClauseEnumSize>::CheckAllowed(
493 C clause, bool warnInsteadOfError) {
494 if (!GetContext().allowedClauses.test(clause) &&
495 !GetContext().allowedOnceClauses.test(clause) &&
496 !GetContext().allowedExclusiveClauses.test(clause) &&
497 !GetContext().requiredClauses.test(clause)) {
498 if (warnInsteadOfError) {
499 context_.Warn(common::UsageWarning::Portability,
500 GetContext().clauseSource,
501 "%s clause is not allowed on the %s directive and will be ignored"_port_en_US,
502 parser::ToUpperCaseLetters(getClauseName(clause).str()),
503 parser::ToUpperCaseLetters(GetContext().directiveSource.ToString()));
504 } else {
505 context_.Say(GetContext().clauseSource,
506 "%s clause is not allowed on the %s directive"_err_en_US,
507 parser::ToUpperCaseLetters(getClauseName(clause).str()),
508 parser::ToUpperCaseLetters(GetContext().directiveSource.ToString()));
509 }
510 return false;
511 }
512 if ((GetContext().allowedOnceClauses.test(clause) ||
513 GetContext().allowedExclusiveClauses.test(clause)) &&
514 FindClause(clause)) {
515 context_.Say(GetContext().clauseSource,
516 "At most one %s clause can appear on the %s directive"_err_en_US,
517 parser::ToUpperCaseLetters(getClauseName(clause).str()),
518 parser::ToUpperCaseLetters(GetContext().directiveSource.ToString()));
519 return false;
520 }
521 if (GetContext().allowedExclusiveClauses.test(clause)) {
522 std::vector<C> others;
523 GetContext().allowedExclusiveClauses.IterateOverMembers([&](C o) {
524 if (FindClause(o)) {
525 others.emplace_back(o);
526 }
527 });
528 for (const auto &e : others) {
529 context_.Say(GetContext().clauseSource,
530 "%s and %s clauses are mutually exclusive and may not appear on the "
531 "same %s directive"_err_en_US,
532 parser::ToUpperCaseLetters(getClauseName(clause).str()),
533 parser::ToUpperCaseLetters(getClauseName(e).str()),
534 parser::ToUpperCaseLetters(GetContext().directiveSource.ToString()));
535 }
536 if (!others.empty()) {
537 return false;
538 }
539 }
540 SetContextClauseInfo(clause);
541 AddClauseToCrtContext(clause);
542 AddClauseToCrtGroupInContext(clause);
543 return true;
544}
545
546// Enforce restriction where clauses in the given set are not allowed if the
547// given clause appears.
548template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
549void DirectiveStructureChecker<D, C, PC,
550 ClauseEnumSize>::CheckNotAllowedIfClause(C clause,
551 common::EnumSet<C, ClauseEnumSize> set) {
552 if (!llvm::is_contained(GetContext().actualClauses, clause)) {
553 return; // Clause is not present
554 }
555
556 for (auto cl : GetContext().actualClauses) {
557 if (set.test(cl)) {
558 context_.Say(GetContext().directiveSource,
559 "Clause %s is not allowed if clause %s appears on the %s directive"_err_en_US,
560 parser::ToUpperCaseLetters(getClauseName(cl).str()),
561 parser::ToUpperCaseLetters(getClauseName(clause).str()),
562 ContextDirectiveAsFortran());
563 }
564 }
565}
566
567template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
568void DirectiveStructureChecker<D, C, PC,
569 ClauseEnumSize>::CheckAllowedOncePerGroup(C clause, C separator) {
570 bool clauseIsPresent = false;
571 for (auto cl : GetContext().actualClauses) {
572 if (cl == clause) {
573 if (clauseIsPresent) {
574 context_.Say(GetContext().clauseSource,
575 "At most one %s clause can appear on the %s directive or in group separated by the %s clause"_err_en_US,
576 parser::ToUpperCaseLetters(getClauseName(clause).str()),
577 parser::ToUpperCaseLetters(GetContext().directiveSource.ToString()),
578 parser::ToUpperCaseLetters(getClauseName(separator).str()));
579 } else {
580 clauseIsPresent = true;
581 }
582 }
583 if (cl == separator)
584 clauseIsPresent = false;
585 }
586}
587
588template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
589void DirectiveStructureChecker<D, C, PC,
590 ClauseEnumSize>::CheckMutuallyExclusivePerGroup(C clause, C separator,
591 common::EnumSet<C, ClauseEnumSize> set) {
592
593 // Checking of there is any offending clauses before the first separator.
594 for (auto cl : GetContext().actualClauses) {
595 if (cl == separator) {
596 break;
597 }
598 if (set.test(cl)) {
599 context_.Say(GetContext().directiveSource,
600 "Clause %s is not allowed if clause %s appears on the %s directive"_err_en_US,
601 parser::ToUpperCaseLetters(getClauseName(clause).str()),
602 parser::ToUpperCaseLetters(getClauseName(cl).str()),
603 ContextDirectiveAsFortran());
604 }
605 }
606
607 // Checking for mutually exclusive clauses in the current group.
608 for (auto cl : GetContext().crtGroup) {
609 if (set.test(cl)) {
610 context_.Say(GetContext().directiveSource,
611 "Clause %s is not allowed if clause %s appears on the %s directive"_err_en_US,
612 parser::ToUpperCaseLetters(getClauseName(clause).str()),
613 parser::ToUpperCaseLetters(getClauseName(cl).str()),
614 ContextDirectiveAsFortran());
615 }
616 }
617}
618
619// Check the value of the clause is a constant positive integer.
620template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
621void DirectiveStructureChecker<D, C, PC,
622 ClauseEnumSize>::RequiresConstantPositiveParameter(const C &clause,
623 const parser::ScalarIntConstantExpr &i) {
624 if (const auto v{GetIntValue(i)}) {
625 if (*v <= 0) {
626 context_.Say(GetContext().clauseSource,
627 "The parameter of the %s clause must be "
628 "a constant positive integer expression"_err_en_US,
629 parser::ToUpperCaseLetters(getClauseName(clause).str()));
630 }
631 }
632}
633
634// Check the value of the clause is a constant positive parameter.
635template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
636void DirectiveStructureChecker<D, C, PC,
637 ClauseEnumSize>::OptionalConstantPositiveParameter(const C &clause,
638 const std::optional<parser::ScalarIntConstantExpr> &o) {
639 if (o != std::nullopt) {
640 RequiresConstantPositiveParameter(clause, o.value());
641 }
642}
643
644template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
645void DirectiveStructureChecker<D, C, PC, ClauseEnumSize>::SayNotMatching(
646 const parser::CharBlock &beginSource, const parser::CharBlock &endSource) {
647 context_
648 .Say(endSource, "Unmatched %s directive"_err_en_US,
649 parser::ToUpperCaseLetters(endSource.ToString()))
650 .Attach(beginSource, "Does not match directive"_en_US);
651}
652
653// Check the value of the clause is a positive parameter.
654template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
655void DirectiveStructureChecker<D, C, PC,
656 ClauseEnumSize>::RequiresPositiveParameter(const C &clause,
657 const parser::ScalarIntExpr &i, llvm::StringRef paramName) {
658 if (const auto v{GetIntValue(i)}) {
659 if (*v < 0) {
660 context_.Say(GetContext().clauseSource,
661 "The %s of the %s clause must be "
662 "a positive integer expression"_err_en_US,
663 paramName.str(),
664 parser::ToUpperCaseLetters(getClauseName(clause).str()));
665 }
666 }
667}
668
669} // namespace Fortran::semantics
670
671#endif // FORTRAN_SEMANTICS_CHECK_DIRECTIVE_STRUCTURE_H_
Definition: enum-set.h:28
Definition: char-block.h:28
Definition: message.h:104
Definition: check-directive-structure.h:181
Definition: check-directive-structure.h:34
Definition: semantics.h:67
Definition: symbol.h:712
Definition: parse-tree.h:2338
Definition: parse-tree.h:580
Definition: parse-tree.h:355
Definition: semantics.h:367
Definition: check-directive-structure.h:24
Definition: check-directive-structure.h:190