[flang][OpenMP] Parse ORDERED as standalone when DEPEND/DOACROSS is p… (#156693)

…resent

The OpenMP spec 4.5-5.1 defines ORDERED as standalone when a DEPEND
clause is present (with either SOURCE or SINK as argument). The OpenMP
spec 5.2+ defines ORDERED as standalone when a DOACROSS clause is
present.

Author: kparzysz

flang/lib/Parser/openmp-parsers.cpp

@@ -1281,6 +1281,16 @@ static bool IsFortranBlockConstruct(const ExecutionPartConstruct &epc) {
   }
 }
 
+static bool IsStandaloneOrdered(const OmpDirectiveSpecification &dirSpec) {
+  // An ORDERED construct is standalone if it has DOACROSS or DEPEND clause.
+  return dirSpec.DirId() == llvm::omp::Directive::OMPD_ordered &&
+      llvm::any_of(dirSpec.Clauses().v, [](const OmpClause &clause) {
+        llvm::omp::Clause id{clause.Id()};
+        return id == llvm::omp::Clause::OMPC_depend ||
+            id == llvm::omp::Clause::OMPC_doacross;
+      });
+}
+
 struct StrictlyStructuredBlockParser {
   using resultType = Block;
 
@@ -1464,6 +1474,9 @@ struct OmpBlockConstructParser {
 
   std::optional<resultType> Parse(ParseState &state) const {
     if (auto &&begin{OmpBeginDirectiveParser(dir_).Parse(state)}) {
+      if (IsStandaloneOrdered(*begin)) {
+        return std::nullopt;
+      }
       if (auto &&body{attempt(StrictlyStructuredBlockParser{}).Parse(state)}) {
         // Try strictly-structured block with an optional end-directive
         auto end{maybe(OmpEndDirectiveParser{dir_}).Parse(state)};
@@ -1475,17 +1488,6 @@ struct OmpBlockConstructParser {
                      attempt(LooselyStructuredBlockParser{}).Parse(state)}) {
         // 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)),
@@ -1642,7 +1644,6 @@ TYPE_PARSER(sourced( //
 static bool IsSimpleStandalone(const OmpDirectiveName &name) {
   switch (name.v) {
   case llvm::omp::Directive::OMPD_barrier:
-  case llvm::omp::Directive::OMPD_ordered:
   case llvm::omp::Directive::OMPD_scan:
   case llvm::omp::Directive::OMPD_target_enter_data:
   case llvm::omp::Directive::OMPD_target_exit_data:
@@ -1658,7 +1659,9 @@ static bool IsSimpleStandalone(const OmpDirectiveName &name) {
 TYPE_PARSER(sourced( //
     construct<OpenMPSimpleStandaloneConstruct>(
         predicated(OmpDirectiveNameParser{}, IsSimpleStandalone) >=
-        Parser<OmpDirectiveSpecification>{})))
+        Parser<OmpDirectiveSpecification>{}) ||
+    construct<OpenMPSimpleStandaloneConstruct>(
+        predicated(Parser<OmpDirectiveSpecification>{}, IsStandaloneOrdered))))
 
 TYPE_PARSER(sourced( //
     construct<OpenMPFlushConstruct>(

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

@@ -890,8 +890,16 @@ void OmpStructureChecker::Enter(const parser::OmpBlockConstruct &x) {
         executableConstruct->u);
   }};
   if (!endSpec && !isStrictlyStructuredBlock(block)) {
-    context_.Say(
-        x.BeginDir().source, "Expected OpenMP end directive"_err_en_US);
+    llvm::omp::Directive dirId{beginSpec.DirId()};
+    auto &msg{context_.Say(beginSpec.source,
+        "Expected OpenMP END %s directive"_err_en_US,
+        parser::ToUpperCaseLetters(getDirectiveName(dirId)))};
+    // ORDERED has two variants, so be explicit about which variant we think
+    // this is.
+    if (dirId == llvm::omp::Directive::OMPD_ordered) {
+      msg.Attach(
+          beginSpec.source, "The ORDERED directive is block-associated"_en_US);
+    }
   }
 
   if (llvm::omp::allTargetSet.test(GetContext().directive)) {

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 OpenMP end directive
+!$omp parallel
+! CHECK: error: Expected OpenMP END PARALLEL directive
 end

flang/test/Parser/OpenMP/ordered-block-vs-standalone.f90

@@ -1,4 +1,4 @@
-! RUN: %flang_fc1 -fdebug-dump-parse-tree -fopenmp -fopenmp-version=45 %s | FileCheck %s
+! RUN: %flang_fc1 -fdebug-dump-parse-tree-no-sema -fopenmp -fopenmp-version=45 %s | FileCheck %s
 
 ! Check that standalone ORDERED is successfully distinguished form block associated ORDERED
 
@@ -12,7 +12,7 @@ subroutine standalone
       ! CHECK-NEXT: | OmpDirectiveName -> llvm::omp::Directive = ordered
       ! CHECK-NEXT: | OmpClauseList ->
       ! CHECK-NEXT: | Flags = None
-      !$omp ordered
+      !$omp ordered depend(source)
       x(i, j) = i + j
     end do
   end do

flang/test/Semantics/OpenMP/missing-end-directive.f90

@@ -2,15 +2,15 @@
 
 ! Test that we can diagnose missing end directives without an explosion of errors
 
-! ERROR: Expected OpenMP end directive
+! ERROR: Expected OpenMP END PARALLEL directive
 !$omp parallel
-! ERROR: Expected OpenMP end directive
+! ERROR: Expected OpenMP END TASK directive
 !$omp task
 ! ERROR: Expected OpenMP END SECTIONS directive
 !$omp sections
-! ERROR: Expected OpenMP end directive
+! ERROR: Expected OpenMP END PARALLEL directive
 !$omp parallel
-! ERROR: Expected OpenMP end directive
+! ERROR: Expected OpenMP END TASK directive
 !$omp task
 ! ERROR: Expected OpenMP END SECTIONS directive
 !$omp sections

flang/test/Semantics/OpenMP/ordered01.f90

@@ -52,27 +52,14 @@ program main
   end do
   !$omp end do
 
-  !$omp do ordered(1)
-  do i = 2, N
-    !ERROR: DEPEND clauses are not allowed when ORDERED construct is a block construct with an ORDERED region
-    !$omp ordered depend(source)
-    arrayA(i) = foo(i)
-    !$omp end ordered
-    !ERROR: DEPEND clauses are not allowed when ORDERED construct is a block construct with an ORDERED region
-    !$omp ordered depend(sink: i - 1)
-    arrayB(i) = bar(arrayA(i), arrayB(i-1))
-    !$omp end ordered
-  end do
-  !$omp end do
-
 contains
   subroutine work1()
-    !ERROR: THREADS and SIMD clauses are not allowed when ORDERED construct is a standalone construct with no ORDERED region
+    !ERROR: Expected OpenMP END ORDERED directive
     !$omp ordered simd
   end subroutine work1
 
   subroutine work2()
-    !ERROR: THREADS and SIMD clauses are not allowed when ORDERED construct is a standalone construct with no ORDERED region
+    !ERROR: Expected OpenMP END ORDERED directive
     !$omp ordered threads
   end subroutine work2