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