[flang][OpenMP]Add support for fail clause

Support the atomic compare option of a fail(memory-order) clauses.

Additional tests introduced to check that parsing and semantics checks for
the new clause is handled.

Lowering for atomic compare is still unsupported and wil end in a TOOD
(aka "Not yet implemented"). A test for this case with the fail clause
is also present.

Author: Leporacanthicus

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

@@ -546,6 +546,7 @@ class ParseTreeDumper {
   NODE(parser, OmpEndCriticalDirective)
   NODE(parser, OmpEndLoopDirective)
   NODE(parser, OmpEndSectionsDirective)
+  NODE(parser, OmpFailClause)
   NODE(parser, OmpFromClause)
   NODE(OmpFromClause, Modifier)
   NODE(parser, OmpExpectation)

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

@@ -269,6 +269,7 @@ struct OpenACCRoutineConstruct;
 struct OpenMPConstruct;
 struct OpenMPDeclarativeConstruct;
 struct OmpEndLoopDirective;
+struct OmpMemoryOrderClause;
 struct CUFKernelDoConstruct;
 
 // Cooked character stream locations
@@ -4098,6 +4099,14 @@ struct OmpUpdateClause {
   std::variant<OmpDependenceType, OmpTaskDependenceType> u;
 };
 
+// OMP 5.2 15.8.3 extened-atomic, fail-clause ->
+//    FAIL(memory-order)
+struct OmpFailClause {
+  WRAPPER_CLASS_BOILERPLATE(
+      OmpFailClause, common::Indirection<OmpMemoryOrderClause>);
+  CharBlock source;
+};
+
 // OpenMP Clauses
 struct OmpClause {
   UNION_CLASS_BOILERPLATE(OmpClause);
@@ -4317,11 +4326,12 @@ struct OmpMemoryOrderClause {
 };
 
 // 2.17.7 Atomic construct
-//        atomic-clause -> memory-order-clause | HINT(hint-expression)
+//        atomic-clause -> memory-order-clause | HINT(hint-expression) |
+//        FAIL(memory-order)
 struct OmpAtomicClause {
   UNION_CLASS_BOILERPLATE(OmpAtomicClause);
   CharBlock source;
-  std::variant<OmpMemoryOrderClause, OmpClause> u;
+  std::variant<OmpMemoryOrderClause, OmpFailClause, OmpClause> u;
 };
 
 // atomic-clause-list -> [atomic-clause, [atomic-clause], ...]

flang/lib/Parser/openmp-parsers.cpp

@@ -739,6 +739,9 @@ TYPE_PARSER(sourced(construct<OpenMPCancellationPointConstruct>(
 TYPE_PARSER(sourced(construct<OpenMPCancelConstruct>(verbatim("CANCEL"_tok),
     Parser<OmpCancelType>{}, maybe("IF" >> parenthesized(scalarLogicalExpr)))))
 
+TYPE_PARSER(sourced(construct<OmpFailClause>(
+    parenthesized(indirect(Parser<OmpMemoryOrderClause>{})))))
+
 // 2.17.7 Atomic construct/2.17.8 Flush construct [OpenMP 5.0]
 //        memory-order-clause ->
 //                               seq_cst
@@ -767,6 +770,7 @@ TYPE_PARSER(construct<OmpAtomicDefaultMemOrderClause>(
 //        atomic-clause -> memory-order-clause | HINT(hint-expression)
 TYPE_PARSER(sourced(construct<OmpAtomicClause>(
     construct<OmpAtomicClause>(Parser<OmpMemoryOrderClause>{}) ||
+    construct<OmpAtomicClause>("FAIL" >> Parser<OmpFailClause>{}) ||
     construct<OmpAtomicClause>("HINT" >>
         sourced(construct<OmpClause>(
             construct<OmpClause::Hint>(parenthesized(constantExpr))))))))

flang/lib/Parser/unparse.cpp

@@ -2702,10 +2702,16 @@ class UnparseVisitor {
     Put("\n");
     EndOpenMP();
   }
+  void Unparse(const OmpFailClause &x) {
+    Word("FAIL(");
+    Walk(x.v);
+    Put(")");
+  }
   void Unparse(const OmpMemoryOrderClause &x) { Walk(x.v); }
   void Unparse(const OmpAtomicClause &x) {
     common::visit(common::visitors{
                       [&](const OmpMemoryOrderClause &y) { Walk(y); },
+                      [&](const OmpFailClause &y) { Walk(y); },
                       [&](const OmpClause &z) { Walk(z); },
                   },
         x.u);

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

@@ -2486,17 +2486,28 @@ void OmpStructureChecker::CheckAtomicMemoryOrderClause(
     const parser::OmpAtomicClauseList *leftHandClauseList,
     const parser::OmpAtomicClauseList *rightHandClauseList) {
   int numMemoryOrderClause = 0;
+  int numFailClause = 0;
   auto checkForValidMemoryOrderClause =
       [&](const parser::OmpAtomicClauseList *clauseList) {
         for (const auto &clause : clauseList->v) {
-          if (std::get_if<Fortran::parser::OmpMemoryOrderClause>(&clause.u)) {
-            numMemoryOrderClause++;
-            if (numMemoryOrderClause > 1) {
+          if (std::get_if<parser::OmpFailClause>(&clause.u)) {
+            numFailClause++;
+            if (numFailClause > 1) {
               context_.Say(clause.source,
-                  "More than one memory order clause not allowed on "
+                  "More than one fail clause not allowed on "
                   "OpenMP Atomic construct"_err_en_US);
               return;
             }
+          } else {
+            if (std::get_if<Fortran::parser::OmpMemoryOrderClause>(&clause.u)) {
+              numMemoryOrderClause++;
+              if (numMemoryOrderClause > 1) {
+                context_.Say(clause.source,
+                    "More than one memory order clause not allowed on "
+                    "OpenMP Atomic construct"_err_en_US);
+                return;
+              }
+            }
           }
         }
       };

flang/lib/Semantics/semantics.cpp

@@ -114,6 +114,11 @@ class SemanticsVisitor : public virtual BaseChecker, public virtual C... {
     context_.set_location(std::nullopt);
   }
 
+  // This is necessary to avoid "walking" into the Fail clause,
+  // which confuses the CheckAllowed into thinking there's another
+  // memoryorder, when it's actually the argument to the fail clause.
+  bool Pre(const parser::OmpFailClause &) { return false; }
+
   bool Walk(const parser::Program &program) {
     parser::Walk(program, *this);
     return !context_.AnyFatalError();

flang/test/Lower/OpenMP/Todo/atomic-compare-fail.f90

@@ -0,0 +1,11 @@
+! RUN: %not_todo_cmd %flang_fc1 -emit-fir -fopenmp -fopenmp-version=51 -o - %s 2>&1 | FileCheck %s
+
+! CHECK: not yet implemented: OpenMP atomic compare
+program p
+  integer :: x
+  logical :: r
+  !$omp atomic compare fail(relaxed)
+  if (x .eq. 0) then
+     x = 2
+  end if
+end program p

flang/test/Parser/OpenMP/atomic-unparse.f90

@@ -165,6 +165,20 @@ program main
       i = j
    end if
 
+
+!$omp atomic compare fail(relaxed)
+   if (i .eq. k) then
+      i = j
+   end if
+!$omp atomic fail(relaxed) compare
+   if (i .eq. k) then
+      i = j
+   end if
+!$omp atomic fail(relaxed) compare acquire
+   if (i .eq. k) then
+      i = j
+   end if
+   
 !ATOMIC
 !$omp atomic
    i = j
@@ -262,6 +276,9 @@ end program main
 !CHECK: !$OMP ATOMIC COMPARE ACQUIRE
 !CHECK: !$OMP ATOMIC RELAXED COMPARE
 !CHECK: !$OMP ATOMIC COMPARE RELAXED
+!CHECK: !$OMP ATOMIC COMPARE FAIL(RELAXED)
+!CHECK: !$OMP ATOMIC FAIL(RELAXED) COMPARE
+!CHECK: !$OMP ATOMIC FAIL(RELAXED) COMPARE ACQUIRE
 
 !ATOMIC
 !CHECK: !$OMP ATOMIC
@@ -270,3 +287,5 @@ end program main
 !CHECK: !$OMP ATOMIC ACQ_REL
 !CHECK: !$OMP ATOMIC ACQUIRE
 !CHECK: !$OMP ATOMIC RELAXED
+
+

flang/test/Semantics/OpenMP/atomic-compare.f90

@@ -35,6 +35,14 @@
   if (b .eq. a) b = c
   !$omp end atomic
 
+  !$omp atomic hint(1) acq_rel compare fail(release)
+  if (c .eq. a) a = b
+  !$omp end atomic
+
+  !$omp atomic compare fail(release)
+  if (c .eq. a) a = b
+  !$omp end atomic
+
   ! Check for error conditions:
   !ERROR: More than one memory order clause not allowed on OpenMP Atomic construct
   !ERROR: At most one SEQ_CST clause can appear on the COMPARE directive
@@ -75,5 +83,10 @@
   !$omp atomic relaxed compare relaxed
   if (b .eq. c) b = a
 
+  !ERROR: More than one fail clause not allowed on OpenMP Atomic construct
+  !$omp atomic fail(release) compare fail(release)
+  if (c .eq. a) a = b
+  !$omp end atomic
+
   !$omp end parallel
 end

llvm/include/llvm/Frontend/OpenMP/OMP.td

@@ -177,6 +177,7 @@ def OMPC_Exclusive : Clause<"exclusive"> {
 }
 def OMPC_Fail : Clause<"fail"> {
   let clangClass = "OMPFailClause";
+  let flangClass = "OmpFailClause";
 }
 def OMPC_Filter : Clause<"filter"> {
   let clangClass = "OMPFilterClause";