12#ifndef FORTRAN_SEMANTICS_CHECK_DIRECTIVE_STRUCTURE_H_
13#define FORTRAN_SEMANTICS_CHECK_DIRECTIVE_STRUCTURE_H_
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"
21#include <unordered_map>
23namespace Fortran::semantics {
35template <
typename D>
class NoBranchingEnforce {
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 &) {}
47 currentStatementSourcePosition_ = statement.source;
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");
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());
76 CheckConstructNameBranching(
"EXIT");
79 void Post(
const parser::CycleStmt &cycleStmt) {
80 if (
const auto &cycleName{cycleStmt.v}) {
81 CheckConstructNameBranching(
"CYCLE", cycleName.value());
83 if constexpr (std::is_same_v<D, llvm::omp::Directive>) {
84 switch ((llvm::omp::Directive)currentDirective_) {
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:
104 }
else if constexpr (std::is_same_v<D, llvm::acc::Directive>) {
105 switch ((llvm::acc::Directive)currentDirective_) {
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:
117 CheckConstructNameBranching(
"CYCLE");
123 return {
"Enclosing %s construct"_en_US, upperCaseDirName_};
126 void EmitBranchOutError(
const char *stmt)
const {
128 .Say(currentStatementSourcePosition_,
129 "%s statement is not allowed in a %s construct"_err_en_US, stmt,
131 .Attach(sourcePosition_, GetEnclosingMsg());
134 void EmitBranchOutOfComputeConstructError(
const char *stmt)
const {
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());
142 inline void EmitUnlabelledBranchOutError(
const char *stmt) {
144 .Say(currentStatementSourcePosition_,
145 "%s to construct outside of %s construct is not allowed"_err_en_US,
146 stmt, upperCaseDirName_)
147 .Attach(sourcePosition_, GetEnclosingMsg());
150 void EmitBranchOutErrorWithName(
152 const std::string branchingToName{toName.ToString()};
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());
166 void CheckConstructNameBranching(
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)};
173 if (stmtName.source == constructName->source) {
174 EmitBranchOutErrorWithName(stmt, stmtName);
182 void CheckConstructNameBranching(
const char *stmt) {
184 if (numDoConstruct_ > 0) {
189 EmitUnlabelledBranchOutError(stmt);
195 std::string upperCaseDirName_;
199 std::set<parser::Label> labelsInBlock_;
207template <
typename D,
typename C,
typename PC, std::
size_t ClauseEnumSize>
212 &directiveClausesMap)
213 : context_{context}, directiveClausesMap_(directiveClausesMap) {}
214 virtual ~DirectiveStructureChecker() {}
216 using ClauseMapTy = std::multimap<C, const PC *>;
217 struct DirectiveContext {
219 : directiveSource{source}, directive{d} {}
229 const PC *clause{
nullptr};
230 ClauseMapTy clauseInfo;
231 std::list<C> actualClauses;
232 std::list<C> endDirectiveClauses;
233 std::list<C> crtGroup;
237 void SetLoopIv(
Symbol *symbol) { GetContext().loopIV = symbol; }
240 DirectiveContext &GetContext() {
241 CHECK(!dirContext_.empty());
242 return dirContext_.back();
245 DirectiveContext &GetContextParent() {
246 CHECK(dirContext_.size() >= 2);
247 return dirContext_[dirContext_.size() - 2];
250 void SetContextClause(
const PC &clause) {
251 GetContext().clauseSource = clause.source;
252 GetContext().clause = &clause;
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};
266 void SetContextDirectiveSource(
const parser::CharBlock &directive) {
267 GetContext().directiveSource = directive;
270 void SetContextDirectiveEnum(D dir) { GetContext().directive = dir; }
272 void SetContextAllowed(
const common::EnumSet<C, ClauseEnumSize> &allowed) {
273 GetContext().allowedClauses = allowed;
276 void SetContextAllowedOnce(
277 const common::EnumSet<C, ClauseEnumSize> &allowedOnce) {
278 GetContext().allowedOnceClauses = allowedOnce;
281 void SetContextAllowedExclusive(
282 const common::EnumSet<C, ClauseEnumSize> &allowedExclusive) {
283 GetContext().allowedExclusiveClauses = allowedExclusive;
286 void SetContextRequired(
const common::EnumSet<C, ClauseEnumSize> &required) {
287 GetContext().requiredClauses = required;
290 void SetContextClauseInfo(C type) {
291 GetContext().clauseInfo.emplace(type, GetContext().clause);
294 void AddClauseToCrtContext(C type) {
295 GetContext().actualClauses.push_back(type);
298 void AddClauseToCrtGroupInContext(C type) {
299 GetContext().crtGroup.push_back(type);
302 void ResetCrtGroup() { GetContext().crtGroup.clear(); }
305 const PC *FindClause(C type) {
return FindClause(GetContext(), type); }
309 auto it{context.clauseInfo.find(type)};
310 if (it != context.clauseInfo.end()) {
317 const PC *FindClauseParent(C type) {
318 auto it{GetContextParent().clauseInfo.find(type)};
319 if (it != GetContextParent().clauseInfo.end()) {
325 llvm::iterator_range<typename ClauseMapTy::iterator> FindClauses(C type) {
326 auto it{GetContext().clauseInfo.equal_range(type)};
327 return llvm::make_range(it);
331 CHECK(!dirContext_.empty());
332 auto it{dirContext_.rbegin()};
333 if (++it != dirContext_.rend()) {
339 void PushContext(
const parser::CharBlock &source, D dir) {
340 dirContext_.emplace_back(source, dir);
344 CHECK(!dirContext_.empty());
345 auto it{dirContext_.rbegin()};
346 while (++it != dirContext_.rend()) {
347 if (it->directive == dir) {
354 bool CurrentDirectiveIsNested() {
return dirContext_.size() > 1; };
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;
365 void PushContextAndClauseSets(
const parser::CharBlock &source, D dir) {
366 PushContext(source, dir);
370 void SayNotMatching(
const parser::CharBlock &,
const parser::CharBlock &);
372 template <
typename B>
void CheckMatching(
const B &beginDir,
const B &endDir) {
373 const auto &begin{beginDir.v};
374 const auto &end{endDir.v};
376 SayNotMatching(beginDir.source, endDir.source);
381 void CheckNoBranching(
const parser::Block &block, D directive,
382 const parser::CharBlock &directiveSource);
385 void CheckOnlyAllowedAfter(C clause, common::EnumSet<C, ClauseEnumSize> set);
387 void CheckRequireAtLeastOneOf(
bool warnInsteadOfError =
false);
391 bool CheckAllowed(C clause,
bool warnInsteadOfError =
false);
395 void CheckAllowedOncePerGroup(C clause, C separator);
397 void CheckMutuallyExclusivePerGroup(
398 C clause, C separator, common::EnumSet<C, ClauseEnumSize> set);
400 void CheckAtLeastOneClause();
402 void CheckNotAllowedIfClause(
403 C clause, common::EnumSet<C, ClauseEnumSize> set);
405 std::string ContextDirectiveAsFortran();
407 void RequiresConstantPositiveParameter(
408 const C &clause,
const parser::ScalarIntConstantExpr &i);
410 void RequiresPositiveParameter(
const C &clause,
411 const parser::ScalarIntExpr &i, llvm::StringRef paramName =
"parameter",
412 bool allowZero =
true);
414 void OptionalConstantPositiveParameter(
415 const C &clause,
const std::optional<parser::ScalarIntConstantExpr> &o);
417 virtual llvm::StringRef getClauseName(C clause) {
return ""; };
419 virtual llvm::StringRef getDirectiveName(D directive) {
return ""; };
421 SemanticsContext &context_;
422 std::vector<DirectiveContext> dirContext_;
423 std::unordered_map<D, DirectiveClauses<C, ClauseEnumSize>>
424 directiveClausesMap_;
426 std::string ClauseSetToString(
const common::EnumSet<C, ClauseEnumSize> set);
431 std::set<parser::Label> labels;
432 template <
typename T>
bool Pre(
const T &) {
return true; }
433 template <
typename T>
void Post(
const T &) {}
436 labels.insert(*stmt.label);
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,
446 parser::Walk(block, labelCollector);
448 context_, directiveSource, directive, ContextDirectiveAsFortran()};
449 for (
auto label : labelCollector.labels)
450 noBranchingEnforce.CollectLabel(label);
451 parser::Walk(block, noBranchingEnforce);
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) {
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());
477template <
typename D,
typename C,
typename PC, std::
size_t ClauseEnumSize>
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());
487template <
typename D,
typename C,
typename PC, std::
size_t ClauseEnumSize>
489DirectiveStructureChecker<D, C, PC, ClauseEnumSize>::ClauseSetToString(
490 const common::EnumSet<C, ClauseEnumSize> set) {
492 set.IterateOverMembers([&](C o) {
495 list.append(parser::ToUpperCaseLetters(getClauseName(o).str()));
502template <
typename D,
typename C,
typename PC, std::
size_t ClauseEnumSize>
504 ClauseEnumSize>::CheckRequireAtLeastOneOf(
bool warnInsteadOfError) {
505 if (GetContext().requiredClauses.empty()) {
508 for (
auto cl : GetContext().actualClauses) {
509 if (GetContext().requiredClauses.test(cl)) {
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());
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());
528template <
typename D,
typename C,
typename PC, std::
size_t ClauseEnumSize>
530 ClauseEnumSize>::ContextDirectiveAsFortran() {
531 return parser::ToUpperCaseLetters(
532 getDirectiveName(GetContext().directive).str());
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()));
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()));
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()));
566 if (GetContext().allowedExclusiveClauses.test(clause)) {
567 std::vector<C> others;
568 GetContext().allowedExclusiveClauses.IterateOverMembers([&](C o) {
570 others.emplace_back(o);
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()));
581 if (!others.empty()) {
585 SetContextClauseInfo(clause);
586 AddClauseToCrtContext(clause);
587 AddClauseToCrtGroupInContext(clause);
593template <
typename D,
typename C,
typename PC, std::
size_t ClauseEnumSize>
595 ClauseEnumSize>::CheckNotAllowedIfClause(C clause,
596 common::EnumSet<C, ClauseEnumSize> set) {
597 if (!llvm::is_contained(GetContext().actualClauses, clause)) {
601 for (
auto cl : GetContext().actualClauses) {
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());
612template <
typename D,
typename C,
typename PC, std::
size_t ClauseEnumSize>
614 ClauseEnumSize>::CheckAllowedOncePerGroup(C clause, C separator) {
615 bool clauseIsPresent =
false;
616 for (
auto cl : GetContext().actualClauses) {
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()));
625 clauseIsPresent =
true;
629 clauseIsPresent =
false;
633template <
typename D,
typename C,
typename PC, std::
size_t ClauseEnumSize>
635 ClauseEnumSize>::CheckMutuallyExclusivePerGroup(C clause, C separator,
636 common::EnumSet<C, ClauseEnumSize> set) {
639 for (
auto cl : GetContext().actualClauses) {
640 if (cl == separator) {
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());
653 for (
auto cl : GetContext().crtGroup) {
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());
665template <
typename D,
typename C,
typename PC, std::
size_t ClauseEnumSize>
667 ClauseEnumSize>::RequiresConstantPositiveParameter(
const C &clause,
668 const parser::ScalarIntConstantExpr &i) {
669 if (
const auto v{GetIntValue(i)}) {
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()));
680template <
typename D,
typename C,
typename PC, std::
size_t ClauseEnumSize>
682 ClauseEnumSize>::OptionalConstantPositiveParameter(
const C &clause,
683 const std::optional<parser::ScalarIntConstantExpr> &o) {
684 if (o != std::nullopt) {
685 RequiresConstantPositiveParameter(clause, o.value());
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) {
693 .Say(endSource,
"Unmatched %s directive"_err_en_US,
694 parser::ToUpperCaseLetters(endSource.ToString()))
695 .Attach(beginSource,
"Does not match directive"_en_US);
699template <
typename D,
typename C,
typename PC, std::
size_t ClauseEnumSize>
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,
709 parser::ToUpperCaseLetters(getClauseName(clause).str()));
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: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