diff --git a/flang/lib/Parser/openmp-parsers.cpp b/flang/lib/Parser/openmp-parsers.cpp index 56cee4ab38e9b..65395c50c4ddf 100644 --- a/flang/lib/Parser/openmp-parsers.cpp +++ b/flang/lib/Parser/openmp-parsers.cpp @@ -1484,11 +1484,25 @@ struct OmpBlockConstructParser { [](auto &&s) { return OmpEndDirective(std::move(s)); })}; } else if (auto &&body{ attempt(LooselyStructuredBlockParser{}).Parse(state)}) { - // Try loosely-structured block with a mandatory end-directive - if (auto end{OmpEndDirectiveParser{dir_}.Parse(state)}) { - return OmpBlockConstruct{OmpBeginDirective(std::move(*begin)), - std::move(*body), OmpEndDirective{std::move(*end)}}; + // Try loosely-structured block with a mandatory end-directive. + auto end{maybe(OmpEndDirectiveParser{dir_}).Parse(state)}; + // Dereference outer optional (maybe() always succeeds) and look at the + // inner optional. + bool endPresent{end->has_value()}; + + // ORDERED is special. We do need to return failure here so that the + // standalone ORDERED construct can be distinguished from the block + // associated construct. + if (!endPresent && dir_ == llvm::omp::Directive::OMPD_ordered) { + return std::nullopt; } + + // Delay the error for a missing end-directive until semantics so that + // we have better control over the output. + return OmpBlockConstruct{OmpBeginDirective(std::move(*begin)), + std::move(*body), + llvm::transformOptional(std::move(*end), + [](auto &&s) { return OmpEndDirective(std::move(s)); })}; } } return std::nullopt; diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp index 92a2cfc330d35..835802d81894e 100644 --- a/flang/lib/Semantics/check-omp-structure.cpp +++ b/flang/lib/Semantics/check-omp-structure.cpp @@ -785,6 +785,30 @@ void OmpStructureChecker::Enter(const parser::OpenMPBlockConstruct &x) { const parser::Block &block{std::get(x.t)}; PushContextAndClauseSets(beginSpec.DirName().source, beginSpec.DirId()); + + // Missing mandatory end block: this is checked in semantics because that + // makes it easier to control the error messages. + // The end block is mandatory when the construct is not applied to a strictly + // structured block (aka it is applied to a loosely structured block). In + // other words, the body doesn't contain exactly one parser::BlockConstruct. + auto isStrictlyStructuredBlock{[](const parser::Block &block) -> bool { + if (block.size() != 1) { + return false; + } + const parser::ExecutionPartConstruct &contents{block.front()}; + auto *executableConstruct{ + std::get_if(&contents.u)}; + if (!executableConstruct) { + return false; + } + return std::holds_alternative>( + executableConstruct->u); + }}; + if (!endSpec && !isStrictlyStructuredBlock(block)) { + context_.Say( + x.BeginDir().source, "Expected OpenMP end directive"_err_en_US); + } + if (llvm::omp::allTargetSet.test(GetContext().directive)) { EnterDirectiveNest(TargetNest); } diff --git a/flang/test/Parser/OpenMP/fail-construct1.f90 b/flang/test/Parser/OpenMP/fail-construct1.f90 index f0b3f7438ae58..9d1af903344d3 100644 --- a/flang/test/Parser/OpenMP/fail-construct1.f90 +++ b/flang/test/Parser/OpenMP/fail-construct1.f90 @@ -1,5 +1,5 @@ ! RUN: not %flang_fc1 -fsyntax-only -fopenmp %s 2>&1 | FileCheck %s !$omp parallel -! CHECK: error: expected '!$OMP ' +! CHECK: error: Expected OpenMP end directive end diff --git a/flang/test/Parser/OpenMP/ordered-block-vs-standalone.f90 b/flang/test/Parser/OpenMP/ordered-block-vs-standalone.f90 new file mode 100644 index 0000000000000..db9c45add8674 --- /dev/null +++ b/flang/test/Parser/OpenMP/ordered-block-vs-standalone.f90 @@ -0,0 +1,60 @@ +! RUN: %flang_fc1 -fdebug-dump-parse-tree -fopenmp -fopenmp-version=45 %s | FileCheck %s + +! Check that standalone ORDERED is successfully distinguished form block associated ORDERED + +! CHECK: | SubroutineStmt +! CHECK-NEXT: | | Name = 'standalone' +subroutine standalone + integer :: x(10, 10) + do i = 1, 10 + do j = 1,10 + ! CHECK: OpenMPConstruct -> OpenMPStandaloneConstruct + ! CHECK-NEXT: | OmpDirectiveName -> llvm::omp::Directive = ordered + ! CHECK-NEXT: | OmpClauseList -> + ! CHECK-NEXT: | Flags = None + !$omp ordered + x(i, j) = i + j + end do + end do +endsubroutine + +! CHECK: | SubroutineStmt +! CHECK-NEXT: | | Name = 'strict_block' +subroutine strict_block + integer :: x(10, 10) + integer :: tmp + do i = 1, 10 + do j = 1,10 + ! CHECK: OpenMPConstruct -> OpenMPBlockConstruct + ! CHECK-NEXT: | OmpBeginDirective + ! CHECK-NEXT: | | OmpDirectiveName -> llvm::omp::Directive = ordered + ! CHECK-NEXT: | | OmpClauseList -> + ! CHECK-NEXT: | | Flags = None + !$omp ordered + block + tmp = i + j + x(i, j) = tmp + end block + end do + end do +endsubroutine + +! CHECK: | SubroutineStmt +! CHECK-NEXT: | | Name = 'loose_block' +subroutine loose_block + integer :: x(10, 10) + integer :: tmp + do i = 1, 10 + do j = 1,10 + ! CHECK: OpenMPConstruct -> OpenMPBlockConstruct + ! CHECK-NEXT: | OmpBeginDirective + ! CHECK-NEXT: | | OmpDirectiveName -> llvm::omp::Directive = ordered + ! CHECK-NEXT: | | OmpClauseList -> + ! CHECK-NEXT: | | Flags = None + !$omp ordered + tmp = i + j + x(i, j) = tmp + !$omp end ordered + end do + end do +endsubroutine diff --git a/flang/test/Semantics/OpenMP/missing-end-directive.f90 b/flang/test/Semantics/OpenMP/missing-end-directive.f90 new file mode 100644 index 0000000000000..3b870d134155b --- /dev/null +++ b/flang/test/Semantics/OpenMP/missing-end-directive.f90 @@ -0,0 +1,13 @@ +! RUN: %python %S/../test_errors.py %s %flang -fopenmp + +! Test that we can diagnose missing end directives without an explosion of errors + +! ERROR: Expected OpenMP end directive +!$omp parallel +! ERROR: Expected OpenMP end directive +!$omp task +! ERROR: Expected OpenMP end directive +!$omp parallel +! ERROR: Expected OpenMP end directive +!$omp task +end