diff --git a/flang/lib/Semantics/check-directive-structure.h b/flang/lib/Semantics/check-directive-structure.h --- a/flang/lib/Semantics/check-directive-structure.h +++ b/flang/lib/Semantics/check-directive-structure.h @@ -30,31 +30,62 @@ // directive. // typename D is the directive enumeration. template class NoBranchingEnforce { +private: + // tracks the number of constructs added to the ConstructStack AFTER + // encoutering an OpenMP/OpenACC directive + uint16_t numPrivateConstructs; + public: NoBranchingEnforce(SemanticsContext &context, - parser::CharBlock sourcePosition, D directive, - std::string &&upperCaseDirName) - : context_{context}, sourcePosition_{sourcePosition}, + parser::CharBlock sourcePosition, D directive, + std::string &&upperCaseDirName) + : numPrivateConstructs{0}, context_{context}, + sourcePosition_{sourcePosition}, upperCaseDirName_{std::move(upperCaseDirName)}, currentDirective_{ directive} {} - template bool Pre(const T &) { return true; } - template void Post(const T &) {} + template bool Pre(const T &node) { + if constexpr (common::HasMember) { + numPrivateConstructs++; + context_.PushConstruct(node); + } + return true; + } + template void Post(const T &) { + if constexpr (common::HasMember) { + numPrivateConstructs--; + context_.PopConstruct(); + } + } template bool Pre(const parser::Statement &statement) { currentStatementSourcePosition_ = statement.source; return true; } - + void Post(const parser::CallStmt &) { EmitBranchOutError("CALL"); } void Post(const parser::ReturnStmt &) { EmitBranchOutError("RETURN"); } void Post(const parser::ExitStmt &exitStmt) { if (const auto &exitName{exitStmt.v}) { + // Control flow enters here when `EXIT [ construct-name ]` is used to + // exit CheckConstructNameBranching("EXIT", exitName.value()); + } else { + // Control flow enters here when `EXIT` (without any loop label) is used + // to exit Prohibit use of unlabelled EXITs within OpenMP constructs + // through a detailed note + CheckConstructNameBranching("EXIT"); } } void Post(const parser::StopStmt &) { EmitBranchOutError("STOP"); } void Post(const parser::CycleStmt &cycleStmt) { if (const auto &cycleName{cycleStmt.v}) { + // Control flow enters here when 'CYCLE [ do-construct-name ]' is used to + // cycle CheckConstructNameBranching("CYCLE", cycleName.value()); + } else { + // Control flow enters here when `CYCLE` (without any loop label) is used + // to cycle Prohibit use of unlabelled CYCLEs within OpenMP constructs + // through a detailed note + CheckConstructNameBranching("CYCLE"); } } @@ -66,16 +97,26 @@ void EmitBranchOutError(const char *stmt) const { context_ .Say(currentStatementSourcePosition_, - "%s statement is not allowed in a %s construct"_err_en_US, stmt, - upperCaseDirName_) + "%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 { + void EmitUnlabelledBranchOutError(const char *stmt) { + context_ + .Say( + currentStatementSourcePosition_, + "invalid branch: unlabelled %s statement leaving %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_, + .Say( + currentStatementSourcePosition_, "%s to construct '%s' outside of %s construct is not allowed"_err_en_US, stmt, branchingToName, upperCaseDirName_) .Attach(sourcePosition_, GetEnclosingMsg()); @@ -87,13 +128,14 @@ // 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) { + void CheckConstructNameBranching(const char *stmt, + const parser::Name &stmtName) { const ConstructStack &stack{context_.constructStack()}; + int16_t counter = numPrivateConstructs; for (auto iter{stack.cend()}; iter-- != stack.cbegin();) { const ConstructNode &construct{*iter}; const auto &constructName{MaybeGetNodeName(construct)}; - if (constructName) { + if (counter-- < 1 && constructName) { if (stmtName.source == constructName->source) { EmitBranchOutErrorWithName(stmt, stmtName); return; @@ -102,6 +144,31 @@ } } + bool CheckForRequiredConstruct(const ConstructNode &construct) const { + return std::visit(common::visitors{ + [&](const parser::DoConstruct *) { return true; }, + [](const auto *) { return false; }, + }, + construct); + } + // Check branching for unlabelled CYCLES and EXITs + void CheckConstructNameBranching(const char *stmt) { + // Check for associated ConstructNode within the OpenMP/OpenACC directive + const ConstructStack &stack{context_.constructStack()}; + int16_t counter = numPrivateConstructs; + for (auto iter{stack.cend()}; iter-- != stack.cbegin();) { + const ConstructNode &construct{*iter}; + // found an enclosing looping construct for the unlabelled EXIT/CYCLE + if (counter-- > 0 && CheckForRequiredConstruct(construct)) { + return; + } + } + // did not found an enclosing looping construct within the OpenMP/OpenACC + // directive + EmitUnlabelledBranchOutError(stmt); + return; + } + SemanticsContext &context_; parser::CharBlock currentStatementSourcePosition_; parser::CharBlock sourcePosition_; @@ -117,7 +184,8 @@ template class DirectiveStructureChecker : public virtual BaseChecker { protected: - DirectiveStructureChecker(SemanticsContext &context, + DirectiveStructureChecker( + SemanticsContext &context, std::unordered_map> directiveClausesMap) : context_{context}, directiveClausesMap_(directiveClausesMap) {} @@ -181,8 +249,8 @@ GetContext().allowedClauses = allowed; } - void SetContextAllowedOnce( - const common::EnumSet &allowedOnce) { + void + SetContextAllowedOnce(const common::EnumSet &allowedOnce) { GetContext().allowedOnceClauses = allowedOnce; } @@ -279,7 +347,7 @@ // Check illegal branching out of `Parser::Block` for `Parser::Name` based // nodes (example `Parser::ExitStmt`) void CheckNoBranching(const parser::Block &block, D directive, - const parser::CharBlock &directiveSource); + const parser::CharBlock &directiveSource); // Check that only clauses in set are after the specific clauses. void CheckOnlyAllowedAfter(C clause, common::EnumSet set); @@ -290,16 +358,18 @@ void CheckAtLeastOneClause(); - void CheckNotAllowedIfClause( - C clause, common::EnumSet set); + void CheckNotAllowedIfClause(C clause, + common::EnumSet set); std::string ContextDirectiveAsFortran(); - void RequiresConstantPositiveParameter( - const C &clause, const parser::ScalarIntConstantExpr &i); + void + RequiresConstantPositiveParameter(const C &clause, + const parser::ScalarIntConstantExpr &i); void RequiresPositiveParameter(const C &clause, - const parser::ScalarIntExpr &i, llvm::StringRef paramName = "parameter"); + const parser::ScalarIntExpr &i, + llvm::StringRef paramName = "parameter"); void OptionalConstantPositiveParameter( const C &clause, const std::optional &o); @@ -320,8 +390,8 @@ void DirectiveStructureChecker::CheckNoBranching( const parser::Block &block, D directive, const parser::CharBlock &directiveSource) { - NoBranchingEnforce noBranchingEnforce{ - context_, directiveSource, directive, ContextDirectiveAsFortran()}; + NoBranchingEnforce noBranchingEnforce{context_, directiveSource, directive, + ContextDirectiveAsFortran()}; parser::Walk(block, noBranchingEnforce); } @@ -338,11 +408,11 @@ } else if (enforceCheck && !set.test(cl)) { auto parserClause = GetContext().clauseInfo.find(cl); context_.Say(parserClause->second->source, - "Clause %s is not allowed after clause %s on the %s " - "directive"_err_en_US, - parser::ToUpperCaseLetters(getClauseName(cl).str()), - parser::ToUpperCaseLetters(getClauseName(clause).str()), - ContextDirectiveAsFortran()); + "Clause %s is not allowed after clause %s on the %s " + "directive"_err_en_US, + parser::ToUpperCaseLetters(getClauseName(cl).str()), + parser::ToUpperCaseLetters(getClauseName(clause).str()), + ContextDirectiveAsFortran()); } } } @@ -350,9 +420,10 @@ // Check that at least one clause is attached to the directive. template void DirectiveStructureChecker::CheckAtLeastOneClause() { + ClauseEnumSize>::CheckAtLeastOneClause() { if (GetContext().actualClauses.empty()) { - context_.Say(GetContext().directiveSource, + context_.Say( + GetContext().directiveSource, "At least one clause is required on the %s directive"_err_en_US, ContextDirectiveAsFortran()); } @@ -375,7 +446,7 @@ // directive. template void DirectiveStructureChecker::CheckRequireAtLeastOneOf() { + ClauseEnumSize>::CheckRequireAtLeastOneOf() { if (GetContext().requiredClauses.empty()) return; for (auto cl : GetContext().actualClauses) { @@ -383,15 +454,17 @@ return; } // No clause matched in the actual clauses list - context_.Say(GetContext().directiveSource, + context_.Say( + GetContext().directiveSource, "At least one of %s clause must appear on the %s directive"_err_en_US, ClauseSetToString(GetContext().requiredClauses), ContextDirectiveAsFortran()); } template -std::string DirectiveStructureChecker::ContextDirectiveAsFortran() { +std::string +DirectiveStructureChecker::ContextDirectiveAsFortran() { return parser::ToUpperCaseLetters( getDirectiveName(GetContext().directive).str()); } @@ -404,16 +477,18 @@ !GetContext().allowedOnceClauses.test(clause) && !GetContext().allowedExclusiveClauses.test(clause) && !GetContext().requiredClauses.test(clause)) { - context_.Say(GetContext().clauseSource, + context_.Say( + GetContext().clauseSource, "%s clause is not allowed on the %s directive"_err_en_US, parser::ToUpperCaseLetters(getClauseName(clause).str()), parser::ToUpperCaseLetters(GetContext().directiveSource.ToString())); return; } if ((GetContext().allowedOnceClauses.test(clause) || - GetContext().allowedExclusiveClauses.test(clause)) && + GetContext().allowedExclusiveClauses.test(clause)) && FindClause(clause)) { - context_.Say(GetContext().clauseSource, + context_.Say( + GetContext().clauseSource, "At most one %s clause can appear on the %s directive"_err_en_US, parser::ToUpperCaseLetters(getClauseName(clause).str()), parser::ToUpperCaseLetters(GetContext().directiveSource.ToString())); @@ -427,7 +502,8 @@ } }); for (const auto &e : others) { - context_.Say(GetContext().clauseSource, + context_.Say( + GetContext().clauseSource, "%s and %s clauses are mutually exclusive and may not appear on the " "same %s directive"_err_en_US, parser::ToUpperCaseLetters(getClauseName(clause).str()), @@ -445,18 +521,18 @@ // Enforce restriction where clauses in the given set are not allowed if the // given clause appears. template -void DirectiveStructureChecker::CheckNotAllowedIfClause(C clause, - common::EnumSet set) { +void DirectiveStructureChecker:: + CheckNotAllowedIfClause(C clause, common::EnumSet set) { if (std::find(GetContext().actualClauses.begin(), - GetContext().actualClauses.end(), - clause) == GetContext().actualClauses.end()) { + GetContext().actualClauses.end(), + clause) == GetContext().actualClauses.end()) { return; // Clause is not present } for (auto cl : GetContext().actualClauses) { if (set.test(cl)) { - context_.Say(GetContext().directiveSource, + context_.Say( + GetContext().directiveSource, "Clause %s is not allowed if clause %s appears on the %s directive"_err_en_US, parser::ToUpperCaseLetters(getClauseName(cl).str()), parser::ToUpperCaseLetters(getClauseName(clause).str()), @@ -467,24 +543,25 @@ // Check the value of the clause is a constant positive integer. template -void DirectiveStructureChecker::RequiresConstantPositiveParameter(const C &clause, - const parser::ScalarIntConstantExpr &i) { +void DirectiveStructureChecker:: + RequiresConstantPositiveParameter(const C &clause, + const parser::ScalarIntConstantExpr &i) { if (const auto v{GetIntValue(i)}) { if (*v <= 0) { context_.Say(GetContext().clauseSource, - "The parameter of the %s clause must be " - "a constant positive integer expression"_err_en_US, - parser::ToUpperCaseLetters(getClauseName(clause).str())); + "The parameter of the %s clause must be " + "a constant positive integer expression"_err_en_US, + parser::ToUpperCaseLetters(getClauseName(clause).str())); } } } // Check the value of the clause is a constant positive parameter. template -void DirectiveStructureChecker::OptionalConstantPositiveParameter(const C &clause, - const std::optional &o) { +void DirectiveStructureChecker:: + OptionalConstantPositiveParameter( + const C &clause, + const std::optional &o) { if (o != std::nullopt) { RequiresConstantPositiveParameter(clause, o.value()); } @@ -495,22 +572,22 @@ const parser::CharBlock &beginSource, const parser::CharBlock &endSource) { context_ .Say(endSource, "Unmatched %s directive"_err_en_US, - parser::ToUpperCaseLetters(endSource.ToString())) + parser::ToUpperCaseLetters(endSource.ToString())) .Attach(beginSource, "Does not match directive"_en_US); } // Check the value of the clause is a positive parameter. template -void DirectiveStructureChecker::RequiresPositiveParameter(const C &clause, - const parser::ScalarIntExpr &i, llvm::StringRef paramName) { +void DirectiveStructureChecker:: + RequiresPositiveParameter(const C &clause, const parser::ScalarIntExpr &i, + llvm::StringRef paramName) { if (const auto v{GetIntValue(i)}) { if (*v <= 0) { context_.Say(GetContext().clauseSource, - "The %s of the %s clause must be " - "a positive integer expression"_err_en_US, - paramName.str(), - parser::ToUpperCaseLetters(getClauseName(clause).str())); + "The %s of the %s clause must be " + "a positive integer expression"_err_en_US, + paramName.str(), + parser::ToUpperCaseLetters(getClauseName(clause).str())); } } } diff --git a/flang/test/Parser/omp-sections01.f90 b/flang/test/Parser/omp-sections01.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Parser/omp-sections01.f90 @@ -0,0 +1,22 @@ +! RUN: not %flang -fsyntax-only -fopenmp %s 2>&1 | FileCheck %s +! REQUIRES: shell + +! OpenMP version 5.0.0 +! 2.8.1 sections construct +! Orphaned section directives are prohibited. That is, the section directives must appear within the sections construct and must not be encountered elsewhere in the sections region + +program OmpOrphanedSections + use omp_lib + integer counter + counter = 0 + !ERROR: error: expected 'END PROGRAM' statement in the context: main program + !$omp section + print*, "An orphaned section containing a single statement" + !$omp section + counter = counter + 1 + print*, "An orphaned section containing multiple statements" +!$omp sections + !$omp section + print*, "Not an orphan structured block" +!$omp end sections +end program OmpOrphanedSections diff --git a/flang/test/Semantics/omp-sections02.f90 b/flang/test/Semantics/omp-sections02.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/omp-sections02.f90 @@ -0,0 +1,139 @@ +! RUN: not %flang -fsyntax-only -fopenmp %s 2>&1 | FileCheck %s +! REQUIRES: shell + +! OpenMP version 5.1.0 +! 2.8.1 sections construct +! The code enclosed in a sections construct must be a structured block. +program OmpConstructSections01 + use omp_lib + integer :: section_count = 0 + integer, parameter :: NT = 4 +print *, 'section_count', section_count +! ERROR: invalid branch into an OpenMP structured block +if(NT) 20, 30, 40 +goto 20 +!$omp sections + !$omp section + !PASS: A single statement as a structured block + print*, "This is a single statement structured block" + !$omp section + !PASS: Jump from one sections construct to within the same sections construct + open(10, file="random-file-name.txt",err=30) + !ERROR: Jump from one sections construct to another sections construct + open(10, file="random-file-name.txt", err=40) + !$omp section + section_count = section_count + 1 + 20 print*, 'Entering into section' + call calledFromWithinSection() + print *, 'section_count', section_count + !$omp section + section_count = section_count + 1 + print *, 'section_count', section_count + !ERROR: invalid branch leaving an OpenMP structured block + goto 10 + !$omp section + 30 print *, "Error in opening file" +!$omp end sections +10 print*, 'Jump from section' + +!$omp sections + !$omp section + 40 print*, 'Error in opening file' +!$omp end sections +end program OmpConstructSections01 + +function returnFromSections () + !$omp sections + !$omp section + ! ERROR: RETURN statement is not allowed in a SECTIONS construct + RETURN + !$omp end sections +end function + +subroutine calledFromWithinSection() + print*, "I am called from within a 'section' structured block" + return +end subroutine calledFromWithinSection + +subroutine continueWithinSections() + integer i + do i = 1, 10 + print*, "Statement within loop but outside section construct" + !$omp sections + !$omp section + IF ( i .EQ. 5 ) THEN + !ERROR: invalid branch: unlabelled CYCLE statement leaving SECTIONS construct + CYCLE + END IF + !$omp end sections + print*, "Statement within loop but outside section contruct" + end do + + !$omp sections + !$omp section + do i = 1, 10 + CYCLE + end do + !$omp end sections + + !$omp sections + !$omp section + loop_1: do i = 1, 10 + IF( i .EQ. 5 ) THEN + !PASS: Branches within the construct itself + CYCLE loop_1 + END IF + end do loop_1 + !$omp end sections + + loop_2: do i = 1, 10 + !$omp sections + !$omp section + IF ( i .EQ. 5 ) THEN + !ERROR: CYCLE to construct 'loop_2' outside of SECTIONS construct is not allowed + CYCLE loop_2 + END IF + !$omp end sections + end do loop_2 +end subroutine continueWithinSections + +subroutine breakWithinSections() + + loop_3: do i = 1, 10 + !$omp sections + !$omp section + !ERROR: EXIT to construct 'loop_3' outside of SECTIONS construct is not allowed + IF (i .EQ. 5) THEN + EXIT loop_3 + END IF + !$omp end sections + end do loop_3 + + loop_4: do i = 1, 10 + !$omp sections + !$omp section + IF (i .EQ. 5) THEN + !ERROR: invalid branch: unlabelled EXIT statement leaving SECTIONS construct + EXIT + END IF + !$omp end sections + end do loop_4 + + !$omp sections + !$omp section + do i = 1, 10 + IF(i .EQ. 5) THEN + EXIT + END IF + end do + !$omp end sections + + !$omp sections + !$omp section + loop_5: do i = 1, 10 + IF(i .EQ. 5) THEN + EXIT loop_5 + END IF + end do loop_5 + !$omp end sections +end subroutine breakWithinSections diff --git a/flang/test/Semantics/omp-simd01.f90 b/flang/test/Semantics/omp-simd01.f90 --- a/flang/test/Semantics/omp-simd01.f90 +++ b/flang/test/Semantics/omp-simd01.f90 @@ -1,7 +1,8 @@ ! RUN: not %flang -fsyntax-only -fopenmp %s 2>&1 | FileCheck %s -! OpenMP Version 4.5 -! 2.8.1 simd Construct -! A program that branches into or out of a simd region is non-conforming. +! OpenMP Version 5.0 +! 2.9.3.1 simd Construct +! - A program that branches into or out of a simd region is non-conforming. +! - The associated loops must be structured blocks program omp_simd integer i, j @@ -13,6 +14,16 @@ !CHECK: invalid branch leaving an OpenMP structured block goto 10 end do + if( i .EQ. 5 ) THEN + call function1() + else if ( i .EQ. 7 ) THEN + !PASS: Does not leave the loop, hence preserves the structured block restriction + open(10, file="random-file-name.txt", err=20) + 20 print*, "Error message doesn't branch out of the loop's structured block" + else + !ERROR: Inavlid branch out of the OpenMP construct + open(10, file="random-file-name.txt", err=10) + end if end do !$omp end simd @@ -20,3 +31,14 @@ 10 stop end program omp_simd + +subroutine function1() + integer i, option + option = 1 + !$omp simd + do i = 1, 10 + !PASS: The enclosed loop is a structured block + print*, "CORRECT SIMD LOOP" + end do + !$omp end simd +end subroutine function1