[flang][OpenMP] Better diagnostics for invalid or misplaced directives

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

@@ -755,7 +755,9 @@ class ParseTreeDumper {
   NODE(parser, OpenMPDispatchConstruct)
   NODE(parser, OpenMPFlushConstruct)
   NODE(parser, OpenMPGroupprivate)
+  NODE(parser, OpenMPInvalidDirective)
   NODE(parser, OpenMPLoopConstruct)
+  NODE(parser, OpenMPMisplacedEndDirective)
   NODE(parser, OpenMPRequiresConstruct)
   NODE(parser, OpenMPSectionConstruct)
   NODE(parser, OpenMPSectionsConstruct)

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

@@ -269,8 +269,9 @@ struct AccEndCombinedDirective;
 struct OpenACCDeclarativeConstruct;
 struct OpenACCRoutineConstruct;
 struct OpenMPConstruct;
-struct OpenMPLoopConstruct;
 struct OpenMPDeclarativeConstruct;
+struct OpenMPInvalidDirective;
+struct OpenMPMisplacedEndDirective;
 struct CUFKernelDoConstruct;
 
 // Cooked character stream locations
@@ -406,6 +407,8 @@ struct SpecificationConstruct {
       common::Indirection<StructureDef>,
       common::Indirection<OpenACCDeclarativeConstruct>,
       common::Indirection<OpenMPDeclarativeConstruct>,
+      common::Indirection<OpenMPMisplacedEndDirective>,
+      common::Indirection<OpenMPInvalidDirective>,
       common::Indirection<CompilerDirective>>
       u;
 };
@@ -538,6 +541,8 @@ struct ExecutableConstruct {
       common::Indirection<OpenACCConstruct>,
       common::Indirection<AccEndCombinedDirective>,
       common::Indirection<OpenMPConstruct>,
+      common::Indirection<OpenMPMisplacedEndDirective>,
+      common::Indirection<OpenMPInvalidDirective>,
       common::Indirection<CUFKernelDoConstruct>>
       u;
 };
@@ -5379,6 +5384,19 @@ struct OpenMPConstruct {
       u;
 };
 
+// Orphaned !$OMP END <directive>, i.e. not being a part of a valid OpenMP
+// construct.
+struct OpenMPMisplacedEndDirective : public OmpEndDirective {
+  INHERITED_TUPLE_CLASS_BOILERPLATE(
+      OpenMPMisplacedEndDirective, OmpEndDirective);
+};
+
+// Unrecognized string after the !$OMP sentinel.
+struct OpenMPInvalidDirective {
+  using EmptyTrait = std::true_type;
+  CharBlock source;
+};
+
 // Parse tree nodes for OpenACC 3.3 directives and clauses
 
 struct AccObject {

flang/lib/Parser/executable-parsers.cpp

@@ -50,6 +50,8 @@ constexpr auto executableConstruct{first(
     construct<ExecutableConstruct>(indirect(whereConstruct)),
     construct<ExecutableConstruct>(indirect(forallConstruct)),
     construct<ExecutableConstruct>(indirect(openmpConstruct)),
+    construct<ExecutableConstruct>(indirect(openmpMisplacedEndDirective)),
+    construct<ExecutableConstruct>(indirect(openmpInvalidDirective)),
     construct<ExecutableConstruct>(indirect(Parser<OpenACCConstruct>{})),
     construct<ExecutableConstruct>(indirect(compilerDirective)),
     construct<ExecutableConstruct>(indirect(Parser<CUFKernelDoConstruct>{})))};

flang/lib/Parser/openmp-parsers.cpp

@@ -1573,6 +1573,14 @@ static inline constexpr auto IsMemberOf(const DirectiveSet &dirs) {
   };
 }
 
+constexpr auto validEPC{//
+    predicated(executionPartConstruct, [](auto &epc) {
+      return !Unwrap<OpenMPMisplacedEndDirective>(epc) &&
+          !Unwrap<OpenMPMisplacedEndDirective>(epc);
+    })};
+
+constexpr auto validBlock{many(validEPC)};
+
 TYPE_PARSER(sourced(construct<OmpDirectiveName>(OmpDirectiveNameParser{})))
 
 OmpDirectiveSpecification static makeFlushFromOldSyntax(Verbatim &&text,
@@ -1630,7 +1638,7 @@ struct StrictlyStructuredBlockParser {
   std::optional<resultType> Parse(ParseState &state) const {
     // Detect BLOCK construct without parsing the entire thing.
     if (lookAhead(skipStuffBeforeStatement >> "BLOCK"_tok).Parse(state)) {
-      if (auto epc{Parser<ExecutionPartConstruct>{}.Parse(state)}) {
+      if (auto &&epc{executionPartConstruct.Parse(state)}) {
         if (GetFortranBlockConstruct(*epc) != nullptr) {
           Block body;
           body.emplace_back(std::move(*epc));
@@ -1650,7 +1658,7 @@ struct LooselyStructuredBlockParser {
     if (lookAhead(skipStuffBeforeStatement >> "BLOCK"_tok).Parse(state)) {
       return std::nullopt;
     }
-    if (auto &&body{block.Parse(state)}) {
+    if (auto &&body{validBlock.Parse(state)}) {
       // Empty body is ok.
       return std::move(body);
     }
@@ -1674,7 +1682,7 @@ struct NonBlockDoConstructParser {
 
     // Keep parsing ExecutionPartConstructs until the set of open label-do
     // statements becomes empty, or until the EPC parser fails.
-    while (auto &&epc{attempt(executionPartConstruct).Parse(state)}) {
+    while (auto &&epc{attempt(validEPC).Parse(state)}) {
       if (auto &&label{GetStatementLabel(*epc)}) {
         labels.erase(*label);
       }
@@ -1825,7 +1833,7 @@ struct OmpStatementConstructParser {
   std::optional<resultType> Parse(ParseState &state) const {
     if (auto begin{OmpBeginDirectiveParser(dir_).Parse(state)}) {
       Block body;
-      if (auto stmt{attempt(Parser<ExecutionPartConstruct>{}).Parse(state)}) {
+      if (auto stmt{attempt(validEPC).Parse(state)}) {
         body.emplace_back(std::move(*stmt));
       }
       // Allow empty block. Check for this in semantics.
@@ -1995,11 +2003,9 @@ struct OmpAtomicConstructParser {
       return std::nullopt;
     }
 
-    auto exec{Parser<ExecutionPartConstruct>{}};
-    auto end{OmpEndDirectiveParser{llvm::omp::Directive::OMPD_atomic}};
     TailType tail;
 
-    if (ParseOne(exec, end, tail, state)) {
+    if (ParseOne(tail, state)) {
       if (!tail.first.empty()) {
         if (auto &&rest{attempt(LimitedTailParser(BodyLimit)).Parse(state)}) {
           for (auto &&s : rest->first) {
@@ -2026,13 +2032,12 @@ struct OmpAtomicConstructParser {
 
   // Parse either an ExecutionPartConstruct, or atomic end-directive. When
   // successful, record the result in the "tail" provided, otherwise fail.
-  static std::optional<Success> ParseOne( //
-      Parser<ExecutionPartConstruct> &exec, OmpEndDirectiveParser &end,
-      TailType &tail, ParseState &state) {
-    auto isRecovery{[](const ExecutionPartConstruct &e) {
-      return std::holds_alternative<ErrorRecovery>(e.u);
+  static std::optional<Success> ParseOne(TailType &tail, ParseState &state) {
+    auto isUsable{[](const std::optional<ExecutionPartConstruct> &e) {
+      return e && !std::holds_alternative<ErrorRecovery>(e->u);
     }};
-    if (auto &&stmt{attempt(exec).Parse(state)}; stmt && !isRecovery(*stmt)) {
+    auto end{OmpEndDirectiveParser{llvm::omp::Directive::OMPD_atomic}};
+    if (auto &&stmt{attempt(validEPC).Parse(state)}; isUsable(stmt)) {
       tail.first.emplace_back(std::move(*stmt));
     } else if (auto &&dir{attempt(end).Parse(state)}) {
       tail.second = std::move(*dir);
@@ -2048,12 +2053,10 @@ struct OmpAtomicConstructParser {
     constexpr LimitedTailParser(size_t count) : count_(count) {}
 
     std::optional<resultType> Parse(ParseState &state) const {
-      auto exec{Parser<ExecutionPartConstruct>{}};
-      auto end{OmpEndDirectiveParser{llvm::omp::Directive::OMPD_atomic}};
       TailType tail;
 
       for (size_t i{0}; i != count_; ++i) {
-        if (ParseOne(exec, end, tail, state)) {
+        if (ParseOne(tail, state)) {
           if (tail.second) {
             // Return when the end-directive was parsed.
             return std::move(tail);
@@ -2325,9 +2328,9 @@ TYPE_PARSER(sourced(construct<OpenMPSectionsConstruct>(
     Parser<OmpBeginSectionsDirective>{} / endOmpLine,
     cons( //
         construct<OpenMPConstruct>(sourced(
-            construct<OpenMPSectionConstruct>(maybe(sectionDir), block))),
-        many(construct<OpenMPConstruct>(
-            sourced(construct<OpenMPSectionConstruct>(sectionDir, block))))),
+            construct<OpenMPSectionConstruct>(maybe(sectionDir), validBlock))),
+        many(construct<OpenMPConstruct>(sourced(
+            construct<OpenMPSectionConstruct>(sectionDir, validBlock))))),
     maybe(Parser<OmpEndSectionsDirective>{} / endOmpLine))))
 
 static bool IsExecutionPart(const OmpDirectiveName &name) {
@@ -2402,4 +2405,14 @@ static constexpr DirectiveSet GetLoopDirectives() {
 TYPE_PARSER(sourced(construct<OpenMPLoopConstruct>(
     OmpLoopConstructParser(GetLoopDirectives()))))
 
+static constexpr DirectiveSet GetAllDirectives() { //
+  return ~DirectiveSet{};
+}
+
+TYPE_PARSER(construct<OpenMPMisplacedEndDirective>(
+    OmpEndDirectiveParser{GetAllDirectives()}))
+
+TYPE_PARSER( //
+    startOmpLine >> sourced(construct<OpenMPInvalidDirective>(
+                        !OmpDirectiveNameParser{} >> SkipTo<'\n'>{})))
 } // namespace Fortran::parser

flang/lib/Parser/program-parsers.cpp

@@ -201,6 +201,9 @@ TYPE_CONTEXT_PARSER("specification construct"_en_US,
         construct<SpecificationConstruct>(
             indirect(openaccDeclarativeConstruct)),
         construct<SpecificationConstruct>(indirect(openmpDeclarativeConstruct)),
+        construct<SpecificationConstruct>(
+            indirect(openmpMisplacedEndDirective)),
+        construct<SpecificationConstruct>(indirect(openmpInvalidDirective)),
         construct<SpecificationConstruct>(indirect(compilerDirective))))
 
 // R513 other-specification-stmt ->

flang/lib/Parser/type-parsers.h

@@ -139,7 +139,8 @@ constexpr Parser<OpenACCDeclarativeConstruct> openaccDeclarativeConstruct;
 constexpr Parser<OpenMPConstruct> openmpConstruct;
 constexpr Parser<OpenMPExecDirective> openmpExecDirective;
 constexpr Parser<OpenMPDeclarativeConstruct> openmpDeclarativeConstruct;
-constexpr Parser<OmpEndLoopDirective> ompEndLoopDirective;
+constexpr Parser<OpenMPMisplacedEndDirective> openmpMisplacedEndDirective;
+constexpr Parser<OpenMPInvalidDirective> openmpInvalidDirective;
 constexpr Parser<IntrinsicVectorTypeSpec> intrinsicVectorTypeSpec; // Extension
 constexpr Parser<VectorTypeSpec> vectorTypeSpec; // Extension
 constexpr Parser<UnsignedTypeSpec> unsignedTypeSpec; // Extension

flang/lib/Parser/unparse.cpp

@@ -2706,6 +2706,16 @@ class UnparseVisitor {
     Put("\n");
     EndOpenMP();
   }
+  void Unparse(const OpenMPMisplacedEndDirective &x) {
+    Unparse(static_cast<const OmpEndDirective &>(x));
+  }
+  void Unparse(const OpenMPInvalidDirective &x) {
+    BeginOpenMP();
+    Word("!$OMP ");
+    Put(parser::ToUpperCaseLetters(x.source.ToString()));
+    Put("\n");
+    EndOpenMP();
+  }
   void Unparse(const BasedPointer &x) {
     Put('('), Walk(std::get<0>(x.t)), Put(","), Walk(std::get<1>(x.t));
     Walk("(", std::get<std::optional<ArraySpec>>(x.t), ")"), Put(')');

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

@@ -5474,6 +5474,25 @@ void OmpStructureChecker::CheckAllowedRequiresClause(llvmOmpClause clause) {
   }
 }
 
+void OmpStructureChecker::Enter(const parser::OpenMPMisplacedEndDirective &x) {
+  context_.Say(x.DirName().source, "Misplaced OpenMP end-directive"_err_en_US);
+  PushContextAndClauseSets(
+      x.DirName().source, llvm::omp::Directive::OMPD_unknown);
+}
+
+void OmpStructureChecker::Leave(const parser::OpenMPMisplacedEndDirective &x) {
+  dirContext_.pop_back();
+}
+
+void OmpStructureChecker::Enter(const parser::OpenMPInvalidDirective &x) {
+  context_.Say(x.source, "Invalid OpenMP directive"_err_en_US);
+  PushContextAndClauseSets(x.source, llvm::omp::Directive::OMPD_unknown);
+}
+
+void OmpStructureChecker::Leave(const parser::OpenMPInvalidDirective &x) {
+  dirContext_.pop_back();
+}
+
 // Use when clause falls under 'struct OmpClause' in 'parse-tree.h'.
 #define CHECK_SIMPLE_CLAUSE(X, Y) \
   void OmpStructureChecker::Enter(const parser::OmpClause::X &) { \

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

@@ -94,6 +94,11 @@ class OmpStructureChecker : public OmpStructureCheckerBase {
   void Enter(const parser::OpenMPDeclarativeConstruct &);
   void Leave(const parser::OpenMPDeclarativeConstruct &);
 
+  void Enter(const parser::OpenMPMisplacedEndDirective &);
+  void Leave(const parser::OpenMPMisplacedEndDirective &);
+  void Enter(const parser::OpenMPInvalidDirective &);
+  void Leave(const parser::OpenMPInvalidDirective &);
+
   void Enter(const parser::OpenMPLoopConstruct &);
   void Leave(const parser::OpenMPLoopConstruct &);
   void Enter(const parser::OmpEndLoopDirective &);

flang/lib/Semantics/resolve-directives.cpp

@@ -529,6 +529,9 @@ class OmpAttributeVisitor : DirectiveAttributeVisitor<llvm::omp::Directive> {
   void Post(const parser::OmpBeginLoopDirective &) {
     GetContext().withinConstruct = true;
   }
+  bool Pre(const parser::OpenMPMisplacedEndDirective &x) { return false; }
+  bool Pre(const parser::OpenMPInvalidDirective &x) { return false; }
+
   bool Pre(const parser::DoConstruct &);
 
   bool Pre(const parser::OpenMPSectionsConstruct &);

flang/test/Parser/OpenMP/fail-construct2.f90

@@ -1,5 +1,5 @@
 ! RUN: not %flang_fc1 -fsyntax-only -fopenmp %s 2>&1 | FileCheck %s
 
-! CHECK: error: expected OpenMP construct
+! CHECK: error: Invalid OpenMP directive
 !$omp dummy
 end

flang/test/Parser/OpenMP/tile-fail.f90

@@ -8,7 +8,7 @@
 ! Parser error
 
 subroutine stray_end1
-  !CHECK: error: expected OpenMP construct
+  !CHECK: error: Misplaced OpenMP end-directive
   !$omp end tile
 end subroutine
 
@@ -17,7 +17,7 @@ subroutine stray_end1
 
 subroutine stray_end2
   print *
-  !CHECK: error: expected 'END'
+  !CHECK: error: Misplaced OpenMP end-directive
   !$omp end tile
 end subroutine
 

flang/test/Semantics/OpenMP/loop-association.f90

@@ -81,6 +81,8 @@
   do i = 1, N
   enddo
   !$omp end parallel do
+  !ERROR: Misplaced OpenMP end-directive
+  !$omp end parallel do
 
   !$omp parallel
   a = 3.0
@@ -96,35 +98,47 @@
   !$omp end parallel
 
   a = 0.0
+  !ERROR: Misplaced OpenMP end-directive
+  !$omp end parallel do
   !$omp parallel do private(c)
   do i = 1, N
      do j = 1, N
         !$omp parallel do shared(b)
         !ERROR: OpenMP loop construct can only contain DO loops or loop-nest-generating OpenMP constructs
         a = 3.14
      enddo
+     !ERROR: Misplaced OpenMP end-directive
+     !$omp end parallel do
   enddo
   a = 1.414
+  !ERROR: Misplaced OpenMP end-directive
+  !$omp end parallel do
 
   do i = 1, N
      !$omp parallel do
      do j = 2*i*N, (2*i+1)*N
         a = 3.14
      enddo
   enddo
+  !ERROR: Misplaced OpenMP end-directive
+  !$omp end parallel do
 
   !$omp parallel do private(c)
   !ERROR: OpenMP loop construct can only contain DO loops or loop-nest-generating OpenMP constructs
 5 FORMAT (1PE12.4, I10)
   do i=1, N
      a = 3.14
   enddo
+  !ERROR: Misplaced OpenMP end-directive
+  !$omp end parallel do
 
   !$omp parallel do simd
   do i = 1, N
      a = 3.14
   enddo
   !$omp end parallel do simd
+  !ERROR: Misplaced OpenMP end-directive
+  !$omp end parallel do simd
 
   !$omp simd
     !ERROR: OpenMP loop construct can only contain DO loops or loop-nest-generating OpenMP constructs