[flang][OpenMP] move omp end directive validation to semantics

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;

flang/lib/Semantics/check-omp-structure.cpp

@@ -785,6 +785,30 @@ void OmpStructureChecker::Enter(const parser::OpenMPBlockConstruct &x) {
   const parser::Block &block{std::get<parser::Block>(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<parser::ExecutableConstruct>(&contents.u)};
+    if (!executableConstruct) {
+      return false;
+    }
+    return std::holds_alternative<common::Indirection<parser::BlockConstruct>>(
+        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);
   }

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

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

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