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

The old parse tree errors quckly exploded to thousands of unhelpful
lines when there were multiple missing end directives (e.g. #90452).

Instead I've added a flag to the parse tree indicating when a missing
end directive needs to be diagnosed, and moved the error messages to
semantics (where they are a lot easier to control).

This has the disadvantage of not displaying the error if there were
other parse errors, but there is a precedent for this approach (e.g.
parsing atomic constructs).

Author: tblah

flang/include/flang/Parser/dump-parse-tree.h

@@ -713,6 +713,7 @@ class ParseTreeDumper {
   NODE(parser, OmpEndDirective)
   NODE(parser, OpenMPAtomicConstruct)
   NODE(parser, OpenMPBlockConstruct)
+  NODE_ENUM(OpenMPBlockConstruct, Flags)
   NODE(parser, OpenMPCancelConstruct)
   NODE(parser, OpenMPCancellationPointConstruct)
   NODE(parser, OpenMPConstruct)

flang/include/flang/Parser/parse-tree.h

@@ -4783,15 +4783,25 @@ struct OmpEndDirective : public OmpDirectiveSpecification {
 // Common base class for block-associated constructs.
 struct OmpBlockConstruct {
   TUPLE_CLASS_BOILERPLATE(OmpBlockConstruct);
+  ENUM_CLASS(Flags, None, MissingMandatoryEndDirective);
+
+  /// Constructor with defualt value for Flags.
+  OmpBlockConstruct(OmpBeginDirective &&begin, Block &&block,
+      std::optional<OmpEndDirective> &&end)
+      : t(std::move(begin), std::move(block), std::move(end), Flags::None) {}
+
   const OmpBeginDirective &BeginDir() const {
     return std::get<OmpBeginDirective>(t);
   }
   const std::optional<OmpEndDirective> &EndDir() const {
     return std::get<std::optional<OmpEndDirective>>(t);
   }
+  bool isMissingMandatoryEndDirecitive() const {
+    return std::get<Flags>(t) == Flags::MissingMandatoryEndDirective;
+  }
 
   CharBlock source;
-  std::tuple<OmpBeginDirective, Block, std::optional<OmpEndDirective>> t;
+  std::tuple<OmpBeginDirective, Block, std::optional<OmpEndDirective>, Flags> t;
 };
 
 struct OmpMetadirectiveDirective {

flang/lib/Parser/openmp-parsers.cpp

@@ -1474,6 +1474,7 @@ struct OmpBlockConstructParser {
   constexpr OmpBlockConstructParser(llvm::omp::Directive dir) : dir_(dir) {}
 
   std::optional<resultType> Parse(ParseState &state) const {
+    using Flags = OmpBlockConstruct::Flags;
     if (auto &&begin{OmpBeginDirectiveParser(dir_).Parse(state)}) {
       if (auto &&body{attempt(StrictlyStructuredBlockParser{}).Parse(state)}) {
         // Try strictly-structured block with an optional end-directive
@@ -1484,11 +1485,26 @@ 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)); }),
+            endPresent ? Flags::None : Flags::MissingMandatoryEndDirective};
       }
     }
     return std::nullopt;

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

@@ -785,6 +785,14 @@ 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.
+  if (x.isMissingMandatoryEndDirecitive()) {
+    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