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"
20#include <unordered_map>
22namespace Fortran::semantics {
34template <
typename D>
class NoBranchingEnforce {
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 &) {}
46 currentStatementSourcePosition_ = statement.source;
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());
60 CheckConstructNameBranching(
"EXIT");
63 void Post(
const parser::CycleStmt &cycleStmt) {
64 if (
const auto &cycleName{cycleStmt.v}) {
65 CheckConstructNameBranching(
"CYCLE", cycleName.value());
67 if constexpr (std::is_same_v<D, llvm::omp::Directive>) {
68 switch ((llvm::omp::Directive)currentDirective_) {
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:
88 }
else if constexpr (std::is_same_v<D, llvm::acc::Directive>) {
89 switch ((llvm::acc::Directive)currentDirective_) {
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:
101 CheckConstructNameBranching(
"CYCLE");
107 return {
"Enclosing %s construct"_en_US, upperCaseDirName_};
110 void EmitBranchOutError(
const char *stmt)
const {
112 .Say(currentStatementSourcePosition_,
113 "%s statement is not allowed in a %s construct"_err_en_US, stmt,
115 .Attach(sourcePosition_, GetEnclosingMsg());
118 inline void EmitUnlabelledBranchOutError(
const char *stmt) {
120 .Say(currentStatementSourcePosition_,
121 "%s to construct outside of %s construct is not allowed"_err_en_US,
122 stmt, upperCaseDirName_)
123 .Attach(sourcePosition_, GetEnclosingMsg());
126 void EmitBranchOutErrorWithName(
128 const std::string branchingToName{toName.ToString()};
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());
142 void CheckConstructNameBranching(
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)};
149 if (stmtName.source == constructName->source) {
150 EmitBranchOutErrorWithName(stmt, stmtName);
158 void CheckConstructNameBranching(
const char *stmt) {
160 if (numDoConstruct_ > 0) {
165 EmitUnlabelledBranchOutError(stmt);
171 std::string upperCaseDirName_;
182template <
typename D,
typename C,
typename PC, std::
size_t ClauseEnumSize>
187 &directiveClausesMap)
188 : context_{context}, directiveClausesMap_(directiveClausesMap) {}
189 virtual ~DirectiveStructureChecker() {}
191 using ClauseMapTy = std::multimap<C, const PC *>;
192 struct DirectiveContext {
194 : directiveSource{source}, directive{d} {}
204 const PC *clause{
nullptr};
205 ClauseMapTy clauseInfo;
206 std::list<C> actualClauses;
207 std::list<C> endDirectiveClauses;
208 std::list<C> crtGroup;
212 void SetLoopIv(
Symbol *symbol) { GetContext().loopIV = symbol; }
215 DirectiveContext &GetContext() {
216 CHECK(!dirContext_.empty());
217 return dirContext_.back();
220 DirectiveContext &GetContextParent() {
221 CHECK(dirContext_.size() >= 2);
222 return dirContext_[dirContext_.size() - 2];
225 void SetContextClause(
const PC &clause) {
226 GetContext().clauseSource = clause.source;
227 GetContext().clause = &clause;
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};
241 void SetContextDirectiveSource(
const parser::CharBlock &directive) {
242 GetContext().directiveSource = directive;
245 void SetContextDirectiveEnum(D dir) { GetContext().directive = dir; }
247 void SetContextAllowed(
const common::EnumSet<C, ClauseEnumSize> &allowed) {
248 GetContext().allowedClauses = allowed;
251 void SetContextAllowedOnce(
252 const common::EnumSet<C, ClauseEnumSize> &allowedOnce) {
253 GetContext().allowedOnceClauses = allowedOnce;
256 void SetContextAllowedExclusive(
257 const common::EnumSet<C, ClauseEnumSize> &allowedExclusive) {
258 GetContext().allowedExclusiveClauses = allowedExclusive;
261 void SetContextRequired(
const common::EnumSet<C, ClauseEnumSize> &required) {
262 GetContext().requiredClauses = required;
265 void SetContextClauseInfo(C type) {
266 GetContext().clauseInfo.emplace(type, GetContext().clause);
269 void AddClauseToCrtContext(C type) {
270 GetContext().actualClauses.push_back(type);
273 void AddClauseToCrtGroupInContext(C type) {
274 GetContext().crtGroup.push_back(type);
277 void ResetCrtGroup() { GetContext().crtGroup.clear(); }
280 const PC *FindClause(C type) {
return FindClause(GetContext(), type); }
284 auto it{context.clauseInfo.find(type)};
285 if (it != context.clauseInfo.end()) {
292 const PC *FindClauseParent(C type) {
293 auto it{GetContextParent().clauseInfo.find(type)};
294 if (it != GetContextParent().clauseInfo.end()) {
300 llvm::iterator_range<typename ClauseMapTy::iterator> FindClauses(C type) {
301 auto it{GetContext().clauseInfo.equal_range(type)};
302 return llvm::make_range(it);
306 CHECK(!dirContext_.empty());
307 auto it{dirContext_.rbegin()};
308 if (++it != dirContext_.rend()) {
314 void PushContext(
const parser::CharBlock &source, D dir) {
315 dirContext_.emplace_back(source, dir);
319 CHECK(!dirContext_.empty());
320 auto it{dirContext_.rbegin()};
321 while (++it != dirContext_.rend()) {
322 if (it->directive == dir) {
329 bool CurrentDirectiveIsNested() {
return dirContext_.size() > 1; };
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;
340 void PushContextAndClauseSets(
const parser::CharBlock &source, D dir) {
341 PushContext(source, dir);
345 void SayNotMatching(
const parser::CharBlock &,
const parser::CharBlock &);
347 template <
typename B>
void CheckMatching(
const B &beginDir,
const B &endDir) {
348 const auto &begin{beginDir.v};
349 const auto &end{endDir.v};
351 SayNotMatching(beginDir.source, endDir.source);
356 void CheckNoBranching(
const parser::Block &block, D directive,
357 const parser::CharBlock &directiveSource);
360 void CheckOnlyAllowedAfter(C clause, common::EnumSet<C, ClauseEnumSize> set);
362 void CheckRequireAtLeastOneOf(
bool warnInsteadOfError =
false);
366 bool CheckAllowed(C clause,
bool warnInsteadOfError =
false);
370 void CheckAllowedOncePerGroup(C clause, C separator);
372 void CheckMutuallyExclusivePerGroup(
373 C clause, C separator, common::EnumSet<C, ClauseEnumSize> set);
375 void CheckAtLeastOneClause();
377 void CheckNotAllowedIfClause(
378 C clause, common::EnumSet<C, ClauseEnumSize> set);
380 std::string ContextDirectiveAsFortran();
382 void RequiresConstantPositiveParameter(
383 const C &clause,
const parser::ScalarIntConstantExpr &i);
385 void RequiresPositiveParameter(
const C &clause,
386 const parser::ScalarIntExpr &i, llvm::StringRef paramName =
"parameter");
388 void OptionalConstantPositiveParameter(
389 const C &clause,
const std::optional<parser::ScalarIntConstantExpr> &o);
391 virtual llvm::StringRef getClauseName(C clause) {
return ""; };
393 virtual llvm::StringRef getDirectiveName(D directive) {
return ""; };
395 SemanticsContext &context_;
396 std::vector<DirectiveContext> dirContext_;
397 std::unordered_map<D, DirectiveClauses<C, ClauseEnumSize>>
398 directiveClausesMap_;
400 std::string ClauseSetToString(
const common::EnumSet<C, ClauseEnumSize> set);
403template <
typename D,
typename C,
typename PC, std::
size_t ClauseEnumSize>
404void DirectiveStructureChecker<D, C, PC, ClauseEnumSize>::CheckNoBranching(
405 const parser::Block &block, D directive,
406 const parser::CharBlock &directiveSource) {
408 context_, directiveSource, directive, ContextDirectiveAsFortran()};
409 parser::Walk(block, noBranchingEnforce);
414template <
typename D,
typename C,
typename PC, std::
size_t ClauseEnumSize>
415void DirectiveStructureChecker<D, C, PC, ClauseEnumSize>::CheckOnlyAllowedAfter(
416 C clause, common::EnumSet<C, ClauseEnumSize> set) {
417 bool enforceCheck =
false;
418 for (
auto cl : GetContext().actualClauses) {
422 }
else if (enforceCheck && !set.test(cl)) {
423 auto parserClause = GetContext().clauseInfo.find(cl);
424 context_.Say(parserClause->second->source,
425 "Clause %s is not allowed after clause %s on the %s "
426 "directive"_err_en_US,
427 parser::ToUpperCaseLetters(getClauseName(cl).str()),
428 parser::ToUpperCaseLetters(getClauseName(clause).str()),
429 ContextDirectiveAsFortran());
435template <
typename D,
typename C,
typename PC, std::
size_t ClauseEnumSize>
437 ClauseEnumSize>::CheckAtLeastOneClause() {
438 if (GetContext().actualClauses.empty()) {
439 context_.Say(GetContext().directiveSource,
440 "At least one clause is required on the %s directive"_err_en_US,
441 ContextDirectiveAsFortran());
445template <
typename D,
typename C,
typename PC, std::
size_t ClauseEnumSize>
447DirectiveStructureChecker<D, C, PC, ClauseEnumSize>::ClauseSetToString(
448 const common::EnumSet<C, ClauseEnumSize> set) {
450 set.IterateOverMembers([&](C o) {
453 list.append(parser::ToUpperCaseLetters(getClauseName(o).str()));
460template <
typename D,
typename C,
typename PC, std::
size_t ClauseEnumSize>
462 ClauseEnumSize>::CheckRequireAtLeastOneOf(
bool warnInsteadOfError) {
463 if (GetContext().requiredClauses.empty()) {
466 for (
auto cl : GetContext().actualClauses) {
467 if (GetContext().requiredClauses.test(cl)) {
472 if (warnInsteadOfError) {
473 context_.Warn(common::UsageWarning::Portability,
474 GetContext().directiveSource,
475 "At least one of %s clause should appear on the %s directive"_port_en_US,
476 ClauseSetToString(GetContext().requiredClauses),
477 ContextDirectiveAsFortran());
479 context_.Say(GetContext().directiveSource,
480 "At least one of %s clause must appear on the %s directive"_err_en_US,
481 ClauseSetToString(GetContext().requiredClauses),
482 ContextDirectiveAsFortran());
486template <
typename D,
typename C,
typename PC, std::
size_t ClauseEnumSize>
488 ClauseEnumSize>::ContextDirectiveAsFortran() {
489 return parser::ToUpperCaseLetters(
490 getDirectiveName(GetContext().directive).str());
494template <
typename D,
typename C,
typename PC, std::
size_t ClauseEnumSize>
495bool DirectiveStructureChecker<D, C, PC, ClauseEnumSize>::CheckAllowed(
496 C clause,
bool warnInsteadOfError) {
497 if (!GetContext().allowedClauses.test(clause) &&
498 !GetContext().allowedOnceClauses.test(clause) &&
499 !GetContext().allowedExclusiveClauses.test(clause) &&
500 !GetContext().requiredClauses.test(clause)) {
501 if (warnInsteadOfError) {
502 context_.Warn(common::UsageWarning::Portability,
503 GetContext().clauseSource,
504 "%s clause is not allowed on the %s directive and will be ignored"_port_en_US,
505 parser::ToUpperCaseLetters(getClauseName(clause).str()),
506 parser::ToUpperCaseLetters(GetContext().directiveSource.ToString()));
508 context_.Say(GetContext().clauseSource,
509 "%s clause is not allowed on the %s directive"_err_en_US,
510 parser::ToUpperCaseLetters(getClauseName(clause).str()),
511 parser::ToUpperCaseLetters(GetContext().directiveSource.ToString()));
515 if ((GetContext().allowedOnceClauses.test(clause) ||
516 GetContext().allowedExclusiveClauses.test(clause)) &&
517 FindClause(clause)) {
518 context_.Say(GetContext().clauseSource,
519 "At most one %s clause can appear on the %s directive"_err_en_US,
520 parser::ToUpperCaseLetters(getClauseName(clause).str()),
521 parser::ToUpperCaseLetters(GetContext().directiveSource.ToString()));
524 if (GetContext().allowedExclusiveClauses.test(clause)) {
525 std::vector<C> others;
526 GetContext().allowedExclusiveClauses.IterateOverMembers([&](C o) {
528 others.emplace_back(o);
531 for (
const auto &e : others) {
532 context_.Say(GetContext().clauseSource,
533 "%s and %s clauses are mutually exclusive and may not appear on the "
534 "same %s directive"_err_en_US,
535 parser::ToUpperCaseLetters(getClauseName(clause).str()),
536 parser::ToUpperCaseLetters(getClauseName(e).str()),
537 parser::ToUpperCaseLetters(GetContext().directiveSource.ToString()));
539 if (!others.empty()) {
543 SetContextClauseInfo(clause);
544 AddClauseToCrtContext(clause);
545 AddClauseToCrtGroupInContext(clause);
551template <
typename D,
typename C,
typename PC, std::
size_t ClauseEnumSize>
553 ClauseEnumSize>::CheckNotAllowedIfClause(C clause,
554 common::EnumSet<C, ClauseEnumSize> set) {
555 if (!llvm::is_contained(GetContext().actualClauses, clause)) {
559 for (
auto cl : GetContext().actualClauses) {
561 context_.Say(GetContext().directiveSource,
562 "Clause %s is not allowed if clause %s appears on the %s directive"_err_en_US,
563 parser::ToUpperCaseLetters(getClauseName(cl).str()),
564 parser::ToUpperCaseLetters(getClauseName(clause).str()),
565 ContextDirectiveAsFortran());
570template <
typename D,
typename C,
typename PC, std::
size_t ClauseEnumSize>
572 ClauseEnumSize>::CheckAllowedOncePerGroup(C clause, C separator) {
573 bool clauseIsPresent =
false;
574 for (
auto cl : GetContext().actualClauses) {
576 if (clauseIsPresent) {
577 context_.Say(GetContext().clauseSource,
578 "At most one %s clause can appear on the %s directive or in group separated by the %s clause"_err_en_US,
579 parser::ToUpperCaseLetters(getClauseName(clause).str()),
580 parser::ToUpperCaseLetters(GetContext().directiveSource.ToString()),
581 parser::ToUpperCaseLetters(getClauseName(separator).str()));
583 clauseIsPresent =
true;
587 clauseIsPresent =
false;
591template <
typename D,
typename C,
typename PC, std::
size_t ClauseEnumSize>
593 ClauseEnumSize>::CheckMutuallyExclusivePerGroup(C clause, C separator,
594 common::EnumSet<C, ClauseEnumSize> set) {
597 for (
auto cl : GetContext().actualClauses) {
598 if (cl == separator) {
602 context_.Say(GetContext().directiveSource,
603 "Clause %s is not allowed if clause %s appears on the %s directive"_err_en_US,
604 parser::ToUpperCaseLetters(getClauseName(clause).str()),
605 parser::ToUpperCaseLetters(getClauseName(cl).str()),
606 ContextDirectiveAsFortran());
611 for (
auto cl : GetContext().crtGroup) {
613 context_.Say(GetContext().directiveSource,
614 "Clause %s is not allowed if clause %s appears on the %s directive"_err_en_US,
615 parser::ToUpperCaseLetters(getClauseName(clause).str()),
616 parser::ToUpperCaseLetters(getClauseName(cl).str()),
617 ContextDirectiveAsFortran());
623template <
typename D,
typename C,
typename PC, std::
size_t ClauseEnumSize>
625 ClauseEnumSize>::RequiresConstantPositiveParameter(
const C &clause,
626 const parser::ScalarIntConstantExpr &i) {
627 if (
const auto v{GetIntValue(i)}) {
629 context_.Say(GetContext().clauseSource,
630 "The parameter of the %s clause must be "
631 "a constant positive integer expression"_err_en_US,
632 parser::ToUpperCaseLetters(getClauseName(clause).str()));
638template <
typename D,
typename C,
typename PC, std::
size_t ClauseEnumSize>
640 ClauseEnumSize>::OptionalConstantPositiveParameter(
const C &clause,
641 const std::optional<parser::ScalarIntConstantExpr> &o) {
642 if (o != std::nullopt) {
643 RequiresConstantPositiveParameter(clause, o.value());
647template <
typename D,
typename C,
typename PC, std::
size_t ClauseEnumSize>
648void DirectiveStructureChecker<D, C, PC, ClauseEnumSize>::SayNotMatching(
649 const parser::CharBlock &beginSource,
const parser::CharBlock &endSource) {
651 .Say(endSource,
"Unmatched %s directive"_err_en_US,
652 parser::ToUpperCaseLetters(endSource.ToString()))
653 .Attach(beginSource,
"Does not match directive"_en_US);
657template <
typename D,
typename C,
typename PC, std::
size_t ClauseEnumSize>
659 ClauseEnumSize>::RequiresPositiveParameter(
const C &clause,
660 const parser::ScalarIntExpr &i, llvm::StringRef paramName) {
661 if (
const auto v{GetIntValue(i)}) {
663 context_.Say(GetContext().clauseSource,
664 "The %s of the %s clause must be "
665 "a positive integer expression"_err_en_US,
667 parser::ToUpperCaseLetters(getClauseName(clause).str()));
Definition char-block.h:28
Definition check-directive-structure.h:183
Definition check-directive-structure.h:34
Definition semantics.h:67
Definition parse-tree.h:2338
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