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