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 {
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_parallel_do:
80 case llvm::omp::Directive::
81 OMPD_target_teams_distribute_parallel_do_simd:
86 }
else if constexpr (std::is_same_v<D, llvm::acc::Directive>) {
87 switch ((llvm::acc::Directive)currentDirective_) {
90 case llvm::acc::Directive::ACCD_loop:
91 case llvm::acc::Directive::ACCD_kernels_loop:
92 case llvm::acc::Directive::ACCD_parallel_loop:
93 case llvm::acc::Directive::ACCD_serial_loop:
99 CheckConstructNameBranching(
"CYCLE");
105 return {
"Enclosing %s construct"_en_US, upperCaseDirName_};
108 void EmitBranchOutError(
const char *stmt)
const {
110 .Say(currentStatementSourcePosition_,
111 "%s statement is not allowed in a %s construct"_err_en_US, stmt,
113 .Attach(sourcePosition_, GetEnclosingMsg());
116 inline void EmitUnlabelledBranchOutError(
const char *stmt) {
118 .Say(currentStatementSourcePosition_,
119 "%s to construct outside of %s construct is not allowed"_err_en_US,
120 stmt, upperCaseDirName_)
121 .Attach(sourcePosition_, GetEnclosingMsg());
124 void EmitBranchOutErrorWithName(
126 const std::string branchingToName{toName.ToString()};
128 .Say(currentStatementSourcePosition_,
129 "%s to construct '%s' outside of %s construct is not allowed"_err_en_US,
130 stmt, branchingToName, upperCaseDirName_)
131 .Attach(sourcePosition_, GetEnclosingMsg());
140 void CheckConstructNameBranching(
142 const ConstructStack &stack{context_.constructStack()};
143 for (
auto iter{stack.cend()}; iter-- != stack.cbegin();) {
144 const ConstructNode &construct{*iter};
145 const auto &constructName{MaybeGetNodeName(construct)};
147 if (stmtName.source == constructName->source) {
148 EmitBranchOutErrorWithName(stmt, stmtName);
156 void CheckConstructNameBranching(
const char *stmt) {
158 if (numDoConstruct_ > 0) {
163 EmitUnlabelledBranchOutError(stmt);
169 std::string upperCaseDirName_;
180template <
typename D,
typename C,
typename PC, std::
size_t ClauseEnumSize>
185 &directiveClausesMap)
186 : context_{context}, directiveClausesMap_(directiveClausesMap) {}
189 using ClauseMapTy = std::multimap<C, const PC *>;
192 : directiveSource{source}, directive{d} {}
202 const PC *clause{
nullptr};
203 ClauseMapTy clauseInfo;
204 std::list<C> actualClauses;
205 std::list<C> crtGroup;
209 void SetLoopIv(
Symbol *symbol) { GetContext().loopIV = symbol; }
212 DirectiveContext &GetContext() {
213 CHECK(!dirContext_.empty());
214 return dirContext_.back();
217 DirectiveContext &GetContextParent() {
218 CHECK(dirContext_.size() >= 2);
219 return dirContext_[dirContext_.size() - 2];
222 void SetContextClause(
const PC &clause) {
223 GetContext().clauseSource = clause.source;
224 GetContext().clause = &clause;
227 void ResetPartialContext(
const parser::CharBlock &source) {
228 CHECK(!dirContext_.empty());
229 SetContextDirectiveSource(source);
230 GetContext().allowedClauses = {};
231 GetContext().allowedOnceClauses = {};
232 GetContext().allowedExclusiveClauses = {};
233 GetContext().requiredClauses = {};
234 GetContext().clauseInfo = {};
235 GetContext().loopIV = {
nullptr};
238 void SetContextDirectiveSource(
const parser::CharBlock &directive) {
239 GetContext().directiveSource = directive;
242 void SetContextDirectiveEnum(D dir) { GetContext().directive = dir; }
244 void SetContextAllowed(
const common::EnumSet<C, ClauseEnumSize> &allowed) {
245 GetContext().allowedClauses = allowed;
248 void SetContextAllowedOnce(
249 const common::EnumSet<C, ClauseEnumSize> &allowedOnce) {
250 GetContext().allowedOnceClauses = allowedOnce;
253 void SetContextAllowedExclusive(
254 const common::EnumSet<C, ClauseEnumSize> &allowedExclusive) {
255 GetContext().allowedExclusiveClauses = allowedExclusive;
258 void SetContextRequired(
const common::EnumSet<C, ClauseEnumSize> &required) {
259 GetContext().requiredClauses = required;
262 void SetContextClauseInfo(C type) {
263 GetContext().clauseInfo.emplace(type, GetContext().clause);
266 void AddClauseToCrtContext(C type) {
267 GetContext().actualClauses.push_back(type);
270 void AddClauseToCrtGroupInContext(C type) {
271 GetContext().crtGroup.push_back(type);
274 void ResetCrtGroup() { GetContext().crtGroup.clear(); }
277 const PC *FindClause(C type) {
return FindClause(GetContext(), type); }
280 const PC *FindClause(DirectiveContext &context, C type) {
281 auto it{context.clauseInfo.find(type)};
282 if (it != context.clauseInfo.end()) {
289 const PC *FindClauseParent(C type) {
290 auto it{GetContextParent().clauseInfo.find(type)};
291 if (it != GetContextParent().clauseInfo.end()) {
297 llvm::iterator_range<typename ClauseMapTy::iterator> FindClauses(C type) {
298 auto it{GetContext().clauseInfo.equal_range(type)};
299 return llvm::make_range(it);
302 DirectiveContext *GetEnclosingDirContext() {
303 CHECK(!dirContext_.empty());
304 auto it{dirContext_.rbegin()};
305 if (++it != dirContext_.rend()) {
311 void PushContext(
const parser::CharBlock &source, D dir) {
312 dirContext_.emplace_back(source, dir);
315 DirectiveContext *GetEnclosingContextWithDir(D dir) {
316 CHECK(!dirContext_.empty());
317 auto it{dirContext_.rbegin()};
318 while (++it != dirContext_.rend()) {
319 if (it->directive == dir) {
326 bool CurrentDirectiveIsNested() {
return dirContext_.size() > 1; };
328 void SetClauseSets(D dir) {
329 dirContext_.back().allowedClauses = directiveClausesMap_[dir].allowed;
330 dirContext_.back().allowedOnceClauses =
331 directiveClausesMap_[dir].allowedOnce;
332 dirContext_.back().allowedExclusiveClauses =
333 directiveClausesMap_[dir].allowedExclusive;
334 dirContext_.back().requiredClauses =
335 directiveClausesMap_[dir].requiredOneOf;
337 void PushContextAndClauseSets(
const parser::CharBlock &source, D dir) {
338 PushContext(source, dir);
342 void SayNotMatching(
const parser::CharBlock &,
const parser::CharBlock &);
344 template <
typename B>
void CheckMatching(
const B &beginDir,
const B &endDir) {
345 const auto &begin{beginDir.v};
346 const auto &end{endDir.v};
348 SayNotMatching(beginDir.source, endDir.source);
353 void CheckNoBranching(
const parser::Block &block, D directive,
354 const parser::CharBlock &directiveSource);
357 void CheckOnlyAllowedAfter(C clause, common::EnumSet<C, ClauseEnumSize> set);
359 void CheckRequireAtLeastOneOf(
bool warnInsteadOfError =
false);
363 bool CheckAllowed(C clause,
bool warnInsteadOfError =
false);
367 void CheckAllowedOncePerGroup(C clause, C separator);
369 void CheckMutuallyExclusivePerGroup(
370 C clause, C separator, common::EnumSet<C, ClauseEnumSize> set);
372 void CheckAtLeastOneClause();
374 void CheckNotAllowedIfClause(
375 C clause, common::EnumSet<C, ClauseEnumSize> set);
377 std::string ContextDirectiveAsFortran();
379 void RequiresConstantPositiveParameter(
380 const C &clause,
const parser::ScalarIntConstantExpr &i);
382 void RequiresPositiveParameter(
const C &clause,
383 const parser::ScalarIntExpr &i, llvm::StringRef paramName =
"parameter");
385 void OptionalConstantPositiveParameter(
386 const C &clause,
const std::optional<parser::ScalarIntConstantExpr> &o);
388 virtual llvm::StringRef getClauseName(C clause) {
return ""; };
390 virtual llvm::StringRef getDirectiveName(D directive) {
return ""; };
392 SemanticsContext &context_;
393 std::vector<DirectiveContext> dirContext_;
394 std::unordered_map<D, DirectiveClauses<C, ClauseEnumSize>>
395 directiveClausesMap_;
397 std::string ClauseSetToString(
const common::EnumSet<C, ClauseEnumSize> set);
400template <
typename D,
typename C,
typename PC, std::
size_t ClauseEnumSize>
401void DirectiveStructureChecker<D, C, PC, ClauseEnumSize>::CheckNoBranching(
402 const parser::Block &block, D directive,
403 const parser::CharBlock &directiveSource) {
404 NoBranchingEnforce<D> noBranchingEnforce{
405 context_, directiveSource, directive, ContextDirectiveAsFortran()};
406 parser::Walk(block, noBranchingEnforce);
411template <
typename D,
typename C,
typename PC, std::
size_t ClauseEnumSize>
412void DirectiveStructureChecker<D, C, PC, ClauseEnumSize>::CheckOnlyAllowedAfter(
413 C clause, common::EnumSet<C, ClauseEnumSize> set) {
414 bool enforceCheck =
false;
415 for (
auto cl : GetContext().actualClauses) {
419 }
else if (enforceCheck && !set.test(cl)) {
420 auto parserClause = GetContext().clauseInfo.find(cl);
421 context_.Say(parserClause->second->source,
422 "Clause %s is not allowed after clause %s on the %s "
423 "directive"_err_en_US,
424 parser::ToUpperCaseLetters(getClauseName(cl).str()),
425 parser::ToUpperCaseLetters(getClauseName(clause).str()),
426 ContextDirectiveAsFortran());
432template <
typename D,
typename C,
typename PC, std::
size_t ClauseEnumSize>
433void DirectiveStructureChecker<D, C, PC,
434 ClauseEnumSize>::CheckAtLeastOneClause() {
435 if (GetContext().actualClauses.empty()) {
436 context_.Say(GetContext().directiveSource,
437 "At least one clause is required on the %s directive"_err_en_US,
438 ContextDirectiveAsFortran());
442template <
typename D,
typename C,
typename PC, std::
size_t ClauseEnumSize>
444DirectiveStructureChecker<D, C, PC, ClauseEnumSize>::ClauseSetToString(
445 const common::EnumSet<C, ClauseEnumSize> set) {
447 set.IterateOverMembers([&](C o) {
450 list.append(parser::ToUpperCaseLetters(getClauseName(o).str()));
457template <
typename D,
typename C,
typename PC, std::
size_t ClauseEnumSize>
458void DirectiveStructureChecker<D, C, PC,
459 ClauseEnumSize>::CheckRequireAtLeastOneOf(
bool warnInsteadOfError) {
460 if (GetContext().requiredClauses.empty()) {
463 for (
auto cl : GetContext().actualClauses) {
464 if (GetContext().requiredClauses.test(cl)) {
469 if (warnInsteadOfError) {
470 context_.Warn(common::UsageWarning::Portability,
471 GetContext().directiveSource,
472 "At least one of %s clause should appear on the %s directive"_port_en_US,
473 ClauseSetToString(GetContext().requiredClauses),
474 ContextDirectiveAsFortran());
476 context_.Say(GetContext().directiveSource,
477 "At least one of %s clause must appear on the %s directive"_err_en_US,
478 ClauseSetToString(GetContext().requiredClauses),
479 ContextDirectiveAsFortran());
483template <
typename D,
typename C,
typename PC, std::
size_t ClauseEnumSize>
484std::string DirectiveStructureChecker<D, C, PC,
485 ClauseEnumSize>::ContextDirectiveAsFortran() {
486 return parser::ToUpperCaseLetters(
487 getDirectiveName(GetContext().directive).str());
491template <
typename D,
typename C,
typename PC, std::
size_t ClauseEnumSize>
492bool DirectiveStructureChecker<D, C, PC, ClauseEnumSize>::CheckAllowed(
493 C clause,
bool warnInsteadOfError) {
494 if (!GetContext().allowedClauses.test(clause) &&
495 !GetContext().allowedOnceClauses.test(clause) &&
496 !GetContext().allowedExclusiveClauses.test(clause) &&
497 !GetContext().requiredClauses.test(clause)) {
498 if (warnInsteadOfError) {
499 context_.Warn(common::UsageWarning::Portability,
500 GetContext().clauseSource,
501 "%s clause is not allowed on the %s directive and will be ignored"_port_en_US,
502 parser::ToUpperCaseLetters(getClauseName(clause).str()),
503 parser::ToUpperCaseLetters(GetContext().directiveSource.ToString()));
505 context_.Say(GetContext().clauseSource,
506 "%s clause is not allowed on the %s directive"_err_en_US,
507 parser::ToUpperCaseLetters(getClauseName(clause).str()),
508 parser::ToUpperCaseLetters(GetContext().directiveSource.ToString()));
512 if ((GetContext().allowedOnceClauses.test(clause) ||
513 GetContext().allowedExclusiveClauses.test(clause)) &&
514 FindClause(clause)) {
515 context_.Say(GetContext().clauseSource,
516 "At most one %s clause can appear on the %s directive"_err_en_US,
517 parser::ToUpperCaseLetters(getClauseName(clause).str()),
518 parser::ToUpperCaseLetters(GetContext().directiveSource.ToString()));
521 if (GetContext().allowedExclusiveClauses.test(clause)) {
522 std::vector<C> others;
523 GetContext().allowedExclusiveClauses.IterateOverMembers([&](C o) {
525 others.emplace_back(o);
528 for (
const auto &e : others) {
529 context_.Say(GetContext().clauseSource,
530 "%s and %s clauses are mutually exclusive and may not appear on the "
531 "same %s directive"_err_en_US,
532 parser::ToUpperCaseLetters(getClauseName(clause).str()),
533 parser::ToUpperCaseLetters(getClauseName(e).str()),
534 parser::ToUpperCaseLetters(GetContext().directiveSource.ToString()));
536 if (!others.empty()) {
540 SetContextClauseInfo(clause);
541 AddClauseToCrtContext(clause);
542 AddClauseToCrtGroupInContext(clause);
548template <
typename D,
typename C,
typename PC, std::
size_t ClauseEnumSize>
549void DirectiveStructureChecker<D, C, PC,
550 ClauseEnumSize>::CheckNotAllowedIfClause(C clause,
551 common::EnumSet<C, ClauseEnumSize> set) {
552 if (!llvm::is_contained(GetContext().actualClauses, clause)) {
556 for (
auto cl : GetContext().actualClauses) {
558 context_.Say(GetContext().directiveSource,
559 "Clause %s is not allowed if clause %s appears on the %s directive"_err_en_US,
560 parser::ToUpperCaseLetters(getClauseName(cl).str()),
561 parser::ToUpperCaseLetters(getClauseName(clause).str()),
562 ContextDirectiveAsFortran());
567template <
typename D,
typename C,
typename PC, std::
size_t ClauseEnumSize>
568void DirectiveStructureChecker<D, C, PC,
569 ClauseEnumSize>::CheckAllowedOncePerGroup(C clause, C separator) {
570 bool clauseIsPresent =
false;
571 for (
auto cl : GetContext().actualClauses) {
573 if (clauseIsPresent) {
574 context_.Say(GetContext().clauseSource,
575 "At most one %s clause can appear on the %s directive or in group separated by the %s clause"_err_en_US,
576 parser::ToUpperCaseLetters(getClauseName(clause).str()),
577 parser::ToUpperCaseLetters(GetContext().directiveSource.ToString()),
578 parser::ToUpperCaseLetters(getClauseName(separator).str()));
580 clauseIsPresent =
true;
584 clauseIsPresent =
false;
588template <
typename D,
typename C,
typename PC, std::
size_t ClauseEnumSize>
589void DirectiveStructureChecker<D, C, PC,
590 ClauseEnumSize>::CheckMutuallyExclusivePerGroup(C clause, C separator,
591 common::EnumSet<C, ClauseEnumSize> set) {
594 for (
auto cl : GetContext().actualClauses) {
595 if (cl == separator) {
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(clause).str()),
602 parser::ToUpperCaseLetters(getClauseName(cl).str()),
603 ContextDirectiveAsFortran());
608 for (
auto cl : GetContext().crtGroup) {
610 context_.Say(GetContext().directiveSource,
611 "Clause %s is not allowed if clause %s appears on the %s directive"_err_en_US,
612 parser::ToUpperCaseLetters(getClauseName(clause).str()),
613 parser::ToUpperCaseLetters(getClauseName(cl).str()),
614 ContextDirectiveAsFortran());
620template <
typename D,
typename C,
typename PC, std::
size_t ClauseEnumSize>
621void DirectiveStructureChecker<D, C, PC,
622 ClauseEnumSize>::RequiresConstantPositiveParameter(
const C &clause,
623 const parser::ScalarIntConstantExpr &i) {
624 if (
const auto v{GetIntValue(i)}) {
626 context_.Say(GetContext().clauseSource,
627 "The parameter of the %s clause must be "
628 "a constant positive integer expression"_err_en_US,
629 parser::ToUpperCaseLetters(getClauseName(clause).str()));
635template <
typename D,
typename C,
typename PC, std::
size_t ClauseEnumSize>
636void DirectiveStructureChecker<D, C, PC,
637 ClauseEnumSize>::OptionalConstantPositiveParameter(
const C &clause,
638 const std::optional<parser::ScalarIntConstantExpr> &o) {
639 if (o != std::nullopt) {
640 RequiresConstantPositiveParameter(clause, o.value());
644template <
typename D,
typename C,
typename PC, std::
size_t ClauseEnumSize>
645void DirectiveStructureChecker<D, C, PC, ClauseEnumSize>::SayNotMatching(
646 const parser::CharBlock &beginSource,
const parser::CharBlock &endSource) {
648 .Say(endSource,
"Unmatched %s directive"_err_en_US,
649 parser::ToUpperCaseLetters(endSource.ToString()))
650 .Attach(beginSource,
"Does not match directive"_en_US);
654template <
typename D,
typename C,
typename PC, std::
size_t ClauseEnumSize>
655void DirectiveStructureChecker<D, C, PC,
656 ClauseEnumSize>::RequiresPositiveParameter(
const C &clause,
657 const parser::ScalarIntExpr &i, llvm::StringRef paramName) {
658 if (
const auto v{GetIntValue(i)}) {
660 context_.Say(GetContext().clauseSource,
661 "The %s of the %s clause must be "
662 "a positive integer expression"_err_en_US,
664 parser::ToUpperCaseLetters(getClauseName(clause).str()));
Definition: enum-set.h:28
Definition: char-block.h:28
Definition: message.h:104
Definition: check-directive-structure.h:181
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:367
Definition: check-directive-structure.h:24
Definition: check-directive-structure.h:190