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 @@ -229,6 +229,23 @@ template bool Pre(const A &) { return true; } template void Post(const A &) {} + template bool Pre(const parser::Statement &statement) { + currentStatementSource_ = statement.source; + if (statement.label) { + auto label{statement.label.value()}; + DirContext *thisContext{nullptr}; + if (!dirContext_.empty()) { + thisContext = &GetContext(); + } + targetLabels_.emplace(label, thisContext); + auto range{sourceLabels_.equal_range(label)}; + for (auto it{range.first}; it != range.second; ++it) { + CheckLabelContext(it->second.first, it->second.second, thisContext); + } + } + return true; + } + bool Pre(const parser::SpecificationPart &x) { Walk(std::get>(x.t)); return true; @@ -325,6 +342,29 @@ } void Post(const parser::Name &); + 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 +397,10 @@ 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 +438,8 @@ 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, DirContext *, DirContext *); }; template @@ -1434,4 +1480,34 @@ } } +void OmpAttributeVisitor::CheckSourceLabel(const parser::Label &label) { + DirContext *thisContext{nullptr}; + if (!dirContext_.empty()) { + thisContext = &GetContext(); + } + sourceLabels_.emplace( + label, std::make_pair(currentStatementSource_, thisContext)); + auto it{targetLabels_.find(label)}; + if (it != targetLabels_.end()) { + CheckLabelContext(currentStatementSource_, thisContext, it->second); + } +} + +// Check for invalid entry to OpenMP structured blocks and branches to/from +// within the enclosing OpenMP structured blocks. +void OmpAttributeVisitor::CheckLabelContext(const parser::CharBlock source, + DirContext *sourceContext, DirContext *targetContext) { + // The checks for control flow branching out of OpenMP structured blocks + // are handled as part of 'LabelEnforce' in 'OmpStructureChecker' + if (targetContext) { + if (!sourceContext) { + context_.Say( + source, "invalid entry to OpenMP structured block"_err_en_US); + } else if (sourceContext->scope != targetContext->scope) { + context_.Say( + source, "invalid branch to/from OpenMP structured block"_err_en_US); + } + } +} + } // 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-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:* - ! OpenMP Version 4.5 ! 2.7.1 Loop Construct ! No statement in the associated loops other than the DO statements @@ -13,7 +11,7 @@ do i = 1, 10 do j = 1, 10 print *, "Hello" - !ERROR: invalid branch to/from OpenMP structured block + !ERROR: Control flow escapes from DO goto 10 end do end do Index: flang/test/Semantics/omp-invalid-branch.f90 =================================================================== --- /dev/null +++ flang/test/Semantics/omp-invalid-branch.f90 @@ -0,0 +1,87 @@ +! RUN: %S/test_errors.sh %s %t %f18 -fopenmp +! OpenMP Version 4.5 +! Check invalid branches to/from OpenMP structured blocks. +! Check invalid entry into OpenMP structured blocks. +! Check control flow escaping OpenMP structured blocks + +subroutine omp_err_end_eor(a,b,x) + integer x + + !$omp parallel + !ERROR: Control flow escapes from PARALLEL + open (10, file="myfile.dat", err=100) + !ERROR: Control flow escapes from PARALLEL + !ERROR: Control flow escapes from PARALLEL + 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) + !ERROR: invalid entry to OpenMP structured block + 40 open (11, file="myfile2.dat", err=100) + goto 50 + !ERROR: invalid entry to OpenMP structured block + 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 + + !ERROR: invalid entry to OpenMP structured block + !ERROR: invalid entry to OpenMP structured block + goto (1, 2, 3) a + + assign 2 to b + !ERROR: invalid entry to OpenMP structured block + goto b (1, 2) + + !$omp parallel + !ERROR: invalid branch to/from OpenMP structured block + !ERROR: Control flow escapes from PARALLEL + 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 + !ERROR: invalid branch to/from OpenMP structured block + !ERROR: Control flow escapes from PARALLEL + 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-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: * - ! OpenMP Version 4.5 ! 2.5 parallel construct. ! A program that branches into or out of a parallel region @@ -16,6 +14,7 @@ do i = 1, 10 do j = 1, 10 print *, "Hello" + !ERROR: 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: * - ! OpenMP Version 4.5 ! 2.8.1 simd Construct ! A program that branches into or out of a simd region is non-conforming. @@ -12,7 +10,7 @@ do i = 1, 10 do j = 1, 10 print *, "omp simd" - !ERROR: invalid branch to/from OpenMP structured block + !ERROR: Control flow escapes from SIMD goto 10 end do end do 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: * - ! OpenMP Version 4.5 ! 2.9.1 task Construct ! Invalid entry to OpenMP structured block. @@ -18,6 +16,7 @@ if (associated(P%left)) then !$omp task call traverse(P%left) + !ERROR: STOP statement is not allowed in a TASK construct 10 stop !$omp end task endif 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: * - ! OpenMP Version 4.5 ! 2.9.2 taskloop Construct ! Invalid entry to OpenMP structured block.