[flang][OpenMP] Overhaul implementation of ATOMIC construct (#137852)

The parser will accept a wide variety of illegal attempts at forming an
ATOMIC construct, leaving it to the semantic analysis to diagnose any
issues. This consolidates the analysis into one place and allows us to
produce more informative diagnostics.

The parser's outcome will be parser::OpenMPAtomicConstruct object
holding the directive, parser::Body, and an optional end-directive. The
prior variety of OmpAtomicXyz classes, as well as OmpAtomicClause have
been removed. READ, WRITE, etc. are now proper clauses.

The semantic analysis consistently operates on "evaluation"
representations, mainly evaluate::Expr (as SomeExpr) and
evaluate::Assignment. The results of the semantic analysis are stored in
a mutable member of the OpenMPAtomicConstruct node. This follows a
precedent of having `typedExpr` member in parser::Expr, for example.
This allows the lowering code to avoid duplicated handling of AST nodes.

Using a BLOCK construct containing multiple statements for an ATOMIC
construct that requires multiple statements is now allowed. In fact, any
nesting of such BLOCK constructs is allowed.

This implementation will parse, and perform semantic checks for both
conditional-update and conditional-update-capture, although no MLIR will
be generated for those. Instead, a TODO error will be issues prior to
lowering.

The allowed forms of the ATOMIC construct were based on the OpenMP 6.0
spec.

flang/docs/OpenMPSupport.md

@@ -60,3 +60,16 @@ Note : No distinction is made between the support in Parser/Semantics, MLIR, Low
 | target teams distribute parallel loop construct            | P      | device, reduction and dist_schedule clauses are not supported |
 | teams distribute parallel loop simd construct              | P      | reduction, dist_schedule, and linear clauses are not supported |
 | target teams distribute parallel loop simd construct       | P      | device, reduction, dist_schedule and linear clauses are not supported |
+
+## Extensions
+### ATOMIC construct
+The implementation of the ATOMIC construct follows OpenMP 6.0 with the following extensions:
+- `x = x` is an allowed form of ATOMIC UPDATE.
+This is motivated by the fact that the equivalent forms `x = x+0` or `x = x*1` are allowed.
+- Explicit type conversions are allowed in ATOMIC READ, WRITE or UPDATE constructs, and in the capture statement in ATOMIC UPDATE CAPTURE.
+The OpenMP spec requires intrinsic- or pointer-assignments, which include (as per the Fortran standard) implicit type conversions.  Since such conversions need to be handled, allowing explicit conversions comes at no extra cost.
+- A literal `.true.` or `.false.` is an allowed condition in ATOMIC UPDATE COMPARE. [1]
+- A logical variable is an allowed form of the condition even if its value is not computed within the ATOMIC UPDATE COMPARE construct [1].
+- `expr equalop x` is an allowed condition in ATOMIC UPDATE COMPARE. [1]
+
+[1] Code generation for ATOMIC UPDATE COMPARE is not implemented yet.

flang/examples/FeatureList/FeatureList.cpp

@@ -445,13 +445,6 @@ public:
   READ_FEATURE(ObjectDecl)
   READ_FEATURE(OldParameterStmt)
   READ_FEATURE(OmpAlignedClause)
-  READ_FEATURE(OmpAtomic)
-  READ_FEATURE(OmpAtomicCapture)
-  READ_FEATURE(OmpAtomicCapture::Stmt1)
-  READ_FEATURE(OmpAtomicCapture::Stmt2)
-  READ_FEATURE(OmpAtomicRead)
-  READ_FEATURE(OmpAtomicUpdate)
-  READ_FEATURE(OmpAtomicWrite)
   READ_FEATURE(OmpBeginBlockDirective)
   READ_FEATURE(OmpBeginLoopDirective)
   READ_FEATURE(OmpBeginSectionsDirective)
@@ -480,7 +473,6 @@ public:
   READ_FEATURE(OmpIterationOffset)
   READ_FEATURE(OmpIterationVector)
   READ_FEATURE(OmpEndAllocators)
-  READ_FEATURE(OmpEndAtomic)
   READ_FEATURE(OmpEndBlockDirective)
   READ_FEATURE(OmpEndCriticalDirective)
   READ_FEATURE(OmpEndLoopDirective)
@@ -566,8 +558,6 @@ public:
   READ_FEATURE(OpenMPDeclareTargetConstruct)
   READ_FEATURE(OmpMemoryOrderType)
   READ_FEATURE(OmpMemoryOrderClause)
-  READ_FEATURE(OmpAtomicClause)
-  READ_FEATURE(OmpAtomicClauseList)
   READ_FEATURE(OmpAtomicDefaultMemOrderClause)
   READ_FEATURE(OpenMPFlushConstruct)
   READ_FEATURE(OpenMPLoopConstruct)

flang/examples/FlangOmpReport/FlangOmpReportVisitor.cpp

@@ -74,25 +74,19 @@ SourcePosition OpenMPCounterVisitor::getLocation(const OpenMPConstruct &c) {
           // the directive field.
           [&](const auto &c) -> SourcePosition {
             const CharBlock &source{std::get<0>(c.t).source};
-            return (parsing->allCooked().GetSourcePositionRange(source))->first;
+            return parsing->allCooked().GetSourcePositionRange(source)->first;
           },
           [&](const OpenMPAtomicConstruct &c) -> SourcePosition {
-            return std::visit(
-                [&](const auto &o) -> SourcePosition {
-                  const CharBlock &source{std::get<Verbatim>(o.t).source};
-                  return parsing->allCooked()
-                      .GetSourcePositionRange(source)
-                      ->first;
-                },
-                c.u);
+            const CharBlock &source{c.source};
+            return parsing->allCooked().GetSourcePositionRange(source)->first;
           },
           [&](const OpenMPSectionConstruct &c) -> SourcePosition {
             const CharBlock &source{c.source};
-            return (parsing->allCooked().GetSourcePositionRange(source))->first;
+            return parsing->allCooked().GetSourcePositionRange(source)->first;
           },
           [&](const OpenMPUtilityConstruct &c) -> SourcePosition {
             const CharBlock &source{c.source};
-            return (parsing->allCooked().GetSourcePositionRange(source))->first;
+            return parsing->allCooked().GetSourcePositionRange(source)->first;
           },
       },
       c.u);
@@ -157,14 +151,9 @@ std::string OpenMPCounterVisitor::getName(const OpenMPConstruct &c) {
             return normalize_construct_name(source.ToString());
           },
           [&](const OpenMPAtomicConstruct &c) -> std::string {
-            return std::visit(
-                [&](const auto &c) {
-                  // Get source from the verbatim fields
-                  const CharBlock &source{std::get<Verbatim>(c.t).source};
-                  return "atomic-" +
-                      normalize_construct_name(source.ToString());
-                },
-                c.u);
+            auto &dirSpec = std::get<OmpDirectiveSpecification>(c.t);
+            auto &dirName = std::get<OmpDirectiveName>(dirSpec.t);
+            return normalize_construct_name(dirName.source.ToString());
           },
           [&](const OpenMPUtilityConstruct &c) -> std::string {
             const CharBlock &source{c.source};

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

@@ -532,15 +532,6 @@ public:
   NODE(parser, OmpAtClause)
   NODE_ENUM(OmpAtClause, ActionTime)
   NODE_ENUM(OmpSeverityClause, Severity)
-  NODE(parser, OmpAtomic)
-  NODE(parser, OmpAtomicCapture)
-  NODE(OmpAtomicCapture, Stmt1)
-  NODE(OmpAtomicCapture, Stmt2)
-  NODE(parser, OmpAtomicCompare)
-  NODE(parser, OmpAtomicCompareIfStmt)
-  NODE(parser, OmpAtomicRead)
-  NODE(parser, OmpAtomicUpdate)
-  NODE(parser, OmpAtomicWrite)
   NODE(parser, OmpBeginBlockDirective)
   NODE(parser, OmpBeginLoopDirective)
   NODE(parser, OmpBeginSectionsDirective)
@@ -587,7 +578,6 @@ public:
   NODE(parser, OmpDoacrossClause)
   NODE(parser, OmpDestroyClause)
   NODE(parser, OmpEndAllocators)
-  NODE(parser, OmpEndAtomic)
   NODE(parser, OmpEndBlockDirective)
   NODE(parser, OmpEndCriticalDirective)
   NODE(parser, OmpEndLoopDirective)
@@ -716,8 +706,6 @@ public:
   NODE(parser, OpenMPDeclareMapperConstruct)
   NODE_ENUM(common, OmpMemoryOrderType)
   NODE(parser, OmpMemoryOrderClause)
-  NODE(parser, OmpAtomicClause)
-  NODE(parser, OmpAtomicClauseList)
   NODE(parser, OmpAtomicDefaultMemOrderClause)
   NODE(parser, OpenMPDepobjConstruct)
   NODE(parser, OpenMPUtilityConstruct)

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

@@ -4857,94 +4857,37 @@ struct OmpMemoryOrderClause {
   CharBlock source;
 };
 
-// 2.17.7 Atomic construct
-//        atomic-clause -> memory-order-clause | HINT(hint-expression) |
-//        FAIL(memory-order)
-struct OmpAtomicClause {
-  UNION_CLASS_BOILERPLATE(OmpAtomicClause);
-  CharBlock source;
-  std::variant<OmpMemoryOrderClause, OmpFailClause, OmpHintClause> u;
-};
-
-// atomic-clause-list -> [atomic-clause, [atomic-clause], ...]
-struct OmpAtomicClauseList {
-  WRAPPER_CLASS_BOILERPLATE(OmpAtomicClauseList, std::list<OmpAtomicClause>);
-  CharBlock source;
-};
-
-// END ATOMIC
-EMPTY_CLASS(OmpEndAtomic);
-
-// ATOMIC READ
-struct OmpAtomicRead {
-  TUPLE_CLASS_BOILERPLATE(OmpAtomicRead);
-  CharBlock source;
-  std::tuple<OmpAtomicClauseList, Verbatim, OmpAtomicClauseList,
-      Statement<AssignmentStmt>, std::optional<OmpEndAtomic>>
-      t;
-};
-
-// ATOMIC WRITE
-struct OmpAtomicWrite {
-  TUPLE_CLASS_BOILERPLATE(OmpAtomicWrite);
-  CharBlock source;
-  std::tuple<OmpAtomicClauseList, Verbatim, OmpAtomicClauseList,
-      Statement<AssignmentStmt>, std::optional<OmpEndAtomic>>
-      t;
-};
-
-// ATOMIC UPDATE
-struct OmpAtomicUpdate {
-  TUPLE_CLASS_BOILERPLATE(OmpAtomicUpdate);
-  CharBlock source;
-  std::tuple<OmpAtomicClauseList, Verbatim, OmpAtomicClauseList,
-      Statement<AssignmentStmt>, std::optional<OmpEndAtomic>>
-      t;
-};
-
-// ATOMIC CAPTURE
-struct OmpAtomicCapture {
-  TUPLE_CLASS_BOILERPLATE(OmpAtomicCapture);
-  CharBlock source;
-  WRAPPER_CLASS(Stmt1, Statement<AssignmentStmt>);
-  WRAPPER_CLASS(Stmt2, Statement<AssignmentStmt>);
-  std::tuple<OmpAtomicClauseList, Verbatim, OmpAtomicClauseList, Stmt1, Stmt2,
-      OmpEndAtomic>
-      t;
-};
-
-struct OmpAtomicCompareIfStmt {
-  UNION_CLASS_BOILERPLATE(OmpAtomicCompareIfStmt);
-  std::variant<common::Indirection<IfStmt>, common::Indirection<IfConstruct>> u;
-};
-
-// ATOMIC COMPARE (OpenMP 5.1, OPenMP 5.2 spec: 15.8.4)
-struct OmpAtomicCompare {
-  TUPLE_CLASS_BOILERPLATE(OmpAtomicCompare);
-  CharBlock source;
-  std::tuple<OmpAtomicClauseList, Verbatim, OmpAtomicClauseList,
-      OmpAtomicCompareIfStmt, std::optional<OmpEndAtomic>>
-      t;
-};
-
-// ATOMIC
-struct OmpAtomic {
-  TUPLE_CLASS_BOILERPLATE(OmpAtomic);
-  CharBlock source;
-  std::tuple<Verbatim, OmpAtomicClauseList, Statement<AssignmentStmt>,
-      std::optional<OmpEndAtomic>>
-      t;
-};
-
-// 2.17.7 atomic ->
-//        ATOMIC [atomic-clause-list] atomic-construct [atomic-clause-list] |
-//        ATOMIC [atomic-clause-list]
-//        atomic-construct -> READ | WRITE | UPDATE | CAPTURE | COMPARE
 struct OpenMPAtomicConstruct {
-  UNION_CLASS_BOILERPLATE(OpenMPAtomicConstruct);
-  std::variant<OmpAtomicRead, OmpAtomicWrite, OmpAtomicCapture, OmpAtomicUpdate,
-      OmpAtomicCompare, OmpAtomic>
-      u;
+  llvm::omp::Clause GetKind() const;
+  bool IsCapture() const;
+  bool IsCompare() const;
+  TUPLE_CLASS_BOILERPLATE(OpenMPAtomicConstruct);
+  CharBlock source;
+  std::tuple<OmpDirectiveSpecification, Block,
+      std::optional<OmpDirectiveSpecification>>
+      t;
+
+  // Information filled out during semantic checks to avoid duplication
+  // of analyses.
+  struct Analysis {
+    static constexpr int None = 0;
+    static constexpr int Read = 1;
+    static constexpr int Write = 2;
+    static constexpr int Update = Read | Write;
+    static constexpr int Action = 3; // Bitmask for None, Read, Write, Update
+    static constexpr int IfTrue = 4;
+    static constexpr int IfFalse = 8;
+    static constexpr int Condition = 12; // Bitmask for IfTrue, IfFalse
+
+    struct Op {
+      int what;
+      AssignmentStmt::TypedAssignment assign;
+    };
+    TypedExpr atom, cond;
+    Op op0, op1;
+  };
+
+  mutable Analysis analysis;
 };
 
 // OpenMP directives that associate with loop(s)

flang/include/flang/Semantics/tools.h

@@ -755,5 +755,152 @@ bool HadUseError(SemanticsContext &, SourceName at, const Symbol *);
 
 // Checks whether the symbol on the LHS is present in the RHS expression.
 bool CheckForSymbolMatch(const SomeExpr *lhs, const SomeExpr *rhs);
+
+namespace operation {
+
+enum class Operator {
+  Unknown,
+  Add,
+  And,
+  Associated,
+  Call,
+  Constant,
+  Convert,
+  Div,
+  Eq,
+  Eqv,
+  False,
+  Ge,
+  Gt,
+  Identity,
+  Intrinsic,
+  Le,
+  Lt,
+  Max,
+  Min,
+  Mul,
+  Ne,
+  Neqv,
+  Not,
+  Or,
+  Pow,
+  Resize, // Convert within the same TypeCategory
+  Sub,
+  True,
+};
+
+std::string ToString(Operator op);
+
+template <typename... Ts, int Kind>
+Operator OperationCode(
+    const evaluate::Operation<evaluate::LogicalOperation<Kind>, Ts...> &op) {
+  switch (op.derived().logicalOperator) {
+  case common::LogicalOperator::And:
+    return Operator::And;
+  case common::LogicalOperator::Or:
+    return Operator::Or;
+  case common::LogicalOperator::Eqv:
+    return Operator::Eqv;
+  case common::LogicalOperator::Neqv:
+    return Operator::Neqv;
+  case common::LogicalOperator::Not:
+    return Operator::Not;
+  }
+  return Operator::Unknown;
+}
+
+template <typename T, typename... Ts>
+Operator OperationCode(
+    const evaluate::Operation<evaluate::Relational<T>, Ts...> &op) {
+  switch (op.derived().opr) {
+  case common::RelationalOperator::LT:
+    return Operator::Lt;
+  case common::RelationalOperator::LE:
+    return Operator::Le;
+  case common::RelationalOperator::EQ:
+    return Operator::Eq;
+  case common::RelationalOperator::NE:
+    return Operator::Ne;
+  case common::RelationalOperator::GE:
+    return Operator::Ge;
+  case common::RelationalOperator::GT:
+    return Operator::Gt;
+  }
+  return Operator::Unknown;
+}
+
+template <typename T, typename... Ts>
+Operator OperationCode(const evaluate::Operation<evaluate::Add<T>, Ts...> &op) {
+  return Operator::Add;
+}
+
+template <typename T, typename... Ts>
+Operator OperationCode(
+    const evaluate::Operation<evaluate::Subtract<T>, Ts...> &op) {
+  return Operator::Sub;
+}
+
+template <typename T, typename... Ts>
+Operator OperationCode(
+    const evaluate::Operation<evaluate::Multiply<T>, Ts...> &op) {
+  return Operator::Mul;
+}
+
+template <typename T, typename... Ts>
+Operator OperationCode(
+    const evaluate::Operation<evaluate::Divide<T>, Ts...> &op) {
+  return Operator::Div;
+}
+
+template <typename T, typename... Ts>
+Operator OperationCode(
+    const evaluate::Operation<evaluate::Power<T>, Ts...> &op) {
+  return Operator::Pow;
+}
+
+template <typename T, typename... Ts>
+Operator OperationCode(
+    const evaluate::Operation<evaluate::RealToIntPower<T>, Ts...> &op) {
+  return Operator::Pow;
+}
+
+template <typename T, common::TypeCategory C, typename... Ts>
+Operator OperationCode(
+    const evaluate::Operation<evaluate::Convert<T, C>, Ts...> &op) {
+  if constexpr (C == T::category) {
+    return Operator::Resize;
+  } else {
+    return Operator::Convert;
+  }
+}
+
+template <typename T> //
+Operator OperationCode(const evaluate::Constant<T> &x) {
+  return Operator::Constant;
+}
+
+template <typename T> //
+Operator OperationCode(const T &) {
+  return Operator::Unknown;
+}
+
+Operator OperationCode(const evaluate::ProcedureDesignator &proc);
+
+} // namespace operation
+
+/// Return information about the top-level operation (ignoring parentheses):
+/// the operation code and the list of arguments.
+std::pair<operation::Operator, std::vector<SomeExpr>> GetTopLevelOperation(
+    const SomeExpr &expr);
+
+/// Check if expr is same as x, or a sequence of Convert operations on x.
+bool IsSameOrConvertOf(const SomeExpr &expr, const SomeExpr &x);
+
+/// Strip away any top-level Convert operations (if any exist) and return
+/// the input value. A ComplexConstructor(x, 0) is also considered as a
+/// convert operation.
+/// If the input is not Operation, Designator, FunctionRef or Constant,
+/// it returns std::nullopt.
+MaybeExpr GetConvertInput(const SomeExpr &x);
 } // namespace Fortran::semantics
 #endif // FORTRAN_SEMANTICS_TOOLS_H_

flang/lib/Lower/OpenMP/DataSharingProcessor.cpp

