Index: flang/lib/Semantics/check-acc-structure.h =================================================================== --- flang/lib/Semantics/check-acc-structure.h +++ flang/lib/Semantics/check-acc-structure.h @@ -107,10 +107,6 @@ private: - void CheckNoBranching(const parser::Block &block, - const llvm::acc::Directive directive, - const parser::CharBlock &directiveSource) const; - llvm::StringRef getClauseName(llvm::acc::Clause clause) override; llvm::StringRef getDirectiveName(llvm::acc::Directive directive) override; }; Index: flang/lib/Semantics/check-acc-structure.cpp =================================================================== --- flang/lib/Semantics/check-acc-structure.cpp +++ flang/lib/Semantics/check-acc-structure.cpp @@ -44,83 +44,6 @@ llvm::acc::Clause::ACCC_bind, llvm::acc::Clause::ACCC_gang, llvm::acc::Clause::ACCC_vector, llvm::acc::Clause::ACCC_worker}; -class NoBranchingEnforce { -public: - NoBranchingEnforce(SemanticsContext &context, - parser::CharBlock sourcePosition, llvm::acc::Directive directive) - : context_{context}, sourcePosition_{sourcePosition}, currentDirective_{ - directive} {} - template bool Pre(const T &) { return true; } - template void Post(const T &) {} - - template bool Pre(const parser::Statement &statement) { - currentStatementSourcePosition_ = statement.source; - return true; - } - - void Post(const parser::ReturnStmt &) { EmitBranchOutError("RETURN"); } - void Post(const parser::ExitStmt &exitStmt) { - if (const auto &exitName{exitStmt.v}) { - CheckConstructNameBranching("EXIT", exitName.value()); - } - } - void Post(const parser::StopStmt &) { EmitBranchOutError("STOP"); } - -private: - parser::MessageFormattedText GetEnclosingMsg() const { - return {"Enclosing %s construct"_en_US, - parser::ToUpperCaseLetters( - llvm::acc::getOpenACCDirectiveName(currentDirective_).str())}; - } - - void EmitBranchOutError(const char *stmt) const { - context_ - .Say(currentStatementSourcePosition_, - "%s statement is not allowed in a %s construct"_err_en_US, stmt, - parser::ToUpperCaseLetters( - llvm::acc::getOpenACCDirectiveName(currentDirective_).str())) - .Attach(sourcePosition_, GetEnclosingMsg()); - } - - void EmitBranchOutErrorWithName( - const char *stmt, const parser::Name &toName) const { - const std::string branchingToName{toName.ToString()}; - const auto upperCaseConstructName{parser::ToUpperCaseLetters( - llvm::acc::getOpenACCDirectiveName(currentDirective_).str())}; - context_ - .Say(currentStatementSourcePosition_, - "%s to construct '%s' outside of %s construct is not allowed"_err_en_US, - stmt, branchingToName, upperCaseConstructName) - .Attach(sourcePosition_, GetEnclosingMsg()); - } - - // Current semantic checker is not following OpenACC constructs as they are - // not Fortran constructs. Hence the ConstructStack doesn't capture OpenACC - // constructs. Apply an inverse way to figure out if a construct-name is - // branching out of an OpenACC construct. The control flow goes out of an - // OpenACC construct, if a construct-name from statement is found in - // ConstructStack. - void CheckConstructNameBranching( - const char *stmt, const parser::Name &stmtName) { - const ConstructStack &stack{context_.constructStack()}; - for (auto iter{stack.cend()}; iter-- != stack.cbegin();) { - const ConstructNode &construct{*iter}; - const auto &constructName{MaybeGetNodeName(construct)}; - if (constructName) { - if (stmtName.source == constructName->source) { - EmitBranchOutErrorWithName(stmt, stmtName); - return; - } - } - } - } - - SemanticsContext &context_; - parser::CharBlock currentStatementSourcePosition_; - parser::CharBlock sourcePosition_; - llvm::acc::Directive currentDirective_; -}; - void AccStructureChecker::Enter(const parser::AccClause &x) { SetContextClause(x); } @@ -150,14 +73,16 @@ parallelAndKernelsOnlyAllowedAfterDeviceTypeClauses); // Restriction - 877 (KERNELS) // Restriction - 840 (PARALLEL) - CheckNoBranching(block, GetContext().directive, blockDir.source); + DirectiveStructureChecker::CheckNoBranching( + block, GetContext().directive, blockDir.source); break; case llvm::acc::Directive::ACCD_serial: // Restriction - 919 CheckOnlyAllowedAfter(llvm::acc::Clause::ACCC_device_type, serialOnlyAllowedAfterDeviceTypeClauses); // Restriction - 916 - CheckNoBranching(block, llvm::acc::Directive::ACCD_serial, blockDir.source); + DirectiveStructureChecker::CheckNoBranching( + block, llvm::acc::Directive::ACCD_serial, blockDir.source); break; case llvm::acc::Directive::ACCD_data: // Restriction - 1117-1118 @@ -173,13 +98,6 @@ dirContext_.pop_back(); } -void AccStructureChecker::CheckNoBranching(const parser::Block &block, - const llvm::acc::Directive directive, - const parser::CharBlock &directiveSource) const { - NoBranchingEnforce noBranchingEnforce{context_, directiveSource, directive}; - parser::Walk(block, noBranchingEnforce); -} - void AccStructureChecker::Enter( const parser::OpenACCStandaloneDeclarativeConstruct &x) { const auto &declarativeDir{std::get(x.t)}; Index: flang/lib/Semantics/check-directive-structure.h =================================================================== --- flang/lib/Semantics/check-directive-structure.h +++ flang/lib/Semantics/check-directive-structure.h @@ -26,6 +26,83 @@ const common::EnumSet allowedExclusive; const common::EnumSet requiredOneOf; }; +// Generic branching checker for invalid branching out of OpenMP/OpenACC +// directive. +// typename D is the directive enumeration. +template class NoBranchingEnforce { +public: + NoBranchingEnforce(SemanticsContext &context, + parser::CharBlock sourcePosition, D directive, + std::string &&upperCaseDirName) + : context_{context}, sourcePosition_{sourcePosition}, + currentDirective_{directive}, upperCaseDirName_{ + std::move(upperCaseDirName)} {} + template bool Pre(const T &) { return true; } + template void Post(const T &) {} + + template bool Pre(const parser::Statement &statement) { + currentStatementSourcePosition_ = statement.source; + return true; + } + + void Post(const parser::ReturnStmt &) { EmitBranchOutError("RETURN"); } + void Post(const parser::ExitStmt &exitStmt) { + if (const auto &exitName{exitStmt.v}) { + CheckConstructNameBranching("EXIT", exitName.value()); + } + } + void Post(const parser::StopStmt &) { EmitBranchOutError("STOP"); } + +private: + parser::MessageFormattedText GetEnclosingMsg() const { + return {"Enclosing %s construct"_en_US, upperCaseDirName_}; + } + + void EmitBranchOutError(const char *stmt) const { + context_ + .Say(currentStatementSourcePosition_, + "%s statement is not allowed in a %s construct"_err_en_US, stmt, + upperCaseDirName_) + .Attach(sourcePosition_, GetEnclosingMsg()); + } + + void EmitBranchOutErrorWithName( + const char *stmt, const parser::Name &toName) const { + const std::string branchingToName{toName.ToString()}; + context_ + .Say(currentStatementSourcePosition_, + "%s to construct '%s' outside of %s construct is not allowed"_err_en_US, + stmt, branchingToName, upperCaseDirName_) + .Attach(sourcePosition_, GetEnclosingMsg()); + } + + // Current semantic checker is not following OpenACC/OpenMP constructs as they + // are not Fortran constructs. Hence the ConstructStack doesn't capture + // OpenACC/OpenMP constructs. Apply an inverse way to figure out if a + // construct-name is branching out of an OpenACC/OpenMP construct. The control + // flow goes out of an OpenACC/OpenMP construct, if a construct-name from + // statement is found in ConstructStack. + void CheckConstructNameBranching( + const char *stmt, const parser::Name &stmtName) { + const ConstructStack &stack{context_.constructStack()}; + for (auto iter{stack.cend()}; iter-- != stack.cbegin();) { + const ConstructNode &construct{*iter}; + const auto &constructName{MaybeGetNodeName(construct)}; + if (constructName) { + if (stmtName.source == constructName->source) { + EmitBranchOutErrorWithName(stmt, stmtName); + return; + } + } + } + } + + SemanticsContext &context_; + parser::CharBlock currentStatementSourcePosition_; + parser::CharBlock sourcePosition_; + std::string upperCaseDirName_; + D currentDirective_; +}; // Generic structure checker for directives/clauses language such as OpenMP // and OpenACC. @@ -148,6 +225,8 @@ SayNotMatching(beginDir.source, endDir.source); } } + void CheckNoBranching(const parser::Block &block, D directive, + const parser::CharBlock &directiveSource); // Check that only clauses in set are after the specific clauses. void CheckOnlyAllowedAfter(C clause, common::EnumSet set); @@ -186,6 +265,15 @@ std::string ClauseSetToString(const common::EnumSet set); }; +template +void DirectiveStructureChecker::CheckNoBranching( + const parser::Block &block, D directive, + const parser::CharBlock &directiveSource) { + NoBranchingEnforce noBranchingEnforce{ + context_, directiveSource, directive, ContextDirectiveAsFortran()}; + parser::Walk(block, noBranchingEnforce); +} + // Check that only clauses included in the given set are present after the given // clause. template Index: flang/lib/Semantics/check-omp-structure.cpp =================================================================== --- flang/lib/Semantics/check-omp-structure.cpp +++ flang/lib/Semantics/check-omp-structure.cpp @@ -95,9 +95,19 @@ const auto &endBlockDir{std::get(x.t)}; const auto &beginDir{std::get(beginBlockDir.t)}; const auto &endDir{std::get(endBlockDir.t)}; + const parser::Block &block{std::get(x.t)}; + CheckMatching(beginDir, endDir); PushContextAndClauseSets(beginDir.source, beginDir.v); + + switch (beginDir.v) { + case llvm::omp::OMPD_parallel: + DirectiveStructureChecker::CheckNoBranching( + block, llvm::omp::OMPD_parallel, beginDir.source); + default: + break; + } } void OmpStructureChecker::Leave(const parser::OpenMPBlockConstruct &) { Index: flang/test/Semantics/omp-clause-validity01.f90 =================================================================== --- flang/test/Semantics/omp-clause-validity01.f90 +++ flang/test/Semantics/omp-clause-validity01.f90 @@ -163,6 +163,22 @@ !ERROR: Unmatched END TARGET directive !$omp end target + ! OMP 5.0 - 2.6 Restriction point 1 + outofparallel: do k =1, 10 + !$omp parallel + !$omp do + outer: do i=0, 10 + inner: do j=1, 10 + exit + exit outer + !ERROR: EXIT to construct 'outofparallel' outside of PARALLEL construct is not allowed + exit outofparallel + end do inner + end do outer + !$end omp do + !$omp end parallel + end do outofparallel + ! 2.7.1 do-clause -> private-clause | ! firstprivate-clause | ! lastprivate-clause |