Index: flang/lib/Semantics/check-directive-structure.h =================================================================== --- flang/lib/Semantics/check-directive-structure.h +++ flang/lib/Semantics/check-directive-structure.h @@ -42,9 +42,6 @@ template bool Pre(const parser::Statement &statement) { currentStatementSourcePosition_ = statement.source; - if (statement.label.has_value()) { - labels_.insert(*statement.label); - } return true; } @@ -55,8 +52,11 @@ } } void Post(const parser::StopStmt &) { EmitBranchOutError("STOP"); } - - std::set labels() { return labels_; } + void Post(const parser::CycleStmt &cycleStmt) { + if (const auto &cycleName{cycleStmt.v}) { + CheckConstructNameBranching("CYCLE", cycleName.value()); + } + } private: parser::MessageFormattedText GetEnclosingMsg() const { @@ -107,7 +107,6 @@ parser::CharBlock sourcePosition_; std::string upperCaseDirName_; D currentDirective_; - std::set labels_; }; // Generic structure checker for directives/clauses language such as OpenMP @@ -236,8 +235,7 @@ } } // Check illegal branching out of `Parser::Block` for `Parser::Name` based - // nodes (examples `Parser::ExitStmt`) along with `Parser::Label` - // based nodes (example `Parser::GotoStmt`). + // nodes (example `Parser::ExitStmt`) void CheckNoBranching(const parser::Block &block, D directive, const parser::CharBlock &directiveSource); @@ -283,11 +281,6 @@ NoBranchingEnforce noBranchingEnforce{ context_, directiveSource, directive, ContextDirectiveAsFortran()}; parser::Walk(block, noBranchingEnforce); - - auto construct{parser::ToUpperCaseLetters(getDirectiveName(directive).str())}; - LabelEnforce directiveLabelEnforce{context_, noBranchingEnforce.labels(), - directiveSource, construct.c_str()}; - parser::Walk(block, directiveLabelEnforce); } // Check that only clauses included in the given set are present after the given Index: flang/lib/Semantics/check-omp-structure.cpp =================================================================== --- flang/lib/Semantics/check-omp-structure.cpp +++ flang/lib/Semantics/check-omp-structure.cpp @@ -141,6 +141,12 @@ PushContextAndClauseSets(beginDir.source, llvm::omp::Directive::OMPD_do); } SetLoopInfo(x); + + if (const auto &doConstruct{ + std::get>(x.t)}) { + const auto &doBlock{std::get(doConstruct->t)}; + CheckNoBranching(doBlock, beginDir.v, beginDir.source); + } } const parser::Name OmpStructureChecker::GetLoopIndex( const parser::DoConstruct *x) { @@ -221,6 +227,10 @@ CheckMatching(beginDir, endDir); PushContextAndClauseSets(beginDir.source, beginDir.v); + const auto §ionBlocks{std::get(x.t)}; + for (const auto &block : sectionBlocks.v) { + CheckNoBranching(block, beginDir.v, beginDir.source); + } } void OmpStructureChecker::Leave(const parser::OpenMPSectionsConstruct &) { @@ -324,6 +334,8 @@ void OmpStructureChecker::Enter(const parser::OpenMPCriticalConstruct &x) { const auto &dir{std::get(x.t)}; PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_critical); + const auto &block{std::get(x.t)}; + CheckNoBranching(block, llvm::omp::Directive::OMPD_critical, dir.source); } void OmpStructureChecker::Leave(const parser::OpenMPCriticalConstruct &) { Index: flang/lib/Semantics/resolve-directives.cpp =================================================================== --- flang/lib/Semantics/resolve-directives.cpp +++ flang/lib/Semantics/resolve-directives.cpp @@ -48,6 +48,11 @@ CHECK(!dirContext_.empty()); return dirContext_.back(); } + std::optional GetContextIf() { + return dirContext_.empty() + ? std::nullopt + : std::make_optional(dirContext_.back()); + } void PushContext(const parser::CharBlock &source, T dir) { dirContext_.emplace_back(source, dir, context_.FindScope(source)); } @@ -229,6 +234,41 @@ template bool Pre(const A &) { return true; } template void Post(const A &) {} + template bool Pre(const parser::Statement &statement) { + currentStatementSource_ = statement.source; + // Keep track of the labels in all the labelled statements + if (statement.label) { + auto label{statement.label.value()}; + // Get the context to check if the labelled statement is in an + // enclosing OpenMP construct + std::optional thisContext{GetContextIf()}; + targetLabels_.emplace( + label, std::make_pair(currentStatementSource_, thisContext)); + // Check if a statement that causes a jump to the 'label' + // has already been encountered + auto range{sourceLabels_.equal_range(label)}; + for (auto it{range.first}; it != range.second; ++it) { + // Check if both the statement with 'label' and the statement that + // causes a jump to the 'label' are in the same scope + CheckLabelContext(it->second.first, currentStatementSource_, + it->second.second, thisContext); + } + } + return true; + } + + bool Pre(const parser::InternalSubprogram &) { + // Clear the labels being tracked in the previous scope + ClearLabels(); + return true; + } + + bool Pre(const parser::ModuleSubprogram &) { + // Clear the labels being tracked in the previous scope + ClearLabels(); + return true; + } + bool Pre(const parser::SpecificationPart &x) { Walk(std::get>(x.t)); return true; @@ -263,6 +303,9 @@ bool Pre(const parser::OpenMPSectionsConstruct &); void Post(const parser::OpenMPSectionsConstruct &) { PopContext(); } + bool Pre(const parser::OpenMPCriticalConstruct &); + void Post(const parser::OpenMPCriticalConstruct &) { PopContext(); } + bool Pre(const parser::OpenMPDeclareSimdConstruct &x) { PushContext(x.source, llvm::omp::Directive::OMPD_declare_simd); const auto &name{std::get>(x.t)}; @@ -325,6 +368,30 @@ } void Post(const parser::Name &); + // Keep track of labels in the statements that causes jumps to target labels + void Post(const parser::GotoStmt &gotoStmt) { CheckSourceLabel(gotoStmt.v); } + void Post(const parser::ComputedGotoStmt &computedGotoStmt) { + for (auto &label : std::get>(computedGotoStmt.t)) { + CheckSourceLabel(label); + } + } + void Post(const parser::ArithmeticIfStmt &arithmeticIfStmt) { + CheckSourceLabel(std::get<1>(arithmeticIfStmt.t)); + CheckSourceLabel(std::get<2>(arithmeticIfStmt.t)); + CheckSourceLabel(std::get<3>(arithmeticIfStmt.t)); + } + void Post(const parser::AssignedGotoStmt &assignedGotoStmt) { + for (auto &label : std::get>(assignedGotoStmt.t)) { + CheckSourceLabel(label); + } + } + void Post(const parser::AltReturnSpec &altReturnSpec) { + CheckSourceLabel(altReturnSpec.v); + } + void Post(const parser::ErrLabel &errLabel) { CheckSourceLabel(errLabel.v); } + void Post(const parser::EndLabel &endLabel) { CheckSourceLabel(endLabel.v); } + void Post(const parser::EorLabel &eorLabel) { CheckSourceLabel(eorLabel.v); } + const parser::OmpClause *associatedClause{nullptr}; void SetAssociatedClause(const parser::OmpClause &c) { associatedClause = &c; @@ -357,6 +424,13 @@ std::vector allocateNames_; // on one directive SymbolSet privateDataSharingAttributeObjects_; // on one directive SymbolSet stmtFunctionExprSymbols_; + std::multimap>> + sourceLabels_; + std::map>> + targetLabels_; + parser::CharBlock currentStatementSource_; void AddAllocateName(const parser::Name *&object) { allocateNames_.push_back(object); @@ -394,6 +468,13 @@ void CheckAssocLoopLevel(std::int64_t level, const parser::OmpClause *clause); void CheckPrivateDSAObject( const parser::Name &, const Symbol &, Symbol::Flag); + void CheckSourceLabel(const parser::Label &); + void CheckLabelContext(const parser::CharBlock, const parser::CharBlock, + std::optional, std::optional); + void ClearLabels() { + sourceLabels_.clear(); + targetLabels_.clear(); + }; }; template @@ -904,6 +985,7 @@ case llvm::omp::Directive::OMPD_parallel_workshare: case llvm::omp::Directive::OMPD_target_teams: case llvm::omp::Directive::OMPD_target_parallel: + case llvm::omp::Directive::OMPD_taskgroup: PushContext(beginDir.source, beginDir.v); break; default: @@ -1139,6 +1221,12 @@ return true; } +bool OmpAttributeVisitor::Pre(const parser::OpenMPCriticalConstruct &x) { + const auto &criticalDir{std::get(x.t)}; + PushContext(criticalDir.source, llvm::omp::Directive::OMPD_critical); + return true; +} + bool OmpAttributeVisitor::Pre(const parser::OpenMPThreadprivate &x) { PushContext(x.source, llvm::omp::Directive::OMPD_threadprivate); const auto &list{std::get(x.t)}; @@ -1434,4 +1522,52 @@ } } +void OmpAttributeVisitor::CheckSourceLabel(const parser::Label &label) { + // Get the context to check if the statement causing a jump to the 'label' is + // in an enclosing OpenMP construct + std::optional thisContext{GetContextIf()}; + sourceLabels_.emplace( + label, std::make_pair(currentStatementSource_, thisContext)); + // Check if the statement with 'label' to which a jump is being introduced + // has already been encountered + auto it{targetLabels_.find(label)}; + if (it != targetLabels_.end()) { + // Check if both the statement with 'label' and the statement that causes a + // jump to the 'label' are in the same scope + CheckLabelContext(currentStatementSource_, it->second.first, thisContext, + it->second.second); + } +} + +// Check for invalid branch into or out of OpenMP structured blocks +void OmpAttributeVisitor::CheckLabelContext(const parser::CharBlock source, + const parser::CharBlock target, std::optional sourceContext, + std::optional targetContext) { + if (targetContext && + (!sourceContext || + (sourceContext->scope != targetContext->scope && + !DoesScopeContain( + &targetContext->scope, sourceContext->scope)))) { + context_ + .Say(source, "invalid branch into an OpenMP structured block"_err_en_US) + .Attach(target, "In the enclosing %s directive branched into"_en_US, + parser::ToUpperCaseLetters( + llvm::omp::getOpenMPDirectiveName(targetContext->directive) + .str())); + } + if (sourceContext && + (!targetContext || + (sourceContext->scope != targetContext->scope && + !DoesScopeContain( + &sourceContext->scope, targetContext->scope)))) { + context_ + .Say(source, + "invalid branch leaving an OpenMP structured block"_err_en_US) + .Attach(target, "Outside the enclosing %s directive"_en_US, + parser::ToUpperCaseLetters( + llvm::omp::getOpenMPDirectiveName(sourceContext->directive) + .str())); + } +} + } // namespace Fortran::semantics Index: flang/test/Semantics/omp-clause-validity01.f90 =================================================================== --- flang/test/Semantics/omp-clause-validity01.f90 +++ flang/test/Semantics/omp-clause-validity01.f90 @@ -172,6 +172,7 @@ exit exit outer !ERROR: EXIT to construct 'outofparallel' outside of PARALLEL construct is not allowed + !ERROR: EXIT to construct 'outofparallel' outside of DO construct is not allowed exit outofparallel end do inner end do outer Index: flang/test/Semantics/omp-do-cycle.f90 =================================================================== --- /dev/null +++ flang/test/Semantics/omp-do-cycle.f90 @@ -0,0 +1,44 @@ +! RUN: %S/test_errors.sh %s %t %f18 -fopenmp +! OpenMP Version 4.5 +! Check for cycle statements leaving an OpenMP structured block + +program omp_do + integer i, j, k + + !$omp parallel + foo: do i = 0, 10 + !$omp do + bar: do j = 0, 10 + !ERROR: CYCLE to construct 'foo' outside of DO construct is not allowed + cycle foo + end do bar + !$omp end do + end do foo + !$omp end parallel + + foo1: do i = 0, 10 + !$omp parallel + foo2: do k = 0, 10 + !$omp do + foo3: do j = 0, 10 + !ERROR: CYCLE to construct 'foo1' outside of PARALLEL construct is not allowed + !ERROR: CYCLE to construct 'foo1' outside of DO construct is not allowed + cycle foo1 + end do foo3 + !$omp end do + end do foo2 + !$omp end parallel + end do foo1 + + bar1: do i = 0, 10 + !$omp parallel + bar2: do k = 0, 10 + bar3: do j = 0, 10 + !ERROR: CYCLE to construct 'bar1' outside of PARALLEL construct is not allowed + cycle bar1 + end do bar3 + end do bar2 + !$omp end parallel + end do bar1 + +end program omp_do Index: flang/test/Semantics/omp-do07.f90 =================================================================== --- flang/test/Semantics/omp-do07.f90 +++ flang/test/Semantics/omp-do07.f90 @@ -1,6 +1,4 @@ -! RUN: %S/test_errors.sh %s %t %f18 -fopenmp -! XFAIL:* - +! RUN: not %f18 -fparse-only -fopenmp %s 2>&1 | FileCheck %s ! OpenMP Version 4.5 ! 2.7.1 Loop Construct ! No statement in the associated loops other than the DO statements @@ -13,12 +11,13 @@ do i = 1, 10 do j = 1, 10 print *, "Hello" - !ERROR: invalid branch to/from OpenMP structured block + !CHECK: invalid branch leaving an OpenMP structured block goto 10 end do end do !$omp end do + !CHECK: Outside the enclosing DO directive 10 stop end program omp_do Index: flang/test/Semantics/omp-invalid-branch.f90 =================================================================== --- /dev/null +++ flang/test/Semantics/omp-invalid-branch.f90 @@ -0,0 +1,107 @@ +! RUN: not %f18 -fparse-only -fopenmp %s 2>&1 | FileCheck %s +! OpenMP Version 4.5 +! Check invalid branches into or out of OpenMP structured blocks. + +subroutine omp_err_end_eor(a, b, x) + integer x + + !$omp parallel + !CHECK: invalid branch into an OpenMP structured block + !CHECK: In the enclosing PARALLEL directive branched into + + !CHECK: invalid branch leaving an OpenMP structured block + !CHECK: Outside the enclosing PARALLEL directive + open (10, file="myfile.dat", err=100) + !CHECK: invalid branch leaving an OpenMP structured block + !CHECK: Outside the enclosing PARALLEL directive + + !CHECK: invalid branch into an OpenMP structured block + !CHECK: In the enclosing PARALLEL directive branched into + + !CHECK: invalid branch leaving an OpenMP structured block + !CHECK: Outside the enclosing PARALLEL directive + read (10, 20, end=200, size=x, advance='no', eor=300) a + !$omp end parallel + + goto 99 + 99 close (10) + goto 40 + !$omp parallel + 100 print *, "error opening" + !$omp end parallel + 101 return + 200 print *, "end of file" + 202 return + + !$omp parallel + 300 print *, "end of record" + !$omp end parallel + + 303 return + 20 format (1x,F5.1) + 30 format (2x,F6.2) + !CHECK: invalid branch into an OpenMP structured block + !CHECK: In the enclosing PARALLEL directive branched into + 40 open (11, file="myfile2.dat", err=100) + goto 50 + !CHECK: invalid branch into an OpenMP structured block + !CHECK: In the enclosing PARALLEL directive branched into + 50 write (11, 30, err=100) b + close (11) +end subroutine + +subroutine omp_alt_return_spec(n, *, *) + if (n .eq. 0) return + if (n .eq. 1) return 1 + return 2 +end subroutine + +program omp_invalid_branch + integer :: n = 0, a = 3, b + + !CHECK: invalid branch into an OpenMP structured block + !CHECK: In the enclosing PARALLEL directive branched into + + !CHECK: invalid branch into an OpenMP structured block + !CHECK: In the enclosing PARALLEL directive branched into + goto (1, 2, 3) a + + assign 2 to b + !CHECK: invalid branch into an OpenMP structured block + !CHECK: In the enclosing PARALLEL directive branched into + goto b (1, 2) + + !$omp parallel + !CHECK: invalid branch into an OpenMP structured block + !CHECK: In the enclosing SINGLE directive branched into + + !CHECK: invalid branch leaving an OpenMP structured block + !CHECK: Outside the enclosing PARALLEL directive + 3 if(n) 4, 5, 6 + + 6 print *, 6 + 2 print *, 2 + + !$omp single + 4 print *, 4 + !$omp end single + !$omp end parallel + + 1 print *, 1 + 5 print *, 5 + + !$omp parallel + !CHECK: invalid branch into an OpenMP structured block + !CHECK: In the enclosing SINGLE directive branched into + + !CHECK: invalid branch leaving an OpenMP structured block + !CHECK: Outside the enclosing PARALLEL directive + call omp_alt_return_spec(n, *8, *9) + print *, "Normal Return" + !$omp single + 8 print *, "1st alternate return" + !$omp end single + !$omp end parallel + 9 print *, "2nd alternate return" + +end program Index: flang/test/Semantics/omp-parallel01.f90 =================================================================== --- flang/test/Semantics/omp-parallel01.f90 +++ flang/test/Semantics/omp-parallel01.f90 @@ -1,5 +1,4 @@ -! RUN: %S/test_errors.sh %s %t %f18 -fopenmp - +! RUN: not %f18 -fparse-only -fopenmp %s 2>&1 | FileCheck %s ! OpenMP Version 4.5 ! 2.5 parallel construct. ! A program that branches into or out of a parallel region @@ -12,12 +11,13 @@ do i = 1, 10 do j = 1, 10 print *, "Hello" - !ERROR: Control flow escapes from PARALLEL + !CHECK: invalid branch leaving an OpenMP structured block goto 10 end do end do !$omp end parallel + !CHECK: Outside the enclosing PARALLEL directive 10 stop end program omp_parallel Index: flang/test/Semantics/omp-parallel02.f90 =================================================================== --- flang/test/Semantics/omp-parallel02.f90 +++ flang/test/Semantics/omp-parallel02.f90 @@ -1,6 +1,4 @@ -! RUN: %S/test_errors.sh %s %t %f18 -fopenmp -! XFAIL: * - +! RUN: not %f18 -fparse-only -fopenmp %s 2>&1 | FileCheck %s ! OpenMP Version 4.5 ! 2.5 parallel construct. ! A program that branches into or out of a parallel region @@ -9,13 +7,15 @@ program omp_parallel integer i, j, k - !ERROR: invalid entry to OpenMP structured block + !CHECK: invalid branch into an OpenMP structured block goto 10 !$omp parallel do i = 1, 10 do j = 1, 10 print *, "Hello" + !CHECK: In the enclosing PARALLEL directive branched into + !CHECK: STOP statement is not allowed in a PARALLEL construct 10 stop end do end do Index: flang/test/Semantics/omp-simd01.f90 =================================================================== --- flang/test/Semantics/omp-simd01.f90 +++ flang/test/Semantics/omp-simd01.f90 @@ -1,6 +1,4 @@ -! RUN: %S/test_errors.sh %s %t %f18 -fopenmp -! XFAIL: * - +! RUN: not %f18 -fparse-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. @@ -12,12 +10,13 @@ do i = 1, 10 do j = 1, 10 print *, "omp simd" - !ERROR: invalid branch to/from OpenMP structured block + !CHECK: invalid branch leaving an OpenMP structured block goto 10 end do end do !$omp end simd + !CHECK: Outside the enclosing SIMD directive 10 stop end program omp_simd Index: flang/test/Semantics/omp-task01.f90 =================================================================== --- flang/test/Semantics/omp-task01.f90 +++ flang/test/Semantics/omp-task01.f90 @@ -1,6 +1,4 @@ -! RUN: %S/test_errors.sh %s %t %f18 -fopenmp -! XFAIL: * - +! RUN: not %f18 -fparse-only -fopenmp %s 2>&1 | FileCheck %s ! OpenMP Version 4.5 ! 2.9.1 task Construct ! Invalid entry to OpenMP structured block. @@ -12,12 +10,14 @@ type(Node) :: P - !ERROR: invalid entry to OpenMP structured block + !CHECK: invalid branch into an OpenMP structured block goto 10 if (associated(P%left)) then !$omp task call traverse(P%left) + !CHECK: In the enclosing TASK directive branched into + !CHECK: STOP statement is not allowed in a TASK construct 10 stop !$omp end task endif Index: flang/test/Semantics/omp-taskloop01.f90 =================================================================== --- flang/test/Semantics/omp-taskloop01.f90 +++ flang/test/Semantics/omp-taskloop01.f90 @@ -1,9 +1,6 @@ ! RUN: %S/test_errors.sh %s %t %f18 -fopenmp -! XFAIL: * - ! OpenMP Version 4.5 ! 2.9.2 taskloop Construct -! Assert fail for correct test case. subroutine parallel_work integer i Index: flang/test/Semantics/omp-taskloop02.f90 =================================================================== --- flang/test/Semantics/omp-taskloop02.f90 +++ flang/test/Semantics/omp-taskloop02.f90 @@ -1,6 +1,4 @@ -! RUN: %S/test_errors.sh %s %t %f18 -fopenmp -! XFAIL: * - +! RUN: not %f18 -fparse-only -fopenmp %s 2>&1 | FileCheck %s ! OpenMP Version 4.5 ! 2.9.2 taskloop Construct ! Invalid entry to OpenMP structured block. @@ -8,12 +6,13 @@ program omp_taskloop integer i , j - !ERROR: invalid entry to OpenMP structured block + !CHECK: invalid branch into an OpenMP structured block goto 10 !$omp taskloop private(j) grainsize(500) nogroup do i=1,10000 do j=1,i + !CHECK: In the enclosing TASKLOOP directive branched into 10 call loop_body(i, j) end do end do