@@ -356,26 +356,26 @@ getSource(const semantics::SemanticsContext &semaCtx,
   const parser::CharBlock *source = nullptr;
 
   auto ompConsVisit = [&](const parser::OpenMPConstruct &x) {
-    std::visit(common::visitors{
-                   [&](const parser::OpenMPSectionsConstruct &x) {
-                     source = &std::get<0>(x.t).source;
-                   },
-                   [&](const parser::OpenMPLoopConstruct &x) {
-                     source = &std::get<0>(x.t).source;
-                   },
-                   [&](const parser::OpenMPBlockConstruct &x) {
-                     source = &std::get<0>(x.t).source;
-                   },
-                   [&](const parser::OpenMPCriticalConstruct &x) {
-                     source = &std::get<0>(x.t).source;
-                   },
-                   [&](const parser::OpenMPAtomicConstruct &x) {
-                     std::visit([&](const auto &x) { source = &x.source; },
-                                x.u);
-                   },
-                   [&](const auto &x) { source = &x.source; },
-               },
-               x.u);
+    std::visit(
+        common::visitors{
+            [&](const parser::OpenMPSectionsConstruct &x) {
+              source = &std::get<0>(x.t).source;
+            },
+            [&](const parser::OpenMPLoopConstruct &x) {
+              source = &std::get<0>(x.t).source;
+            },
+            [&](const parser::OpenMPBlockConstruct &x) {
+              source = &std::get<0>(x.t).source;
+            },
+            [&](const parser::OpenMPCriticalConstruct &x) {
+              source = &std::get<0>(x.t).source;
+            },
+            [&](const parser::OpenMPAtomicConstruct &x) {
+              source = &std::get<parser::OmpDirectiveSpecification>(x.t).source;
+            },
+            [&](const auto &x) { source = &x.source; },
+        },
+        x.u);
   };
 
   eval.visit(common::visitors{

flang/lib/Parser/openmp-parsers.cpp

@@ -24,6 +24,12 @@
 // OpenMP Directives and Clauses
 namespace Fortran::parser {
 
+// Helper function to print the buffer contents starting at the current point.
+[[maybe_unused]] static std::string ahead(const ParseState &state) {
+  return std::string(
+      state.GetLocation(), std::min<size_t>(64, state.BytesRemaining()));
+}
+
 constexpr auto startOmpLine = skipStuffBeforeStatement >> "!$OMP "_sptok;
 constexpr auto endOmpLine = space >> endOfLine;
 
@@ -941,8 +947,10 @@ TYPE_PARSER( //
             parenthesized(Parser<OmpAtomicDefaultMemOrderClause>{}))) ||
     "BIND" >> construct<OmpClause>(construct<OmpClause::Bind>(
                   parenthesized(Parser<OmpBindClause>{}))) ||
+    "CAPTURE" >> construct<OmpClause>(construct<OmpClause::Capture>()) ||
     "COLLAPSE" >> construct<OmpClause>(construct<OmpClause::Collapse>(
                       parenthesized(scalarIntConstantExpr))) ||
+    "COMPARE" >> construct<OmpClause>(construct<OmpClause::Compare>()) ||
     "CONTAINS" >> construct<OmpClause>(construct<OmpClause::Contains>(
                       parenthesized(Parser<OmpContainsClause>{}))) ||
     "COPYIN" >> construct<OmpClause>(construct<OmpClause::Copyin>(
@@ -1062,6 +1070,7 @@ TYPE_PARSER( //
     "TASK_REDUCTION" >>
         construct<OmpClause>(construct<OmpClause::TaskReduction>(
             parenthesized(Parser<OmpTaskReductionClause>{}))) ||
+    "READ" >> construct<OmpClause>(construct<OmpClause::Read>()) ||
     "RELAXED" >> construct<OmpClause>(construct<OmpClause::Relaxed>()) ||
     "RELEASE" >> construct<OmpClause>(construct<OmpClause::Release>()) ||
     "REVERSE_OFFLOAD" >>
@@ -1105,6 +1114,7 @@ TYPE_PARSER( //
                     maybe(Parser<OmpUpdateClause>{}))) ||
     "WHEN" >> construct<OmpClause>(construct<OmpClause::When>(
                   parenthesized(Parser<OmpWhenClause>{}))) ||
+    "WRITE" >> construct<OmpClause>(construct<OmpClause::Write>()) ||
     // Cancellable constructs
     construct<OmpClause>(construct<OmpClause::CancellationConstructType>(
         Parser<OmpCancellationConstructTypeClause>{})))
@@ -1223,6 +1233,155 @@ TYPE_PARSER(sourced(construct<OmpLoopDirective>(first(
 TYPE_PARSER(sourced(construct<OmpBeginLoopDirective>(
     sourced(Parser<OmpLoopDirective>{}), Parser<OmpClauseList>{})))
 
+struct OmpEndDirectiveParser {
+  using resultType = OmpDirectiveSpecification;
+
+  constexpr OmpEndDirectiveParser(llvm::omp::Directive dir) : dir_(dir) {}
+
+  std::optional<resultType> Parse(ParseState &state) const {
+    if ((startOmpLine >> "END"_sptok).Parse(state)) {
+      auto &&dirSpec{Parser<OmpDirectiveSpecification>{}.Parse(state)};
+      if (dirSpec && dirSpec->DirId() == dir_) {
+        return std::move(dirSpec);
+      }
+    }
+    return std::nullopt;
+  }
+
+private:
+  llvm::omp::Directive dir_;
+};
+
+// Parser for an arbitrary OpenMP ATOMIC construct.
+//
+// Depending on circumstances, an ATOMIC construct applies to one or more
+// following statements. In certain cases when a single statement is
+// expected, the end-directive is optional. The specifics depend on both
+// the clauses used, and the form of the executable statement. To emit
+// more meaningful messages in case of errors, the exact analysis of the
+// structure of the construct will be delayed until semantic checks.
+//
+// The parser will first try the case when the end-directive is present,
+// and will parse at most "BodyLimit" (and potentially zero) constructs
+// while looking for the end-directive before it gives up.
+// Then it will assume that no end-directive is present, and will try to
+// parse a single executable construct as the body of the construct.
+//
+// The limit on the number of constructs is there to reduce the amount of
+// unnecessary parsing when the end-directive is absent. It's higher than
+// the maximum number of statements in any valid construct to accept cases
+// when extra statements are present by mistake.
+// A problem can occur when atomic constructs without end-directive follow
+// each other closely, e.g.
+//   !$omp atomic write
+//     x = v
+//   !$omp atomic update
+//     x = x + 1
+//   ...
+// The speculative parsing will become "recursive", and has the potential
+// to take a (practically) infinite amount of time given a sufficiently
+// large number of such constructs in a row. Since atomic constructs cannot
+// contain other OpenMP constructs, guarding against recursive calls to the
+// atomic construct parser solves the problem.
+struct OmpAtomicConstructParser {
+  using resultType = OpenMPAtomicConstruct;
+
+  static constexpr size_t BodyLimit{5};
+
+  std::optional<resultType> Parse(ParseState &state) const {
+    if (recursing_) {
+      return std::nullopt;
+    }
+    recursing_ = true;
+
+    auto dirSpec{Parser<OmpDirectiveSpecification>{}.Parse(state)};
+    if (!dirSpec || dirSpec->DirId() != llvm::omp::Directive::OMPD_atomic) {
+      recursing_ = false;
+      return std::nullopt;
+    }
+
+    auto exec{Parser<ExecutionPartConstruct>{}};
+    auto end{OmpEndDirectiveParser{llvm::omp::Directive::OMPD_atomic}};
+    TailType tail;
+
+    if (ParseOne(exec, end, tail, state)) {
+      if (!tail.first.empty()) {
+        if (auto &&rest{attempt(LimitedTailParser(BodyLimit)).Parse(state)}) {
+          for (auto &&s : rest->first) {
+            tail.first.emplace_back(std::move(s));
+          }
+          assert(!tail.second);
+          tail.second = std::move(rest->second);
+        }
+      }
+      recursing_ = false;
+      return OpenMPAtomicConstruct{
+          std::move(*dirSpec), std::move(tail.first), std::move(tail.second)};
+    }
+
+    recursing_ = false;
+    return std::nullopt;
+  }
+
+private:
+  // Begin-directive + TailType = entire construct.
+  using TailType = std::pair<Block, std::optional<OmpDirectiveSpecification>>;
+
+  // 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);
+    }};
+    if (auto &&stmt{attempt(exec).Parse(state)}; stmt && !isRecovery(*stmt)) {
+      tail.first.emplace_back(std::move(*stmt));
+    } else if (auto &&dir{attempt(end).Parse(state)}) {
+      tail.second = std::move(*dir);
+    } else {
+      return std::nullopt;
+    }
+    return Success{};
+  }
+
+  struct LimitedTailParser {
+    using resultType = TailType;
+
+    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 (tail.second) {
+            // Return when the end-directive was parsed.
+            return std::move(tail);
+          }
+        } else {
+          break;
+        }
+      }
+      return std::nullopt;
+    }
+
+  private:
+    const size_t count_;
+  };
+
+  // The recursion guard should become thread_local if parsing is ever
+  // parallelized.
+  static bool recursing_;
+};
+
+bool OmpAtomicConstructParser::recursing_{false};
+
+TYPE_PARSER(sourced( //
+    construct<OpenMPAtomicConstruct>(OmpAtomicConstructParser{})))
+
 // 2.17.7 Atomic construct/2.17.8 Flush construct [OpenMP 5.0]
 //        memory-order-clause ->
 //                               acq_rel
@@ -1237,19 +1396,6 @@ TYPE_PARSER(sourced(construct<OmpMemoryOrderClause>(
         "RELEASE" >> construct<OmpClause>(construct<OmpClause::Release>()) ||
         "SEQ_CST" >> construct<OmpClause>(construct<OmpClause::SeqCst>())))))
 
-// 2.17.7 Atomic construct
-//        atomic-clause -> memory-order-clause | HINT(hint-expression)
-TYPE_PARSER(sourced(construct<OmpAtomicClause>(
-    construct<OmpAtomicClause>(Parser<OmpMemoryOrderClause>{}) ||
-    construct<OmpAtomicClause>(
-        "FAIL" >> parenthesized(Parser<OmpFailClause>{})) ||
-    construct<OmpAtomicClause>(
-        "HINT" >> parenthesized(Parser<OmpHintClause>{})))))
-
-// atomic-clause-list -> [atomic-clause, [atomic-clause], ...]
-TYPE_PARSER(sourced(construct<OmpAtomicClauseList>(
-    many(maybe(","_tok) >> sourced(Parser<OmpAtomicClause>{})))))
-
 static bool IsSimpleStandalone(const OmpDirectiveName &name) {
   switch (name.v) {
   case llvm::omp::Directive::OMPD_barrier:
@@ -1421,67 +1567,6 @@ TYPE_PARSER(sourced(
 TYPE_PARSER(construct<OmpReductionCombiner>(Parser<AssignmentStmt>{}) ||
     construct<OmpReductionCombiner>(Parser<FunctionReference>{}))
 
-// 2.17.7 atomic -> ATOMIC [clause [,]] atomic-clause [[,] clause] |
-//                  ATOMIC [clause]
-//       clause -> memory-order-clause | HINT(hint-expression)
-//       memory-order-clause -> SEQ_CST | ACQ_REL | RELEASE | ACQUIRE | RELAXED
-//       atomic-clause -> READ | WRITE | UPDATE | CAPTURE
-
-// OMP END ATOMIC
-TYPE_PARSER(construct<OmpEndAtomic>(startOmpLine >> "END ATOMIC"_tok))
-
-// OMP ATOMIC [MEMORY-ORDER-CLAUSE-LIST] READ [MEMORY-ORDER-CLAUSE-LIST]
-TYPE_PARSER("ATOMIC" >>
-    sourced(construct<OmpAtomicRead>(
-        Parser<OmpAtomicClauseList>{} / maybe(","_tok), verbatim("READ"_tok),
-        Parser<OmpAtomicClauseList>{} / endOmpLine, statement(assignmentStmt),
-        maybe(Parser<OmpEndAtomic>{} / endOmpLine))))
-
-// OMP ATOMIC [MEMORY-ORDER-CLAUSE-LIST] CAPTURE [MEMORY-ORDER-CLAUSE-LIST]
-TYPE_PARSER("ATOMIC" >>
-    sourced(construct<OmpAtomicCapture>(
-        Parser<OmpAtomicClauseList>{} / maybe(","_tok), verbatim("CAPTURE"_tok),
-        Parser<OmpAtomicClauseList>{} / endOmpLine, statement(assignmentStmt),
-        statement(assignmentStmt), Parser<OmpEndAtomic>{} / endOmpLine)))
-
-TYPE_PARSER(construct<OmpAtomicCompareIfStmt>(indirect(Parser<IfStmt>{})) ||
-    construct<OmpAtomicCompareIfStmt>(indirect(Parser<IfConstruct>{})))
-
-// OMP ATOMIC [MEMORY-ORDER-CLAUSE-LIST] COMPARE [MEMORY-ORDER-CLAUSE-LIST]
-TYPE_PARSER("ATOMIC" >>
-    sourced(construct<OmpAtomicCompare>(
-        Parser<OmpAtomicClauseList>{} / maybe(","_tok), verbatim("COMPARE"_tok),
-        Parser<OmpAtomicClauseList>{} / endOmpLine,
-        Parser<OmpAtomicCompareIfStmt>{},
-        maybe(Parser<OmpEndAtomic>{} / endOmpLine))))
-
-// OMP ATOMIC [MEMORY-ORDER-CLAUSE-LIST] UPDATE [MEMORY-ORDER-CLAUSE-LIST]
-TYPE_PARSER("ATOMIC" >>
-    sourced(construct<OmpAtomicUpdate>(
-        Parser<OmpAtomicClauseList>{} / maybe(","_tok), verbatim("UPDATE"_tok),
-        Parser<OmpAtomicClauseList>{} / endOmpLine, statement(assignmentStmt),
-        maybe(Parser<OmpEndAtomic>{} / endOmpLine))))
-
-// OMP ATOMIC [atomic-clause-list]
-TYPE_PARSER(sourced(construct<OmpAtomic>(verbatim("ATOMIC"_tok),
-    Parser<OmpAtomicClauseList>{} / endOmpLine, statement(assignmentStmt),
-    maybe(Parser<OmpEndAtomic>{} / endOmpLine))))
-
-// OMP ATOMIC [MEMORY-ORDER-CLAUSE-LIST] WRITE [MEMORY-ORDER-CLAUSE-LIST]
-TYPE_PARSER("ATOMIC" >>
-    sourced(construct<OmpAtomicWrite>(
-        Parser<OmpAtomicClauseList>{} / maybe(","_tok), verbatim("WRITE"_tok),
-        Parser<OmpAtomicClauseList>{} / endOmpLine, statement(assignmentStmt),
-        maybe(Parser<OmpEndAtomic>{} / endOmpLine))))
-
-// Atomic Construct
-TYPE_PARSER(construct<OpenMPAtomicConstruct>(Parser<OmpAtomicRead>{}) ||
-    construct<OpenMPAtomicConstruct>(Parser<OmpAtomicCapture>{}) ||
-    construct<OpenMPAtomicConstruct>(Parser<OmpAtomicCompare>{}) ||
-    construct<OpenMPAtomicConstruct>(Parser<OmpAtomicWrite>{}) ||
-    construct<OpenMPAtomicConstruct>(Parser<OmpAtomicUpdate>{}) ||
-    construct<OpenMPAtomicConstruct>(Parser<OmpAtomic>{}))
-
 // 2.13.2 OMP CRITICAL
 TYPE_PARSER(startOmpLine >>
     sourced(construct<OmpEndCriticalDirective>(

flang/lib/Parser/parse-tree.cpp

@@ -321,6 +321,34 @@ std::string OmpTraitSetSelectorName::ToString() const {
   return std::string(EnumToString(v));
 }
 
+llvm::omp::Clause OpenMPAtomicConstruct::GetKind() const {
+  auto &dirSpec{std::get<OmpDirectiveSpecification>(t)};
+  for (auto &clause : dirSpec.Clauses().v) {
+    switch (clause.Id()) {
+    case llvm::omp::Clause::OMPC_read:
+    case llvm::omp::Clause::OMPC_write:
+    case llvm::omp::Clause::OMPC_update:
+      return clause.Id();
+    default:
+      break;
+    }
+  }
+  return llvm::omp::Clause::OMPC_update;
+}
+
+bool OpenMPAtomicConstruct::IsCapture() const {
+  auto &dirSpec{std::get<OmpDirectiveSpecification>(t)};
+  return llvm::any_of(dirSpec.Clauses().v, [](auto &clause) {
+    return clause.Id() == llvm::omp::Clause::OMPC_capture;
+  });
+}
+
+bool OpenMPAtomicConstruct::IsCompare() const {
+  auto &dirSpec{std::get<OmpDirectiveSpecification>(t)};
+  return llvm::any_of(dirSpec.Clauses().v, [](auto &clause) {
+    return clause.Id() == llvm::omp::Clause::OMPC_compare;
+  });
+}
 } // namespace Fortran::parser
 
 template <typename C> static llvm::omp::Clause getClauseIdForClass(C &&) {

flang/lib/Parser/unparse.cpp

@@ -2571,83 +2571,22 @@ public:
     Word(ToUpperCaseLetters(common::EnumToString(x)));
   }
 
-  void Unparse(const OmpAtomicClauseList &x) { Walk(" ", x.v, " "); }
+  void Unparse(const OpenMPAtomicConstruct &x) {
+    BeginOpenMP();
+    Word("!$OMP ");
+    Walk(std::get<OmpDirectiveSpecification>(x.t));
+    Put("\n");
+    EndOpenMP();
+    Walk(std::get<Block>(x.t), "");
+    if (auto &end{std::get<std::optional<OmpDirectiveSpecification>>(x.t)}) {
+      BeginOpenMP();
+      Word("!$OMP END ");
+      Walk(*end);
+      Put("\n");
+      EndOpenMP();
+    }
+  }
 
-  void Unparse(const OmpAtomic &x) {
-    BeginOpenMP();
-    Word("!$OMP ATOMIC");
-    Walk(std::get<OmpAtomicClauseList>(x.t));
-    Put("\n");
-    EndOpenMP();
-    Walk(std::get<Statement<AssignmentStmt>>(x.t));
-    BeginOpenMP();
-    Walk(std::get<std::optional<OmpEndAtomic>>(x.t), "!$OMP END ATOMIC\n");
-    EndOpenMP();
-  }
-  void Unparse(const OmpAtomicCapture &x) {
-    BeginOpenMP();
-    Word("!$OMP ATOMIC");
-    Walk(std::get<0>(x.t));
-    Word(" CAPTURE");
-    Walk(std::get<2>(x.t));
-    Put("\n");
-    EndOpenMP();
-    Walk(std::get<OmpAtomicCapture::Stmt1>(x.t));
-    Put("\n");
-    Walk(std::get<OmpAtomicCapture::Stmt2>(x.t));
-    BeginOpenMP();
-    Word("!$OMP END ATOMIC\n");
-    EndOpenMP();
-  }
-  void Unparse(const OmpAtomicCompare &x) {
-    BeginOpenMP();
-    Word("!$OMP ATOMIC");
-    Walk(std::get<0>(x.t));
-    Word(" COMPARE");
-    Walk(std::get<2>(x.t));
-    Put("\n");
-    EndOpenMP();
-    Walk(std::get<OmpAtomicCompareIfStmt>(x.t));
-  }
-  void Unparse(const OmpAtomicRead &x) {
-    BeginOpenMP();
-    Word("!$OMP ATOMIC");
-    Walk(std::get<0>(x.t));
-    Word(" READ");
-    Walk(std::get<2>(x.t));
-    Put("\n");
-    EndOpenMP();
-    Walk(std::get<Statement<AssignmentStmt>>(x.t));
-    BeginOpenMP();
-    Walk(std::get<std::optional<OmpEndAtomic>>(x.t), "!$OMP END ATOMIC\n");
-    EndOpenMP();
-  }
-  void Unparse(const OmpAtomicUpdate &x) {
-    BeginOpenMP();
-    Word("!$OMP ATOMIC");
-    Walk(std::get<0>(x.t));
-    Word(" UPDATE");
-    Walk(std::get<2>(x.t));
-    Put("\n");
-    EndOpenMP();
-    Walk(std::get<Statement<AssignmentStmt>>(x.t));
-    BeginOpenMP();
-    Walk(std::get<std::optional<OmpEndAtomic>>(x.t), "!$OMP END ATOMIC\n");
-    EndOpenMP();
-  }
-  void Unparse(const OmpAtomicWrite &x) {
-    BeginOpenMP();
-    Word("!$OMP ATOMIC");
-    Walk(std::get<0>(x.t));
-    Word(" WRITE");
-    Walk(std::get<2>(x.t));
-    Put("\n");
-    EndOpenMP();
-    Walk(std::get<Statement<AssignmentStmt>>(x.t));
-    BeginOpenMP();
-    Walk(std::get<std::optional<OmpEndAtomic>>(x.t), "!$OMP END ATOMIC\n");
-    EndOpenMP();
-  }
   void Unparse(const OpenMPExecutableAllocate &x) {
     const auto &fields =
         std::get<std::optional<std::list<parser::OpenMPDeclarativeAllocate>>>(
@@ -2920,23 +2859,8 @@ public:
     Put("\n");
     EndOpenMP();
   }
+  void Unparse(const OmpFailClause &x) { Walk(x.v); }
   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) {
-                        Word("FAIL(");
-                        Walk(y.v);
-                        Put(")");
-                      },
-                      [&](const OmpHintClause &y) {
-                        Word("HINT(");
-                        Walk(y.v);
-                        Put(")");
-                      },
-                  },
-        x.u);
-  }
   void Unparse(const OmpMetadirectiveDirective &x) {
     BeginOpenMP();
     Word("!$OMP METADIRECTIVE ");

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

@@ -48,6 +48,7 @@ static const OmpDirectiveSet noWaitClauseNotAllowedSet{
 } // namespace llvm
 
 namespace Fortran::semantics {
+struct AnalyzedCondStmt;
 
 // Mapping from 'Symbol' to 'Source' to keep track of the variables
 // used in multiple clauses
@@ -144,15 +145,6 @@ public:
   void Leave(const parser::OmpClauseList &);
   void Enter(const parser::OmpClause &);
 
-  void Enter(const parser::OmpAtomicRead &);
-  void Leave(const parser::OmpAtomicRead &);
-  void Enter(const parser::OmpAtomicWrite &);
-  void Leave(const parser::OmpAtomicWrite &);
-  void Enter(const parser::OmpAtomicUpdate &);
-  void Leave(const parser::OmpAtomicUpdate &);
-  void Enter(const parser::OmpAtomicCapture &);
-  void Leave(const parser::OmpAtomic &);
-
   void Enter(const parser::DoConstruct &);
   void Leave(const parser::DoConstruct &);
 
@@ -192,8 +184,6 @@ private:
   void CheckAllowedMapTypes(const parser::OmpMapType::Value &,
       const std::list<parser::OmpMapType::Value> &);
 
-  std::optional<evaluate::DynamicType> GetDynamicType(
-      const common::Indirection<parser::Expr> &);
   const std::list<parser::OmpTraitProperty> &GetTraitPropertyList(
       const parser::OmpTraitSelector &);
   std::optional<llvm::omp::Clause> GetClauseFromProperty(
@@ -265,14 +255,44 @@ private:
   void CheckDoWhile(const parser::OpenMPLoopConstruct &x);
   void CheckAssociatedLoopConstraints(const parser::OpenMPLoopConstruct &x);
   template <typename T, typename D> bool IsOperatorValid(const T &, const D &);
-  void CheckAtomicMemoryOrderClause(
-      const parser::OmpAtomicClauseList *, const parser::OmpAtomicClauseList *);
-  void CheckAtomicUpdateStmt(const parser::AssignmentStmt &);
-  void CheckAtomicCaptureStmt(const parser::AssignmentStmt &);
-  void CheckAtomicWriteStmt(const parser::AssignmentStmt &);
-  void CheckAtomicCaptureConstruct(const parser::OmpAtomicCapture &);
-  void CheckAtomicCompareConstruct(const parser::OmpAtomicCompare &);
-  void CheckAtomicConstructStructure(const parser::OpenMPAtomicConstruct &);
+
+  void CheckStorageOverlap(const evaluate::Expr<evaluate::SomeType> &,
+      llvm::ArrayRef<evaluate::Expr<evaluate::SomeType>>, parser::CharBlock);
+  void ErrorShouldBeVariable(const MaybeExpr &expr, parser::CharBlock source);
+  void CheckAtomicType(
+      SymbolRef sym, parser::CharBlock source, std::string_view name);
+  void CheckAtomicVariable(
+      const evaluate::Expr<evaluate::SomeType> &, parser::CharBlock);
+  std::pair<const parser::ExecutionPartConstruct *,
+      const parser::ExecutionPartConstruct *>
+  CheckUpdateCapture(const parser::ExecutionPartConstruct *ec1,
+      const parser::ExecutionPartConstruct *ec2, parser::CharBlock source);
+  void CheckAtomicCaptureAssignment(const evaluate::Assignment &capture,
+      const SomeExpr &atom, parser::CharBlock source);
+  void CheckAtomicReadAssignment(
+      const evaluate::Assignment &read, parser::CharBlock source);
+  void CheckAtomicWriteAssignment(
+      const evaluate::Assignment &write, parser::CharBlock source);
+  void CheckAtomicUpdateAssignment(
+      const evaluate::Assignment &update, parser::CharBlock source);
+  void CheckAtomicConditionalUpdateAssignment(const SomeExpr &cond,
+      parser::CharBlock condSource, const evaluate::Assignment &assign,
+      parser::CharBlock assignSource);
+  void CheckAtomicConditionalUpdateStmt(
+      const AnalyzedCondStmt &update, parser::CharBlock source);
+  void CheckAtomicUpdateOnly(const parser::OpenMPAtomicConstruct &x,
+      const parser::Block &body, parser::CharBlock source);
+  void CheckAtomicConditionalUpdate(const parser::OpenMPAtomicConstruct &x,
+      const parser::Block &body, parser::CharBlock source);
+  void CheckAtomicUpdateCapture(const parser::OpenMPAtomicConstruct &x,
+      const parser::Block &body, parser::CharBlock source);
+  void CheckAtomicConditionalUpdateCapture(
+      const parser::OpenMPAtomicConstruct &x, const parser::Block &body,
+      parser::CharBlock source);
+  void CheckAtomicRead(const parser::OpenMPAtomicConstruct &x);
+  void CheckAtomicWrite(const parser::OpenMPAtomicConstruct &x);
+  void CheckAtomicUpdate(const parser::OpenMPAtomicConstruct &x);
+
   void CheckDistLinear(const parser::OpenMPLoopConstruct &x);
   void CheckSIMDNest(const parser::OpenMPConstruct &x);
   void CheckTargetNest(const parser::OpenMPConstruct &x);
@@ -324,7 +344,6 @@ private:
   void EnterDirectiveNest(const int index) { directiveNest_[index]++; }
   void ExitDirectiveNest(const int index) { directiveNest_[index]--; }
   int GetDirectiveNest(const int index) { return directiveNest_[index]; }
-  template <typename D> void CheckHintClause(D *, D *, std::string_view);
   inline void ErrIfAllocatableVariable(const parser::Variable &);
   inline void ErrIfLHSAndRHSSymbolsMatch(
       const parser::Variable &, const parser::Expr &);

flang/lib/Semantics/resolve-names.cpp

@@ -1684,11 +1684,8 @@ public:
     messageHandler().set_currStmtSource(std::nullopt);
   }
   bool Pre(const parser::OpenMPAtomicConstruct &x) {
-    return common::visit(common::visitors{[&](const auto &u) -> bool {
-      AddOmpSourceRange(u.source);
-      return true;
-    }},
-        x.u);
+    AddOmpSourceRange(x.source);
+    return true;
   }
   void Post(const parser::OpenMPAtomicConstruct &) {
     messageHandler().set_currStmtSource(std::nullopt);

flang/lib/Semantics/rewrite-directives.cpp

@@ -51,23 +51,21 @@ private:
 
 bool OmpRewriteMutator::Pre(parser::OpenMPAtomicConstruct &x) {
   // Find top-level parent of the operation.
-  Symbol *topLevelParent{common::visit(
-      [&](auto &atomic) {
-        Symbol *symbol{nullptr};
-        Scope *scope{
-            &context_.FindScope(std::get<parser::Verbatim>(atomic.t).source)};
-        do {
-          if (Symbol * parent{scope->symbol()}) {
-            symbol = parent;
-          }
-          scope = &scope->parent();
-        } while (!scope->IsGlobal());
+  Symbol *topLevelParent{[&]() {
+    Symbol *symbol{nullptr};
+    Scope *scope{&context_.FindScope(
+        std::get<parser::OmpDirectiveSpecification>(x.t).source)};
+    do {
+      if (Symbol * parent{scope->symbol()}) {
+        symbol = parent;
+      }
+      scope = &scope->parent();
+    } while (!scope->IsGlobal());
 
-        assert(symbol &&
-            "Atomic construct must be within a scope associated with a symbol");
-        return symbol;
-      },
-      x.u)};
+    assert(symbol &&
+        "Atomic construct must be within a scope associated with a symbol");
+    return symbol;
+  }()};
 
   // Get the `atomic_default_mem_order` clause from the top-level parent.
   std::optional<common::OmpMemoryOrderType> defaultMemOrder;
@@ -86,66 +84,48 @@ bool OmpRewriteMutator::Pre(parser::OpenMPAtomicConstruct &x) {
     return false;
   }
 
-  auto findMemOrderClause =
-      [](const std::list<parser::OmpAtomicClause> &clauses) {
-        return llvm::any_of(clauses, [](const auto &clause) {
-          return std::get_if<parser::OmpMemoryOrderClause>(&clause.u);
+  auto findMemOrderClause{[](const parser::OmpClauseList &clauses) {
+    return llvm::any_of(
+        clauses.v, [](auto &clause) -> const parser::OmpClause * {
+          switch (clause.Id()) {
+          case llvm::omp::Clause::OMPC_acq_rel:
+          case llvm::omp::Clause::OMPC_acquire:
+          case llvm::omp::Clause::OMPC_relaxed:
+          case llvm::omp::Clause::OMPC_release:
+          case llvm::omp::Clause::OMPC_seq_cst:
+            return &clause;
+          default:
+            return nullptr;
+          }
         });
-      };
+  }};
 
-  // Get the clause list to which the new memory order clause must be added,
-  // only if there are no other memory order clauses present for this atomic
-  // directive.
-  std::list<parser::OmpAtomicClause> *clauseList = common::visit(
-      common::visitors{[&](parser::OmpAtomic &atomicConstruct) {
-                         // OmpAtomic only has a single list of clauses.
-                         auto &clauses{std::get<parser::OmpAtomicClauseList>(
-                             atomicConstruct.t)};
-                         return !findMemOrderClause(clauses.v) ? &clauses.v
-                                                               : nullptr;
-                       },
-          [&](auto &atomicConstruct) {
-            // All other atomic constructs have two lists of clauses.
-            auto &clausesLhs{std::get<0>(atomicConstruct.t)};
-            auto &clausesRhs{std::get<2>(atomicConstruct.t)};
-            return !findMemOrderClause(clausesLhs.v) &&
-                    !findMemOrderClause(clausesRhs.v)
-                ? &clausesRhs.v
-                : nullptr;
-          }},
-      x.u);
+  auto &dirSpec{std::get<parser::OmpDirectiveSpecification>(x.t)};
+  auto &clauseList{std::get<std::optional<parser::OmpClauseList>>(dirSpec.t)};
+  if (clauseList) {
+    if (findMemOrderClause(*clauseList)) {
+      return false;
+    }
+  } else {
+    clauseList = parser::OmpClauseList(decltype(parser::OmpClauseList::v){});
+  }
 
   // Add a memory order clause to the atomic directive.
-  if (clauseList) {
-    atomicDirectiveDefaultOrderFound_ = true;
-    switch (*defaultMemOrder) {
-    case common::OmpMemoryOrderType::Acq_Rel:
-      clauseList->emplace_back<parser::OmpMemoryOrderClause>(common::visit(
-          common::visitors{[](parser::OmpAtomicRead &) -> parser::OmpClause {
-                             return parser::OmpClause::Acquire{};
-                           },
-              [](parser::OmpAtomicCapture &) -> parser::OmpClause {
-                return parser::OmpClause::AcqRel{};
-              },
-              [](auto &) -> parser::OmpClause {
-                // parser::{OmpAtomic, OmpAtomicUpdate, OmpAtomicWrite}
-                return parser::OmpClause::Release{};
-              }},
-          x.u));
-      break;
-    case common::OmpMemoryOrderType::Relaxed:
-      clauseList->emplace_back<parser::OmpMemoryOrderClause>(
-          parser::OmpClause{parser::OmpClause::Relaxed{}});
-      break;
-    case common::OmpMemoryOrderType::Seq_Cst:
-      clauseList->emplace_back<parser::OmpMemoryOrderClause>(
-          parser::OmpClause{parser::OmpClause::SeqCst{}});
-      break;
-    default:
-      // FIXME: Don't process other values at the moment since their validity
-      // depends on the OpenMP version (which is unavailable here).
-      break;
-    }
+  atomicDirectiveDefaultOrderFound_ = true;
+  switch (*defaultMemOrder) {
+  case common::OmpMemoryOrderType::Acq_Rel:
+    clauseList->v.emplace_back(parser::OmpClause{parser::OmpClause::AcqRel{}});
+    break;
+  case common::OmpMemoryOrderType::Relaxed:
+    clauseList->v.emplace_back(parser::OmpClause{parser::OmpClause::Relaxed{}});
+    break;
+  case common::OmpMemoryOrderType::Seq_Cst:
+    clauseList->v.emplace_back(parser::OmpClause{parser::OmpClause::SeqCst{}});
+    break;
+  default:
+    // FIXME: Don't process other values at the moment since their validity
+    // depends on the OpenMP version (which is unavailable here).
+    break;
   }
 
   return false;

flang/lib/Semantics/tools.cpp

@@ -17,6 +17,7 @@
 #include "flang/Semantics/tools.h"
 #include "flang/Semantics/type.h"
 #include "flang/Support/Fortran.h"
+#include "llvm/ADT/StringSwitch.h"
 #include "llvm/Support/raw_ostream.h"
 #include <algorithm>
 #include <set>
@@ -1770,4 +1771,318 @@ bool CheckForSymbolMatch(const SomeExpr *lhs, const SomeExpr *rhs) {
   }
   return false;
 }
-} // namespace Fortran::semantics
+
+namespace operation {
+template <typename T> //
+SomeExpr asSomeExpr(const T &x) {
+  auto copy{x};
+  return AsGenericExpr(std::move(copy));
+}
+
+template <bool IgnoreResizingConverts> //
+struct ArgumentExtractor
+    : public evaluate::Traverse<ArgumentExtractor<IgnoreResizingConverts>,
+          std::pair<operation::Operator, std::vector<SomeExpr>>, false> {
+  using Arguments = std::vector<SomeExpr>;
+  using Result = std::pair<operation::Operator, Arguments>;
+  using Base = evaluate::Traverse<ArgumentExtractor<IgnoreResizingConverts>,
+      Result, false>;
+  static constexpr auto IgnoreResizes = IgnoreResizingConverts;
+  static constexpr auto Logical = common::TypeCategory::Logical;
+  ArgumentExtractor() : Base(*this) {}
+
+  Result Default() const { return {}; }
+
+  using Base::operator();
+
+  template <int Kind> //
+  Result operator()(
+      const evaluate::Constant<evaluate::Type<Logical, Kind>> &x) const {
+    if (const auto &val{x.GetScalarValue()}) {
+      return val->IsTrue()
+          ? std::make_pair(operation::Operator::True, Arguments{})
+          : std::make_pair(operation::Operator::False, Arguments{});
+    }
+    return Default();
+  }
+
+  template <typename R> //
+  Result operator()(const evaluate::FunctionRef<R> &x) const {
+    Result result{operation::OperationCode(x.proc()), {}};
+    for (size_t i{0}, e{x.arguments().size()}; i != e; ++i) {
+      if (auto *e{x.UnwrapArgExpr(i)}) {
+        result.second.push_back(*e);
+      }
+    }
+    return result;
+  }
+
+  template <typename D, typename R, typename... Os>
+  Result operator()(const evaluate::Operation<D, R, Os...> &x) const {
+    if constexpr (std::is_same_v<D, evaluate::Parentheses<R>>) {
+      // Ignore top-level parentheses.
+      return (*this)(x.template operand<0>());
+    }
+    if constexpr (IgnoreResizes &&
+        std::is_same_v<D, evaluate::Convert<R, R::category>>) {
+      // Ignore conversions within the same category.
+      // Atomic operations on int(kind=1) may be implicitly widened
+      // to int(kind=4) for example.
+      return (*this)(x.template operand<0>());
+    } else {
+      return std::make_pair(operation::OperationCode(x),
+          OperationArgs(x, std::index_sequence_for<Os...>{}));
+    }
+  }
+
+  template <typename T> //
+  Result operator()(const evaluate::Designator<T> &x) const {
+    return {operation::Operator::Identity, {asSomeExpr(x)}};
+  }
+
+  template <typename T> //
+  Result operator()(const evaluate::Constant<T> &x) const {
+    return {operation::Operator::Identity, {asSomeExpr(x)}};
+  }
+
+  template <typename... Rs> //
+  Result Combine(Result &&result, Rs &&...results) const {
+    // There shouldn't be any combining needed, since we're stopping the
+    // traversal at the top-level operation, but implement one that picks
+    // the first non-empty result.
+    if constexpr (sizeof...(Rs) == 0) {
+      return std::move(result);
+    } else {
+      if (!result.second.empty()) {
+        return std::move(result);
+      } else {
+        return Combine(std::move(results)...);
+      }
+    }
+  }
+
+private:
+  template <typename D, typename R, typename... Os, size_t... Is>
+  Arguments OperationArgs(const evaluate::Operation<D, R, Os...> &x,
+      std::index_sequence<Is...>) const {
+    return Arguments{SomeExpr(x.template operand<Is>())...};
+  }
+};
+} // namespace operation
+
+std::string operation::ToString(operation::Operator op) {
+  switch (op) {
+  case Operator::Unknown:
+    return "??";
+  case Operator::Add:
+    return "+";
+  case Operator::And:
+    return "AND";
+  case Operator::Associated:
+    return "ASSOCIATED";
+  case Operator::Call:
+    return "function-call";
+  case Operator::Constant:
+    return "constant";
+  case Operator::Convert:
+    return "type-conversion";
+  case Operator::Div:
+    return "/";
+  case Operator::Eq:
+    return "==";
+  case Operator::Eqv:
+    return "EQV";
+  case Operator::False:
+    return ".FALSE.";
+  case Operator::Ge:
+    return ">=";
+  case Operator::Gt:
+    return ">";
+  case Operator::Identity:
+    return "identity";
+  case Operator::Intrinsic:
+    return "intrinsic";
+  case Operator::Le:
+    return "<=";
+  case Operator::Lt:
+    return "<";
+  case Operator::Max:
+    return "MAX";
+  case Operator::Min:
+    return "MIN";
+  case Operator::Mul:
+    return "*";
+  case Operator::Ne:
+    return "/=";
+  case Operator::Neqv:
+    return "NEQV/EOR";
+  case Operator::Not:
+    return "NOT";
+  case Operator::Or:
+    return "OR";
+  case Operator::Pow:
+    return "**";
+  case Operator::Resize:
+    return "resize";
+  case Operator::Sub:
+    return "-";
+  case Operator::True:
+    return ".TRUE.";
+  }
+  llvm_unreachable("Unhandler operator");
+}
+
+operation::Operator operation::OperationCode(
+    const evaluate::ProcedureDesignator &proc) {
+  Operator code = llvm::StringSwitch<Operator>(proc.GetName())
+                      .Case("associated", Operator::Associated)
+                      .Case("min", Operator::Min)
+                      .Case("max", Operator::Max)
+                      .Case("iand", Operator::And)
+                      .Case("ior", Operator::Or)
+                      .Case("ieor", Operator::Neqv)
+                      .Default(Operator::Call);
+  if (code == Operator::Call && proc.GetSpecificIntrinsic()) {
+    return Operator::Intrinsic;
+  }
+  return code;
+}
+
+std::pair<operation::Operator, std::vector<SomeExpr>> GetTopLevelOperation(
+    const SomeExpr &expr) {
+  return operation::ArgumentExtractor<true>{}(expr);
+}
+
+namespace operation {
+struct ConvertCollector
+    : public evaluate::Traverse<ConvertCollector,
+          std::pair<MaybeExpr, std::vector<evaluate::DynamicType>>, false> {
+  using Result = std::pair<MaybeExpr, std::vector<evaluate::DynamicType>>;
+  using Base = evaluate::Traverse<ConvertCollector, Result, false>;
+  ConvertCollector() : Base(*this) {}
+
+  Result Default() const { return {}; }
+
+  using Base::operator();
+
+  template <typename T> //
+  Result operator()(const evaluate::Designator<T> &x) const {
+    return {asSomeExpr(x), {}};
+  }
+
+  template <typename T> //
+  Result operator()(const evaluate::FunctionRef<T> &x) const {
+    return {asSomeExpr(x), {}};
+  }
+
+  template <typename T> //
+  Result operator()(const evaluate::Constant<T> &x) const {
+    return {asSomeExpr(x), {}};
+  }
+
+  template <typename D, typename R, typename... Os>
+  Result operator()(const evaluate::Operation<D, R, Os...> &x) const {
+    if constexpr (std::is_same_v<D, evaluate::Parentheses<R>>) {
+      // Ignore parentheses.
+      return (*this)(x.template operand<0>());
+    } else if constexpr (is_convert_v<D>) {
+      // Convert should always have a typed result, so it should be safe to
+      // dereference x.GetType().
+      return Combine(
+          {std::nullopt, {*x.GetType()}}, (*this)(x.template operand<0>()));
+    } else if constexpr (is_complex_constructor_v<D>) {
+      // This is a conversion iff the imaginary operand is 0.
+      if (IsZero(x.template operand<1>())) {
+        return Combine(
+            {std::nullopt, {*x.GetType()}}, (*this)(x.template operand<0>()));
+      } else {
+        return {asSomeExpr(x.derived()), {}};
+      }
+    } else {
+      return {asSomeExpr(x.derived()), {}};
+    }
+  }
+
+  template <typename... Rs> //
+  Result Combine(Result &&result, Rs &&...results) const {
+    Result v(std::move(result));
+    auto setValue{[](MaybeExpr &x, MaybeExpr &&y) {
+      assert((!x.has_value() || !y.has_value()) && "Multiple designators");
+      if (!x.has_value()) {
+        x = std::move(y);
+      }
+    }};
+    auto moveAppend{[](auto &accum, auto &&other) {
+      for (auto &&s : other) {
+        accum.push_back(std::move(s));
+      }
+    }};
+    (setValue(v.first, std::move(results).first), ...);
+    (moveAppend(v.second, std::move(results).second), ...);
+    return v;
+  }
+
+private:
+  template <typename T> //
+  static bool IsZero(const T &x) {
+    return false;
+  }
+  template <typename T> //
+  static bool IsZero(const evaluate::Expr<T> &x) {
+    return common::visit([](auto &&s) { return IsZero(s); }, x.u);
+  }
+  template <typename T> //
+  static bool IsZero(const evaluate::Constant<T> &x) {
+    if (auto &&maybeScalar{x.GetScalarValue()}) {
+      return maybeScalar->IsZero();
+    } else {
+      return false;
+    }
+  }
+
+  template <typename T> //
+  struct is_convert {
+    static constexpr bool value{false};
+  };
+  template <typename T, common::TypeCategory C> //
+  struct is_convert<evaluate::Convert<T, C>> {
+    static constexpr bool value{true};
+  };
+  template <int K> //
+  struct is_convert<evaluate::ComplexComponent<K>> {
+    // Conversion from complex to real.
+    static constexpr bool value{true};
+  };
+  template <typename T> //
+  static constexpr bool is_convert_v = is_convert<T>::value;
+
+  template <typename T> //
+  struct is_complex_constructor {
+    static constexpr bool value{false};
+  };
+  template <int K> //
+  struct is_complex_constructor<evaluate::ComplexConstructor<K>> {
+    static constexpr bool value{true};
+  };
+  template <typename T> //
+  static constexpr bool is_complex_constructor_v =
+      is_complex_constructor<T>::value;
+};
+} // namespace operation
+
+MaybeExpr GetConvertInput(const SomeExpr &x) {
+  // This returns SomeExpr(x) when x is a designator/functionref/constant.
+  return operation::ConvertCollector{}(x).first;
+}
+
+bool IsSameOrConvertOf(const SomeExpr &expr, const SomeExpr &x) {
+  // Check if expr is same as x, or a sequence of Convert operations on x.
+  if (expr == x) {
+    return true;
+  } else if (auto maybe{GetConvertInput(expr)}) {
+    return *maybe == x;
+  } else {
+    return false;
+  }
+}
+} // namespace Fortran::semantics

flang/test/Examples/omp-atomic.f90

@@ -26,25 +26,31 @@ end
 ! CHECK:---
 ! CHECK-NEXT:- file:            '{{[^"]*}}omp-atomic.f90'
 ! CHECK-NEXT:  line:            9
-! CHECK-NEXT:  construct:       atomic-read
+! CHECK-NEXT:  construct:       atomic
 ! CHECK-NEXT:  clauses:
-! CHECK-NEXT:    - clause:      seq_cst
+! CHECK-NEXT:    - clause:      read
 ! CHECK-NEXT:      details:     ''
+! CHECK-NEXT:    - clause:      seq_cst
+! CHECK-NEXT:      details:     'name_modifier=atomic;'
 ! CHECK-NEXT:- file:            '{{[^"]*}}omp-atomic.f90'
 ! CHECK-NEXT:  line:            12
-! CHECK-NEXT:  construct:       atomic-write
+! CHECK-NEXT:  construct:       atomic
 ! CHECK-NEXT:  clauses:
 ! CHECK-NEXT:    - clause:      seq_cst
+! CHECK-NEXT:      details:     'name_modifier=atomic;'
+! CHECK-NEXT:    - clause:      write
 ! CHECK-NEXT:      details:     ''
 ! CHECK-NEXT:- file:            '{{[^"]*}}omp-atomic.f90'
 ! CHECK-NEXT:  line:            16
-! CHECK-NEXT:  construct:       atomic-capture
+! CHECK-NEXT:  construct:       atomic
 ! CHECK-NEXT:  clauses:
+! CHECK-NEXT:    - clause:      capture
+! CHECK-NEXT:      details:     'name_modifier=atomic;name_modifier=atomic;'
 ! CHECK-NEXT:    - clause:      seq_cst
 ! CHECK-NEXT:      details:     ''
 ! CHECK-NEXT:- file:            '{{[^"]*}}omp-atomic.f90'
 ! CHECK-NEXT:  line:            21
-! CHECK-NEXT:  construct:       atomic-atomic
+! CHECK-NEXT:  construct:       atomic
 ! CHECK-NEXT:  clauses:         []
 ! CHECK-NEXT:- file:            '{{[^"]*}}omp-atomic.f90'
 ! CHECK-NEXT:  line:            8

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

@@ -1,6 +1,6 @@
 ! 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
+! CHECK: not yet implemented: OpenMP ATOMIC COMPARE
 program p
   integer :: x
   logical :: r

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

@@ -1,6 +1,6 @@
 ! 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
+! CHECK: not yet implemented: OpenMP ATOMIC COMPARE
 program p
   integer :: x
   logical :: r

flang/test/Lower/OpenMP/atomic-capture.f90

@@ -79,16 +79,16 @@ subroutine pointers_in_atomic_capture()
 !CHECK: %[[VAL_A_BOX_ADDR:.*]] = fir.box_addr %[[VAL_A_LOADED]] : (!fir.box<!fir.ptr<i32>>) -> !fir.ptr<i32>
 !CHECK: %[[VAL_B_LOADED:.*]] = fir.load %[[VAL_B_DECLARE]]#0 : !fir.ref<!fir.box<!fir.ptr<i32>>>
 !CHECK: %[[VAL_B_BOX_ADDR:.*]] = fir.box_addr %[[VAL_B_LOADED]] : (!fir.box<!fir.ptr<i32>>) -> !fir.ptr<i32>
+!CHECK: %[[VAL_B:.*]] = fir.load %[[VAL_B_BOX_ADDR]] : !fir.ptr<i32>
 !CHECK: %[[VAL_B_LOADED_2:.*]] = fir.load %[[VAL_B_DECLARE]]#0 : !fir.ref<!fir.box<!fir.ptr<i32>>>
 !CHECK: %[[VAL_B_BOX_ADDR_2:.*]] = fir.box_addr %[[VAL_B_LOADED_2]] : (!fir.box<!fir.ptr<i32>>) -> !fir.ptr<i32>
-!CHECK: %[[VAL_B:.*]] = fir.load %[[VAL_B_BOX_ADDR_2]] : !fir.ptr<i32>
 !CHECK: omp.atomic.capture {
 !CHECK: omp.atomic.update %[[VAL_A_BOX_ADDR]] : !fir.ptr<i32> {
 !CHECK: ^bb0(%[[ARG:.*]]: i32):
 !CHECK: %[[TEMP:.*]] = arith.addi %[[ARG]], %[[VAL_B]] : i32
 !CHECK: omp.yield(%[[TEMP]] : i32)
 !CHECK: }
-!CHECK: omp.atomic.read %[[VAL_B_BOX_ADDR]] = %[[VAL_A_BOX_ADDR]] : !fir.ptr<i32>, !fir.ptr<i32>, i32
+!CHECK: omp.atomic.read %[[VAL_B_BOX_ADDR_2]] = %[[VAL_A_BOX_ADDR]] : !fir.ptr<i32>, !fir.ptr<i32>, i32
 !CHECK: }
 !CHECK: return
 !CHECK: }

flang/test/Lower/OpenMP/atomic-implicit-cast.f90

@@ -1,5 +1,3 @@
-! REQUIRES : openmp_runtime
-
 ! RUN: %flang_fc1 -emit-hlfir -fopenmp %s -o - | FileCheck %s
 
 ! CHECK: func.func @_QPatomic_implicit_cast_read() {
@@ -97,9 +95,9 @@ subroutine atomic_implicit_cast_read
 ! CHECK: }
 ! CHECK: omp.atomic.read %[[ALLOCA6]] = %[[X_DECL]]#0 : !fir.ref<i32>, !fir.ref<i32>, i32
 ! CHECK: %[[LOAD:.*]] = fir.load %[[ALLOCA6]] : !fir.ref<i32>
-! CHECK: %[[UNDEF:.*]] = fir.undefined complex<f32>
 ! CHECK: %[[CVT:.*]] = fir.convert %[[LOAD]] : (i32) -> f32
 ! CHECK: %[[CST:.*]] = arith.constant 0.000000e+00 : f32
+! CHECK: %[[UNDEF:.*]] = fir.undefined complex<f32>
 ! CHECK: %[[IDX1:.*]] = fir.insert_value %[[UNDEF]], %[[CVT]], [0 : index] : (complex<f32>, f32) -> complex<f32>
 ! CHECK: %[[IDX2:.*]] = fir.insert_value %[[IDX1]], %[[CST]], [1 : index] : (complex<f32>, f32) -> complex<f32>
 ! CHECK: fir.store %[[IDX2]] to %[[W_DECL]]#0 : !fir.ref<complex<f32>>
@@ -109,14 +107,14 @@ subroutine atomic_implicit_cast_read
      !$omp end atomic
 
 
-! CHECK: omp.atomic.capture {
-! CHECK: omp.atomic.update %[[M_DECL]]#0 : !fir.ref<complex<f64>> {
-! CHECK: ^bb0(%[[ARG:.*]]: complex<f64>):
 ! CHECK: %[[CST1:.*]] = arith.constant 1.000000e+00 : f64
 ! CHECK: %[[CST2:.*]] = arith.constant 0.000000e+00 : f64
 ! CHECK: %[[UNDEF:.*]] = fir.undefined complex<f64>
 ! CHECK: %[[IDX1:.*]] = fir.insert_value %[[UNDEF]], %[[CST1]], [0 : index] : (complex<f64>, f64) -> complex<f64>
 ! CHECK: %[[IDX2:.*]] = fir.insert_value %[[IDX1]], %[[CST2]], [1 : index] : (complex<f64>, f64) -> complex<f64>
+! CHECK: omp.atomic.capture {
+! CHECK: omp.atomic.update %[[M_DECL]]#0 : !fir.ref<complex<f64>> {
+! CHECK: ^bb0(%[[ARG:.*]]: complex<f64>):
 ! CHECK: %[[RESULT:.*]] = fir.addc %[[ARG]], %[[IDX2]] {fastmath = #arith.fastmath<contract>} : complex<f64>
 ! CHECK: omp.yield(%[[RESULT]] : complex<f64>)
 ! CHECK: }

flang/test/Lower/OpenMP/atomic-privatize.f90

@@ -8,7 +8,7 @@
 
 !CHECK: omp.task private(@_QFfredEprv_firstprivate_i32 %{{[0-9]+}}#0 -> %arg0
 !CHECK: %[[DECL:[0-9]+]]:2 = hlfir.declare %arg0 {uniq_name = "_QFfredEprv"}
-!CHECK: omp.atomic.update %[[DECL]]#0
+!CHECK: omp.atomic.update memory_order(relaxed) %[[DECL]]#0
 
 integer function fred
   integer :: prv

flang/test/Lower/OpenMP/atomic-write.f90

@@ -44,9 +44,9 @@ end program OmpAtomicWrite
 !CHECK-LABEL: func.func @_QPatomic_write_pointer() {
 !CHECK:    %[[X_REF:.*]] = fir.alloca !fir.box<!fir.ptr<i32>> {bindc_name = "x", uniq_name = "_QFatomic_write_pointerEx"}
 !CHECK:    %[[X_DECL:.*]]:2 = hlfir.declare %[[X_REF]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFatomic_write_pointerEx"} : (!fir.ref<!fir.box<!fir.ptr<i32>>>) -> (!fir.ref<!fir.box<!fir.ptr<i32>>>, !fir.ref<!fir.box<!fir.ptr<i32>>>)
-!CHECK:    %[[C1:.*]] = arith.constant 1 : i32
 !CHECK:    %[[X_ADDR_BOX:.*]] = fir.load %[[X_DECL]]#0 : !fir.ref<!fir.box<!fir.ptr<i32>>>
 !CHECK:    %[[X_POINTEE_ADDR:.*]] = fir.box_addr %[[X_ADDR_BOX]] : (!fir.box<!fir.ptr<i32>>) -> !fir.ptr<i32>
+!CHECK:    %[[C1:.*]] = arith.constant 1 : i32
 !CHECK:    omp.atomic.write %[[X_POINTEE_ADDR]] = %[[C1]]   : !fir.ptr<i32>, i32
 !CHECK:    %[[C2:.*]] = arith.constant 2 : i32
 !CHECK:    %[[X_ADDR_BOX:.*]] = fir.load %[[X_DECL]]#0 : !fir.ref<!fir.box<!fir.ptr<i32>>>

flang/test/Lower/OpenMP/dump-atomic-analysis.f90

@@ -0,0 +1,82 @@
+!RUN: %flang_fc1 -fopenmp -fopenmp-version=60 -emit-hlfir -mmlir -fdebug-dump-atomic-analysis %s -o /dev/null 2>&1 | FileCheck %s
+
+subroutine f00(x)
+  integer :: x, v
+  !$omp atomic read
+    v = x
+end
+
+!CHECK: Analysis {
+!CHECK-NEXT:   atom: x
+!CHECK-NEXT:   cond: <null>
+!CHECK-NEXT:   op0 {
+!CHECK-NEXT:     what: Read
+!CHECK-NEXT:     assign: v=x
+!CHECK-NEXT:   }
+!CHECK-NEXT:   op1 {
+!CHECK-NEXT:     what: None
+!CHECK-NEXT:     assign: <null>
+!CHECK-NEXT:   }
+!CHECK-NEXT: }
+
+
+subroutine f01(v)
+  integer :: x, v
+  !$omp atomic write
+    x = v
+end
+
+!CHECK: Analysis {
+!CHECK-NEXT:   atom: x
+!CHECK-NEXT:   cond: <null>
+!CHECK-NEXT:   op0 {
+!CHECK-NEXT:     what: Write
+!CHECK-NEXT:     assign: x=v
+!CHECK-NEXT:   }
+!CHECK-NEXT:   op1 {
+!CHECK-NEXT:     what: None
+!CHECK-NEXT:     assign: <null>
+!CHECK-NEXT:   }
+!CHECK-NEXT: }
+
+
+subroutine f02(x, v)
+  integer :: x, v
+  !$omp atomic update
+    x = x + v
+end
+
+!CHECK: Analysis {
+!CHECK-NEXT:   atom: x
+!CHECK-NEXT:   cond: <null>
+!CHECK-NEXT:   op0 {
+!CHECK-NEXT:     what: Update
+!CHECK-NEXT:     assign: x=x+v
+!CHECK-NEXT:   }
+!CHECK-NEXT:   op1 {
+!CHECK-NEXT:     what: None
+!CHECK-NEXT:     assign: <null>
+!CHECK-NEXT:   }
+!CHECK-NEXT: }
+
+
+subroutine f03(x, v)
+  integer :: x, v, t
+  !$omp atomic update capture
+    t = x
+    x = x + v
+  !$omp end atomic
+end
+
+!CHECK: Analysis {
+!CHECK-NEXT:   atom: x
+!CHECK-NEXT:   cond: <null>
+!CHECK-NEXT:   op0 {
+!CHECK-NEXT:     what: Read
+!CHECK-NEXT:     assign: t=x
+!CHECK-NEXT:   }
+!CHECK-NEXT:   op1 {
+!CHECK-NEXT:     what: Update
+!CHECK-NEXT:     assign: x=x+v
+!CHECK-NEXT:   }
+!CHECK-NEXT: }

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

@@ -1,16 +1,290 @@
-! RUN: not %flang_fc1  -fopenmp-version=51 -fopenmp %s 2>&1 | FileCheck %s
-! OpenMP version for documentation purposes only - it isn't used until Sema.
-! This is testing for Parser errors that bail out before Sema. 
-program main
-   implicit none
-   integer :: i, j = 10
-   logical :: r
+!RUN: %flang_fc1 -fdebug-unparse -fopenmp -fopenmp-version=60 %s | FileCheck --ignore-case --check-prefix="UNPARSE" %s
+!RUN: %flang_fc1 -fdebug-dump-parse-tree -fopenmp -fopenmp-version=60 %s | FileCheck --check-prefix="PARSE-TREE" %s
 
-  !CHECK: error: expected OpenMP construct
-  !$omp atomic compare write
-  r =  i .eq. j + 1
+subroutine f00(a, b)
+  integer :: a, b
+  integer :: x
+  !$omp atomic update compare
+  if (x < a) x = b
+end
 
-  !CHECK: error: expected end of line
-  !$omp atomic compare num_threads(4)
-  r = i .eq. j
-end program main
+!UNPARSE: SUBROUTINE f00 (a, b)
+!UNPARSE:  INTEGER a, b
+!UNPARSE:  INTEGER x
+!UNPARSE: !$OMP ATOMIC UPDATE COMPARE
+!UNPARSE:  IF (x<a)  x=b
+!UNPARSE: END SUBROUTINE
+
+!PARSE-TREE: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OpenMPAtomicConstruct
+!PARSE-TREE: | OmpDirectiveSpecification
+!PARSE-TREE: | | OmpDirectiveName -> llvm::omp::Directive = atomic
+!PARSE-TREE: | | OmpClauseList -> OmpClause -> Update ->
+!PARSE-TREE: | | OmpClause -> Compare
+!PARSE-TREE: | | Flags = None
+!PARSE-TREE: | Block
+!PARSE-TREE: | | ExecutionPartConstruct -> ExecutableConstruct -> ActionStmt -> IfStmt
+!PARSE-TREE: | | | Scalar -> Logical -> Expr = 'x<a'
+!PARSE-TREE: | | | | LT
+!PARSE-TREE: | | | | | Expr = 'x'
+!PARSE-TREE: | | | | | | Designator -> DataRef -> Name = 'x'
+!PARSE-TREE: | | | | | Expr = 'a'
+!PARSE-TREE: | | | | | | Designator -> DataRef -> Name = 'a'
+!PARSE-TREE: | | | ActionStmt -> AssignmentStmt = 'x=b'
+!PARSE-TREE: | | | | Variable = 'x'
+!PARSE-TREE: | | | | | Designator -> DataRef -> Name = 'x'
+!PARSE-TREE: | | | | Expr = 'b'
+!PARSE-TREE: | | | | | Designator -> DataRef -> Name = 'b'
+
+subroutine f01(a, b)
+  integer :: a, b
+  integer :: x
+  !$omp atomic update compare
+  if (x < a) then
+    x = b
+  endif
+end
+
+!UNPARSE: SUBROUTINE f01 (a, b)
+!UNPARSE:  INTEGER a, b
+!UNPARSE:  INTEGER x
+!UNPARSE: !$OMP ATOMIC UPDATE COMPARE
+!UNPARSE:  IF (x<a) THEN
+!UNPARSE:    x=b
+!UNPARSE:  END IF
+!UNPARSE: END SUBROUTINE
+
+!PARSE-TREE: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OpenMPAtomicConstruct
+!PARSE-TREE: | OmpDirectiveSpecification
+!PARSE-TREE: | | OmpDirectiveName -> llvm::omp::Directive = atomic
+!PARSE-TREE: | | OmpClauseList -> OmpClause -> Update ->
+!PARSE-TREE: | | OmpClause -> Compare
+!PARSE-TREE: | | Flags = None
+!PARSE-TREE: | Block
+!PARSE-TREE: | | ExecutionPartConstruct -> ExecutableConstruct -> IfConstruct
+!PARSE-TREE: | | | IfThenStmt
+!PARSE-TREE: | | | | Scalar -> Logical -> Expr = 'x<a'
+!PARSE-TREE: | | | | | LT
+!PARSE-TREE: | | | | | | Expr = 'x'
+!PARSE-TREE: | | | | | | | Designator -> DataRef -> Name = 'x'
+!PARSE-TREE: | | | | | | Expr = 'a'
+!PARSE-TREE: | | | | | | | Designator -> DataRef -> Name = 'a'
+!PARSE-TREE: | | | Block
+!PARSE-TREE: | | | | ExecutionPartConstruct -> ExecutableConstruct -> ActionStmt -> AssignmentStmt = 'x=b'
+!PARSE-TREE: | | | | | Variable = 'x'
+!PARSE-TREE: | | | | | | Designator -> DataRef -> Name = 'x'
+!PARSE-TREE: | | | | | Expr = 'b'
+!PARSE-TREE: | | | | | | Designator -> DataRef -> Name = 'b'
+!PARSE-TREE: | | | EndIfStmt ->
+
+subroutine f02(a, b)
+  integer :: a, b
+  integer :: x
+  logical :: c
+  c = x < a
+  !$omp atomic update compare
+  if (c) then
+    x = b
+  endif
+end
+
+!UNPARSE: SUBROUTINE f02 (a, b)
+!UNPARSE:  INTEGER a, b
+!UNPARSE:  INTEGER x
+!UNPARSE:  LOGICAL c
+!UNPARSE:   c=x<a
+!UNPARSE: !$OMP ATOMIC UPDATE COMPARE
+!UNPARSE:  IF (c) THEN
+!UNPARSE:    x=b
+!UNPARSE:  END IF
+!UNPARSE: END SUBROUTINE
+
+!PARSE-TREE: ExecutionPartConstruct -> ExecutableConstruct -> ActionStmt -> AssignmentStmt = 'c=x<a'
+!PARSE-TREE: | Variable = 'c'
+!PARSE-TREE: | | Designator -> DataRef -> Name = 'c'
+!PARSE-TREE: | Expr = 'x<a'
+!PARSE-TREE: | | LT
+!PARSE-TREE: | | | Expr = 'x'
+!PARSE-TREE: | | | | Designator -> DataRef -> Name = 'x'
+!PARSE-TREE: | | | Expr = 'a'
+!PARSE-TREE: | | | | Designator -> DataRef -> Name = 'a'
+!PARSE-TREE: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OpenMPAtomicConstruct
+!PARSE-TREE: | OmpDirectiveSpecification
+!PARSE-TREE: | | OmpDirectiveName -> llvm::omp::Directive = atomic
+!PARSE-TREE: | | OmpClauseList -> OmpClause -> Update ->
+!PARSE-TREE: | | OmpClause -> Compare
+!PARSE-TREE: | | Flags = None
+!PARSE-TREE: | Block
+!PARSE-TREE: | | ExecutionPartConstruct -> ExecutableConstruct -> IfConstruct
+!PARSE-TREE: | | | IfThenStmt
+!PARSE-TREE: | | | | Scalar -> Logical -> Expr = 'c'
+!PARSE-TREE: | | | | | Designator -> DataRef -> Name = 'c'
+!PARSE-TREE: | | | Block
+!PARSE-TREE: | | | | ExecutionPartConstruct -> ExecutableConstruct -> ActionStmt -> AssignmentStmt = 'x=b'
+!PARSE-TREE: | | | | | Variable = 'x'
+!PARSE-TREE: | | | | | | Designator -> DataRef -> Name = 'x'
+!PARSE-TREE: | | | | | Expr = 'b'
+!PARSE-TREE: | | | | | | Designator -> DataRef -> Name = 'b'
+!PARSE-TREE: | | | EndIfStmt ->
+
+subroutine g00(a, b)
+  integer :: a, b
+  integer :: x, v
+  !$omp atomic update capture compare
+  v = x
+  if (x < a) x = b
+  !$omp end atomic
+end
+
+!UNPARSE: SUBROUTINE g00 (a, b)
+!UNPARSE:  INTEGER a, b
+!UNPARSE:  INTEGER x, v
+!UNPARSE: !$OMP ATOMIC UPDATE CAPTURE COMPARE
+!UNPARSE:   v=x
+!UNPARSE:  IF (x<a)  x=b
+!UNPARSE: !$OMP END ATOMIC
+!UNPARSE: END SUBROUTINE
+
+!PARSE-TREE: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OpenMPAtomicConstruct
+!PARSE-TREE: | OmpDirectiveSpecification
+!PARSE-TREE: | | OmpDirectiveName -> llvm::omp::Directive = atomic
+!PARSE-TREE: | | OmpClauseList -> OmpClause -> Update ->
+!PARSE-TREE: | | OmpClause -> Capture
+!PARSE-TREE: | | OmpClause -> Compare
+!PARSE-TREE: | | Flags = None
+!PARSE-TREE: | Block
+!PARSE-TREE: | | ExecutionPartConstruct -> ExecutableConstruct -> ActionStmt -> AssignmentStmt = 'v=x'
+!PARSE-TREE: | | | Variable = 'v'
+!PARSE-TREE: | | | | Designator -> DataRef -> Name = 'v'
+!PARSE-TREE: | | | Expr = 'x'
+!PARSE-TREE: | | | | Designator -> DataRef -> Name = 'x'
+!PARSE-TREE: | | ExecutionPartConstruct -> ExecutableConstruct -> ActionStmt -> IfStmt
+!PARSE-TREE: | | | Scalar -> Logical -> Expr = 'x<a'
+!PARSE-TREE: | | | | LT
+!PARSE-TREE: | | | | | Expr = 'x'
+!PARSE-TREE: | | | | | | Designator -> DataRef -> Name = 'x'
+!PARSE-TREE: | | | | | Expr = 'a'
+!PARSE-TREE: | | | | | | Designator -> DataRef -> Name = 'a'
+!PARSE-TREE: | | | ActionStmt -> AssignmentStmt = 'x=b'
+!PARSE-TREE: | | | | Variable = 'x'
+!PARSE-TREE: | | | | | Designator -> DataRef -> Name = 'x'
+!PARSE-TREE: | | | | Expr = 'b'
+!PARSE-TREE: | | | | | Designator -> DataRef -> Name = 'b'
+!PARSE-TREE: | OmpDirectiveSpecification
+!PARSE-TREE: | | OmpDirectiveName -> llvm::omp::Directive = atomic
+!PARSE-TREE: | | OmpClauseList ->
+!PARSE-TREE: | | Flags = None
+
+subroutine g01(a, b)
+  integer :: a, b
+  integer :: x, v
+  !$omp atomic update capture compare
+  v = x
+  if (x < a) then
+    x = b
+  endif
+  !$omp end atomic
+end
+
+!UNPARSE: SUBROUTINE g01 (a, b)
+!UNPARSE:  INTEGER a, b
+!UNPARSE:  INTEGER x, v
+!UNPARSE: !$OMP ATOMIC UPDATE CAPTURE COMPARE
+!UNPARSE:   v=x
+!UNPARSE:  IF (x<a) THEN
+!UNPARSE:    x=b
+!UNPARSE:  END IF
+!UNPARSE: !$OMP END ATOMIC
+!UNPARSE: END SUBROUTINE
+
+!PARSE-TREE: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OpenMPAtomicConstruct
+!PARSE-TREE: | OmpDirectiveSpecification
+!PARSE-TREE: | | OmpDirectiveName -> llvm::omp::Directive = atomic
+!PARSE-TREE: | | OmpClauseList -> OmpClause -> Update ->
+!PARSE-TREE: | | OmpClause -> Capture
+!PARSE-TREE: | | OmpClause -> Compare
+!PARSE-TREE: | | Flags = None
+!PARSE-TREE: | Block
+!PARSE-TREE: | | ExecutionPartConstruct -> ExecutableConstruct -> ActionStmt -> AssignmentStmt = 'v=x'
+!PARSE-TREE: | | | Variable = 'v'
+!PARSE-TREE: | | | | Designator -> DataRef -> Name = 'v'
+!PARSE-TREE: | | | Expr = 'x'
+!PARSE-TREE: | | | | Designator -> DataRef -> Name = 'x'
+!PARSE-TREE: | | ExecutionPartConstruct -> ExecutableConstruct -> IfConstruct
+!PARSE-TREE: | | | IfThenStmt
+!PARSE-TREE: | | | | Scalar -> Logical -> Expr = 'x<a'
+!PARSE-TREE: | | | | | LT
+!PARSE-TREE: | | | | | | Expr = 'x'
+!PARSE-TREE: | | | | | | | Designator -> DataRef -> Name = 'x'
+!PARSE-TREE: | | | | | | Expr = 'a'
+!PARSE-TREE: | | | | | | | Designator -> DataRef -> Name = 'a'
+!PARSE-TREE: | | | Block
+!PARSE-TREE: | | | | ExecutionPartConstruct -> ExecutableConstruct -> ActionStmt -> AssignmentStmt = 'x=b'
+!PARSE-TREE: | | | | | Variable = 'x'
+!PARSE-TREE: | | | | | | Designator -> DataRef -> Name = 'x'
+!PARSE-TREE: | | | | | Expr = 'b'
+!PARSE-TREE: | | | | | | Designator -> DataRef -> Name = 'b'
+!PARSE-TREE: | | | EndIfStmt ->
+!PARSE-TREE: | OmpDirectiveSpecification
+!PARSE-TREE: | | OmpDirectiveName -> llvm::omp::Directive = atomic
+!PARSE-TREE: | | OmpClauseList ->
+!PARSE-TREE: | | Flags = None
+
+subroutine g02(a, b)
+  integer :: a, b
+  integer :: x, v
+  !$omp atomic update capture compare
+  if (x < a) then
+    x = b
+  else
+    v = x
+  endif
+  !$omp end atomic
+end
+
+!UNPARSE: SUBROUTINE g02 (a, b)
+!UNPARSE:  INTEGER a, b
+!UNPARSE:  INTEGER x, v
+!UNPARSE: !$OMP ATOMIC UPDATE CAPTURE COMPARE
+!UNPARSE:  IF (x<a) THEN
+!UNPARSE:    x=b
+!UNPARSE:  ELSE
+!UNPARSE:    v=x
+!UNPARSE:  END IF
+!UNPARSE: !$OMP END ATOMIC
+!UNPARSE: END SUBROUTINE
+
+!PARSE-TREE: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OpenMPAtomicConstruct
+!PARSE-TREE: | OmpDirectiveSpecification
+!PARSE-TREE: | | OmpDirectiveName -> llvm::omp::Directive = atomic
+!PARSE-TREE: | | OmpClauseList -> OmpClause -> Update ->
+!PARSE-TREE: | | OmpClause -> Capture
+!PARSE-TREE: | | OmpClause -> Compare
+!PARSE-TREE: | | Flags = None
+!PARSE-TREE: | Block
+!PARSE-TREE: | | ExecutionPartConstruct -> ExecutableConstruct -> IfConstruct
+!PARSE-TREE: | | | IfThenStmt
+!PARSE-TREE: | | | | Scalar -> Logical -> Expr = 'x<a'
+!PARSE-TREE: | | | | | LT
+!PARSE-TREE: | | | | | | Expr = 'x'
+!PARSE-TREE: | | | | | | | Designator -> DataRef -> Name = 'x'
+!PARSE-TREE: | | | | | | Expr = 'a'
+!PARSE-TREE: | | | | | | | Designator -> DataRef -> Name = 'a'
+!PARSE-TREE: | | | Block
+!PARSE-TREE: | | | | ExecutionPartConstruct -> ExecutableConstruct -> ActionStmt -> AssignmentStmt = 'x=b'
+!PARSE-TREE: | | | | | Variable = 'x'
+!PARSE-TREE: | | | | | | Designator -> DataRef -> Name = 'x'
+!PARSE-TREE: | | | | | Expr = 'b'
+!PARSE-TREE: | | | | | | Designator -> DataRef -> Name = 'b'
+!PARSE-TREE: | | | ElseBlock
+!PARSE-TREE: | | | | ElseStmt ->
+!PARSE-TREE: | | | | Block
+!PARSE-TREE: | | | | | ExecutionPartConstruct -> ExecutableConstruct -> ActionStmt -> AssignmentStmt = 'v=x'
+!PARSE-TREE: | | | | | | Variable = 'v'
+!PARSE-TREE: | | | | | | | Designator -> DataRef -> Name = 'v'
+!PARSE-TREE: | | | | | | Expr = 'x'
+!PARSE-TREE: | | | | | | | Designator -> DataRef -> Name = 'x'
+!PARSE-TREE: | | | EndIfStmt ->
+!PARSE-TREE: | OmpDirectiveSpecification
+!PARSE-TREE: | | OmpDirectiveName -> llvm::omp::Directive = atomic
+!PARSE-TREE: | | OmpClauseList ->
+!PARSE-TREE: | | Flags = None

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

@@ -0,0 +1,63 @@
+!RUN: %flang_fc1 -fdebug-unparse -fopenmp -fopenmp-version=60 %s | FileCheck --ignore-case --check-prefix="UNPARSE" %s
+!RUN: %flang_fc1 -fdebug-dump-parse-tree -fopenmp -fopenmp-version=60 %s | FileCheck --check-prefix="PARSE-TREE" %s
+
+subroutine f00
+  integer :: x, v
+  !$omp atomic read
+  v = x
+  !$omp end atomic
+end
+
+!UNPARSE: SUBROUTINE f00
+!UNPARSE:  INTEGER x, v
+!UNPARSE: !$OMP ATOMIC READ
+!UNPARSE:   v=x
+!UNPARSE: !$OMP END ATOMIC
+!UNPARSE: END SUBROUTINE
+
+!PARSE-TREE: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OpenMPAtomicConstruct
+!PARSE-TREE: | OmpDirectiveSpecification
+!PARSE-TREE: | | OmpDirectiveName -> llvm::omp::Directive = atomic
+!PARSE-TREE: | | OmpClauseList -> OmpClause -> Read
+!PARSE-TREE: | | Flags = None
+!PARSE-TREE: | Block
+!PARSE-TREE: | | ExecutionPartConstruct -> ExecutableConstruct -> ActionStmt -> AssignmentStmt = 'v=x'
+!PARSE-TREE: | | | Variable = 'v'
+!PARSE-TREE: | | | | Designator -> DataRef -> Name = 'v'
+!PARSE-TREE: | | | Expr = 'x'
+!PARSE-TREE: | | | | Designator -> DataRef -> Name = 'x'
+!PARSE-TREE: | OmpDirectiveSpecification
+!PARSE-TREE: | | OmpDirectiveName -> llvm::omp::Directive = atomic
+!PARSE-TREE: | | OmpClauseList ->
+!PARSE-TREE: | | Flags = None
+
+
+subroutine f01
+  integer :: x, v
+  !$omp atomic read
+  v = x
+  !$omp endatomic
+end
+
+!UNPARSE: SUBROUTINE f01
+!UNPARSE:  INTEGER x, v
+!UNPARSE: !$OMP ATOMIC READ
+!UNPARSE:   v=x
+!UNPARSE: !$OMP END ATOMIC
+!UNPARSE: END SUBROUTINE
+
+!PARSE-TREE: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OpenMPAtomicConstruct
+!PARSE-TREE: | OmpDirectiveSpecification
+!PARSE-TREE: | | OmpDirectiveName -> llvm::omp::Directive = atomic
+!PARSE-TREE: | | OmpClauseList -> OmpClause -> Read
+!PARSE-TREE: | | Flags = None
+!PARSE-TREE: | Block
+!PARSE-TREE: | | ExecutionPartConstruct -> ExecutableConstruct -> ActionStmt -> AssignmentStmt = 'v=x'
+!PARSE-TREE: | | | Variable = 'v'
+!PARSE-TREE: | | | | Designator -> DataRef -> Name = 'v'
+!PARSE-TREE: | | | Expr = 'x'
+!PARSE-TREE: | | | | Designator -> DataRef -> Name = 'x'
+!PARSE-TREE: | OmpDirectiveSpecification
+!PARSE-TREE: | | OmpDirectiveName -> llvm::omp::Directive = atomic
+!PARSE-TREE: | | OmpClauseList ->
+!PARSE-TREE: | | Flags = None

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

@@ -44,46 +44,37 @@
   !$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
+  !ERROR: At most one SEQ_CST clause can appear on the ATOMIC directive
   !$omp atomic seq_cst seq_cst compare
   if (b .eq. c) b = a
-  !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
+  !ERROR: At most one SEQ_CST clause can appear on the ATOMIC directive
   !$omp atomic compare seq_cst seq_cst
   if (b .eq. c) b = a
-  !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
+  !ERROR: At most one SEQ_CST clause can appear on the ATOMIC directive
   !$omp atomic seq_cst compare seq_cst
   if (b .eq. c) b = a
 
-  !ERROR: More than one memory order clause not allowed on OpenMP ATOMIC construct
-  !ERROR: At most one ACQUIRE clause can appear on the COMPARE directive
+  !ERROR: At most one ACQUIRE clause can appear on the ATOMIC directive
   !$omp atomic acquire acquire compare
   if (b .eq. c) b = a
-  !ERROR: More than one memory order clause not allowed on OpenMP ATOMIC construct
-  !ERROR: At most one ACQUIRE clause can appear on the COMPARE directive
+  !ERROR: At most one ACQUIRE clause can appear on the ATOMIC directive
   !$omp atomic compare acquire acquire
   if (b .eq. c) b = a
-  !ERROR: More than one memory order clause not allowed on OpenMP ATOMIC construct
-  !ERROR: At most one ACQUIRE clause can appear on the COMPARE directive
+  !ERROR: At most one ACQUIRE clause can appear on the ATOMIC directive
   !$omp atomic acquire compare acquire
   if (b .eq. c) b = a
 
-  !ERROR: More than one memory order clause not allowed on OpenMP ATOMIC construct
-  !ERROR: At most one RELAXED clause can appear on the COMPARE directive
+  !ERROR: At most one RELAXED clause can appear on the ATOMIC directive
   !$omp atomic relaxed relaxed compare
   if (b .eq. c) b = a
-  !ERROR: More than one memory order clause not allowed on OpenMP ATOMIC construct
-  !ERROR: At most one RELAXED clause can appear on the COMPARE directive
+  !ERROR: At most one RELAXED clause can appear on the ATOMIC directive
   !$omp atomic compare relaxed relaxed
   if (b .eq. c) b = a
-  !ERROR: More than one memory order clause not allowed on OpenMP ATOMIC construct
-  !ERROR: At most one RELAXED clause can appear on the COMPARE directive
+  !ERROR: At most one RELAXED clause can appear on the ATOMIC directive
   !$omp atomic relaxed compare relaxed
   if (b .eq. c) b = a
 
-  !ERROR: More than one FAIL clause not allowed on OpenMP ATOMIC construct
+  !ERROR: At most one FAIL clause can appear on the ATOMIC directive
   !$omp atomic fail(release) compare fail(release)
   if (c .eq. a) a = b
   !$omp end atomic

flang/test/Semantics/OpenMP/atomic-hint-clause.f90

@@ -16,20 +16,21 @@ program sample
     !$omp atomic read hint(2)
         y = x    
      
-    !ERROR: Hint clause value is not a valid OpenMP synchronization value
+    !ERROR: The synchronization hint is not valid
     !$omp atomic hint(3)
         y = y + 10
     
     !$omp atomic update hint(5)
         y = x + y
     
-    !ERROR: Hint clause value is not a valid OpenMP synchronization value
+    !ERROR: The synchronization hint is not valid
     !$omp atomic hint(7) capture
+    !WARNING: In ATOMIC UPDATE operation with CAPTURE either statement could be the update and the capture, assuming the first one is the capture statement
         y = x
         x = y
     !$omp end atomic
    
-    !ERROR: Hint clause must have non-negative constant integer expression
+    !ERROR: Synchronization hint must be a constant integer value
     !ERROR: Must be a constant value
     !$omp atomic update hint(x)
         y = y * 1
@@ -46,7 +47,7 @@ program sample
     !$omp atomic hint(omp_lock_hint_speculative)
         x = y + x
     
-    !ERROR: Hint clause must have non-negative constant integer expression
+    !ERROR: Synchronization hint must be a constant integer value
     !ERROR: Must be a constant value
     !$omp atomic hint(omp_sync_hint_uncontended + omp_sync_hint) read
         y = x 
@@ -69,36 +70,36 @@ program sample
     !$omp atomic hint(omp_lock_hint_contended + omp_sync_hint_nonspeculative)
         x = y + x
 
-    !ERROR: Hint clause value is not a valid OpenMP synchronization value
+    !ERROR: The synchronization hint is not valid
     !$omp atomic hint(omp_sync_hint_uncontended + omp_sync_hint_contended) read
         y = x 
 
-    !ERROR: Hint clause value is not a valid OpenMP synchronization value
+    !ERROR: The synchronization hint is not valid
     !$omp atomic hint(omp_sync_hint_nonspeculative + omp_lock_hint_speculative)
         y = y * 9
 
-    !ERROR: Hint clause must have non-negative constant integer expression
+    !ERROR: Synchronization hint must be a constant integer value
     !ERROR: Must have INTEGER type, but is REAL(4)
     !$omp atomic hint(1.0) read
         y = x
 
-    !ERROR: Hint clause must have non-negative constant integer expression
+    !ERROR: Synchronization hint must be a constant integer value
     !ERROR: Operands of + must be numeric; have LOGICAL(4) and INTEGER(4)
     !$omp atomic hint(z + omp_sync_hint_nonspeculative) read
         y = x
 
-    !ERROR: Hint clause must have non-negative constant integer expression
+    !ERROR: Synchronization hint must be a constant integer value
     !ERROR: Must be a constant value
     !$omp atomic hint(k + omp_sync_hint_speculative) read
         y = x
 
-    !ERROR: Hint clause must have non-negative constant integer expression
+    !ERROR: Synchronization hint must be a constant integer value
     !ERROR: Must be a constant value
     !$omp atomic hint(p(1) + omp_sync_hint_uncontended) write
         x = 10 * y
 
     !$omp atomic write hint(a)
-    !ERROR: RHS expression on atomic assignment statement cannot access 'x'
+    !ERROR: Within atomic operation x and y+x access the same storage
         x = y + x
 
     !$omp atomic hint(abs(-1)) write

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

@@ -0,0 +1,118 @@
+!RUN: %python %S/../test_errors.py %s %flang -fopenmp -fopenmp-version=60
+
+subroutine f00
+  integer :: x, v
+  ! The end-directive is optional in ATOMIC READ. Expect no diagnostics.
+  !$omp atomic read
+  v = x
+
+  !$omp atomic read
+  v = x
+  !$omp end atomic
+end
+
+subroutine f01
+  integer, pointer :: x, v
+  ! Intrinsic assignment and pointer assignment are both ok. Expect no
+  ! diagnostics.
+  !$omp atomic read
+  v = x
+
+  !$omp atomic read
+  v => x
+end
+
+subroutine f02(i)
+  integer :: i, v
+  interface
+    function p(i)
+      integer, pointer :: p
+      integer :: i
+    end
+  end interface
+
+  ! Atomic variable can be a function reference. Expect no diagostics.
+  !$omp atomic read
+  v = p(i)
+end
+
+subroutine f03
+  integer :: x(3), y(5), v(3)
+
+  !$omp atomic read
+  !ERROR: Atomic variable x should be a scalar
+  v = x
+
+  !$omp atomic read
+  !ERROR: Atomic variable y(2_8:4_8:1_8) should be a scalar
+  v = y(2:4)
+end
+
+subroutine f04
+  integer :: x, y(3), v
+
+  !$omp atomic read
+  !ERROR: Within atomic operation x and x access the same storage
+  x = x
+
+  ! Accessing same array, but not the same storage. Expect no diagnostics.
+  !$omp atomic read
+  y(1) = y(2)
+end
+
+subroutine f05
+  integer :: x, v
+
+  !$omp atomic read
+  !ERROR: Atomic expression x+1_4 should be a variable
+  v = x + 1
+end
+
+subroutine f06
+  character :: x, v
+
+  !$omp atomic read
+  !ERROR: Atomic variable x cannot have CHARACTER type
+  v = x
+end
+
+subroutine f07
+  integer, allocatable :: x
+  integer :: v
+
+  allocate(x)
+
+  !$omp atomic read
+  !ERROR: Atomic variable x cannot be ALLOCATABLE
+  v = x
+end
+
+subroutine f08
+  type :: struct
+    integer :: m
+  end type
+  type(struct) :: x, v
+
+  !$omp atomic read
+  !ERROR: Atomic variable x should have an intrinsic type
+  v = x
+end
+
+subroutine f09(x, v)
+  class(*), pointer :: x, v
+
+  !$omp atomic read
+  !ERROR: Atomic variable x cannot be a pointer to a polymorphic type
+  v => x
+end
+
+subroutine f10(x, v)
+  type struct(length)
+    integer, len :: length
+  end type
+  type(struct(*)), pointer :: x, v
+
+  !$omp atomic read
+  !ERROR: Atomic variable x is a pointer to a type with non-constant length parameter
+  v => x
+end

flang/test/Semantics/OpenMP/atomic-update-capture.f90

@@ -0,0 +1,77 @@
+!RUN: %python %S/../test_errors.py %s %flang -fopenmp -fopenmp-version=60
+
+subroutine f00
+  integer :: x, y, v
+
+  !ERROR: ATOMIC UPDATE operation with CAPTURE should contain two statements
+  !$omp atomic update capture
+  x = v
+  x = x + 1
+  y = x
+  !$omp end atomic
+end
+
+subroutine f01
+  integer :: x, y, v
+
+  !ERROR: ATOMIC UPDATE operation with CAPTURE should contain two assignments
+  !$omp atomic update capture
+  x = v
+  block
+    x = x + 1
+    y = x
+  end block
+  !$omp end atomic
+end
+
+subroutine f02
+  integer :: x, y
+
+  ! The update and capture statements can be inside of a single BLOCK.
+  ! The end-directive is then optional. Expect no diagnostics.
+  !$omp atomic update capture
+  block
+    x = x + 1
+    y = x
+  end block
+end
+
+subroutine f03
+  integer :: x
+
+  !ERROR: In ATOMIC UPDATE operation with CAPTURE neither statement could be the capture
+  !$omp atomic update capture
+  x = x + 1
+  x = x + 2
+  !$omp end atomic
+end
+
+subroutine f04
+  integer :: x, v
+
+  !$omp atomic update capture
+  !WARNING: In ATOMIC UPDATE operation with CAPTURE either statement could be the update and the capture, assuming the first one is the capture statement
+  v = x
+  x = v
+  !$omp end atomic
+end
+
+subroutine f05
+  integer :: x, v, z
+
+  !$omp atomic update capture
+  !ERROR: In ATOMIC UPDATE operation with CAPTURE the right-hand side of the capture assignment should read z
+  v = x
+  z = x + 1
+  !$omp end atomic
+end
+
+subroutine f06
+  integer :: x, v, z
+
+  !$omp atomic update capture
+  z = x + 1
+  !ERROR: In ATOMIC UPDATE operation with CAPTURE the right-hand side of the capture assignment should read z
+  v = x
+  !$omp end atomic
+end

flang/test/Semantics/OpenMP/atomic-update-only.f90

@@ -0,0 +1,83 @@
+!RUN: %python %S/../test_errors.py %s %flang -fopenmp -fopenmp-version=60
+
+subroutine f00
+  integer :: x, y
+
+  ! The x is a direct argument of the + operator. Expect no diagnostics.
+  !$omp atomic update
+  x = x + (y - 1)
+end
+
+subroutine f01
+  integer :: x
+
+  ! x + 0 is unusual, but legal. Expect no diagnostics.
+  !$omp atomic update
+  x = x + 0
+end
+
+subroutine f02
+  integer :: x
+
+  ! This is formally not allowed by the syntax restrictions of the spec,
+  ! but it's equivalent to either x+0 or x*1, both of which are legal.
+  ! Allow this case. Expect no diagnostics.
+  !$omp atomic update
+  x = x
+end
+
+subroutine f03
+  integer :: x, y
+
+  !$omp atomic update
+  !ERROR: The atomic variable x should occur exactly once among the arguments of the top-level + operator
+  x = (x + y) + 1
+end
+
+subroutine f04
+  integer :: x
+  real :: y
+
+  !$omp atomic update
+  !ERROR: This intrinsic function is not a valid ATOMIC UPDATE operation
+  x = floor(x + y)
+end
+
+subroutine f05
+  integer :: x
+  real :: y
+
+  ! An explicit conversion is accepted as an extension.
+  !$omp atomic update
+  x = int(x + y)
+end
+
+subroutine f06
+  integer :: x, y
+  interface
+    function f(i, j)
+      integer :: f, i, j
+    end
+  end interface
+
+  !$omp atomic update
+  !ERROR: A call to this function is not a valid ATOMIC UPDATE operation
+  x = f(x, y)
+end
+
+subroutine f07
+  real :: x
+  integer :: y
+
+  !$omp atomic update
+  !ERROR: The ** operator is not a valid ATOMIC UPDATE operation
+  x = x ** y
+end
+
+subroutine f08
+  integer :: x, y
+
+  !$omp atomic update
+  !ERROR: The atomic variable x should appear as an argument in the update operation
+  x = y
+end

flang/test/Semantics/OpenMP/atomic-update-overloaded-ops.f90

@@ -22,10 +22,10 @@ program sample
         x = x / y
      
     !$omp atomic update
-    !ERROR: Invalid or missing operator in atomic update statement
+    !ERROR: A call to this function is not a valid ATOMIC UPDATE operation
         x = x .MYOPERATOR. y
 
     !$omp atomic
-    !ERROR: Invalid or missing operator in atomic update statement
+    !ERROR: A call to this function is not a valid ATOMIC UPDATE operation
         x = x .MYOPERATOR. y
 end program

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

@@ -0,0 +1,81 @@
+!RUN: %python %S/../test_errors.py %s %flang -fopenmp -fopenmp-version=60
+
+subroutine f00
+  integer :: x, v
+  ! The end-directive is optional in ATOMIC WRITE. Expect no diagnostics.
+  !$omp atomic write
+  x = v + 1
+
+  !$omp atomic write
+  x = v + 3
+  !$omp end atomic
+end
+
+subroutine f01
+  integer, pointer :: x, v
+  ! Intrinsic assignment and pointer assignment are both ok. Expect no
+  ! diagnostics.
+  !$omp atomic write
+  x = 2 * v + 3
+
+  !$omp atomic write
+  x => v
+end
+
+subroutine f02(i)
+  integer :: i, v
+  interface
+    function p(i)
+      integer, pointer :: p
+      integer :: i
+    end
+  end interface
+
+  ! Atomic variable can be a function reference. Expect no diagostics.
+  !$omp atomic write
+  p(i) = v
+end
+
+subroutine f03
+  integer :: x(3), y(5), v(3)
+
+  !$omp atomic write
+  !ERROR: Atomic variable x should be a scalar
+  x = v
+
+  !$omp atomic write
+  !ERROR: Atomic variable y(2_8:4_8:1_8) should be a scalar
+  y(2:4) = v
+end
+
+subroutine f04
+  integer :: x, y(3), v
+
+  !$omp atomic write
+  !ERROR: Within atomic operation x and x+1_4 access the same storage
+  x = x + 1
+
+  ! Accessing same array, but not the same storage. Expect no diagnostics.
+  !$omp atomic write
+  y(1) = y(2)
+end
+
+subroutine f06
+  character :: x, v
+
+  !$omp atomic write
+  !ERROR: Atomic variable x cannot have CHARACTER type
+  x = v
+end
+
+subroutine f07
+  integer, allocatable :: x
+  integer :: v
+
+  allocate(x)
+
+  !$omp atomic write
+  !ERROR: Atomic variable x cannot be ALLOCATABLE
+  x = v
+end
+

flang/test/Semantics/OpenMP/atomic.f90

@@ -1,4 +1,6 @@
-! RUN: %python %S/../test_errors.py %s %flang -fopenmp
+! REQUIRES: openmp_runtime
+
+! RUN: %python %S/../test_errors.py %s %flang -fopenmp %openmp_flags
 use omp_lib
 ! Check OpenMP 2.13.6 atomic Construct
 
@@ -11,9 +13,13 @@ use omp_lib
   a = b
   !$omp end atomic
 
+  !ERROR: ACQUIRE clause is not allowed on directive ATOMIC in OpenMP v3.1, try -fopenmp-version=50
+  !ERROR: HINT clause is not allowed on directive ATOMIC in OpenMP v3.1, try -fopenmp-version=50
   !$omp atomic read acquire hint(OMP_LOCK_HINT_CONTENDED)
   a = b
 
+  !ERROR: RELEASE clause is not allowed on directive ATOMIC in OpenMP v3.1, try -fopenmp-version=50
+  !ERROR: HINT clause is not allowed on directive ATOMIC in OpenMP v3.1, try -fopenmp-version=50
   !$omp atomic release hint(OMP_LOCK_HINT_UNCONTENDED) write
   a = b
 
@@ -22,39 +28,32 @@ use omp_lib
   a = a + 1
   !$omp end atomic
 
+  !ERROR: HINT clause is not allowed on directive ATOMIC in OpenMP v3.1, try -fopenmp-version=50
+  !ERROR: ACQ_REL clause is not allowed on directive ATOMIC in OpenMP v3.1, try -fopenmp-version=50
   !$omp atomic hint(1) acq_rel capture
   b = a
   a = a + 1
   !$omp end atomic
 
-  !ERROR: expected end of line
+  !ERROR: At most one clause from the 'atomic' group is allowed on ATOMIC construct
   !$omp atomic read write
+  !ERROR: Atomic expression a+1._4 should be a variable
   a = a + 1
 
   !$omp atomic
   a = a + 1
-  !ERROR: expected 'UPDATE'
-  !ERROR: expected 'WRITE'
-  !ERROR: expected 'COMPARE'
-  !ERROR: expected 'CAPTURE'
-  !ERROR: expected 'READ'
+  !ERROR: NUM_THREADS clause is not allowed on the ATOMIC directive
   !$omp atomic num_threads(4)
   a = a + 1
 
-  !ERROR: expected end of line
+  !ERROR: ATOMIC UPDATE operation with CAPTURE should contain two statements
+  !ERROR: NUM_THREADS clause is not allowed on the ATOMIC directive
   !$omp atomic capture num_threads(4)
   a = a + 1
 
+  !ERROR: RELAXED clause is not allowed on directive ATOMIC in OpenMP v3.1, try -fopenmp-version=50
   !$omp atomic relaxed
   a = a + 1
 
-  !ERROR: expected 'UPDATE'
-  !ERROR: expected 'WRITE'
-  !ERROR: expected 'COMPARE'
-  !ERROR: expected 'CAPTURE'
-  !ERROR: expected 'READ'
-  !$omp atomic num_threads write
-  a = a + 1
-
   !$omp end parallel
 end

flang/test/Semantics/OpenMP/atomic01.f90

@@ -14,322 +14,277 @@ use omp_lib
 ! At most one memory-order-clause may appear on the construct.
 
 !READ
-  !ERROR: More than one memory order clause not allowed on OpenMP ATOMIC construct
-  !ERROR: At most one SEQ_CST clause can appear on the READ directive
+  !ERROR: At most one SEQ_CST clause can appear on the ATOMIC directive
   !$omp atomic seq_cst seq_cst read
     i = j
-  !ERROR: More than one memory order clause not allowed on OpenMP ATOMIC construct
-  !ERROR: At most one SEQ_CST clause can appear on the READ directive
+  !ERROR: At most one SEQ_CST clause can appear on the ATOMIC directive
   !$omp atomic read seq_cst seq_cst
     i = j
-  !ERROR: More than one memory order clause not allowed on OpenMP ATOMIC construct
-  !ERROR: At most one SEQ_CST clause can appear on the READ directive
+  !ERROR: At most one SEQ_CST clause can appear on the ATOMIC directive
   !$omp atomic seq_cst read seq_cst
     i = j
 
-  !ERROR: More than one memory order clause not allowed on OpenMP ATOMIC construct
-  !ERROR: At most one ACQUIRE clause can appear on the READ directive
+  !ERROR: At most one ACQUIRE clause can appear on the ATOMIC directive
   !$omp atomic acquire acquire read
     i = j
-  !ERROR: More than one memory order clause not allowed on OpenMP ATOMIC construct
-  !ERROR: At most one ACQUIRE clause can appear on the READ directive
+  !ERROR: At most one ACQUIRE clause can appear on the ATOMIC directive
   !$omp atomic read acquire acquire
     i = j
-  !ERROR: More than one memory order clause not allowed on OpenMP ATOMIC construct
-  !ERROR: At most one ACQUIRE clause can appear on the READ directive
+  !ERROR: At most one ACQUIRE clause can appear on the ATOMIC directive
   !$omp atomic acquire read acquire
     i = j
 
-  !ERROR: More than one memory order clause not allowed on OpenMP ATOMIC construct
-  !ERROR: At most one RELAXED clause can appear on the READ directive
+  !ERROR: At most one RELAXED clause can appear on the ATOMIC directive
   !$omp atomic relaxed relaxed read
     i = j
-  !ERROR: More than one memory order clause not allowed on OpenMP ATOMIC construct
-  !ERROR: At most one RELAXED clause can appear on the READ directive
+  !ERROR: At most one RELAXED clause can appear on the ATOMIC directive
   !$omp atomic read relaxed relaxed
     i = j
-  !ERROR: More than one memory order clause not allowed on OpenMP ATOMIC construct
-  !ERROR: At most one RELAXED clause can appear on the READ directive
+  !ERROR: At most one RELAXED clause can appear on the ATOMIC directive
   !$omp atomic relaxed read relaxed
     i = j
 
 !UPDATE
-  !ERROR: More than one memory order clause not allowed on OpenMP ATOMIC construct
-  !ERROR: At most one SEQ_CST clause can appear on the UPDATE directive
+  !ERROR: At most one SEQ_CST clause can appear on the ATOMIC directive
   !$omp atomic seq_cst seq_cst update
-  !ERROR: Invalid or missing operator in atomic update statement
+  !ERROR: The atomic variable i should appear as an argument in the update operation
     i = j
-  !ERROR: More than one memory order clause not allowed on OpenMP ATOMIC construct
-  !ERROR: At most one SEQ_CST clause can appear on the UPDATE directive
+  !ERROR: At most one SEQ_CST clause can appear on the ATOMIC directive
   !$omp atomic update seq_cst seq_cst
-  !ERROR: Invalid or missing operator in atomic update statement
+  !ERROR: The atomic variable i should appear as an argument in the update operation
     i = j
-  !ERROR: More than one memory order clause not allowed on OpenMP ATOMIC construct
-  !ERROR: At most one SEQ_CST clause can appear on the UPDATE directive
+  !ERROR: At most one SEQ_CST clause can appear on the ATOMIC directive
   !$omp atomic seq_cst update seq_cst
-  !ERROR: Invalid or missing operator in atomic update statement
+  !ERROR: The atomic variable i should appear as an argument in the update operation
     i = j
 
-  !ERROR: More than one memory order clause not allowed on OpenMP ATOMIC construct
-  !ERROR: At most one RELEASE clause can appear on the UPDATE directive
+  !ERROR: At most one RELEASE clause can appear on the ATOMIC directive
   !$omp atomic release release update
-  !ERROR: Invalid or missing operator in atomic update statement
+  !ERROR: The atomic variable i should appear as an argument in the update operation
     i = j
-  !ERROR: More than one memory order clause not allowed on OpenMP ATOMIC construct
-  !ERROR: At most one RELEASE clause can appear on the UPDATE directive
+  !ERROR: At most one RELEASE clause can appear on the ATOMIC directive
   !$omp atomic update release release
-  !ERROR: Invalid or missing operator in atomic update statement
+  !ERROR: The atomic variable i should appear as an argument in the update operation
     i = j
-  !ERROR: More than one memory order clause not allowed on OpenMP ATOMIC construct
-  !ERROR: At most one RELEASE clause can appear on the UPDATE directive
+  !ERROR: At most one RELEASE clause can appear on the ATOMIC directive
   !$omp atomic release update release
-  !ERROR: Invalid or missing operator in atomic update statement
+  !ERROR: The atomic variable i should appear as an argument in the update operation
     i = j
 
-  !ERROR: More than one memory order clause not allowed on OpenMP ATOMIC construct
-  !ERROR: At most one RELAXED clause can appear on the UPDATE directive
+  !ERROR: At most one RELAXED clause can appear on the ATOMIC directive
   !$omp atomic relaxed relaxed update
-  !ERROR: Invalid or missing operator in atomic update statement
+  !ERROR: The atomic variable i should appear as an argument in the update operation
     i = j
-  !ERROR: More than one memory order clause not allowed on OpenMP ATOMIC construct
-  !ERROR: At most one RELAXED clause can appear on the UPDATE directive
+  !ERROR: At most one RELAXED clause can appear on the ATOMIC directive
   !$omp atomic update relaxed relaxed
-  !ERROR: Invalid or missing operator in atomic update statement
+  !ERROR: The atomic variable i should appear as an argument in the update operation
     i = j
-  !ERROR: More than one memory order clause not allowed on OpenMP ATOMIC construct
-  !ERROR: At most one RELAXED clause can appear on the UPDATE directive
+  !ERROR: At most one RELAXED clause can appear on the ATOMIC directive
   !$omp atomic relaxed update relaxed
-  !ERROR: Invalid or missing operator in atomic update statement
+  !ERROR: The atomic variable i should appear as an argument in the update operation
     i = j
 
 !CAPTURE
-  !ERROR: More than one memory order clause not allowed on OpenMP ATOMIC construct
-  !ERROR: At most one SEQ_CST clause can appear on the CAPTURE directive
+  !ERROR: At most one SEQ_CST clause can appear on the ATOMIC directive
   !$omp atomic seq_cst seq_cst capture
     i = j
     j = k
   !$omp end atomic
-  !ERROR: More than one memory order clause not allowed on OpenMP ATOMIC construct
-  !ERROR: At most one SEQ_CST clause can appear on the CAPTURE directive
+  !ERROR: At most one SEQ_CST clause can appear on the ATOMIC directive
   !$omp atomic capture seq_cst seq_cst
     i = j
     j = k
   !$omp end atomic
 
-  !ERROR: More than one memory order clause not allowed on OpenMP ATOMIC construct
-  !ERROR: At most one SEQ_CST clause can appear on the CAPTURE directive
+  !ERROR: At most one SEQ_CST clause can appear on the ATOMIC directive
   !$omp atomic seq_cst capture seq_cst
     i = j
     j = k
   !$omp end atomic
 
-  !ERROR: More than one memory order clause not allowed on OpenMP ATOMIC construct
-  !ERROR: At most one RELEASE clause can appear on the CAPTURE directive
+  !ERROR: At most one RELEASE clause can appear on the ATOMIC directive
   !$omp atomic release release capture
     i = j
     j = k
   !$omp end atomic
 
-  !ERROR: More than one memory order clause not allowed on OpenMP ATOMIC construct
-  !ERROR: At most one RELEASE clause can appear on the CAPTURE directive
+  !ERROR: At most one RELEASE clause can appear on the ATOMIC directive
   !$omp atomic capture release release
     i = j
     j = k
   !$omp end atomic
 
-  !ERROR: More than one memory order clause not allowed on OpenMP ATOMIC construct
-  !ERROR: At most one RELEASE clause can appear on the CAPTURE directive
+  !ERROR: At most one RELEASE clause can appear on the ATOMIC directive
   !$omp atomic release capture release
     i = j
     j = k
   !$omp end atomic
 
-  !ERROR: More than one memory order clause not allowed on OpenMP ATOMIC construct
-  !ERROR: At most one RELAXED clause can appear on the CAPTURE directive
+  !ERROR: At most one RELAXED clause can appear on the ATOMIC directive
   !$omp atomic relaxed relaxed capture
     i = j
     j = k
   !$omp end atomic
 
-  !ERROR: More than one memory order clause not allowed on OpenMP ATOMIC construct
-  !ERROR: At most one RELAXED clause can appear on the CAPTURE directive
+  !ERROR: At most one RELAXED clause can appear on the ATOMIC directive
   !$omp atomic capture relaxed relaxed
     i = j
     j = k
   !$omp end atomic
 
-  !ERROR: More than one memory order clause not allowed on OpenMP ATOMIC construct
-  !ERROR: At most one RELAXED clause can appear on the CAPTURE directive
+  !ERROR: At most one RELAXED clause can appear on the ATOMIC directive
   !$omp atomic relaxed capture relaxed
     i = j
     j = k
   !$omp end atomic
 
-  !ERROR: More than one memory order clause not allowed on OpenMP ATOMIC construct
-  !ERROR: At most one ACQ_REL clause can appear on the CAPTURE directive
+  !ERROR: At most one ACQ_REL clause can appear on the ATOMIC directive
   !$omp atomic acq_rel acq_rel capture
     i = j
     j = k
   !$omp end atomic
 
-  !ERROR: More than one memory order clause not allowed on OpenMP ATOMIC construct
-  !ERROR: At most one ACQ_REL clause can appear on the CAPTURE directive
+  !ERROR: At most one ACQ_REL clause can appear on the ATOMIC directive
   !$omp atomic capture acq_rel acq_rel
     i = j
     j = k
   !$omp end atomic
 
-  !ERROR: More than one memory order clause not allowed on OpenMP ATOMIC construct
-  !ERROR: At most one ACQ_REL clause can appear on the CAPTURE directive
+  !ERROR: At most one ACQ_REL clause can appear on the ATOMIC directive
   !$omp atomic acq_rel capture acq_rel
     i = j
     j = k
   !$omp end atomic
 
-  !ERROR: More than one memory order clause not allowed on OpenMP ATOMIC construct
-  !ERROR: At most one ACQUIRE clause can appear on the CAPTURE directive
+  !ERROR: At most one ACQUIRE clause can appear on the ATOMIC directive
   !$omp atomic acquire acquire capture
     i = j
     j = k
   !$omp end atomic
 
-  !ERROR: More than one memory order clause not allowed on OpenMP ATOMIC construct
-  !ERROR: At most one ACQUIRE clause can appear on the CAPTURE directive
+  !ERROR: At most one ACQUIRE clause can appear on the ATOMIC directive
   !$omp atomic capture acquire acquire
     i = j
     j = k
   !$omp end atomic
 
-  !ERROR: More than one memory order clause not allowed on OpenMP ATOMIC construct
-  !ERROR: At most one ACQUIRE clause can appear on the CAPTURE directive
+  !ERROR: At most one ACQUIRE clause can appear on the ATOMIC directive
   !$omp atomic acquire capture acquire
     i = j
     j = k
   !$omp end atomic
 
 !WRITE
-  !ERROR: More than one memory order clause not allowed on OpenMP ATOMIC construct
-  !ERROR: At most one SEQ_CST clause can appear on the WRITE directive
+  !ERROR: At most one SEQ_CST clause can appear on the ATOMIC directive
   !$omp atomic seq_cst seq_cst write
     i = j
-  !ERROR: More than one memory order clause not allowed on OpenMP ATOMIC construct
-  !ERROR: At most one SEQ_CST clause can appear on the WRITE directive
+  !ERROR: At most one SEQ_CST clause can appear on the ATOMIC directive
   !$omp atomic write seq_cst seq_cst
     i = j
 
-  !ERROR: More than one memory order clause not allowed on OpenMP ATOMIC construct
-  !ERROR: At most one SEQ_CST clause can appear on the WRITE directive
+  !ERROR: At most one SEQ_CST clause can appear on the ATOMIC directive
   !$omp atomic seq_cst write seq_cst
     i = j
 
-  !ERROR: More than one memory order clause not allowed on OpenMP ATOMIC construct
-  !ERROR: At most one RELEASE clause can appear on the WRITE directive
+  !ERROR: At most one RELEASE clause can appear on the ATOMIC directive
   !$omp atomic release release write
     i = j
-  !ERROR: More than one memory order clause not allowed on OpenMP ATOMIC construct
-  !ERROR: At most one RELEASE clause can appear on the WRITE directive
+  !ERROR: At most one RELEASE clause can appear on the ATOMIC directive
   !$omp atomic write release release
     i = j
-  !ERROR: More than one memory order clause not allowed on OpenMP ATOMIC construct
-  !ERROR: At most one RELEASE clause can appear on the WRITE directive
+  !ERROR: At most one RELEASE clause can appear on the ATOMIC directive
   !$omp atomic release write release
     i = j
-  !ERROR: More than one memory order clause not allowed on OpenMP ATOMIC construct
-  !ERROR: At most one RELAXED clause can appear on the WRITE directive
+  !ERROR: At most one RELAXED clause can appear on the ATOMIC directive
   !$omp atomic relaxed relaxed write
     i = j
-  !ERROR: More than one memory order clause not allowed on OpenMP ATOMIC construct
-  !ERROR: At most one RELAXED clause can appear on the WRITE directive
+  !ERROR: At most one RELAXED clause can appear on the ATOMIC directive
   !$omp atomic write relaxed relaxed
     i = j
-  !ERROR: More than one memory order clause not allowed on OpenMP ATOMIC construct
-  !ERROR: At most one RELAXED clause can appear on the WRITE directive
+  !ERROR: At most one RELAXED clause can appear on the ATOMIC directive
   !$omp atomic relaxed write relaxed
     i = j
 
 !No atomic-clause
-  !ERROR: More than one memory order clause not allowed on OpenMP ATOMIC construct
   !ERROR: At most one RELAXED clause can appear on the ATOMIC directive
   !$omp atomic relaxed relaxed
-  !ERROR: Invalid or missing operator in atomic update statement
+  !ERROR: The atomic variable i should appear as an argument in the update operation
     i = j
-  !ERROR: More than one memory order clause not allowed on OpenMP ATOMIC construct
   !ERROR: At most one SEQ_CST clause can appear on the ATOMIC directive
   !$omp atomic seq_cst seq_cst
-  !ERROR: Invalid or missing operator in atomic update statement
+  !ERROR: The atomic variable i should appear as an argument in the update operation
     i = j
-  !ERROR: More than one memory order clause not allowed on OpenMP ATOMIC construct
   !ERROR: At most one RELEASE clause can appear on the ATOMIC directive
   !$omp atomic release release
-  !ERROR: Invalid or missing operator in atomic update statement
+  !ERROR: The atomic variable i should appear as an argument in the update operation
     i = j
 
 ! 2.17.7.3
 ! At most one hint clause may appear on the construct.
 
-  !ERROR: At most one HINT clause can appear on the READ directive
+  !ERROR: At most one HINT clause can appear on the ATOMIC directive
   !$omp atomic hint(omp_sync_hint_speculative) hint(omp_sync_hint_speculative) read
     i = j
-  !ERROR: At most one HINT clause can appear on the READ directive
+  !ERROR: At most one HINT clause can appear on the ATOMIC directive
   !$omp atomic hint(omp_sync_hint_nonspeculative) read hint(omp_sync_hint_nonspeculative)
     i = j
-  !ERROR: At most one HINT clause can appear on the READ directive
+  !ERROR: At most one HINT clause can appear on the ATOMIC directive
   !$omp atomic read hint(omp_sync_hint_uncontended) hint (omp_sync_hint_uncontended)
     i = j
-  !ERROR: At most one HINT clause can appear on the WRITE directive
+  !ERROR: At most one HINT clause can appear on the ATOMIC directive
   !$omp atomic hint(omp_sync_hint_contended) hint(omp_sync_hint_speculative) write
     i = j
-  !ERROR: At most one HINT clause can appear on the WRITE directive
+  !ERROR: At most one HINT clause can appear on the ATOMIC directive
   !$omp atomic hint(omp_sync_hint_nonspeculative) write hint(omp_sync_hint_nonspeculative)
     i = j
-  !ERROR: At most one HINT clause can appear on the WRITE directive
+  !ERROR: At most one HINT clause can appear on the ATOMIC directive
   !$omp atomic write hint(omp_sync_hint_none) hint (omp_sync_hint_uncontended)
     i = j
-  !ERROR: At most one HINT clause can appear on the WRITE directive
+  !ERROR: At most one HINT clause can appear on the ATOMIC directive
   !$omp atomic hint(omp_sync_hint_contended) hint(omp_sync_hint_speculative) write
     i = j
-  !ERROR: At most one HINT clause can appear on the WRITE directive
+  !ERROR: At most one HINT clause can appear on the ATOMIC directive
   !$omp atomic hint(omp_sync_hint_nonspeculative) write hint(omp_sync_hint_nonspeculative)
     i = j
-  !ERROR: At most one HINT clause can appear on the WRITE directive
+  !ERROR: At most one HINT clause can appear on the ATOMIC directive
   !$omp atomic write hint(omp_sync_hint_none) hint (omp_sync_hint_uncontended)
     i = j
-  !ERROR: At most one HINT clause can appear on the UPDATE directive
+  !ERROR: At most one HINT clause can appear on the ATOMIC directive
   !$omp atomic hint(omp_sync_hint_contended) hint(omp_sync_hint_speculative) update
-  !ERROR: Invalid or missing operator in atomic update statement
+  !ERROR: The atomic variable i should appear as an argument in the update operation
     i = j
-  !ERROR: At most one HINT clause can appear on the UPDATE directive
+  !ERROR: At most one HINT clause can appear on the ATOMIC directive
   !$omp atomic hint(omp_sync_hint_nonspeculative) update hint(omp_sync_hint_nonspeculative)
-  !ERROR: Invalid or missing operator in atomic update statement
+  !ERROR: The atomic variable i should appear as an argument in the update operation
     i = j
-  !ERROR: At most one HINT clause can appear on the UPDATE directive
+  !ERROR: At most one HINT clause can appear on the ATOMIC directive
   !$omp atomic update hint(omp_sync_hint_none) hint (omp_sync_hint_uncontended)
-  !ERROR: Invalid or missing operator in atomic update statement
+  !ERROR: The atomic variable i should appear as an argument in the update operation
     i = j
   !ERROR: At most one HINT clause can appear on the ATOMIC directive
   !$omp atomic hint(omp_sync_hint_contended) hint(omp_sync_hint_speculative)
-  !ERROR: Invalid or missing operator in atomic update statement
+  !ERROR: The atomic variable i should appear as an argument in the update operation
     i = j
   !ERROR: At most one HINT clause can appear on the ATOMIC directive
   !$omp atomic hint(omp_sync_hint_none) hint(omp_sync_hint_nonspeculative)
-  !ERROR: Invalid or missing operator in atomic update statement
+  !ERROR: The atomic variable i should appear as an argument in the update operation
     i = j
   !ERROR: At most one HINT clause can appear on the ATOMIC directive
   !$omp atomic hint(omp_sync_hint_none) hint (omp_sync_hint_uncontended)
-  !ERROR: Invalid or missing operator in atomic update statement
+  !ERROR: The atomic variable i should appear as an argument in the update operation
     i = j
 
-  !ERROR: At most one HINT clause can appear on the CAPTURE directive
+  !ERROR: At most one HINT clause can appear on the ATOMIC directive
   !$omp atomic hint(omp_sync_hint_contended) hint(omp_sync_hint_speculative) capture
     i = j
     j = k
   !$omp end atomic
-  !ERROR: At most one HINT clause can appear on the CAPTURE directive
+  !ERROR: At most one HINT clause can appear on the ATOMIC directive
   !$omp atomic hint(omp_sync_hint_nonspeculative) capture hint(omp_sync_hint_nonspeculative)
     i = j
     j = k
   !$omp end atomic
-  !ERROR: At most one HINT clause can appear on the CAPTURE directive
+  !ERROR: At most one HINT clause can appear on the ATOMIC directive
   !$omp atomic capture hint(omp_sync_hint_none) hint (omp_sync_hint_uncontended)
     i = j
     j = k
@@ -337,34 +292,26 @@ use omp_lib
 ! 2.17.7.4
 ! If atomic-clause is read then memory-order-clause must not be acq_rel or release.
 
-  !ERROR: Clause ACQ_REL is not allowed if clause READ appears on the ATOMIC directive
   !$omp atomic acq_rel read
     i = j
-  !ERROR: Clause ACQ_REL is not allowed if clause READ appears on the ATOMIC directive
   !$omp atomic read acq_rel
     i = j
 
-  !ERROR: Clause RELEASE is not allowed if clause READ appears on the ATOMIC directive
   !$omp atomic release read
     i = j
-  !ERROR: Clause RELEASE is not allowed if clause READ appears on the ATOMIC directive
   !$omp atomic read release
     i = j
 
 ! 2.17.7.5
 ! If atomic-clause is write then memory-order-clause must not be acq_rel or acquire.
 
-  !ERROR: Clause ACQ_REL is not allowed if clause WRITE appears on the ATOMIC directive
   !$omp atomic acq_rel write
     i = j
-  !ERROR: Clause ACQ_REL is not allowed if clause WRITE appears on the ATOMIC directive
   !$omp atomic write acq_rel
     i = j
 
-  !ERROR: Clause ACQUIRE is not allowed if clause WRITE appears on the ATOMIC directive
   !$omp atomic acquire write
     i = j
-  !ERROR: Clause ACQUIRE is not allowed if clause WRITE appears on the ATOMIC directive
   !$omp atomic write acquire
     i = j
 
@@ -372,33 +319,27 @@ use omp_lib
 ! 2.17.7.6
 ! If atomic-clause is update or not present then memory-order-clause must not be acq_rel or acquire.
 
-  !ERROR: Clause ACQ_REL is not allowed if clause UPDATE appears on the ATOMIC directive
   !$omp atomic acq_rel update
-  !ERROR: Invalid or missing operator in atomic update statement
+  !ERROR: The atomic variable i should appear as an argument in the update operation
     i = j
-  !ERROR: Clause ACQ_REL is not allowed if clause UPDATE appears on the ATOMIC directive
   !$omp atomic update acq_rel
-  !ERROR: Invalid or missing operator in atomic update statement
+  !ERROR: The atomic variable i should appear as an argument in the update operation
     i = j
 
-  !ERROR: Clause ACQUIRE is not allowed if clause UPDATE appears on the ATOMIC directive
   !$omp atomic acquire update
-  !ERROR: Invalid or missing operator in atomic update statement
+  !ERROR: The atomic variable i should appear as an argument in the update operation
     i = j
 
-  !ERROR: Clause ACQUIRE is not allowed if clause UPDATE appears on the ATOMIC directive
   !$omp atomic update acquire
-  !ERROR: Invalid or missing operator in atomic update statement
+  !ERROR: The atomic variable i should appear as an argument in the update operation
     i = j
 
-  !ERROR: Clause ACQ_REL is not allowed on the ATOMIC directive
   !$omp atomic acq_rel
-  !ERROR: Invalid or missing operator in atomic update statement
+  !ERROR: The atomic variable i should appear as an argument in the update operation
     i = j
 
-  !ERROR: Clause ACQUIRE is not allowed on the ATOMIC directive
   !$omp atomic acquire
-  !ERROR: Invalid or missing operator in atomic update statement
+  !ERROR: The atomic variable i should appear as an argument in the update operation
     i = j
 end program
 

flang/test/Semantics/OpenMP/atomic02.f90

@@ -28,36 +28,29 @@ program OmpAtomic
    !$omp atomic
    a = a/(b + 1)
    !$omp atomic
-   !ERROR: Invalid or missing operator in atomic update statement
+   !ERROR: The ** operator is not a valid ATOMIC UPDATE operation
    a = a**4
    !$omp atomic 
-   !ERROR: Expected scalar variable on the LHS of atomic update assignment statement
-   !ERROR: Invalid or missing operator in atomic update statement
-   !ERROR: Expected scalar expression on the RHS of atomic update assignment statement
+   !ERROR: Atomic variable c cannot have CHARACTER type
+   !ERROR: The atomic variable c should appear as an argument in the update operation
    c = d 
    !$omp atomic
-   !ERROR: Atomic update statement should be of form `l = l operator expr` OR `l = expr operator l`
-   !ERROR: Invalid or missing operator in atomic update statement
+   !ERROR: The < operator is not a valid ATOMIC UPDATE operation
    l = a .LT. b
    !$omp atomic
-   !ERROR: Atomic update statement should be of form `l = l operator expr` OR `l = expr operator l`
-   !ERROR: Invalid or missing operator in atomic update statement
+   !ERROR: The <= operator is not a valid ATOMIC UPDATE operation
    l = a .LE. b
    !$omp atomic
-   !ERROR: Atomic update statement should be of form `l = l operator expr` OR `l = expr operator l`
-   !ERROR: Invalid or missing operator in atomic update statement
+   !ERROR: The == operator is not a valid ATOMIC UPDATE operation
    l = a .EQ. b
    !$omp atomic
-   !ERROR: Atomic update statement should be of form `l = l operator expr` OR `l = expr operator l`
-   !ERROR: Invalid or missing operator in atomic update statement
+   !ERROR: The /= operator is not a valid ATOMIC UPDATE operation
    l = a .NE. b
    !$omp atomic
-   !ERROR: Atomic update statement should be of form `l = l operator expr` OR `l = expr operator l`
-   !ERROR: Invalid or missing operator in atomic update statement
+   !ERROR: The >= operator is not a valid ATOMIC UPDATE operation
    l = a .GE. b
    !$omp atomic
-   !ERROR: Atomic update statement should be of form `l = l operator expr` OR `l = expr operator l`
-   !ERROR: Invalid or missing operator in atomic update statement
+   !ERROR: The > operator is not a valid ATOMIC UPDATE operation
    l = a .GT. b
    !$omp atomic
    m = m .AND. n
@@ -76,32 +69,26 @@ program OmpAtomic
    !$omp atomic update
    a = a/(b + 1)
    !$omp atomic update
-   !ERROR: Invalid or missing operator in atomic update statement
+   !ERROR: The ** operator is not a valid ATOMIC UPDATE operation
    a = a**4
    !$omp atomic update
-   !ERROR: Expected scalar variable on the LHS of atomic update assignment statement
-   !ERROR: Invalid or missing operator in atomic update statement
-   !ERROR: Expected scalar expression on the RHS of atomic update assignment statement
+   !ERROR: Atomic variable c cannot have CHARACTER type
+   !ERROR: This is not a valid ATOMIC UPDATE operation
    c = c//d
    !$omp atomic update
-   !ERROR: Atomic update statement should be of form `l = l operator expr` OR `l = expr operator l`
-   !ERROR: Invalid or missing operator in atomic update statement
+   !ERROR: The < operator is not a valid ATOMIC UPDATE operation
    l = a .LT. b
    !$omp atomic update
-   !ERROR: Atomic update statement should be of form `l = l operator expr` OR `l = expr operator l`
-   !ERROR: Invalid or missing operator in atomic update statement
+   !ERROR: The <= operator is not a valid ATOMIC UPDATE operation
    l = a .LE. b
    !$omp atomic update
-   !ERROR: Atomic update statement should be of form `l = l operator expr` OR `l = expr operator l`
-   !ERROR: Invalid or missing operator in atomic update statement
+   !ERROR: The == operator is not a valid ATOMIC UPDATE operation
    l = a .EQ. b
    !$omp atomic update
-   !ERROR: Atomic update statement should be of form `l = l operator expr` OR `l = expr operator l`
-   !ERROR: Invalid or missing operator in atomic update statement
+   !ERROR: The >= operator is not a valid ATOMIC UPDATE operation
    l = a .GE. b
    !$omp atomic update
-   !ERROR: Atomic update statement should be of form `l = l operator expr` OR `l = expr operator l`
-   !ERROR: Invalid or missing operator in atomic update statement
+   !ERROR: The > operator is not a valid ATOMIC UPDATE operation
    l = a .GT. b
    !$omp atomic update
    m = m .AND. n

flang/test/Semantics/OpenMP/atomic03.f90

@@ -25,28 +25,26 @@ program OmpAtomic
    y = MIN(y, 8)
 
 !$omp atomic
-   !ERROR: Intrinsic procedure arguments in atomic update statement must have exactly one occurence of 'z'
+   !ERROR: The atomic variable z should occur exactly once among the arguments of the top-level AND operator
    z = IAND(y, 4)
 !$omp atomic
-   !ERROR: Intrinsic procedure arguments in atomic update statement must have exactly one occurence of 'z'
+   !ERROR: The atomic variable z should occur exactly once among the arguments of the top-level OR operator
    z = IOR(y, 5)
 !$omp atomic
-   !ERROR: Intrinsic procedure arguments in atomic update statement must have exactly one occurence of 'z'
+   !ERROR: The atomic variable z should occur exactly once among the arguments of the top-level NEQV/EOR operator
    z = IEOR(y, 6)
 !$omp atomic
-   !ERROR: Intrinsic procedure arguments in atomic update statement must have exactly one occurence of 'z'
+   !ERROR: The atomic variable z should occur exactly once among the arguments of the top-level MAX operator
    z = MAX(y, 7, b, c)
 !$omp atomic
-   !ERROR: Intrinsic procedure arguments in atomic update statement must have exactly one occurence of 'z'
+   !ERROR: The atomic variable z should occur exactly once among the arguments of the top-level MIN operator
    z = MIN(y, 8, a, d)
 
 !$omp atomic
-   !ERROR: Invalid intrinsic procedure name in OpenMP ATOMIC (UPDATE) statement
-   !ERROR: Intrinsic procedure arguments in atomic update statement must have exactly one occurence of 'y'
+   !ERROR: This intrinsic function is not a valid ATOMIC UPDATE operation
    y = FRACTION(x)
 !$omp atomic
-   !ERROR: Invalid intrinsic procedure name in OpenMP ATOMIC (UPDATE) statement
-   !ERROR: Intrinsic procedure arguments in atomic update statement must have exactly one occurence of 'y'
+   !ERROR: The atomic variable y should appear as an argument in the update operation
    y = REAL(x)
 !$omp atomic update
    y = IAND(y, 4)
@@ -60,26 +58,26 @@ program OmpAtomic
    y = MIN(y, 8)
 
 !$omp atomic update
-   !ERROR: Intrinsic procedure arguments in atomic update statement must have exactly one occurence of 'z'
+   !ERROR: The atomic variable z should occur exactly once among the arguments of the top-level AND operator
    z = IAND(y, 4)
 !$omp atomic update 
-   !ERROR: Intrinsic procedure arguments in atomic update statement must have exactly one occurence of 'z'
+   !ERROR: The atomic variable z should occur exactly once among the arguments of the top-level OR operator
    z = IOR(y, 5)
 !$omp atomic update
-   !ERROR: Intrinsic procedure arguments in atomic update statement must have exactly one occurence of 'z'
+   !ERROR: The atomic variable z should occur exactly once among the arguments of the top-level NEQV/EOR operator
    z = IEOR(y, 6)
 !$omp atomic update
-   !ERROR: Intrinsic procedure arguments in atomic update statement must have exactly one occurence of 'z'
+   !ERROR: The atomic variable z should occur exactly once among the arguments of the top-level MAX operator
    z = MAX(y, 7)
 !$omp atomic update
-   !ERROR: Intrinsic procedure arguments in atomic update statement must have exactly one occurence of 'z'
+   !ERROR: The atomic variable z should occur exactly once among the arguments of the top-level MIN operator
    z = MIN(y, 8)
 
 !$omp atomic update
-   !ERROR: Invalid intrinsic procedure name in OpenMP ATOMIC (UPDATE) statement
+  !ERROR: This intrinsic function is not a valid ATOMIC UPDATE operation
    y = MOD(y, 9)
 !$omp atomic update
-   !ERROR: Invalid intrinsic procedure name in OpenMP ATOMIC (UPDATE) statement
+  !ERROR: This intrinsic function is not a valid ATOMIC UPDATE operation
    x = ABS(x)
 end program OmpAtomic
 
@@ -92,7 +90,7 @@ subroutine conflicting_types()
     type(simple) ::s
     z = 1
     !$omp atomic
-    !ERROR: Intrinsic procedure arguments in atomic update statement must have exactly one occurence of 'z'
+    !ERROR: The atomic variable z should occur exactly once among the arguments of the top-level AND operator
     z = IAND(s%z, 4)
 end subroutine
 
@@ -105,40 +103,37 @@ subroutine more_invalid_atomic_update_stmts()
     type(some_type) :: s
  
     !$omp atomic update
-    !ERROR: Intrinsic procedure arguments in atomic update statement must have exactly one occurence of 'a'
+    !ERROR: The atomic variable a should occur exactly once among the arguments of the top-level MIN operator
         a = min(a, a, b)
      
     !$omp atomic
-    !ERROR: Intrinsic procedure arguments in atomic update statement must have exactly one occurence of 'a'
+    !ERROR: The atomic variable a should occur exactly once among the arguments of the top-level MAX operator
         a = max(b, a, b, a)
 
     !$omp atomic
-    !ERROR: Atomic update statement should be of the form `a = intrinsic_procedure(a, expr_list)` OR `a = intrinsic_procedure(expr_list, a)`
         a = min(b, a, b)
 
     !$omp atomic
-    !ERROR: Intrinsic procedure arguments in atomic update statement must have exactly one occurence of 'a'
+    !ERROR: The atomic variable a should occur exactly once among the arguments of the top-level MAX operator
         a = max(b, a, b, a, b)
     
     !$omp atomic update
-    !ERROR: Intrinsic procedure arguments in atomic update statement must have exactly one occurence of 'y'
+    !ERROR: The atomic variable y should occur exactly once among the arguments of the top-level MIN operator
         y = min(z, x)
      
     !$omp atomic
         z = max(z, y)
 
     !$omp atomic update
-    !ERROR: Expected scalar variable on the LHS of atomic update assignment statement
-    !ERROR: Intrinsic procedure arguments in atomic update statement must have exactly one occurence of 'k'
+    !ERROR: Atomic variable k should be a scalar
+    !ERROR: The atomic variable k should occur exactly once among the arguments of the top-level MAX operator
         k = max(x, y)
-    
+
     !$omp atomic
     !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches scalar REAL(4) and rank 1 array of REAL(4)
-    !ERROR: Expected scalar expression on the RHS of atomic update assignment statement
         x = min(x, k)
 
     !$omp atomic
     !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches scalar REAL(4) and rank 1 array of REAL(4)
-    !ERROR: Expected scalar expression on the RHS of atomic update assignment statement
-        z =z + s%m
+        z = z + s%m
 end subroutine

flang/test/Semantics/OpenMP/atomic04.f90

@@ -1,5 +1,3 @@
-! REQUIRES: openmp_runtime
-
 ! RUN: %python %S/../test_errors.py %s %flang_fc1 %openmp_flags
 
 ! OpenMP Atomic construct
@@ -7,7 +5,6 @@
 ! Update assignment must be 'var = var op expr' or 'var = expr op var'
 
 program OmpAtomic
-   use omp_lib
    real x
    integer y
    logical m, n, l
@@ -20,12 +17,10 @@ program OmpAtomic
 !$omp atomic
    x = 1 + x
 !$omp atomic
-   !ERROR: Atomic update statement should be of form `x = x operator expr` OR `x = expr operator x`
-   !ERROR: Exactly one occurence of 'x' expected on the RHS of atomic update assignment statement
+   !ERROR: The atomic variable x should occur exactly once among the arguments of the top-level + operator
    x = y + 1
 !$omp atomic
-   !ERROR: Atomic update statement should be of form `x = x operator expr` OR `x = expr operator x`
-   !ERROR: Exactly one occurence of 'x' expected on the RHS of atomic update assignment statement
+   !ERROR: The atomic variable x should occur exactly once among the arguments of the top-level + operator
    x = 1 + y
 
 !$omp atomic
@@ -33,12 +28,10 @@ program OmpAtomic
 !$omp atomic
    x = 1 - x
 !$omp atomic
-   !ERROR: Atomic update statement should be of form `x = x operator expr` OR `x = expr operator x`
-   !ERROR: Exactly one occurence of 'x' expected on the RHS of atomic update assignment statement
+   !ERROR: The atomic variable x should occur exactly once among the arguments of the top-level - operator
    x = y - 1
 !$omp atomic
-   !ERROR: Atomic update statement should be of form `x = x operator expr` OR `x = expr operator x`
-   !ERROR: Exactly one occurence of 'x' expected on the RHS of atomic update assignment statement
+   !ERROR: The atomic variable x should occur exactly once among the arguments of the top-level - operator
    x = 1 - y
 
 !$omp atomic
@@ -46,12 +39,10 @@ program OmpAtomic
 !$omp atomic
    x = 1*x
 !$omp atomic
-   !ERROR: Atomic update statement should be of form `x = x operator expr` OR `x = expr operator x`
-   !ERROR: Exactly one occurence of 'x' expected on the RHS of atomic update assignment statement
+   !ERROR: The atomic variable x should appear as an argument in the update operation
    x = y*1
 !$omp atomic
-   !ERROR: Atomic update statement should be of form `x = x operator expr` OR `x = expr operator x`
-   !ERROR: Exactly one occurence of 'x' expected on the RHS of atomic update assignment statement
+   !ERROR: The atomic variable x should appear as an argument in the update operation
    x = 1*y
 
 !$omp atomic
@@ -59,12 +50,10 @@ program OmpAtomic
 !$omp atomic
    x = 1/x
 !$omp atomic
-   !ERROR: Atomic update statement should be of form `x = x operator expr` OR `x = expr operator x`
-   !ERROR: Exactly one occurence of 'x' expected on the RHS of atomic update assignment statement
+   !ERROR: The atomic variable x should occur exactly once among the arguments of the top-level / operator
    x = y/1
 !$omp atomic
-   !ERROR: Atomic update statement should be of form `x = x operator expr` OR `x = expr operator x`
-   !ERROR: Exactly one occurence of 'x' expected on the RHS of atomic update assignment statement
+   !ERROR: The atomic variable x should occur exactly once among the arguments of the top-level / operator
    x = 1/y
 
 !$omp atomic
@@ -72,8 +61,7 @@ program OmpAtomic
 !$omp atomic
    m = n .AND. m
 !$omp atomic 
-   !ERROR: Atomic update statement should be of form `m = m operator expr` OR `m = expr operator m`
-   !ERROR: Exactly one occurence of 'm' expected on the RHS of atomic update assignment statement
+   !ERROR: The atomic variable m should occur exactly once among the arguments of the top-level AND operator
    m = n .AND. l
 
 !$omp atomic
@@ -81,8 +69,7 @@ program OmpAtomic
 !$omp atomic
    m = n .OR. m
 !$omp atomic 
-   !ERROR: Atomic update statement should be of form `m = m operator expr` OR `m = expr operator m`
-   !ERROR: Exactly one occurence of 'm' expected on the RHS of atomic update assignment statement
+   !ERROR: The atomic variable m should occur exactly once among the arguments of the top-level OR operator
    m = n .OR. l
 
 !$omp atomic
@@ -90,8 +77,7 @@ program OmpAtomic
 !$omp atomic
    m = n .EQV. m
 !$omp atomic
-   !ERROR: Atomic update statement should be of form `m = m operator expr` OR `m = expr operator m`
-   !ERROR: Exactly one occurence of 'm' expected on the RHS of atomic update assignment statement
+   !ERROR: The atomic variable m should occur exactly once among the arguments of the top-level EQV operator
    m = n .EQV. l
 
 !$omp atomic
@@ -99,8 +85,7 @@ program OmpAtomic
 !$omp atomic
    m = n .NEQV. m
 !$omp atomic
-   !ERROR: Atomic update statement should be of form `m = m operator expr` OR `m = expr operator m`
-   !ERROR: Exactly one occurence of 'm' expected on the RHS of atomic update assignment statement
+   !ERROR: The atomic variable m should occur exactly once among the arguments of the top-level NEQV/EOR operator
    m = n .NEQV. l
 
 !$omp atomic update
@@ -108,12 +93,10 @@ program OmpAtomic
 !$omp atomic update
    x = 1 + x
 !$omp atomic update
-   !ERROR: Atomic update statement should be of form `x = x operator expr` OR `x = expr operator x`
-   !ERROR: Exactly one occurence of 'x' expected on the RHS of atomic update assignment statement
+   !ERROR: The atomic variable x should occur exactly once among the arguments of the top-level + operator
    x = y + 1
 !$omp atomic update
-   !ERROR: Atomic update statement should be of form `x = x operator expr` OR `x = expr operator x`
-   !ERROR: Exactly one occurence of 'x' expected on the RHS of atomic update assignment statement
+   !ERROR: The atomic variable x should occur exactly once among the arguments of the top-level + operator
    x = 1 + y
 
 !$omp atomic update
@@ -121,12 +104,10 @@ program OmpAtomic
 !$omp atomic update
    x = 1 - x
 !$omp atomic update
-   !ERROR: Atomic update statement should be of form `x = x operator expr` OR `x = expr operator x`
-   !ERROR: Exactly one occurence of 'x' expected on the RHS of atomic update assignment statement
+   !ERROR: The atomic variable x should occur exactly once among the arguments of the top-level - operator
    x = y - 1
 !$omp atomic update
-   !ERROR: Atomic update statement should be of form `x = x operator expr` OR `x = expr operator x`
-   !ERROR: Exactly one occurence of 'x' expected on the RHS of atomic update assignment statement
+   !ERROR: The atomic variable x should occur exactly once among the arguments of the top-level - operator
    x = 1 - y
 
 !$omp atomic update
@@ -134,12 +115,10 @@ program OmpAtomic
 !$omp atomic update
    x = 1*x
 !$omp atomic update
-   !ERROR: Atomic update statement should be of form `x = x operator expr` OR `x = expr operator x`
-   !ERROR: Exactly one occurence of 'x' expected on the RHS of atomic update assignment statement
+   !ERROR: The atomic variable x should appear as an argument in the update operation
    x = y*1
 !$omp atomic update
-   !ERROR: Atomic update statement should be of form `x = x operator expr` OR `x = expr operator x`
-   !ERROR: Exactly one occurence of 'x' expected on the RHS of atomic update assignment statement
+   !ERROR: The atomic variable x should appear as an argument in the update operation
    x = 1*y
 
 !$omp atomic update
@@ -147,12 +126,10 @@ program OmpAtomic
 !$omp atomic update
    x = 1/x
 !$omp atomic update
-   !ERROR: Atomic update statement should be of form `x = x operator expr` OR `x = expr operator x`
-   !ERROR: Exactly one occurence of 'x' expected on the RHS of atomic update assignment statement
+   !ERROR: The atomic variable x should occur exactly once among the arguments of the top-level / operator
    x = y/1
 !$omp atomic update
-   !ERROR: Atomic update statement should be of form `x = x operator expr` OR `x = expr operator x`
-   !ERROR: Exactly one occurence of 'x' expected on the RHS of atomic update assignment statement
+   !ERROR: The atomic variable x should occur exactly once among the arguments of the top-level / operator
    x = 1/y
 
 !$omp atomic update
@@ -160,8 +137,7 @@ program OmpAtomic
 !$omp atomic update
    m = n .AND. m
 !$omp atomic update
-   !ERROR: Atomic update statement should be of form `m = m operator expr` OR `m = expr operator m`
-   !ERROR: Exactly one occurence of 'm' expected on the RHS of atomic update assignment statement
+   !ERROR: The atomic variable m should occur exactly once among the arguments of the top-level AND operator
    m = n .AND. l
 
 !$omp atomic update
@@ -169,8 +145,7 @@ program OmpAtomic
 !$omp atomic update
    m = n .OR. m
 !$omp atomic update
-   !ERROR: Atomic update statement should be of form `m = m operator expr` OR `m = expr operator m`
-   !ERROR: Exactly one occurence of 'm' expected on the RHS of atomic update assignment statement
+   !ERROR: The atomic variable m should occur exactly once among the arguments of the top-level OR operator
    m = n .OR. l
 
 !$omp atomic update
@@ -178,8 +153,7 @@ program OmpAtomic
 !$omp atomic update
    m = n .EQV. m
 !$omp atomic update
-   !ERROR: Atomic update statement should be of form `m = m operator expr` OR `m = expr operator m`
-   !ERROR: Exactly one occurence of 'm' expected on the RHS of atomic update assignment statement
+   !ERROR: The atomic variable m should occur exactly once among the arguments of the top-level EQV operator
    m = n .EQV. l
 
 !$omp atomic update
@@ -187,8 +161,7 @@ program OmpAtomic
 !$omp atomic update
    m = n .NEQV. m
 !$omp atomic update
-   !ERROR: Atomic update statement should be of form `m = m operator expr` OR `m = expr operator m`
-   !ERROR: Exactly one occurence of 'm' expected on the RHS of atomic update assignment statement
+   !ERROR: The atomic variable m should occur exactly once among the arguments of the top-level NEQV/EOR operator
    m = n .NEQV. l
 
 end program OmpAtomic
@@ -204,35 +177,34 @@ subroutine more_invalid_atomic_update_stmts()
     type(some_type) p
     
     !$omp atomic
-    !ERROR: Invalid or missing operator in atomic update statement
         x = x
 
     !$omp atomic update
-    !ERROR: Invalid or missing operator in atomic update statement
+    !ERROR: The atomic variable x should appear as an argument in the update operation
         x = 1    
 
     !$omp atomic update
-    !ERROR: Exactly one occurence of 'a' expected on the RHS of atomic update assignment statement
+    !ERROR: Within atomic operation a and a*b access the same storage
         a = a * b + a
 
     !$omp atomic
-    !ERROR: Atomic update statement should be of form `a = a operator expr` OR `a = expr operator a`
+    !ERROR: The atomic variable a should occur exactly once among the arguments of the top-level * operator
         a = b * (a + 9)
 
     !$omp atomic update
-    !ERROR: Exactly one occurence of 'a' expected on the RHS of atomic update assignment statement
+    !ERROR: Within atomic operation a and (a+b) access the same storage
         a = a * (a + b)
 
     !$omp atomic
-    !ERROR: Exactly one occurence of 'a' expected on the RHS of atomic update assignment statement
+    !ERROR: Within atomic operation a and (b+a) access the same storage
         a = (b + a) * a
 
     !$omp atomic
-    !ERROR: Atomic update statement should be of form `a = a operator expr` OR `a = expr operator a`
+    !ERROR: The atomic variable a should occur exactly once among the arguments of the top-level + operator
         a = a * b + c
 
     !$omp atomic update
-    !ERROR: Atomic update statement should be of form `a = a operator expr` OR `a = expr operator a`
+    !ERROR: The atomic variable a should occur exactly once among the arguments of the top-level + operator
         a = a + b + c
 
     !$omp atomic
@@ -243,23 +215,18 @@ subroutine more_invalid_atomic_update_stmts()
 
     !$omp atomic
     !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches scalar INTEGER(4) and rank 1 array of INTEGER(4)
-    !ERROR: Expected scalar expression on the RHS of atomic update assignment statement
         a = a + d
 
     !$omp atomic update
     !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches scalar REAL(4) and rank 1 array of REAL(4)
-    !ERROR: Atomic update statement should be of form `x = x operator expr` OR `x = expr operator x`
-    !ERROR: Expected scalar expression on the RHS of atomic update assignment statement
+    !ERROR: The atomic variable x should occur exactly once among the arguments of the top-level / operator
         x = x * y / z
 
     !$omp atomic
-    !ERROR: Atomic update statement should be of form `p%m = p%m operator expr` OR `p%m = expr operator p%m`
-    !ERROR: Exactly one occurence of 'p%m' expected on the RHS of atomic update assignment statement
+    !ERROR: The atomic variable p%m should occur exactly once among the arguments of the top-level + operator
         p%m = x + y
 
     !$omp atomic update
     !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches scalar REAL(4) and rank 1 array of REAL(4)
-    !ERROR: Expected scalar expression on the RHS of atomic update assignment statement
-    !ERROR: Exactly one occurence of 'p%m' expected on the RHS of atomic update assignment statement
         p%m = p%m + p%n
 end subroutine

flang/test/Semantics/OpenMP/atomic05.f90

@@ -8,20 +8,20 @@ program OmpAtomic
     use omp_lib
     integer :: g, x
 
-    !ERROR: More than one memory order clause not allowed on OpenMP ATOMIC construct
+    !ERROR: At most one clause from the 'memory-order' group is allowed on ATOMIC construct
     !$omp atomic relaxed, seq_cst
         x = x + 1
-    !ERROR: More than one memory order clause not allowed on OpenMP ATOMIC construct
+    !ERROR: At most one clause from the 'memory-order' group is allowed on ATOMIC construct
     !$omp atomic read seq_cst, relaxed
         x = g
-    !ERROR: More than one memory order clause not allowed on OpenMP ATOMIC construct
+    !ERROR: At most one clause from the 'memory-order' group is allowed on ATOMIC construct
     !$omp atomic write relaxed, release
         x = 2 * 4
-    !ERROR: More than one memory order clause not allowed on OpenMP ATOMIC construct
+    !ERROR: At most one clause from the 'memory-order' group is allowed on ATOMIC construct
     !$omp atomic update release, seq_cst
-    !ERROR: Invalid or missing operator in atomic update statement
+    !ERROR: The atomic variable x should appear as an argument in the update operation
         x = 10
-    !ERROR: More than one memory order clause not allowed on OpenMP ATOMIC construct
+    !ERROR: At most one clause from the 'memory-order' group is allowed on ATOMIC construct
     !$omp atomic capture release, seq_cst
         x = g
         g = x * 10

flang/test/Semantics/OpenMP/critical-hint-clause.f90

@@ -18,7 +18,7 @@ program sample
         y = 2
     !$omp end critical (name)
      
-    !ERROR: Hint clause value is not a valid OpenMP synchronization value
+    !ERROR: The synchronization hint is not valid
     !$omp critical (name) hint(3)
         y = 2
     !$omp end critical (name)
@@ -27,12 +27,12 @@ program sample
         y = 2
     !$omp end critical (name)
     
-    !ERROR: Hint clause value is not a valid OpenMP synchronization value
+    !ERROR: The synchronization hint is not valid
     !$omp critical (name) hint(7)
         y = 2
     !$omp end critical (name)
    
-    !ERROR: Hint clause must have non-negative constant integer expression
+    !ERROR: Synchronization hint must be a constant integer value
     !ERROR: Must be a constant value
     !$omp critical (name) hint(x)
         y = 2
@@ -54,7 +54,7 @@ program sample
         y = 2
     !$omp end critical (name)
     
-    !ERROR: Hint clause must have non-negative constant integer expression
+    !ERROR: Synchronization hint must be a constant integer value
     !ERROR: Must be a constant value
     !$omp critical (name) hint(omp_sync_hint_uncontended + omp_sync_hint) 
         y = 2
@@ -84,35 +84,35 @@ program sample
         y = 2
     !$omp end critical (name)
 
-    !ERROR: Hint clause value is not a valid OpenMP synchronization value
+    !ERROR: The synchronization hint is not valid
      !$omp critical (name) hint(omp_sync_hint_uncontended + omp_sync_hint_contended)
         y = 2
     !$omp end critical (name)
 
-    !ERROR: Hint clause value is not a valid OpenMP synchronization value
+    !ERROR: The synchronization hint is not valid
     !$omp critical (name) hint(omp_sync_hint_nonspeculative + omp_lock_hint_speculative)
         y = 2
     !$omp end critical (name)
 
-    !ERROR: Hint clause must have non-negative constant integer expression
+    !ERROR: Synchronization hint must be a constant integer value
     !ERROR: Must have INTEGER type, but is REAL(4)
     !$omp critical (name) hint(1.0) 
         y = 2
     !$omp end critical (name)
 
-    !ERROR: Hint clause must have non-negative constant integer expression
+    !ERROR: Synchronization hint must be a constant integer value
     !ERROR: Operands of + must be numeric; have LOGICAL(4) and INTEGER(4)
     !$omp critical (name) hint(z + omp_sync_hint_nonspeculative)
         y = 2
     !$omp end critical (name)
 
-    !ERROR: Hint clause must have non-negative constant integer expression
+    !ERROR: Synchronization hint must be a constant integer value
     !ERROR: Must be a constant value
     !$omp critical (name) hint(k + omp_sync_hint_speculative)
         y = 2
     !$omp end critical (name)
 
-    !ERROR: Hint clause must have non-negative constant integer expression
+    !ERROR: Synchronization hint must be a constant integer value
     !ERROR: Must be a constant value
     !$omp critical (name) hint(p(1) + omp_sync_hint_uncontended)
         y = 2

flang/test/Semantics/OpenMP/omp-atomic-assignment-stmt.f90

@@ -20,70 +20,64 @@ program sample
 
     !$omp atomic read
     !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches scalar INTEGER(4) and rank 1 array of INTEGER(4)
-    !ERROR: Expected scalar expression on the RHS of atomic assignment statement
+    !ERROR: Atomic variable y(1_8:3_8:1_8) should be a scalar
         v = y(1:3)
 
     !$omp atomic read
-    !ERROR: Expected scalar variable of intrinsic type on RHS of atomic assignment statement
+    !ERROR: Atomic expression x*(10_4+x) should be a variable
         v = x * (10 + x)
 
     !$omp atomic read
-    !ERROR: Expected scalar variable of intrinsic type on RHS of atomic assignment statement
+    !ERROR: Atomic expression 4_4 should be a variable
         v = 4
 
     !$omp atomic read
-    !ERROR: k must not have ALLOCATABLE attribute
+    !ERROR: Atomic variable k cannot be ALLOCATABLE
         v = k
 
     !$omp atomic write
-    !ERROR: k must not have ALLOCATABLE attribute
+    !ERROR: Atomic variable k cannot be ALLOCATABLE
         k = x
 
     !$omp atomic update
-    !ERROR: k must not have ALLOCATABLE attribute
+    !ERROR: Atomic variable k cannot be ALLOCATABLE
         k = k + x * (v * x)
 
     !$omp atomic
-    !ERROR: k must not have ALLOCATABLE attribute
+    !ERROR: Atomic variable k cannot be ALLOCATABLE
         k = v * k  
          
     !$omp atomic write
-    !ERROR: RHS expression on atomic assignment statement cannot access 'z%y'
+    !ERROR: Within atomic operation z%y and x+z%y access the same storage
        z%y = x + z%y
 
     !$omp atomic write
-    !ERROR: RHS expression on atomic assignment statement cannot access 'x'
+    !ERROR: Within atomic operation x and x access the same storage
         x = x
 
     !$omp atomic write
-    !ERROR: RHS expression on atomic assignment statement cannot access 'm'
+    !ERROR: Within atomic operation m and min(m,x,z%m)+k access the same storage
         m = min(m, x, z%m) + k
  
     !$omp atomic read
-    !ERROR: RHS expression on atomic assignment statement cannot access 'x'
+    !ERROR: Within atomic operation x and x access the same storage
         x = x
 
     !$omp atomic read
-    !ERROR: Expected scalar variable of intrinsic type on RHS of atomic assignment statement
-    !ERROR: RHS expression on atomic assignment statement cannot access 'm'
+    !ERROR: Atomic expression min(m,x,z%m)+k should be a variable
         m = min(m, x, z%m) + k
 
     !$omp atomic read
     !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches scalar INTEGER(4) and rank 1 array of INTEGER(4)
-    !ERROR: Expected scalar expression on the RHS of atomic assignment statement
+    !ERROR: Atomic variable a should be a scalar
         x = a
 
-    !$omp atomic read
-    !ERROR: Expected scalar variable on the LHS of atomic assignment statement
-        a = x
-
     !$omp atomic write
     !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches scalar INTEGER(4) and rank 1 array of INTEGER(4)
-    !ERROR: Expected scalar expression on the RHS of atomic assignment statement
         x = a
 
     !$omp atomic write
-    !ERROR: Expected scalar variable on the LHS of atomic assignment statement
+    !ERROR: Atomic variable a should be a scalar
         a = x
 
     !$omp atomic capture
@@ -93,7 +87,7 @@ program sample
 
     !$omp atomic release capture
         v = x
-    !ERROR: Atomic update statement should be of form `x = x operator expr` OR `x = expr operator x`
+    ! This ends up being "x = b + x".
         x = b + (x*1)
     !$omp end atomic
 
@@ -103,60 +97,58 @@ program sample
     !$omp end atomic
 
     !$omp atomic capture
-    !ERROR: Captured variable/array element/derived-type component x expected to be assigned in the second statement of ATOMIC CAPTURE construct
+    !ERROR: In ATOMIC UPDATE operation with CAPTURE the right-hand side of the capture assignment should read b
         v = x
         b = b + 1
     !$omp end atomic
 
     !$omp atomic capture
-    !ERROR: Captured variable/array element/derived-type component x expected to be assigned in the second statement of ATOMIC CAPTURE construct
+    !ERROR: In ATOMIC UPDATE operation with CAPTURE the right-hand side of the capture assignment should read b
         v = x
         b = 10
     !$omp end atomic
 
     !$omp atomic capture
-    !ERROR: Updated variable/array element/derived-type component x expected to be captured in the second statement of ATOMIC CAPTURE construct
         x = x + 10
+    !ERROR: In ATOMIC UPDATE operation with CAPTURE the right-hand side of the capture assignment should read x
         v = b
     !$omp end atomic
 
+    !ERROR: In ATOMIC UPDATE operation with CAPTURE neither statement could be the update or the capture
     !$omp atomic capture
-    !ERROR: Invalid ATOMIC CAPTURE construct statements. Expected one of [update-stmt, capture-stmt], [capture-stmt, update-stmt], or [capture-stmt, write-stmt]
         v = 1
         x = 4
     !$omp end atomic
 
     !$omp atomic capture
-    !ERROR: Captured variable/array element/derived-type component z%y expected to be assigned in the second statement of ATOMIC CAPTURE construct
+    !ERROR: In ATOMIC UPDATE operation with CAPTURE the right-hand side of the capture assignment should read z%m
         x = z%y
         z%m = z%m + 1.0
     !$omp end atomic
 
     !$omp atomic capture
-    !ERROR: Updated variable/array element/derived-type component z%m expected to be captured in the second statement of ATOMIC CAPTURE construct
         z%m = z%m + 1.0
+    !ERROR: In ATOMIC UPDATE operation with CAPTURE the right-hand side of the capture assignment should read z%m
         x = z%y
     !$omp end atomic
 
     !$omp atomic capture
-    !ERROR: Captured variable/array element/derived-type component y(2) expected to be assigned in the second statement of ATOMIC CAPTURE construct
+    !ERROR: In ATOMIC UPDATE operation with CAPTURE the right-hand side of the capture assignment should read y(1_8)
         x = y(2)
         y(1) = y(1) + 1
     !$omp end atomic
 
     !$omp atomic capture
-    !ERROR: Updated variable/array element/derived-type component y(1) expected to be captured in the second statement of ATOMIC CAPTURE construct
         y(1) = y(1) + 1
+    !ERROR: In ATOMIC UPDATE operation with CAPTURE the right-hand side of the capture assignment should read y(1_8)
         x = y(2)
     !$omp end atomic
 
     !$omp atomic read
-    !ERROR: Expected scalar variable on the LHS of atomic assignment statement
-    !ERROR: Expected scalar expression on the RHS of atomic assignment statement
+    !ERROR: Atomic variable r cannot have CHARACTER type
         l = r
 
     !$omp atomic write
-    !ERROR: Expected scalar variable on the LHS of atomic assignment statement
-    !ERROR: Expected scalar expression on the RHS of atomic assignment statement
+    !ERROR: Atomic variable l cannot have CHARACTER type
         l = r
 end program

flang/test/Semantics/OpenMP/requires-atomic01.f90

@@ -10,20 +10,23 @@ program requires
   ! READ
   ! ----------------------------------------------------------------------------
 
-  ! CHECK-LABEL: OpenMPAtomicConstruct -> OmpAtomicRead
-  ! CHECK: OmpMemoryOrderClause -> OmpClause -> SeqCst
+  ! CHECK-LABEL: OpenMPAtomicConstruct
+  ! CHECK: OmpClause -> Read
+  ! CHECK: OmpClause -> SeqCst
   !$omp atomic read
   i = j
 
-  ! CHECK-LABEL: OpenMPAtomicConstruct -> OmpAtomicRead
-  ! CHECK-NOT: OmpMemoryOrderClause -> OmpClause -> SeqCst
-  ! CHECK: OmpMemoryOrderClause -> OmpClause -> Relaxed
+  ! CHECK-LABEL: OpenMPAtomicConstruct
+  ! CHECK-NOT: OmpClause -> SeqCst
+  ! CHECK: OmpClause -> Relaxed
+  ! CHECK: OmpClause -> Read
   !$omp atomic relaxed read
   i = j
 
-  ! CHECK-LABEL: OpenMPAtomicConstruct -> OmpAtomicRead
-  ! CHECK-NOT: OmpMemoryOrderClause -> OmpClause -> SeqCst
-  ! CHECK: OmpMemoryOrderClause -> OmpClause -> Relaxed
+  ! CHECK-LABEL: OpenMPAtomicConstruct
+  ! CHECK: OmpClause -> Read
+  ! CHECK-NOT: OmpClause -> SeqCst
+  ! CHECK: OmpClause -> Relaxed
   !$omp atomic read relaxed
   i = j
   
@@ -31,20 +34,23 @@ program requires
   ! WRITE
   ! ----------------------------------------------------------------------------
 
-  ! CHECK-LABEL: OpenMPAtomicConstruct -> OmpAtomicWrite
-  ! CHECK: OmpMemoryOrderClause -> OmpClause -> SeqCst
+  ! CHECK-LABEL: OpenMPAtomicConstruct
+  ! CHECK: OmpClause -> Write
+  ! CHECK: OmpClause -> SeqCst
   !$omp atomic write
   i = j
 
-  ! CHECK-LABEL: OpenMPAtomicConstruct -> OmpAtomicWrite
-  ! CHECK-NOT: OmpMemoryOrderClause -> OmpClause -> SeqCst
-  ! CHECK: OmpMemoryOrderClause -> OmpClause -> Relaxed
+  ! CHECK-LABEL: OpenMPAtomicConstruct
+  ! CHECK-NOT: OmpClause -> SeqCst
+  ! CHECK: OmpClause -> Relaxed
+  ! CHECK: OmpClause -> Write
   !$omp atomic relaxed write
   i = j
 
-  ! CHECK-LABEL: OpenMPAtomicConstruct -> OmpAtomicWrite
-  ! CHECK-NOT: OmpMemoryOrderClause -> OmpClause -> SeqCst
-  ! CHECK: OmpMemoryOrderClause -> OmpClause -> Relaxed
+  ! CHECK-LABEL: OpenMPAtomicConstruct
+  ! CHECK: OmpClause -> Write
+  ! CHECK-NOT: OmpClause -> SeqCst
+  ! CHECK: OmpClause -> Relaxed
   !$omp atomic write relaxed
   i = j
 
@@ -52,31 +58,34 @@ program requires
   ! UPDATE
   ! ----------------------------------------------------------------------------
 
-  ! CHECK-LABEL: OpenMPAtomicConstruct -> OmpAtomicUpdate
-  ! CHECK: OmpMemoryOrderClause -> OmpClause -> SeqCst
+  ! CHECK-LABEL: OpenMPAtomicConstruct
+  ! CHECK: OmpClause -> Update
+  ! CHECK: OmpClause -> SeqCst
   !$omp atomic update
   i = i + j
 
-  ! CHECK-LABEL: OpenMPAtomicConstruct -> OmpAtomicUpdate
-  ! CHECK-NOT: OmpMemoryOrderClause -> OmpClause -> SeqCst
-  ! CHECK: OmpMemoryOrderClause -> OmpClause -> Relaxed
+  ! CHECK-LABEL: OpenMPAtomicConstruct
+  ! CHECK-NOT: OmpClause -> SeqCst
+  ! CHECK: OmpClause -> Relaxed
+  ! CHECK: OmpClause -> Update
   !$omp atomic relaxed update
   i = i + j
 
-  ! CHECK-LABEL: OpenMPAtomicConstruct -> OmpAtomicUpdate
-  ! CHECK-NOT: OmpMemoryOrderClause -> OmpClause -> SeqCst
-  ! CHECK: OmpMemoryOrderClause -> OmpClause -> Relaxed
+  ! CHECK-LABEL: OpenMPAtomicConstruct
+  ! CHECK: OmpClause -> Update
+  ! CHECK-NOT: OmpClause -> SeqCst
+  ! CHECK: OmpClause -> Relaxed
   !$omp atomic update relaxed
   i = i + j
 
-  ! CHECK-LABEL: OpenMPAtomicConstruct -> OmpAtomic
-  ! CHECK: OmpMemoryOrderClause -> OmpClause -> SeqCst
+  ! CHECK-LABEL: OpenMPAtomicConstruct
+  ! CHECK: OmpClause -> SeqCst
   !$omp atomic
   i = i + j
 
-  ! CHECK-LABEL: OpenMPAtomicConstruct -> OmpAtomic
-  ! CHECK-NOT: OmpMemoryOrderClause -> OmpClause -> SeqCst
-  ! CHECK: OmpMemoryOrderClause -> OmpClause -> Relaxed
+  ! CHECK-LABEL: OpenMPAtomicConstruct
+  ! CHECK-NOT: OmpClause -> SeqCst
+  ! CHECK: OmpClause -> Relaxed
   !$omp atomic relaxed
   i = i + j
 
@@ -84,24 +93,27 @@ program requires
   ! CAPTURE
   ! ----------------------------------------------------------------------------
 
-  ! CHECK-LABEL: OpenMPAtomicConstruct -> OmpAtomicCapture
-  ! CHECK: OmpMemoryOrderClause -> OmpClause -> SeqCst
+  ! CHECK-LABEL: OpenMPAtomicConstruct
+  ! CHECK: OmpClause -> Capture
+  ! CHECK: OmpClause -> SeqCst
   !$omp atomic capture
   i = j
   j = j + 1
   !$omp end atomic
 
-  ! CHECK-LABEL: OpenMPAtomicConstruct -> OmpAtomicCapture
-  ! CHECK-NOT: OmpMemoryOrderClause -> OmpClause -> SeqCst
-  ! CHECK: OmpMemoryOrderClause -> OmpClause -> Relaxed
+  ! CHECK-LABEL: OpenMPAtomicConstruct
+  ! CHECK-NOT: OmpClause -> SeqCst
+  ! CHECK: OmpClause -> Relaxed
+  ! CHECK: OmpClause -> Capture
   !$omp atomic relaxed capture
   i = j
   j = j + 1
   !$omp end atomic
 
-  ! CHECK-LABEL: OpenMPAtomicConstruct -> OmpAtomicCapture
-  ! CHECK-NOT: OmpMemoryOrderClause -> OmpClause -> SeqCst
-  ! CHECK: OmpMemoryOrderClause -> OmpClause -> Relaxed
+  ! CHECK-LABEL: OpenMPAtomicConstruct
+  ! CHECK: OmpClause -> Capture
+  ! CHECK-NOT: OmpClause -> SeqCst
+  ! CHECK: OmpClause -> Relaxed
   !$omp atomic capture relaxed
   i = j
   j = j + 1

flang/test/Semantics/OpenMP/requires-atomic02.f90

@@ -10,20 +10,23 @@ program requires
   ! READ
   ! ----------------------------------------------------------------------------
 
-  ! CHECK-LABEL: OpenMPAtomicConstruct -> OmpAtomicRead
-  ! CHECK: OmpMemoryOrderClause -> OmpClause -> Acquire
+  ! CHECK-LABEL: OpenMPAtomicConstruct
+  ! CHECK: OmpClause -> Read
+  ! CHECK: OmpClause -> AcqRel
   !$omp atomic read
   i = j
 
-  ! CHECK-LABEL: OpenMPAtomicConstruct -> OmpAtomicRead
-  ! CHECK-NOT: OmpMemoryOrderClause -> OmpClause -> Acquire
-  ! CHECK: OmpMemoryOrderClause -> OmpClause -> Relaxed
+  ! CHECK-LABEL: OpenMPAtomicConstruct
+  ! CHECK-NOT: OmpClause -> AcqRel
+  ! CHECK: OmpClause -> Relaxed
+  ! CHECK: OmpClause -> Read
   !$omp atomic relaxed read
   i = j
 
-  ! CHECK-LABEL: OpenMPAtomicConstruct -> OmpAtomicRead
-  ! CHECK-NOT: OmpMemoryOrderClause -> OmpClause -> Acquire
-  ! CHECK: OmpMemoryOrderClause -> OmpClause -> Relaxed
+  ! CHECK-LABEL: OpenMPAtomicConstruct
+  ! CHECK: OmpClause -> Read
+  ! CHECK-NOT: OmpClause -> AcqRel
+  ! CHECK: OmpClause -> Relaxed
   !$omp atomic read relaxed
   i = j
   
@@ -31,20 +34,23 @@ program requires
   ! WRITE
   ! ----------------------------------------------------------------------------
 
-  ! CHECK-LABEL: OpenMPAtomicConstruct -> OmpAtomicWrite
-  ! CHECK: OmpMemoryOrderClause -> OmpClause -> Release
+  ! CHECK-LABEL: OpenMPAtomicConstruct
+  ! CHECK: OmpClause -> Write
+  ! CHECK: OmpClause -> AcqRel
   !$omp atomic write
   i = j
 
-  ! CHECK-LABEL: OpenMPAtomicConstruct -> OmpAtomicWrite
-  ! CHECK-NOT: OmpMemoryOrderClause -> OmpClause -> Release
-  ! CHECK: OmpMemoryOrderClause -> OmpClause -> Relaxed
+  ! CHECK-LABEL: OpenMPAtomicConstruct
+  ! CHECK-NOT: OmpClause -> AcqRel
+  ! CHECK: OmpClause -> Relaxed
+  ! CHECK: OmpClause -> Write
   !$omp atomic relaxed write
   i = j
 
-  ! CHECK-LABEL: OpenMPAtomicConstruct -> OmpAtomicWrite
-  ! CHECK-NOT: OmpMemoryOrderClause -> OmpClause -> Release
-  ! CHECK: OmpMemoryOrderClause -> OmpClause -> Relaxed
+  ! CHECK-LABEL: OpenMPAtomicConstruct
+  ! CHECK: OmpClause -> Write
+  ! CHECK-NOT: OmpClause -> AcqRel
+  ! CHECK: OmpClause -> Relaxed
   !$omp atomic write relaxed
   i = j
 
@@ -52,31 +58,34 @@ program requires
   ! UPDATE
   ! ----------------------------------------------------------------------------
 
-  ! CHECK-LABEL: OpenMPAtomicConstruct -> OmpAtomicUpdate
-  ! CHECK: OmpMemoryOrderClause -> OmpClause -> Release
+  ! CHECK-LABEL: OpenMPAtomicConstruct
+  ! CHECK: OmpClause -> Update
+  ! CHECK: OmpClause -> AcqRel
   !$omp atomic update
   i = i + j
 
-  ! CHECK-LABEL: OpenMPAtomicConstruct -> OmpAtomicUpdate
-  ! CHECK-NOT: OmpMemoryOrderClause -> OmpClause -> Release
-  ! CHECK: OmpMemoryOrderClause -> OmpClause -> Relaxed
+  ! CHECK-LABEL: OpenMPAtomicConstruct
+  ! CHECK-NOT: OmpClause -> AcqRel
+  ! CHECK: OmpClause -> Relaxed
+  ! CHECK: OmpClause -> Update
   !$omp atomic relaxed update
   i = i + j
 
-  ! CHECK-LABEL: OpenMPAtomicConstruct -> OmpAtomicUpdate
-  ! CHECK-NOT: OmpMemoryOrderClause -> OmpClause -> Release
-  ! CHECK: OmpMemoryOrderClause -> OmpClause -> Relaxed
+  ! CHECK-LABEL: OpenMPAtomicConstruct
+  ! CHECK: OmpClause -> Update
+  ! CHECK-NOT: OmpClause -> AcqRel
+  ! CHECK: OmpClause -> Relaxed
   !$omp atomic update relaxed
   i = i + j
 
-  ! CHECK-LABEL: OpenMPAtomicConstruct -> OmpAtomic
-  ! CHECK: OmpMemoryOrderClause -> OmpClause -> Release
+  ! CHECK-LABEL: OpenMPAtomicConstruct
+  ! CHECK: OmpClause -> AcqRel
   !$omp atomic
   i = i + j
 
-  ! CHECK-LABEL: OpenMPAtomicConstruct -> OmpAtomic
-  ! CHECK-NOT: OmpMemoryOrderClause -> OmpClause -> Release
-  ! CHECK: OmpMemoryOrderClause -> OmpClause -> Relaxed
+  ! CHECK-LABEL: OpenMPAtomicConstruct
+  ! CHECK-NOT: OmpClause -> AcqRel
+  ! CHECK: OmpClause -> Relaxed
   !$omp atomic relaxed
   i = i + j
 
@@ -84,24 +93,27 @@ program requires
   ! CAPTURE
   ! ----------------------------------------------------------------------------
 
-  ! CHECK-LABEL: OpenMPAtomicConstruct -> OmpAtomicCapture
-  ! CHECK: OmpMemoryOrderClause -> OmpClause -> AcqRel
+  ! CHECK-LABEL: OpenMPAtomicConstruct
+  ! CHECK: OmpClause -> Capture
+  ! CHECK: OmpClause -> AcqRel
   !$omp atomic capture
   i = j
   j = j + 1
   !$omp end atomic
 
-  ! CHECK-LABEL: OpenMPAtomicConstruct -> OmpAtomicCapture
-  ! CHECK-NOT: OmpMemoryOrderClause -> OmpClause -> AcqRel
-  ! CHECK: OmpMemoryOrderClause -> OmpClause -> Relaxed
+  ! CHECK-LABEL: OpenMPAtomicConstruct
+  ! CHECK-NOT: OmpClause -> AcqRel
+  ! CHECK: OmpClause -> Relaxed
+  ! CHECK: OmpClause -> Capture
   !$omp atomic relaxed capture
   i = j
   j = j + 1
   !$omp end atomic
 
-  ! CHECK-LABEL: OpenMPAtomicConstruct -> OmpAtomicCapture
-  ! CHECK-NOT: OmpMemoryOrderClause -> OmpClause -> AcqRel
-  ! CHECK: OmpMemoryOrderClause -> OmpClause -> Relaxed
+  ! CHECK-LABEL: OpenMPAtomicConstruct
+  ! CHECK-NOT: OmpClause -> AcqRel
+  ! CHECK: OmpClause -> Capture
+  ! CHECK: OmpClause -> Relaxed
   !$omp atomic capture relaxed
   i = j
   j = j + 1