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