[flang-commits] [flang] 141d390 - [flang][OpenMP] Overhaul implementation of ATOMIC construct (#137852)
via flang-commits
flang-commits at lists.llvm.org
Wed Jun 11 08:05:38 PDT 2025
Author: Krzysztof Parzyszek
Date: 2025-06-11T10:05:34-05:00
New Revision: 141d390dcb6cd174b07ca663e58f37ab24eee08a
URL: https://github.com/llvm/llvm-project/commit/141d390dcb6cd174b07ca663e58f37ab24eee08a
DIFF: https://github.com/llvm/llvm-project/commit/141d390dcb6cd174b07ca663e58f37ab24eee08a.diff
LOG: [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.
Added:
flang/test/Lower/OpenMP/dump-atomic-analysis.f90
flang/test/Parser/OpenMP/atomic-end.f90
flang/test/Semantics/OpenMP/atomic-read.f90
flang/test/Semantics/OpenMP/atomic-update-capture.f90
flang/test/Semantics/OpenMP/atomic-update-only.f90
flang/test/Semantics/OpenMP/atomic-write.f90
Modified:
flang/docs/OpenMPSupport.md
flang/examples/FeatureList/FeatureList.cpp
flang/examples/FlangOmpReport/FlangOmpReportVisitor.cpp
flang/include/flang/Parser/dump-parse-tree.h
flang/include/flang/Parser/parse-tree.h
flang/include/flang/Semantics/tools.h
flang/lib/Lower/OpenMP/DataSharingProcessor.cpp
flang/lib/Lower/OpenMP/OpenMP.cpp
flang/lib/Parser/openmp-parsers.cpp
flang/lib/Parser/parse-tree.cpp
flang/lib/Parser/unparse.cpp
flang/lib/Semantics/check-omp-structure.cpp
flang/lib/Semantics/check-omp-structure.h
flang/lib/Semantics/resolve-names.cpp
flang/lib/Semantics/rewrite-directives.cpp
flang/lib/Semantics/tools.cpp
flang/test/Examples/omp-atomic.f90
flang/test/Lower/OpenMP/Todo/atomic-compare-fail.f90
flang/test/Lower/OpenMP/Todo/atomic-compare.f90
flang/test/Lower/OpenMP/atomic-capture.f90
flang/test/Lower/OpenMP/atomic-implicit-cast.f90
flang/test/Lower/OpenMP/atomic-privatize.f90
flang/test/Lower/OpenMP/atomic-write.f90
flang/test/Parser/OpenMP/atomic-compare.f90
flang/test/Semantics/OpenMP/atomic-compare.f90
flang/test/Semantics/OpenMP/atomic-hint-clause.f90
flang/test/Semantics/OpenMP/atomic-update-overloaded-ops.f90
flang/test/Semantics/OpenMP/atomic.f90
flang/test/Semantics/OpenMP/atomic01.f90
flang/test/Semantics/OpenMP/atomic02.f90
flang/test/Semantics/OpenMP/atomic03.f90
flang/test/Semantics/OpenMP/atomic04.f90
flang/test/Semantics/OpenMP/atomic05.f90
flang/test/Semantics/OpenMP/critical-hint-clause.f90
flang/test/Semantics/OpenMP/omp-atomic-assignment-stmt.f90
flang/test/Semantics/OpenMP/requires-atomic01.f90
flang/test/Semantics/OpenMP/requires-atomic02.f90
Removed:
################################################################################
diff --git a/flang/docs/OpenMPSupport.md b/flang/docs/OpenMPSupport.md
index 7a4f95693a89c..c9f19c37fd7fa 100644
--- a/flang/docs/OpenMPSupport.md
+++ b/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.
diff --git a/flang/examples/FeatureList/FeatureList.cpp b/flang/examples/FeatureList/FeatureList.cpp
index d1407cf0ef239..a36b8719e365d 100644
--- a/flang/examples/FeatureList/FeatureList.cpp
+++ b/flang/examples/FeatureList/FeatureList.cpp
@@ -445,13 +445,6 @@ struct NodeVisitor {
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 @@ struct NodeVisitor {
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 @@ struct NodeVisitor {
READ_FEATURE(OpenMPDeclareTargetConstruct)
READ_FEATURE(OmpMemoryOrderType)
READ_FEATURE(OmpMemoryOrderClause)
- READ_FEATURE(OmpAtomicClause)
- READ_FEATURE(OmpAtomicClauseList)
READ_FEATURE(OmpAtomicDefaultMemOrderClause)
READ_FEATURE(OpenMPFlushConstruct)
READ_FEATURE(OpenMPLoopConstruct)
diff --git a/flang/examples/FlangOmpReport/FlangOmpReportVisitor.cpp b/flang/examples/FlangOmpReport/FlangOmpReportVisitor.cpp
index bf66151d59950..feb7b4eced9e9 100644
--- a/flang/examples/FlangOmpReport/FlangOmpReportVisitor.cpp
+++ b/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};
diff --git a/flang/include/flang/Parser/dump-parse-tree.h b/flang/include/flang/Parser/dump-parse-tree.h
index df9278697346f..c6a5150a85a4c 100644
--- a/flang/include/flang/Parser/dump-parse-tree.h
+++ b/flang/include/flang/Parser/dump-parse-tree.h
@@ -532,15 +532,6 @@ class ParseTreeDumper {
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 @@ class ParseTreeDumper {
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 @@ class ParseTreeDumper {
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)
diff --git a/flang/include/flang/Parser/parse-tree.h b/flang/include/flang/Parser/parse-tree.h
index c99006f0c1c22..67405f88e09f2 100644
--- a/flang/include/flang/Parser/parse-tree.h
+++ b/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);
+struct OpenMPAtomicConstruct {
+ llvm::omp::Clause GetKind() const;
+ bool IsCapture() const;
+ bool IsCompare() const;
+ TUPLE_CLASS_BOILERPLATE(OpenMPAtomicConstruct);
CharBlock source;
- std::tuple<OmpAtomicClauseList, Verbatim, OmpAtomicClauseList,
- OmpAtomicCompareIfStmt, std::optional<OmpEndAtomic>>
+ std::tuple<OmpDirectiveSpecification, Block,
+ std::optional<OmpDirectiveSpecification>>
t;
-};
-// ATOMIC
-struct OmpAtomic {
- TUPLE_CLASS_BOILERPLATE(OmpAtomic);
- CharBlock source;
- std::tuple<Verbatim, OmpAtomicClauseList, Statement<AssignmentStmt>,
- std::optional<OmpEndAtomic>>
- 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;
+ };
-// 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;
+ mutable Analysis analysis;
};
// OpenMP directives that associate with loop(s)
diff --git a/flang/include/flang/Semantics/tools.h b/flang/include/flang/Semantics/tools.h
index 4b2bb4fa167f8..b13370512e5cc 100644
--- a/flang/include/flang/Semantics/tools.h
+++ b/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_
diff --git a/flang/lib/Lower/OpenMP/DataSharingProcessor.cpp b/flang/lib/Lower/OpenMP/DataSharingProcessor.cpp
index f8c68bfc3056a..1b8670b379f82 100644
--- a/flang/lib/Lower/OpenMP/DataSharingProcessor.cpp
+++ b/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{
diff --git a/flang/lib/Lower/OpenMP/OpenMP.cpp b/flang/lib/Lower/OpenMP/OpenMP.cpp
index 784749bba5a0c..3f3b85696db31 100644
--- a/flang/lib/Lower/OpenMP/OpenMP.cpp
+++ b/flang/lib/Lower/OpenMP/OpenMP.cpp
@@ -41,10 +41,13 @@
#include "mlir/Transforms/RegionUtils.h"
#include "llvm/ADT/STLExtras.h"
#include "llvm/Frontend/OpenMP/OMPConstants.h"
+#include "llvm/Support/CommandLine.h"
using namespace Fortran::lower::omp;
using namespace Fortran::common::openmp;
+static llvm::cl::opt<bool> DumpAtomicAnalysis("fdebug-dump-atomic-analysis");
+
//===----------------------------------------------------------------------===//
// Code generation helper functions
//===----------------------------------------------------------------------===//
@@ -1122,6 +1125,16 @@ markDeclareTarget(mlir::Operation *op, lower::AbstractConverter &converter,
declareTargetOp.setDeclareTarget(deviceType, captureClause);
}
+static bool isPointerAssignment(const evaluate::Assignment &assign) {
+ return common::visit(
+ common::visitors{
+ [](const evaluate::Assignment::BoundsSpec &) { return true; },
+ [](const evaluate::Assignment::BoundsRemapping &) { return true; },
+ [](const auto &) { return false; },
+ },
+ assign.u);
+}
+
//===----------------------------------------------------------------------===//
// Op body generation helper structures and functions
//===----------------------------------------------------------------------===//
@@ -2676,645 +2689,215 @@ genTeamsOp(lower::AbstractConverter &converter, lower::SymMap &symTable,
//===----------------------------------------------------------------------===//
// Code generation for atomic operations
//===----------------------------------------------------------------------===//
+static fir::FirOpBuilder::InsertPoint
+getInsertionPointBefore(mlir::Operation *op) {
+ return fir::FirOpBuilder::InsertPoint(op->getBlock(),
+ mlir::Block::iterator(op));
+}
-/// Populates \p hint and \p memoryOrder with appropriate clause information
-/// if present on atomic construct.
-static void genOmpAtomicHintAndMemoryOrderClauses(
- lower::AbstractConverter &converter,
- const parser::OmpAtomicClauseList &clauseList, mlir::IntegerAttr &hint,
- mlir::omp::ClauseMemoryOrderKindAttr &memoryOrder) {
- fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder();
- for (const parser::OmpAtomicClause &clause : clauseList.v) {
- common::visit(
- common::visitors{
- [&](const parser::OmpMemoryOrderClause &s) {
- auto kind = common::visit(
- common::visitors{
- [&](const parser::OmpClause::AcqRel &) {
- return mlir::omp::ClauseMemoryOrderKind::Acq_rel;
- },
- [&](const parser::OmpClause::Acquire &) {
- return mlir::omp::ClauseMemoryOrderKind::Acquire;
- },
- [&](const parser::OmpClause::Relaxed &) {
- return mlir::omp::ClauseMemoryOrderKind::Relaxed;
- },
- [&](const parser::OmpClause::Release &) {
- return mlir::omp::ClauseMemoryOrderKind::Release;
- },
- [&](const parser::OmpClause::SeqCst &) {
- return mlir::omp::ClauseMemoryOrderKind::Seq_cst;
- },
- [&](auto &&) -> mlir::omp::ClauseMemoryOrderKind {
- llvm_unreachable("Unexpected clause");
- },
- },
- s.v.u);
- memoryOrder = mlir::omp::ClauseMemoryOrderKindAttr::get(
- firOpBuilder.getContext(), kind);
- },
- [&](const parser::OmpHintClause &s) {
- const auto *expr = semantics::GetExpr(s.v);
- uint64_t hintExprValue = *evaluate::ToInt64(*expr);
- hint = firOpBuilder.getI64IntegerAttr(hintExprValue);
- },
- [&](const parser::OmpFailClause &) {},
- },
- clause.u);
+static fir::FirOpBuilder::InsertPoint
+getInsertionPointAfter(mlir::Operation *op) {
+ return fir::FirOpBuilder::InsertPoint(op->getBlock(),
+ ++mlir::Block::iterator(op));
+}
+
+static mlir::IntegerAttr getAtomicHint(lower::AbstractConverter &converter,
+ const List<Clause> &clauses) {
+ fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+ for (const Clause &clause : clauses) {
+ if (clause.id != llvm::omp::Clause::OMPC_hint)
+ continue;
+ auto &hint = std::get<clause::Hint>(clause.u);
+ auto maybeVal = evaluate::ToInt64(hint.v);
+ CHECK(maybeVal);
+ return builder.getI64IntegerAttr(*maybeVal);
}
+ return nullptr;
}
-static void processOmpAtomicTODO(mlir::Type elementType, mlir::Location loc) {
- if (!elementType)
- return;
- assert(fir::isa_trivial(fir::unwrapRefType(elementType)) &&
- "is supported type for omp atomic");
-}
-
-/// Used to generate atomic.read operation which is created in existing
-/// location set by builder.
-static void genAtomicCaptureStatement(
- lower::AbstractConverter &converter, mlir::Value fromAddress,
- mlir::Value toAddress,
- const parser::OmpAtomicClauseList *leftHandClauseList,
- const parser::OmpAtomicClauseList *rightHandClauseList,
- mlir::Type elementType, mlir::Location loc) {
- // Generate `atomic.read` operation for atomic assigment statements
- fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder();
+static mlir::omp::ClauseMemoryOrderKindAttr
+getAtomicMemoryOrder(lower::AbstractConverter &converter,
+ semantics::SemanticsContext &semaCtx,
+ const List<Clause> &clauses) {
+ std::optional<mlir::omp::ClauseMemoryOrderKind> kind;
+ unsigned version = semaCtx.langOptions().OpenMPVersion;
- processOmpAtomicTODO(elementType, loc);
-
- // If no hint clause is specified, the effect is as if
- // hint(omp_sync_hint_none) had been specified.
- mlir::IntegerAttr hint = nullptr;
-
- mlir::omp::ClauseMemoryOrderKindAttr memoryOrder = nullptr;
- if (leftHandClauseList)
- genOmpAtomicHintAndMemoryOrderClauses(converter, *leftHandClauseList, hint,
- memoryOrder);
- if (rightHandClauseList)
- genOmpAtomicHintAndMemoryOrderClauses(converter, *rightHandClauseList, hint,
- memoryOrder);
- firOpBuilder.create<mlir::omp::AtomicReadOp>(loc, fromAddress, toAddress,
- mlir::TypeAttr::get(elementType),
- hint, memoryOrder);
-}
-
-/// Used to generate atomic.write operation which is created in existing
-/// location set by builder.
-static void genAtomicWriteStatement(
- lower::AbstractConverter &converter, mlir::Value lhsAddr,
- mlir::Value rhsExpr, const parser::OmpAtomicClauseList *leftHandClauseList,
- const parser::OmpAtomicClauseList *rightHandClauseList, mlir::Location loc,
- mlir::Value *evaluatedExprValue = nullptr) {
- // Generate `atomic.write` operation for atomic assignment statements
- fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder();
+ for (const Clause &clause : clauses) {
+ switch (clause.id) {
+ case llvm::omp::Clause::OMPC_acq_rel:
+ kind = mlir::omp::ClauseMemoryOrderKind::Acq_rel;
+ break;
+ case llvm::omp::Clause::OMPC_acquire:
+ kind = mlir::omp::ClauseMemoryOrderKind::Acquire;
+ break;
+ case llvm::omp::Clause::OMPC_relaxed:
+ kind = mlir::omp::ClauseMemoryOrderKind::Relaxed;
+ break;
+ case llvm::omp::Clause::OMPC_release:
+ kind = mlir::omp::ClauseMemoryOrderKind::Release;
+ break;
+ case llvm::omp::Clause::OMPC_seq_cst:
+ kind = mlir::omp::ClauseMemoryOrderKind::Seq_cst;
+ break;
+ default:
+ break;
+ }
+ }
- mlir::Type varType = fir::unwrapRefType(lhsAddr.getType());
- // Create a conversion outside the capture block.
- auto insertionPoint = firOpBuilder.saveInsertionPoint();
- firOpBuilder.setInsertionPointAfter(rhsExpr.getDefiningOp());
- rhsExpr = firOpBuilder.createConvert(loc, varType, rhsExpr);
- firOpBuilder.restoreInsertionPoint(insertionPoint);
-
- processOmpAtomicTODO(varType, loc);
-
- // If no hint clause is specified, the effect is as if
- // hint(omp_sync_hint_none) had been specified.
- mlir::IntegerAttr hint = nullptr;
- mlir::omp::ClauseMemoryOrderKindAttr memoryOrder = nullptr;
- if (leftHandClauseList)
- genOmpAtomicHintAndMemoryOrderClauses(converter, *leftHandClauseList, hint,
- memoryOrder);
- if (rightHandClauseList)
- genOmpAtomicHintAndMemoryOrderClauses(converter, *rightHandClauseList, hint,
- memoryOrder);
- firOpBuilder.create<mlir::omp::AtomicWriteOp>(loc, lhsAddr, rhsExpr, hint,
- memoryOrder);
-}
-
-/// Used to generate atomic.update operation which is created in existing
-/// location set by builder.
-static void genAtomicUpdateStatement(
- lower::AbstractConverter &converter, mlir::Value lhsAddr,
- mlir::Type varType, const parser::Variable &assignmentStmtVariable,
- const parser::Expr &assignmentStmtExpr,
- const parser::OmpAtomicClauseList *leftHandClauseList,
- const parser::OmpAtomicClauseList *rightHandClauseList, mlir::Location loc,
- mlir::Operation *atomicCaptureOp = nullptr,
- lower::StatementContext *atomicCaptureStmtCtx = nullptr) {
- // Generate `atomic.update` operation for atomic assignment statements
- fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder();
- mlir::Location currentLocation = converter.getCurrentLocation();
+ // Starting with 5.1, if no memory-order clause is present, the effect
+ // is as if "relaxed" was present.
+ if (!kind) {
+ if (version <= 50)
+ return nullptr;
+ kind = mlir::omp::ClauseMemoryOrderKind::Relaxed;
+ }
+ fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+ return mlir::omp::ClauseMemoryOrderKindAttr::get(builder.getContext(), *kind);
+}
+
+static mlir::Operation * //
+genAtomicRead(lower::AbstractConverter &converter, mlir::Location loc,
+ lower::StatementContext &stmtCtx, mlir::Value atomAddr,
+ const semantics::SomeExpr &atom,
+ const evaluate::Assignment &assign, mlir::IntegerAttr hint,
+ mlir::omp::ClauseMemoryOrderKindAttr memOrder,
+ fir::FirOpBuilder::InsertPoint preAt,
+ fir::FirOpBuilder::InsertPoint atomicAt,
+ fir::FirOpBuilder::InsertPoint postAt) {
+ fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+ builder.restoreInsertionPoint(preAt);
+
+ mlir::Value storeAddr =
+ fir::getBase(converter.genExprAddr(assign.lhs, stmtCtx, &loc));
+ mlir::Type atomType = fir::unwrapRefType(atomAddr.getType());
+ mlir::Type storeType = fir::unwrapRefType(storeAddr.getType());
+
+ mlir::Value toAddr = [&]() {
+ if (atomType == storeType)
+ return storeAddr;
+ return builder.createTemporary(loc, atomType, ".tmp.atomval");
+ }();
- // Create the omp.atomic.update or acc.atomic.update operation
- //
- // func.func @_QPsb() {
- // %0 = fir.alloca i32 {bindc_name = "a", uniq_name = "_QFsbEa"}
- // %1 = fir.alloca i32 {bindc_name = "b", uniq_name = "_QFsbEb"}
- // %2 = fir.load %1 : !fir.ref<i32>
- // omp.atomic.update %0 : !fir.ref<i32> {
- // ^bb0(%arg0: i32):
- // %3 = arith.addi %arg0, %2 : i32
- // omp.yield(%3 : i32)
- // }
- // return
- // }
-
- auto getArgExpression =
- [](std::list<parser::ActualArgSpec>::const_iterator it) {
- const auto &arg{std::get<parser::ActualArg>((*it).t)};
- const auto *parserExpr{
- std::get_if<common::Indirection<parser::Expr>>(&arg.u)};
- return parserExpr;
- };
+ builder.restoreInsertionPoint(atomicAt);
+ mlir::Operation *op = builder.create<mlir::omp::AtomicReadOp>(
+ loc, atomAddr, toAddr, mlir::TypeAttr::get(atomType), hint, memOrder);
+
+ if (atomType != storeType) {
+ lower::ExprToValueMap overrides;
+ // The READ operation could be a part of UPDATE CAPTURE, so make sure
+ // we don't emit extra code into the body of the atomic op.
+ builder.restoreInsertionPoint(postAt);
+ mlir::Value load = builder.create<fir::LoadOp>(loc, toAddr);
+ overrides.try_emplace(&atom, load);
+
+ converter.overrideExprValues(&overrides);
+ mlir::Value value =
+ fir::getBase(converter.genExprValue(assign.rhs, stmtCtx, &loc));
+ converter.resetExprOverrides();
- // Lower any non atomic sub-expression before the atomic operation, and
- // map its lowered value to the semantic representation.
- lower::ExprToValueMap exprValueOverrides;
- // Max and min intrinsics can have a list of Args. Hence we need a list
- // of nonAtomicSubExprs to hoist. Currently, only the load is hoisted.
- llvm::SmallVector<const lower::SomeExpr *> nonAtomicSubExprs;
- common::visit(
- common::visitors{
- [&](const common::Indirection<parser::FunctionReference> &funcRef)
- -> void {
- const auto &args{std::get<std::list<parser::ActualArgSpec>>(
- funcRef.value().v.t)};
- std::list<parser::ActualArgSpec>::const_iterator beginIt =
- args.begin();
- std::list<parser::ActualArgSpec>::const_iterator endIt = args.end();
- const auto *exprFirst{getArgExpression(beginIt)};
- if (exprFirst && exprFirst->value().source ==
- assignmentStmtVariable.GetSource()) {
- // Add everything except the first
- beginIt++;
- } else {
- // Add everything except the last
- endIt--;
- }
- std::list<parser::ActualArgSpec>::const_iterator it;
- for (it = beginIt; it != endIt; it++) {
- const common::Indirection<parser::Expr> *expr =
- getArgExpression(it);
- if (expr)
- nonAtomicSubExprs.push_back(semantics::GetExpr(*expr));
- }
- },
- [&](const auto &op) -> void {
- using T = std::decay_t<decltype(op)>;
- if constexpr (std::is_base_of<parser::Expr::IntrinsicBinary,
- T>::value) {
- const auto &exprLeft{std::get<0>(op.t)};
- const auto &exprRight{std::get<1>(op.t)};
- if (exprLeft.value().source == assignmentStmtVariable.GetSource())
- nonAtomicSubExprs.push_back(semantics::GetExpr(exprRight));
- else
- nonAtomicSubExprs.push_back(semantics::GetExpr(exprLeft));
- }
- },
- },
- assignmentStmtExpr.u);
- lower::StatementContext nonAtomicStmtCtx;
- lower::StatementContext *stmtCtxPtr = &nonAtomicStmtCtx;
- if (!nonAtomicSubExprs.empty()) {
- // Generate non atomic part before all the atomic operations.
- auto insertionPoint = firOpBuilder.saveInsertionPoint();
- if (atomicCaptureOp) {
- assert(atomicCaptureStmtCtx && "must specify statement context");
- firOpBuilder.setInsertionPoint(atomicCaptureOp);
- // Any clean-ups associated with the expression lowering
- // must also be generated outside of the atomic update operation
- // and after the atomic capture operation.
- // The atomicCaptureStmtCtx will be finalized at the end
- // of the atomic capture operation generation.
- stmtCtxPtr = atomicCaptureStmtCtx;
- }
- mlir::Value nonAtomicVal;
- for (auto *nonAtomicSubExpr : nonAtomicSubExprs) {
- nonAtomicVal = fir::getBase(converter.genExprValue(
- currentLocation, *nonAtomicSubExpr, *stmtCtxPtr));
- exprValueOverrides.try_emplace(nonAtomicSubExpr, nonAtomicVal);
- }
- if (atomicCaptureOp)
- firOpBuilder.restoreInsertionPoint(insertionPoint);
+ builder.create<fir::StoreOp>(loc, value, storeAddr);
}
+ return op;
+}
- mlir::Operation *atomicUpdateOp = nullptr;
- // If no hint clause is specified, the effect is as if
- // hint(omp_sync_hint_none) had been specified.
- mlir::IntegerAttr hint = nullptr;
- mlir::omp::ClauseMemoryOrderKindAttr memoryOrder = nullptr;
- if (leftHandClauseList)
- genOmpAtomicHintAndMemoryOrderClauses(converter, *leftHandClauseList, hint,
- memoryOrder);
- if (rightHandClauseList)
- genOmpAtomicHintAndMemoryOrderClauses(converter, *rightHandClauseList, hint,
- memoryOrder);
- atomicUpdateOp = firOpBuilder.create<mlir::omp::AtomicUpdateOp>(
- currentLocation, lhsAddr, hint, memoryOrder);
-
- processOmpAtomicTODO(varType, loc);
-
- llvm::SmallVector<mlir::Type> varTys = {varType};
- llvm::SmallVector<mlir::Location> locs = {currentLocation};
- firOpBuilder.createBlock(&atomicUpdateOp->getRegion(0), {}, varTys, locs);
- mlir::Value val =
- fir::getBase(atomicUpdateOp->getRegion(0).front().getArgument(0));
-
- exprValueOverrides.try_emplace(semantics::GetExpr(assignmentStmtVariable),
- val);
- {
- // statement context inside the atomic block.
- converter.overrideExprValues(&exprValueOverrides);
- lower::StatementContext atomicStmtCtx;
- mlir::Value rhsExpr = fir::getBase(converter.genExprValue(
- *semantics::GetExpr(assignmentStmtExpr), atomicStmtCtx));
- mlir::Type exprType = fir::unwrapRefType(rhsExpr.getType());
- if (fir::isa_complex(exprType) && !fir::isa_complex(varType)) {
- // Emit an additional `ExtractValueOp` if the expression is of complex
- // type
- auto extract = firOpBuilder.create<fir::ExtractValueOp>(
- currentLocation,
- mlir::cast<mlir::ComplexType>(exprType).getElementType(), rhsExpr,
- firOpBuilder.getArrayAttr(
- firOpBuilder.getIntegerAttr(firOpBuilder.getIndexType(), 0)));
- mlir::Value convertResult = firOpBuilder.create<fir::ConvertOp>(
- currentLocation, varType, extract);
- firOpBuilder.create<mlir::omp::YieldOp>(currentLocation, convertResult);
- } else {
- mlir::Value convertResult =
- firOpBuilder.createConvert(currentLocation, varType, rhsExpr);
- firOpBuilder.create<mlir::omp::YieldOp>(currentLocation, convertResult);
+static mlir::Operation * //
+genAtomicWrite(lower::AbstractConverter &converter, mlir::Location loc,
+ lower::StatementContext &stmtCtx, mlir::Value atomAddr,
+ const semantics::SomeExpr &atom,
+ const evaluate::Assignment &assign, mlir::IntegerAttr hint,
+ mlir::omp::ClauseMemoryOrderKindAttr memOrder,
+ fir::FirOpBuilder::InsertPoint preAt,
+ fir::FirOpBuilder::InsertPoint atomicAt,
+ fir::FirOpBuilder::InsertPoint postAt) {
+ fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+ builder.restoreInsertionPoint(preAt);
+
+ mlir::Value value =
+ fir::getBase(converter.genExprValue(assign.rhs, stmtCtx, &loc));
+ mlir::Type atomType = fir::unwrapRefType(atomAddr.getType());
+ mlir::Value converted = builder.createConvert(loc, atomType, value);
+
+ builder.restoreInsertionPoint(atomicAt);
+ mlir::Operation *op = builder.create<mlir::omp::AtomicWriteOp>(
+ loc, atomAddr, converted, hint, memOrder);
+ return op;
+}
+
+static mlir::Operation *
+genAtomicUpdate(lower::AbstractConverter &converter, mlir::Location loc,
+ lower::StatementContext &stmtCtx, mlir::Value atomAddr,
+ const semantics::SomeExpr &atom,
+ const evaluate::Assignment &assign, mlir::IntegerAttr hint,
+ mlir::omp::ClauseMemoryOrderKindAttr memOrder,
+ fir::FirOpBuilder::InsertPoint preAt,
+ fir::FirOpBuilder::InsertPoint atomicAt,
+ fir::FirOpBuilder::InsertPoint postAt) {
+ lower::ExprToValueMap overrides;
+ lower::StatementContext naCtx;
+ fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+ builder.restoreInsertionPoint(preAt);
+
+ mlir::Type atomType = fir::unwrapRefType(atomAddr.getType());
+
+ // This must exist by now.
+ SomeExpr input = *semantics::GetConvertInput(assign.rhs);
+ std::vector<SomeExpr> args{semantics::GetTopLevelOperation(input).second};
+ assert(!args.empty() && "Update operation without arguments");
+ for (auto &arg : args) {
+ if (!semantics::IsSameOrConvertOf(arg, atom)) {
+ mlir::Value val = fir::getBase(converter.genExprValue(arg, naCtx, &loc));
+ overrides.try_emplace(&arg, val);
}
- converter.resetExprOverrides();
}
- firOpBuilder.setInsertionPointAfter(atomicUpdateOp);
-}
-
-/// Processes an atomic construct with write clause.
-static void genAtomicWrite(lower::AbstractConverter &converter,
- const parser::OmpAtomicWrite &atomicWrite,
- mlir::Location loc) {
- const parser::OmpAtomicClauseList *rightHandClauseList = nullptr;
- const parser::OmpAtomicClauseList *leftHandClauseList = nullptr;
- // Get the address of atomic read operands.
- rightHandClauseList = &std::get<2>(atomicWrite.t);
- leftHandClauseList = &std::get<0>(atomicWrite.t);
-
- const parser::AssignmentStmt &stmt =
- std::get<parser::Statement<parser::AssignmentStmt>>(atomicWrite.t)
- .statement;
- const evaluate::Assignment &assign = *stmt.typedAssignment->v;
- lower::StatementContext stmtCtx;
- // Get the value and address of atomic write operands.
- mlir::Value rhsExpr =
- fir::getBase(converter.genExprValue(assign.rhs, stmtCtx));
- mlir::Value lhsAddr =
- fir::getBase(converter.genExprAddr(assign.lhs, stmtCtx));
- genAtomicWriteStatement(converter, lhsAddr, rhsExpr, leftHandClauseList,
- rightHandClauseList, loc);
-}
-
-/*
- Emit an implicit cast. Different yet compatible types on
- omp.atomic.read constitute valid Fortran. The OMPIRBuilder will
- emit atomic instructions (on primitive types) and `__atomic_load`
- libcall (on complex type) without explicitly converting
- between such compatible types. The OMPIRBuilder relies on the
- frontend to resolve such inconsistencies between `omp.atomic.read `
- operand types. Similar inconsistencies between operand types in
- `omp.atomic.write` are resolved through implicit casting by use of typed
- assignment (i.e. `evaluate::Assignment`). However, use of typed
- assignment in `omp.atomic.read` (of form `v = x`) leads to an unsafe,
- non-atomic load of `x` into a temporary `alloca`, followed by an atomic
- read of form `v = alloca`. Hence, it is needed to perform a custom
- implicit cast.
-
- An atomic read of form `v = x` would (without implicit casting)
- lower to `omp.atomic.read %v = %x : !fir.ref<type1>, !fir.ref<type2>,
- type2`. This implicit casting will rather generate the following FIR:
-
- %alloca = fir.alloca type2
- omp.atomic.read %alloca = %x : !fir.ref<type2>, !fir.ref<type2>, type2
- %load = fir.load %alloca : !fir.ref<type2>
- %cvt = fir.convert %load : (type2) -> type1
- fir.store %cvt to %v : !fir.ref<type1>
-
- These sequence of operations is thread-safe since each thread allocates
- the `alloca` in its stack, and performs `%alloca = %x` atomically. Once
- safely read, each thread performs the implicit cast on the local
- `alloca`, and writes the final result to `%v`.
-
-/// \param builder : FirOpBuilder
-/// \param loc : Location for FIR generation
-/// \param toAddress : Address of %v
-/// \param toType : Type of %v
-/// \param fromType : Type of %x
-/// \param alloca : Thread scoped `alloca`
-// It is the responsibility of the callee
-// to position the `alloca` at `AllocaIP`
-// through `builder.getAllocaBlock()`
-*/
-
-static void emitAtomicReadImplicitCast(fir::FirOpBuilder &builder,
- mlir::Location loc,
- mlir::Value toAddress, mlir::Type toType,
- mlir::Type fromType,
- mlir::Value alloca) {
- auto load = builder.create<fir::LoadOp>(loc, alloca);
- if (fir::isa_complex(fromType) && !fir::isa_complex(toType)) {
- // Emit an additional `ExtractValueOp` if `fromAddress` is of complex
- // type, but `toAddress` is not.
- auto extract = builder.create<fir::ExtractValueOp>(
- loc, mlir::cast<mlir::ComplexType>(fromType).getElementType(), load,
- builder.getArrayAttr(
- builder.getIntegerAttr(builder.getIndexType(), 0)));
- auto cvt = builder.create<fir::ConvertOp>(loc, toType, extract);
- builder.create<fir::StoreOp>(loc, cvt, toAddress);
- } else if (!fir::isa_complex(fromType) && fir::isa_complex(toType)) {
- // Emit an additional `InsertValueOp` if `toAddress` is of complex
- // type, but `fromAddress` is not.
- mlir::Value undef = builder.create<fir::UndefOp>(loc, toType);
- mlir::Type complexEleTy =
- mlir::cast<mlir::ComplexType>(toType).getElementType();
- mlir::Value cvt = builder.create<fir::ConvertOp>(loc, complexEleTy, load);
- mlir::Value zero = builder.createRealZeroConstant(loc, complexEleTy);
- mlir::Value idx0 = builder.create<fir::InsertValueOp>(
- loc, toType, undef, cvt,
- builder.getArrayAttr(
- builder.getIntegerAttr(builder.getIndexType(), 0)));
- mlir::Value idx1 = builder.create<fir::InsertValueOp>(
- loc, toType, idx0, zero,
- builder.getArrayAttr(
- builder.getIntegerAttr(builder.getIndexType(), 1)));
- builder.create<fir::StoreOp>(loc, idx1, toAddress);
- } else {
- auto cvt = builder.create<fir::ConvertOp>(loc, toType, load);
- builder.create<fir::StoreOp>(loc, cvt, toAddress);
- }
-}
-/// Processes an atomic construct with read clause.
-static void genAtomicRead(lower::AbstractConverter &converter,
- const parser::OmpAtomicRead &atomicRead,
- mlir::Location loc) {
- const parser::OmpAtomicClauseList *rightHandClauseList = nullptr;
- const parser::OmpAtomicClauseList *leftHandClauseList = nullptr;
- // Get the address of atomic read operands.
- rightHandClauseList = &std::get<2>(atomicRead.t);
- leftHandClauseList = &std::get<0>(atomicRead.t);
+ builder.restoreInsertionPoint(atomicAt);
+ auto updateOp =
+ builder.create<mlir::omp::AtomicUpdateOp>(loc, atomAddr, hint, memOrder);
- const auto &assignmentStmtExpr = std::get<parser::Expr>(
- std::get<parser::Statement<parser::AssignmentStmt>>(atomicRead.t)
- .statement.t);
- const auto &assignmentStmtVariable = std::get<parser::Variable>(
- std::get<parser::Statement<parser::AssignmentStmt>>(atomicRead.t)
- .statement.t);
+ mlir::Region ®ion = updateOp->getRegion(0);
+ mlir::Block *block = builder.createBlock(®ion, {}, {atomType}, {loc});
+ mlir::Value localAtom = fir::getBase(block->getArgument(0));
+ overrides.try_emplace(&atom, localAtom);
- lower::StatementContext stmtCtx;
- const semantics::SomeExpr &fromExpr = *semantics::GetExpr(assignmentStmtExpr);
- mlir::Type elementType = converter.genType(fromExpr);
- mlir::Value fromAddress =
- fir::getBase(converter.genExprAddr(fromExpr, stmtCtx));
- mlir::Value toAddress = fir::getBase(converter.genExprAddr(
- *semantics::GetExpr(assignmentStmtVariable), stmtCtx));
-
- if (fromAddress.getType() != toAddress.getType()) {
-
- mlir::Type toType = fir::unwrapRefType(toAddress.getType());
- mlir::Type fromType = fir::unwrapRefType(fromAddress.getType());
- fir::FirOpBuilder &builder = converter.getFirOpBuilder();
- auto oldIP = builder.saveInsertionPoint();
- builder.setInsertionPointToStart(builder.getAllocaBlock());
- mlir::Value alloca = builder.create<fir::AllocaOp>(
- loc, fromType); // Thread scope `alloca` to atomically read `%x`.
- builder.restoreInsertionPoint(oldIP);
- genAtomicCaptureStatement(converter, fromAddress, alloca,
- leftHandClauseList, rightHandClauseList,
- elementType, loc);
- emitAtomicReadImplicitCast(builder, loc, toAddress, toType, fromType,
- alloca);
- } else
- genAtomicCaptureStatement(converter, fromAddress, toAddress,
- leftHandClauseList, rightHandClauseList,
- elementType, loc);
-}
-
-/// Processes an atomic construct with update clause.
-static void genAtomicUpdate(lower::AbstractConverter &converter,
- const parser::OmpAtomicUpdate &atomicUpdate,
- mlir::Location loc) {
- const parser::OmpAtomicClauseList *rightHandClauseList = nullptr;
- const parser::OmpAtomicClauseList *leftHandClauseList = nullptr;
- // Get the address of atomic read operands.
- rightHandClauseList = &std::get<2>(atomicUpdate.t);
- leftHandClauseList = &std::get<0>(atomicUpdate.t);
-
- const auto &assignmentStmtExpr = std::get<parser::Expr>(
- std::get<parser::Statement<parser::AssignmentStmt>>(atomicUpdate.t)
- .statement.t);
- const auto &assignmentStmtVariable = std::get<parser::Variable>(
- std::get<parser::Statement<parser::AssignmentStmt>>(atomicUpdate.t)
- .statement.t);
+ converter.overrideExprValues(&overrides);
+ mlir::Value updated =
+ fir::getBase(converter.genExprValue(assign.rhs, stmtCtx, &loc));
+ mlir::Value converted = builder.createConvert(loc, atomType, updated);
+ builder.create<mlir::omp::YieldOp>(loc, converted);
+ converter.resetExprOverrides();
- lower::StatementContext stmtCtx;
- mlir::Value lhsAddr = fir::getBase(converter.genExprAddr(
- *semantics::GetExpr(assignmentStmtVariable), stmtCtx));
- mlir::Type varType = fir::unwrapRefType(lhsAddr.getType());
- genAtomicUpdateStatement(converter, lhsAddr, varType, assignmentStmtVariable,
- assignmentStmtExpr, leftHandClauseList,
- rightHandClauseList, loc);
-}
-
-/// Processes an atomic construct with no clause - which implies update clause.
-static void genOmpAtomic(lower::AbstractConverter &converter,
- const parser::OmpAtomic &atomicConstruct,
- mlir::Location loc) {
- const parser::OmpAtomicClauseList &atomicClauseList =
- std::get<parser::OmpAtomicClauseList>(atomicConstruct.t);
- const auto &assignmentStmtExpr = std::get<parser::Expr>(
- std::get<parser::Statement<parser::AssignmentStmt>>(atomicConstruct.t)
- .statement.t);
- const auto &assignmentStmtVariable = std::get<parser::Variable>(
- std::get<parser::Statement<parser::AssignmentStmt>>(atomicConstruct.t)
- .statement.t);
- lower::StatementContext stmtCtx;
- mlir::Value lhsAddr = fir::getBase(converter.genExprAddr(
- *semantics::GetExpr(assignmentStmtVariable), stmtCtx));
- mlir::Type varType = fir::unwrapRefType(lhsAddr.getType());
- // If atomic-clause is not present on the construct, the behaviour is as if
- // the update clause is specified (for both OpenMP and OpenACC).
- genAtomicUpdateStatement(converter, lhsAddr, varType, assignmentStmtVariable,
- assignmentStmtExpr, &atomicClauseList, nullptr, loc);
-}
-
-/// Processes an atomic construct with capture clause.
-static void genAtomicCapture(lower::AbstractConverter &converter,
- const parser::OmpAtomicCapture &atomicCapture,
- mlir::Location loc) {
- fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder();
+ builder.restoreInsertionPoint(postAt); // For naCtx cleanups
+ return updateOp;
+}
- const parser::AssignmentStmt &stmt1 =
- std::get<parser::OmpAtomicCapture::Stmt1>(atomicCapture.t).v.statement;
- const evaluate::Assignment &assign1 = *stmt1.typedAssignment->v;
- const auto &stmt1Var{std::get<parser::Variable>(stmt1.t)};
- const auto &stmt1Expr{std::get<parser::Expr>(stmt1.t)};
- const parser::AssignmentStmt &stmt2 =
- std::get<parser::OmpAtomicCapture::Stmt2>(atomicCapture.t).v.statement;
- const evaluate::Assignment &assign2 = *stmt2.typedAssignment->v;
- const auto &stmt2Var{std::get<parser::Variable>(stmt2.t)};
- const auto &stmt2Expr{std::get<parser::Expr>(stmt2.t)};
-
- // Pre-evaluate expressions to be used in the various operations inside
- // `atomic.capture` since it is not desirable to have anything other than
- // a `atomic.read`, `atomic.write`, or `atomic.update` operation
- // inside `atomic.capture`
- lower::StatementContext stmtCtx;
- // LHS evaluations are common to all combinations of `atomic.capture`
- mlir::Value stmt1LHSArg =
- fir::getBase(converter.genExprAddr(assign1.lhs, stmtCtx));
- mlir::Value stmt2LHSArg =
- fir::getBase(converter.genExprAddr(assign2.lhs, stmtCtx));
-
- // Type information used in generation of `atomic.update` operation
- mlir::Type stmt1VarType =
- fir::getBase(converter.genExprValue(assign1.lhs, stmtCtx)).getType();
- mlir::Type stmt2VarType =
- fir::getBase(converter.genExprValue(assign2.lhs, stmtCtx)).getType();
-
- mlir::Operation *atomicCaptureOp = nullptr;
- mlir::IntegerAttr hint = nullptr;
- mlir::omp::ClauseMemoryOrderKindAttr memoryOrder = nullptr;
- const parser::OmpAtomicClauseList &rightHandClauseList =
- std::get<2>(atomicCapture.t);
- const parser::OmpAtomicClauseList &leftHandClauseList =
- std::get<0>(atomicCapture.t);
- genOmpAtomicHintAndMemoryOrderClauses(converter, leftHandClauseList, hint,
- memoryOrder);
- genOmpAtomicHintAndMemoryOrderClauses(converter, rightHandClauseList, hint,
- memoryOrder);
- atomicCaptureOp =
- firOpBuilder.create<mlir::omp::AtomicCaptureOp>(loc, hint, memoryOrder);
-
- firOpBuilder.createBlock(&(atomicCaptureOp->getRegion(0)));
- mlir::Block &block = atomicCaptureOp->getRegion(0).back();
- firOpBuilder.setInsertionPointToStart(&block);
- if (parser::CheckForSingleVariableOnRHS(stmt1)) {
- if (semantics::CheckForSymbolMatch(semantics::GetExpr(stmt2Var),
- semantics::GetExpr(stmt2Expr))) {
- // Atomic capture construct is of the form [capture-stmt, update-stmt]
- const semantics::SomeExpr &fromExpr = *semantics::GetExpr(stmt1Expr);
- mlir::Type elementType = converter.genType(fromExpr);
- if (stmt1VarType != stmt2VarType) {
- mlir::Value alloca;
- mlir::Type toType = fir::unwrapRefType(stmt1LHSArg.getType());
- mlir::Type fromType = fir::unwrapRefType(stmt2LHSArg.getType());
- {
- mlir::OpBuilder::InsertionGuard guard(firOpBuilder);
- firOpBuilder.setInsertionPointToStart(firOpBuilder.getAllocaBlock());
- alloca = firOpBuilder.create<fir::AllocaOp>(loc, fromType);
- }
- genAtomicCaptureStatement(converter, stmt2LHSArg, alloca,
- /*leftHandClauseList=*/nullptr,
- /*rightHandClauseList=*/nullptr, elementType,
- loc);
- {
- mlir::OpBuilder::InsertionGuard guard(firOpBuilder);
- firOpBuilder.setInsertionPointAfter(atomicCaptureOp);
- emitAtomicReadImplicitCast(firOpBuilder, loc, stmt1LHSArg, toType,
- fromType, alloca);
- }
- } else {
- genAtomicCaptureStatement(converter, stmt2LHSArg, stmt1LHSArg,
- /*leftHandClauseList=*/nullptr,
- /*rightHandClauseList=*/nullptr, elementType,
- loc);
- }
- genAtomicUpdateStatement(
- converter, stmt2LHSArg, stmt2VarType, stmt2Var, stmt2Expr,
- /*leftHandClauseList=*/nullptr,
- /*rightHandClauseList=*/nullptr, loc, atomicCaptureOp, &stmtCtx);
- } else {
- // Atomic capture construct is of the form [capture-stmt, write-stmt]
- firOpBuilder.setInsertionPoint(atomicCaptureOp);
- mlir::Value stmt2RHSArg =
- fir::getBase(converter.genExprValue(assign2.rhs, stmtCtx));
- firOpBuilder.setInsertionPointToStart(&block);
- const semantics::SomeExpr &fromExpr = *semantics::GetExpr(stmt1Expr);
- mlir::Type elementType = converter.genType(fromExpr);
-
- if (stmt1VarType != stmt2VarType) {
- mlir::Value alloca;
- mlir::Type toType = fir::unwrapRefType(stmt1LHSArg.getType());
- mlir::Type fromType = fir::unwrapRefType(stmt2LHSArg.getType());
- {
- mlir::OpBuilder::InsertionGuard guard(firOpBuilder);
- firOpBuilder.setInsertionPointToStart(firOpBuilder.getAllocaBlock());
- alloca = firOpBuilder.create<fir::AllocaOp>(loc, fromType);
- }
- genAtomicCaptureStatement(converter, stmt2LHSArg, alloca,
- /*leftHandClauseList=*/nullptr,
- /*rightHandClauseList=*/nullptr, elementType,
- loc);
- {
- mlir::OpBuilder::InsertionGuard guard(firOpBuilder);
- firOpBuilder.setInsertionPointAfter(atomicCaptureOp);
- emitAtomicReadImplicitCast(firOpBuilder, loc, stmt1LHSArg, toType,
- fromType, alloca);
- }
- } else {
- genAtomicCaptureStatement(converter, stmt2LHSArg, stmt1LHSArg,
- /*leftHandClauseList=*/nullptr,
- /*rightHandClauseList=*/nullptr, elementType,
- loc);
- }
- genAtomicWriteStatement(converter, stmt2LHSArg, stmt2RHSArg,
- /*leftHandClauseList=*/nullptr,
- /*rightHandClauseList=*/nullptr, loc);
- }
- } else {
- // Atomic capture construct is of the form [update-stmt, capture-stmt]
- const semantics::SomeExpr &fromExpr = *semantics::GetExpr(stmt2Expr);
- mlir::Type elementType = converter.genType(fromExpr);
- genAtomicUpdateStatement(
- converter, stmt1LHSArg, stmt1VarType, stmt1Var, stmt1Expr,
- /*leftHandClauseList=*/nullptr,
- /*rightHandClauseList=*/nullptr, loc, atomicCaptureOp, &stmtCtx);
-
- if (stmt1VarType != stmt2VarType) {
- mlir::Value alloca;
- mlir::Type toType = fir::unwrapRefType(stmt2LHSArg.getType());
- mlir::Type fromType = fir::unwrapRefType(stmt1LHSArg.getType());
-
- {
- mlir::OpBuilder::InsertionGuard guard(firOpBuilder);
- firOpBuilder.setInsertionPointToStart(firOpBuilder.getAllocaBlock());
- alloca = firOpBuilder.create<fir::AllocaOp>(loc, fromType);
- }
+static mlir::Operation *
+genAtomicOperation(lower::AbstractConverter &converter, mlir::Location loc,
+ lower::StatementContext &stmtCtx, int action,
+ mlir::Value atomAddr, const semantics::SomeExpr &atom,
+ const evaluate::Assignment &assign, mlir::IntegerAttr hint,
+ mlir::omp::ClauseMemoryOrderKindAttr memOrder,
+ fir::FirOpBuilder::InsertPoint preAt,
+ fir::FirOpBuilder::InsertPoint atomicAt,
+ fir::FirOpBuilder::InsertPoint postAt) {
+ if (isPointerAssignment(assign)) {
+ TODO(loc, "Code generation for pointer assignment is not implemented yet");
+ }
- genAtomicCaptureStatement(converter, stmt1LHSArg, alloca,
- /*leftHandClauseList=*/nullptr,
- /*rightHandClauseList=*/nullptr, elementType,
- loc);
- {
- mlir::OpBuilder::InsertionGuard guard(firOpBuilder);
- firOpBuilder.setInsertionPointAfter(atomicCaptureOp);
- emitAtomicReadImplicitCast(firOpBuilder, loc, stmt2LHSArg, toType,
- fromType, alloca);
- }
- } else {
- genAtomicCaptureStatement(converter, stmt1LHSArg, stmt2LHSArg,
- /*leftHandClauseList=*/nullptr,
- /*rightHandClauseList=*/nullptr, elementType,
- loc);
- }
+ // This function and the functions called here do not preserve the
+ // builder's insertion point, or set it to anything specific.
+ switch (action) {
+ case parser::OpenMPAtomicConstruct::Analysis::Read:
+ return genAtomicRead(converter, loc, stmtCtx, atomAddr, atom, assign, hint,
+ memOrder, preAt, atomicAt, postAt);
+ case parser::OpenMPAtomicConstruct::Analysis::Write:
+ return genAtomicWrite(converter, loc, stmtCtx, atomAddr, atom, assign, hint,
+ memOrder, preAt, atomicAt, postAt);
+ case parser::OpenMPAtomicConstruct::Analysis::Update:
+ return genAtomicUpdate(converter, loc, stmtCtx, atomAddr, atom, assign,
+ hint, memOrder, preAt, atomicAt, postAt);
+ default:
+ return nullptr;
}
- firOpBuilder.setInsertionPointToEnd(&block);
- firOpBuilder.create<mlir::omp::TerminatorOp>(loc);
- // The clean-ups associated with the statements inside the capture
- // construct must be generated after the AtomicCaptureOp.
- firOpBuilder.setInsertionPointAfter(atomicCaptureOp);
}
//===----------------------------------------------------------------------===//
@@ -4212,10 +3795,6 @@ genOMP(lower::AbstractConverter &converter, lower::SymMap &symTable,
standaloneConstruct.u);
}
-//===----------------------------------------------------------------------===//
-// OpenMPConstruct visitors
-//===----------------------------------------------------------------------===//
-
static void genOMP(lower::AbstractConverter &converter, lower::SymMap &symTable,
semantics::SemanticsContext &semaCtx,
lower::pft::Evaluation &eval,
@@ -4223,38 +3802,164 @@ static void genOMP(lower::AbstractConverter &converter, lower::SymMap &symTable,
TODO(converter.getCurrentLocation(), "OpenMPAllocatorsConstruct");
}
+//===----------------------------------------------------------------------===//
+// OpenMPConstruct visitors
+//===----------------------------------------------------------------------===//
+
+[[maybe_unused]] static void
+dumpAtomicAnalysis(const parser::OpenMPAtomicConstruct::Analysis &analysis) {
+ auto whatStr = [](int k) {
+ std::string txt = "?";
+ switch (k & parser::OpenMPAtomicConstruct::Analysis::Action) {
+ case parser::OpenMPAtomicConstruct::Analysis::None:
+ txt = "None";
+ break;
+ case parser::OpenMPAtomicConstruct::Analysis::Read:
+ txt = "Read";
+ break;
+ case parser::OpenMPAtomicConstruct::Analysis::Write:
+ txt = "Write";
+ break;
+ case parser::OpenMPAtomicConstruct::Analysis::Update:
+ txt = "Update";
+ break;
+ }
+ switch (k & parser::OpenMPAtomicConstruct::Analysis::Condition) {
+ case parser::OpenMPAtomicConstruct::Analysis::IfTrue:
+ txt += " | IfTrue";
+ break;
+ case parser::OpenMPAtomicConstruct::Analysis::IfFalse:
+ txt += " | IfFalse";
+ break;
+ }
+ return txt;
+ };
+
+ auto exprStr = [&](const parser::TypedExpr &expr) {
+ if (auto *maybe = expr.get()) {
+ if (maybe->v)
+ return maybe->v->AsFortran();
+ }
+ return "<null>"s;
+ };
+ auto assignStr = [&](const parser::AssignmentStmt::TypedAssignment &assign) {
+ if (auto *maybe = assign.get(); maybe && maybe->v) {
+ std::string str;
+ llvm::raw_string_ostream os(str);
+ maybe->v->AsFortran(os);
+ return str;
+ }
+ return "<null>"s;
+ };
+
+ const SomeExpr &atom = *analysis.atom.get()->v;
+
+ llvm::errs() << "Analysis {\n";
+ llvm::errs() << " atom: " << atom.AsFortran() << "\n";
+ llvm::errs() << " cond: " << exprStr(analysis.cond) << "\n";
+ llvm::errs() << " op0 {\n";
+ llvm::errs() << " what: " << whatStr(analysis.op0.what) << "\n";
+ llvm::errs() << " assign: " << assignStr(analysis.op0.assign) << "\n";
+ llvm::errs() << " }\n";
+ llvm::errs() << " op1 {\n";
+ llvm::errs() << " what: " << whatStr(analysis.op1.what) << "\n";
+ llvm::errs() << " assign: " << assignStr(analysis.op1.assign) << "\n";
+ llvm::errs() << " }\n";
+ llvm::errs() << "}\n";
+}
+
static void genOMP(lower::AbstractConverter &converter, lower::SymMap &symTable,
semantics::SemanticsContext &semaCtx,
lower::pft::Evaluation &eval,
- const parser::OpenMPAtomicConstruct &atomicConstruct) {
- Fortran::common::visit(
- common::visitors{
- [&](const parser::OmpAtomicRead &atomicRead) {
- mlir::Location loc = converter.genLocation(atomicRead.source);
- genAtomicRead(converter, atomicRead, loc);
- },
- [&](const parser::OmpAtomicWrite &atomicWrite) {
- mlir::Location loc = converter.genLocation(atomicWrite.source);
- genAtomicWrite(converter, atomicWrite, loc);
- },
- [&](const parser::OmpAtomic &atomicConstruct) {
- mlir::Location loc = converter.genLocation(atomicConstruct.source);
- genOmpAtomic(converter, atomicConstruct, loc);
- },
- [&](const parser::OmpAtomicUpdate &atomicUpdate) {
- mlir::Location loc = converter.genLocation(atomicUpdate.source);
- genAtomicUpdate(converter, atomicUpdate, loc);
- },
- [&](const parser::OmpAtomicCapture &atomicCapture) {
- mlir::Location loc = converter.genLocation(atomicCapture.source);
- genAtomicCapture(converter, atomicCapture, loc);
- },
- [&](const parser::OmpAtomicCompare &atomicCompare) {
- mlir::Location loc = converter.genLocation(atomicCompare.source);
- TODO(loc, "OpenMP atomic compare");
- },
- },
- atomicConstruct.u);
+ const parser::OpenMPAtomicConstruct &construct) {
+ auto get = [](auto &&typedWrapper) -> decltype(&*typedWrapper.get()->v) {
+ if (auto *maybe = typedWrapper.get(); maybe && maybe->v) {
+ return &*maybe->v;
+ } else {
+ return nullptr;
+ }
+ };
+
+ fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+ auto &dirSpec = std::get<parser::OmpDirectiveSpecification>(construct.t);
+ List<Clause> clauses = makeClauses(dirSpec.Clauses(), semaCtx);
+ lower::StatementContext stmtCtx;
+
+ const parser::OpenMPAtomicConstruct::Analysis &analysis = construct.analysis;
+ if (DumpAtomicAnalysis)
+ dumpAtomicAnalysis(analysis);
+
+ const semantics::SomeExpr &atom = *get(analysis.atom);
+ mlir::Location loc = converter.genLocation(construct.source);
+ mlir::Value atomAddr =
+ fir::getBase(converter.genExprAddr(atom, stmtCtx, &loc));
+ mlir::IntegerAttr hint = getAtomicHint(converter, clauses);
+ mlir::omp::ClauseMemoryOrderKindAttr memOrder =
+ getAtomicMemoryOrder(converter, semaCtx, clauses);
+
+ if (auto *cond = get(analysis.cond)) {
+ (void)cond;
+ TODO(loc, "OpenMP ATOMIC COMPARE");
+ } else {
+ int action0 = analysis.op0.what & analysis.Action;
+ int action1 = analysis.op1.what & analysis.Action;
+ mlir::Operation *captureOp = nullptr;
+ fir::FirOpBuilder::InsertPoint preAt = builder.saveInsertionPoint();
+ fir::FirOpBuilder::InsertPoint atomicAt, postAt;
+
+ if (construct.IsCapture()) {
+ // Capturing operation.
+ assert(action0 != analysis.None && action1 != analysis.None &&
+ "Expexcing two actions");
+ captureOp =
+ builder.create<mlir::omp::AtomicCaptureOp>(loc, hint, memOrder);
+ // Set the non-atomic insertion point to before the atomic.capture.
+ preAt = getInsertionPointBefore(captureOp);
+
+ mlir::Block *block = builder.createBlock(&captureOp->getRegion(0));
+ builder.setInsertionPointToEnd(block);
+ // Set the atomic insertion point to before the terminator inside
+ // atomic.capture.
+ mlir::Operation *term = builder.create<mlir::omp::TerminatorOp>(loc);
+ atomicAt = getInsertionPointBefore(term);
+ postAt = getInsertionPointAfter(captureOp);
+ hint = nullptr;
+ memOrder = nullptr;
+ } else {
+ // Non-capturing operation.
+ assert(action0 != analysis.None && action1 == analysis.None &&
+ "Expexcing single action");
+ assert(!(analysis.op0.what & analysis.Condition));
+ postAt = atomicAt = preAt;
+ }
+
+ // The builder's insertion point needs to be specifically set before
+ // each call to `genAtomicOperation`.
+ mlir::Operation *firstOp = genAtomicOperation(
+ converter, loc, stmtCtx, analysis.op0.what, atomAddr, atom,
+ *get(analysis.op0.assign), hint, memOrder, preAt, atomicAt, postAt);
+ assert(firstOp && "Should have created an atomic operation");
+ atomicAt = getInsertionPointAfter(firstOp);
+
+ mlir::Operation *secondOp = nullptr;
+ if (analysis.op1.what != analysis.None) {
+ secondOp = genAtomicOperation(converter, loc, stmtCtx, analysis.op1.what,
+ atomAddr, atom, *get(analysis.op1.assign),
+ hint, memOrder, preAt, atomicAt, postAt);
+ }
+
+ if (construct.IsCapture()) {
+ // If this is a capture operation, the first/second ops will be inside
+ // of it. Set the insertion point to past the capture op itself.
+ builder.restoreInsertionPoint(postAt);
+ } else {
+ if (secondOp) {
+ builder.setInsertionPointAfter(secondOp);
+ } else {
+ builder.setInsertionPointAfter(firstOp);
+ }
+ }
+ }
}
static void genOMP(lower::AbstractConverter &converter, lower::SymMap &symTable,
diff --git a/flang/lib/Parser/openmp-parsers.cpp b/flang/lib/Parser/openmp-parsers.cpp
index 08326fad8c143..9b112a2133918 100644
--- a/flang/lib/Parser/openmp-parsers.cpp
+++ b/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>(
diff --git a/flang/lib/Parser/parse-tree.cpp b/flang/lib/Parser/parse-tree.cpp
index 3dd87ad9a3650..824612e49293f 100644
--- a/flang/lib/Parser/parse-tree.cpp
+++ b/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 &&) {
diff --git a/flang/lib/Parser/unparse.cpp b/flang/lib/Parser/unparse.cpp
index e0abe95d07c86..ed0f227fd5b98 100644
--- a/flang/lib/Parser/unparse.cpp
+++ b/flang/lib/Parser/unparse.cpp
@@ -2571,83 +2571,22 @@ class UnparseVisitor {
Word(ToUpperCaseLetters(common::EnumToString(x)));
}
- void Unparse(const OmpAtomicClauseList &x) { Walk(" ", x.v, " "); }
-
- 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) {
+ void Unparse(const OpenMPAtomicConstruct &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));
+ Word("!$OMP ");
+ Walk(std::get<OmpDirectiveSpecification>(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();
+ 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 OpenMPExecutableAllocate &x) {
const auto &fields =
std::get<std::optional<std::list<parser::OpenMPDeclarativeAllocate>>>(
@@ -2920,23 +2859,8 @@ class UnparseVisitor {
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 ");
diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index 31fcbb9683202..4dccb0e88e324 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -17,10 +17,16 @@
#include "flang/Semantics/openmp-modifiers.h"
#include "flang/Semantics/tools.h"
#include "llvm/ADT/STLExtras.h"
+#include "llvm/ADT/StringSwitch.h"
#include <variant>
namespace Fortran::semantics {
+template <typename T, typename U>
+static bool operator!=(const evaluate::Expr<T> &e, const evaluate::Expr<U> &f) {
+ return !(e == f);
+}
+
// Use when clause falls under 'struct OmpClause' in 'parse-tree.h'.
#define CHECK_SIMPLE_CLAUSE(X, Y) \
void OmpStructureChecker::Enter(const parser::OmpClause::X &) { \
@@ -79,6 +85,32 @@ static const parser::ArrayElement *GetArrayElementFromObj(
return nullptr;
}
+static bool IsVarOrFunctionRef(const MaybeExpr &expr) {
+ if (expr) {
+ return evaluate::UnwrapProcedureRef(*expr) != nullptr ||
+ evaluate::IsVariable(*expr);
+ } else {
+ return false;
+ }
+}
+
+static std::optional<SomeExpr> GetEvaluateExpr(const parser::Expr &parserExpr) {
+ const parser::TypedExpr &typedExpr{parserExpr.typedExpr};
+ // ForwardOwningPointer typedExpr
+ // `- GenericExprWrapper ^.get()
+ // `- std::optional<Expr> ^->v
+ return typedExpr.get()->v;
+}
+
+static std::optional<evaluate::DynamicType> GetDynamicType(
+ const parser::Expr &parserExpr) {
+ if (auto maybeExpr{GetEvaluateExpr(parserExpr)}) {
+ return maybeExpr->GetType();
+ } else {
+ return std::nullopt;
+ }
+}
+
// 'OmpWorkshareBlockChecker' is used to check the validity of the assignment
// statements and the expressions enclosed in an OpenMP Workshare construct
class OmpWorkshareBlockChecker {
@@ -595,51 +627,26 @@ void OmpStructureChecker::CheckPredefinedAllocatorRestriction(
}
}
-template <class D>
-void OmpStructureChecker::CheckHintClause(
- D *leftOmpClauseList, D *rightOmpClauseList, std::string_view dirName) {
- bool foundHint{false};
+void OmpStructureChecker::Enter(const parser::OmpClause::Hint &x) {
+ CheckAllowedClause(llvm::omp::Clause::OMPC_hint);
+ auto &dirCtx{GetContext()};
- auto checkForValidHintClause = [&](const D *clauseList) {
- for (const auto &clause : clauseList->v) {
- const parser::OmpHintClause *ompHintClause = nullptr;
- if constexpr (std::is_same_v<D, const parser::OmpAtomicClauseList>) {
- ompHintClause = std::get_if<parser::OmpHintClause>(&clause.u);
- } else if constexpr (std::is_same_v<D, const parser::OmpClauseList>) {
- if (auto *hint{std::get_if<parser::OmpClause::Hint>(&clause.u)}) {
- ompHintClause = &hint->v;
- }
- }
- if (!ompHintClause)
- continue;
- if (foundHint) {
- context_.Say(clause.source,
- "At most one HINT clause can appear on the %s directive"_err_en_US,
- parser::ToUpperCaseLetters(dirName));
- }
- foundHint = true;
- std::optional<std::int64_t> hintValue = GetIntValue(ompHintClause->v);
- if (hintValue && *hintValue >= 0) {
- /*`omp_sync_hint_nonspeculative` and `omp_lock_hint_speculative`*/
- if ((*hintValue & 0xC) == 0xC
- /*`omp_sync_hint_uncontended` and omp_sync_hint_contended*/
- || (*hintValue & 0x3) == 0x3)
- context_.Say(clause.source,
- "Hint clause value "
- "is not a valid OpenMP synchronization value"_err_en_US);
- } else {
- context_.Say(clause.source,
- "Hint clause must have non-negative constant "
- "integer expression"_err_en_US);
+ if (std::optional<int64_t> maybeVal{GetIntValue(x.v.v)}) {
+ int64_t val{*maybeVal};
+ if (val >= 0) {
+ // Check contradictory values.
+ if ((val & 0xC) == 0xC || // omp_sync_hint_speculative and nonspeculative
+ (val & 0x3) == 0x3) { // omp_sync_hint_contended and uncontended
+ context_.Say(dirCtx.clauseSource,
+ "The synchronization hint is not valid"_err_en_US);
}
+ } else {
+ context_.Say(dirCtx.clauseSource,
+ "Synchronization hint must be non-negative"_err_en_US);
}
- };
-
- if (leftOmpClauseList) {
- checkForValidHintClause(leftOmpClauseList);
- }
- if (rightOmpClauseList) {
- checkForValidHintClause(rightOmpClauseList);
+ } else {
+ context_.Say(dirCtx.clauseSource,
+ "Synchronization hint must be a constant integer value"_err_en_US);
}
}
@@ -2396,8 +2403,9 @@ void OmpStructureChecker::Leave(const parser::OpenMPCancelConstruct &) {
void OmpStructureChecker::Enter(const parser::OpenMPCriticalConstruct &x) {
const auto &dir{std::get<parser::OmpCriticalDirective>(x.t)};
+ const auto &dirSource{std::get<parser::Verbatim>(dir.t).source};
const auto &endDir{std::get<parser::OmpEndCriticalDirective>(x.t)};
- PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_critical);
+ PushContextAndClauseSets(dirSource, llvm::omp::Directive::OMPD_critical);
const auto &block{std::get<parser::Block>(x.t)};
CheckNoBranching(block, llvm::omp::Directive::OMPD_critical, dir.source);
const auto &dirName{std::get<std::optional<parser::Name>>(dir.t)};
@@ -2430,7 +2438,6 @@ void OmpStructureChecker::Enter(const parser::OpenMPCriticalConstruct &x) {
"Hint clause other than omp_sync_hint_none cannot be specified for "
"an unnamed CRITICAL directive"_err_en_US});
}
- CheckHintClause<const parser::OmpClauseList>(&ompClause, nullptr, "CRITICAL");
}
void OmpStructureChecker::Leave(const parser::OpenMPCriticalConstruct &) {
@@ -2667,422 +2674,1418 @@ void OmpStructureChecker::Leave(const parser::OmpEndBlockDirective &x) {
}
}
-inline void OmpStructureChecker::ErrIfAllocatableVariable(
- const parser::Variable &var) {
- // Err out if the given symbol has
- // ALLOCATABLE attribute
- if (const auto *e{GetExpr(context_, var)})
- for (const Symbol &symbol : evaluate::CollectSymbols(*e))
- if (IsAllocatable(symbol)) {
- const auto &designator =
- std::get<common::Indirection<parser::Designator>>(var.u);
- const auto *dataRef =
- std::get_if<parser::DataRef>(&designator.value().u);
- const parser::Name *name =
- dataRef ? std::get_if<parser::Name>(&dataRef->u) : nullptr;
- if (name)
- context_.Say(name->source,
- "%s must not have ALLOCATABLE "
- "attribute"_err_en_US,
- name->ToString());
+/// parser::Block is a list of executable constructs, parser::BlockConstruct
+/// is Fortran's BLOCK/ENDBLOCK construct.
+/// Strip the outermost BlockConstructs, return the reference to the Block
+/// in the executable part of the innermost of the stripped constructs.
+/// Specifically, if the given `block` has a single entry (it's a list), and
+/// the entry is a BlockConstruct, get the Block contained within. Repeat
+/// this step as many times as possible.
+static const parser::Block &GetInnermostExecPart(const parser::Block &block) {
+ const parser::Block *iter{&block};
+ while (iter->size() == 1) {
+ const parser::ExecutionPartConstruct &ep{iter->front()};
+ if (auto *exec{std::get_if<parser::ExecutableConstruct>(&ep.u)}) {
+ using BlockConstruct = common::Indirection<parser::BlockConstruct>;
+ if (auto *bc{std::get_if<BlockConstruct>(&exec->u)}) {
+ iter = &std::get<parser::Block>(bc->value().t);
+ continue;
}
+ }
+ break;
+ }
+ return *iter;
}
-inline void OmpStructureChecker::ErrIfLHSAndRHSSymbolsMatch(
- const parser::Variable &var, const parser::Expr &expr) {
- // Err out if the symbol on the LHS is also used on the RHS of the assignment
- // statement
- const auto *e{GetExpr(context_, expr)};
- const auto *v{GetExpr(context_, var)};
- if (e && v) {
- auto vSyms{evaluate::GetSymbolVector(*v)};
- const Symbol &varSymbol = vSyms.front();
- for (const Symbol &symbol : evaluate::GetSymbolVector(*e)) {
- if (varSymbol == symbol) {
- const common::Indirection<parser::Designator> *designator =
- std::get_if<common::Indirection<parser::Designator>>(&expr.u);
- if (designator) {
- auto *z{var.typedExpr.get()};
- auto *c{expr.typedExpr.get()};
- if (z->v == c->v) {
- context_.Say(expr.source,
- "RHS expression on atomic assignment statement cannot access '%s'"_err_en_US,
- var.GetSource());
- }
+// There is no consistent way to get the source of a given ActionStmt, so
+// extract the source information from Statement<ActionStmt> when we can,
+// and keep it around for error reporting in further analyses.
+struct SourcedActionStmt {
+ const parser::ActionStmt *stmt{nullptr};
+ parser::CharBlock source;
+
+ operator bool() const { return stmt != nullptr; }
+};
+
+struct AnalyzedCondStmt {
+ SomeExpr cond{evaluate::NullPointer{}}; // Default ctor is deleted
+ parser::CharBlock source;
+ SourcedActionStmt ift, iff;
+};
+
+static SourcedActionStmt GetActionStmt(
+ const parser::ExecutionPartConstruct *x) {
+ if (x == nullptr) {
+ return SourcedActionStmt{};
+ }
+ if (auto *exec{std::get_if<parser::ExecutableConstruct>(&x->u)}) {
+ using ActionStmt = parser::Statement<parser::ActionStmt>;
+ if (auto *stmt{std::get_if<ActionStmt>(&exec->u)}) {
+ return SourcedActionStmt{&stmt->statement, stmt->source};
+ }
+ }
+ return SourcedActionStmt{};
+}
+
+static SourcedActionStmt GetActionStmt(const parser::Block &block) {
+ if (block.size() == 1) {
+ return GetActionStmt(&block.front());
+ }
+ return SourcedActionStmt{};
+}
+
+// Compute the `evaluate::Assignment` from parser::ActionStmt. The assumption
+// is that the ActionStmt will be either an assignment or a pointer-assignment,
+// otherwise return std::nullopt.
+// Note: This function can return std::nullopt on [Pointer]AssignmentStmt where
+// the "typedAssignment" is unset. This can happen if there are semantic errors
+// in the purported assignment.
+static std::optional<evaluate::Assignment> GetEvaluateAssignment(
+ const parser::ActionStmt *x) {
+ if (x == nullptr) {
+ return std::nullopt;
+ }
+
+ using AssignmentStmt = common::Indirection<parser::AssignmentStmt>;
+ using PointerAssignmentStmt =
+ common::Indirection<parser::PointerAssignmentStmt>;
+ using TypedAssignment = parser::AssignmentStmt::TypedAssignment;
+
+ return common::visit(
+ [](auto &&s) -> std::optional<evaluate::Assignment> {
+ using BareS = llvm::remove_cvref_t<decltype(s)>;
+ if constexpr (std::is_same_v<BareS, AssignmentStmt> ||
+ std::is_same_v<BareS, PointerAssignmentStmt>) {
+ const TypedAssignment &typed{s.value().typedAssignment};
+ // ForwardOwningPointer typedAssignment
+ // `- GenericAssignmentWrapper ^.get()
+ // `- std::optional<Assignment> ^->v
+ return typed.get()->v;
} else {
- context_.Say(expr.source,
- "RHS expression on atomic assignment statement cannot access '%s'"_err_en_US,
- var.GetSource());
+ return std::nullopt;
+ }
+ },
+ x->u);
+}
+
+// Check if the ActionStmt is actually a [Pointer]AssignmentStmt. This is
+// to separate cases where the source has something that looks like an
+// assignment, but is semantically wrong (diagnosed by general semantic
+// checks), and where the source has some other statement (which we want
+// to report as "should be an assignment").
+static bool IsAssignment(const parser::ActionStmt *x) {
+ if (x == nullptr) {
+ return false;
+ }
+
+ using AssignmentStmt = common::Indirection<parser::AssignmentStmt>;
+ using PointerAssignmentStmt =
+ common::Indirection<parser::PointerAssignmentStmt>;
+
+ return common::visit(
+ [](auto &&s) -> bool {
+ using BareS = llvm::remove_cvref_t<decltype(s)>;
+ return std::is_same_v<BareS, AssignmentStmt> ||
+ std::is_same_v<BareS, PointerAssignmentStmt>;
+ },
+ x->u);
+}
+
+static std::optional<AnalyzedCondStmt> AnalyzeConditionalStmt(
+ const parser::ExecutionPartConstruct *x) {
+ if (x == nullptr) {
+ return std::nullopt;
+ }
+
+ // Extract the evaluate::Expr from ScalarLogicalExpr.
+ auto getFromLogical{[](const parser::ScalarLogicalExpr &logical) {
+ // ScalarLogicalExpr is Scalar<Logical<common::Indirection<Expr>>>
+ const parser::Expr &expr{logical.thing.thing.value()};
+ return GetEvaluateExpr(expr);
+ }};
+
+ // Recognize either
+ // ExecutionPartConstruct -> ExecutableConstruct -> ActionStmt -> IfStmt, or
+ // ExecutionPartConstruct -> ExecutableConstruct -> IfConstruct.
+
+ if (auto &&action{GetActionStmt(x)}) {
+ if (auto *ifs{std::get_if<common::Indirection<parser::IfStmt>>(
+ &action.stmt->u)}) {
+ const parser::IfStmt &s{ifs->value()};
+ auto &&maybeCond{
+ getFromLogical(std::get<parser::ScalarLogicalExpr>(s.t))};
+ auto &thenStmt{
+ std::get<parser::UnlabeledStatement<parser::ActionStmt>>(s.t)};
+ if (maybeCond) {
+ return AnalyzedCondStmt{std::move(*maybeCond), action.source,
+ SourcedActionStmt{&thenStmt.statement, thenStmt.source},
+ SourcedActionStmt{}};
+ }
+ }
+ return std::nullopt;
+ }
+
+ if (auto *exec{std::get_if<parser::ExecutableConstruct>(&x->u)}) {
+ if (auto *ifc{
+ std::get_if<common::Indirection<parser::IfConstruct>>(&exec->u)}) {
+ using ElseBlock = parser::IfConstruct::ElseBlock;
+ using ElseIfBlock = parser::IfConstruct::ElseIfBlock;
+ const parser::IfConstruct &s{ifc->value()};
+
+ if (!std::get<std::list<ElseIfBlock>>(s.t).empty()) {
+ // Not expecting any else-if statements.
+ return std::nullopt;
+ }
+ auto &stmt{std::get<parser::Statement<parser::IfThenStmt>>(s.t)};
+ auto &&maybeCond{getFromLogical(
+ std::get<parser::ScalarLogicalExpr>(stmt.statement.t))};
+ if (!maybeCond) {
+ return std::nullopt;
+ }
+
+ if (auto &maybeElse{std::get<std::optional<ElseBlock>>(s.t)}) {
+ AnalyzedCondStmt result{std::move(*maybeCond), stmt.source,
+ GetActionStmt(std::get<parser::Block>(s.t)),
+ GetActionStmt(std::get<parser::Block>(maybeElse->t))};
+ if (result.ift.stmt && result.iff.stmt) {
+ return result;
+ }
+ } else {
+ AnalyzedCondStmt result{std::move(*maybeCond), stmt.source,
+ GetActionStmt(std::get<parser::Block>(s.t)), SourcedActionStmt{}};
+ if (result.ift.stmt) {
+ return result;
}
}
}
+ return std::nullopt;
}
+
+ return std::nullopt;
}
-inline void OmpStructureChecker::ErrIfNonScalarAssignmentStmt(
- const parser::Variable &var, const parser::Expr &expr) {
- // Err out if either the variable on the LHS or the expression on the RHS of
- // the assignment statement are non-scalar (i.e. have rank > 0 or is of
- // CHARACTER type)
- const auto *e{GetExpr(context_, expr)};
- const auto *v{GetExpr(context_, var)};
- if (e && v) {
- if (e->Rank() != 0 ||
- (e->GetType().has_value() &&
- e->GetType().value().category() == common::TypeCategory::Character))
- context_.Say(expr.source,
- "Expected scalar expression "
- "on the RHS of atomic assignment "
- "statement"_err_en_US);
- if (v->Rank() != 0 ||
- (v->GetType().has_value() &&
- v->GetType()->category() == common::TypeCategory::Character))
- context_.Say(var.GetSource(),
- "Expected scalar variable "
- "on the LHS of atomic assignment "
- "statement"_err_en_US);
- }
-}
-
-template <typename T, typename D>
-bool OmpStructureChecker::IsOperatorValid(const T &node, const D &variable) {
- using AllowedBinaryOperators =
- std::variant<parser::Expr::Add, parser::Expr::Multiply,
- parser::Expr::Subtract, parser::Expr::Divide, parser::Expr::AND,
- parser::Expr::OR, parser::Expr::EQV, parser::Expr::NEQV>;
- using BinaryOperators = std::variant<parser::Expr::Add,
- parser::Expr::Multiply, parser::Expr::Subtract, parser::Expr::Divide,
- parser::Expr::AND, parser::Expr::OR, parser::Expr::EQV,
- parser::Expr::NEQV, parser::Expr::Power, parser::Expr::Concat,
- parser::Expr::LT, parser::Expr::LE, parser::Expr::EQ, parser::Expr::NE,
- parser::Expr::GE, parser::Expr::GT>;
-
- if constexpr (common::HasMember<T, BinaryOperators>) {
- const auto &variableName{variable.GetSource().ToString()};
- const auto &exprLeft{std::get<0>(node.t)};
- const auto &exprRight{std::get<1>(node.t)};
- if ((exprLeft.value().source.ToString() != variableName) &&
- (exprRight.value().source.ToString() != variableName)) {
- context_.Say(variable.GetSource(),
- "Atomic update statement should be of form "
- "`%s = %s operator expr` OR `%s = expr operator %s`"_err_en_US,
- variableName, variableName, variableName, variableName);
- }
- return common::HasMember<T, AllowedBinaryOperators>;
+static std::pair<parser::CharBlock, parser::CharBlock> SplitAssignmentSource(
+ parser::CharBlock source) {
+ // Find => in the range, if not found, find = that is not a part of
+ // <=, >=, ==, or /=.
+ auto trim{[](std::string_view v) {
+ const char *begin{v.data()};
+ const char *end{begin + v.size()};
+ while (*begin == ' ' && begin != end) {
+ ++begin;
+ }
+ while (begin != end && end[-1] == ' ') {
+ --end;
+ }
+ assert(begin != end && "Source should not be empty");
+ return parser::CharBlock(begin, end - begin);
+ }};
+
+ std::string_view sv(source.begin(), source.size());
+
+ if (auto where{sv.find("=>")}; where != sv.npos) {
+ std::string_view lhs(sv.data(), where);
+ std::string_view rhs(sv.data() + where + 2, sv.size() - where - 2);
+ return std::make_pair(trim(lhs), trim(rhs));
}
- return false;
+
+ // Go backwards, since all the exclusions above end with a '='.
+ for (size_t next{source.size()}; next > 1; --next) {
+ if (sv[next - 1] == '=' && !llvm::is_contained("<>=/", sv[next - 2])) {
+ std::string_view lhs(sv.data(), next - 1);
+ std::string_view rhs(sv.data() + next, sv.size() - next);
+ return std::make_pair(trim(lhs), trim(rhs));
+ }
+ }
+ llvm_unreachable("Could not find assignment operator");
}
-void OmpStructureChecker::CheckAtomicCaptureStmt(
- const parser::AssignmentStmt &assignmentStmt) {
- const auto &var{std::get<parser::Variable>(assignmentStmt.t)};
- const auto &expr{std::get<parser::Expr>(assignmentStmt.t)};
- common::visit(
- common::visitors{
- [&](const common::Indirection<parser::Designator> &designator) {
- const auto *dataRef =
- std::get_if<parser::DataRef>(&designator.value().u);
- const auto *name =
- dataRef ? std::get_if<parser::Name>(&dataRef->u) : nullptr;
- if (name && IsAllocatable(*name->symbol))
- context_.Say(name->source,
- "%s must not have ALLOCATABLE "
- "attribute"_err_en_US,
- name->ToString());
- },
- [&](const auto &) {
- // Anything other than a `parser::Designator` is not allowed
- context_.Say(expr.source,
- "Expected scalar variable "
- "of intrinsic type on RHS of atomic "
- "assignment statement"_err_en_US);
- }},
- expr.u);
- ErrIfLHSAndRHSSymbolsMatch(var, expr);
- ErrIfNonScalarAssignmentStmt(var, expr);
-}
-
-void OmpStructureChecker::CheckAtomicWriteStmt(
- const parser::AssignmentStmt &assignmentStmt) {
- const auto &var{std::get<parser::Variable>(assignmentStmt.t)};
- const auto &expr{std::get<parser::Expr>(assignmentStmt.t)};
- ErrIfAllocatableVariable(var);
- ErrIfLHSAndRHSSymbolsMatch(var, expr);
- ErrIfNonScalarAssignmentStmt(var, expr);
-}
-
-void OmpStructureChecker::CheckAtomicUpdateStmt(
- const parser::AssignmentStmt &assignment) {
- const auto &expr{std::get<parser::Expr>(assignment.t)};
- const auto &var{std::get<parser::Variable>(assignment.t)};
- bool isIntrinsicProcedure{false};
- bool isValidOperator{false};
- common::visit(
- common::visitors{
- [&](const common::Indirection<parser::FunctionReference> &x) {
- isIntrinsicProcedure = true;
- const auto &procedureDesignator{
- std::get<parser::ProcedureDesignator>(x.value().v.t)};
- const parser::Name *name{
- std::get_if<parser::Name>(&procedureDesignator.u)};
- if (name &&
- !(name->source == "max" || name->source == "min" ||
- name->source == "iand" || name->source == "ior" ||
- name->source == "ieor")) {
- context_.Say(expr.source,
- "Invalid intrinsic procedure name in "
- "OpenMP ATOMIC (UPDATE) statement"_err_en_US);
- }
- },
- [&](const auto &x) {
- if (!IsOperatorValid(x, var)) {
- context_.Say(expr.source,
- "Invalid or missing operator in atomic update "
- "statement"_err_en_US);
- } else
- isValidOperator = true;
- },
- },
- expr.u);
- if (const auto *e{GetExpr(context_, expr)}) {
- const auto *v{GetExpr(context_, var)};
- if (e->Rank() != 0 ||
- (e->GetType().has_value() &&
- e->GetType().value().category() == common::TypeCategory::Character))
- context_.Say(expr.source,
- "Expected scalar expression "
- "on the RHS of atomic update assignment "
- "statement"_err_en_US);
- if (v->Rank() != 0 ||
- (v->GetType().has_value() &&
- v->GetType()->category() == common::TypeCategory::Character))
- context_.Say(var.GetSource(),
- "Expected scalar variable "
- "on the LHS of atomic update assignment "
- "statement"_err_en_US);
- auto vSyms{evaluate::GetSymbolVector(*v)};
- const Symbol &varSymbol = vSyms.front();
- int numOfSymbolMatches{0};
- SymbolVector exprSymbols{evaluate::GetSymbolVector(*e)};
- for (const Symbol &symbol : exprSymbols) {
- if (varSymbol == symbol) {
- numOfSymbolMatches++;
+namespace atomic {
+
+struct DesignatorCollector : public evaluate::Traverse<DesignatorCollector,
+ std::vector<SomeExpr>, false> {
+ using Result = std::vector<SomeExpr>;
+ using Base = evaluate::Traverse<DesignatorCollector, Result, false>;
+ DesignatorCollector() : Base(*this) {}
+
+ Result Default() const { return {}; }
+
+ using Base::operator();
+
+ template <typename T> //
+ Result operator()(const evaluate::Designator<T> &x) const {
+ // Once in a designator, don't traverse it any further (i.e. only
+ // collect top-level designators).
+ auto copy{x};
+ return Result{AsGenericExpr(std::move(copy))};
+ }
+
+ template <typename... Rs> //
+ Result Combine(Result &&result, Rs &&...results) const {
+ Result v(std::move(result));
+ auto moveAppend{[](auto &accum, auto &&other) {
+ for (auto &&s : other) {
+ accum.push_back(std::move(s));
}
+ }};
+ (moveAppend(v, std::move(results)), ...);
+ return v;
+ }
+};
+
+struct VariableFinder : public evaluate::AnyTraverse<VariableFinder> {
+ using Base = evaluate::AnyTraverse<VariableFinder>;
+ VariableFinder(const SomeExpr &v) : Base(*this), var(v) {}
+
+ using Base::operator();
+
+ template <typename T>
+ bool operator()(const evaluate::Designator<T> &x) const {
+ auto copy{x};
+ return evaluate::AsGenericExpr(std::move(copy)) == var;
+ }
+
+ template <typename T>
+ bool operator()(const evaluate::FunctionRef<T> &x) const {
+ auto copy{x};
+ return evaluate::AsGenericExpr(std::move(copy)) == var;
+ }
+
+private:
+ const SomeExpr &var;
+};
+} // namespace atomic
+
+static bool IsPointerAssignment(const evaluate::Assignment &x) {
+ return std::holds_alternative<evaluate::Assignment::BoundsSpec>(x.u) ||
+ std::holds_alternative<evaluate::Assignment::BoundsRemapping>(x.u);
+}
+
+static bool IsCheckForAssociated(const SomeExpr &cond) {
+ return GetTopLevelOperation(cond).first == operation::Operator::Associated;
+}
+
+static bool HasCommonDesignatorSymbols(
+ const evaluate::SymbolVector &baseSyms, const SomeExpr &other) {
+ // Compare the designators used in "other" with the designators whose
+ // symbols are given in baseSyms.
+ // This is a part of the check if these two expressions can access the same
+ // storage: if the designators used in them are
diff erent enough, then they
+ // will be assumed not to access the same memory.
+ //
+ // Consider an (array element) expression x%y(w%z), the corresponding symbol
+ // vector will be {x, y, w, z} (i.e. the symbols for these names).
+ // Check whether this exact sequence appears anywhere in any the symbol
+ // vector for "other". This will be true for x(y) and x(y+1), so this is
+ // not a sufficient condition, but can be used to eliminate candidates
+ // before doing more exhaustive checks.
+ //
+ // If any of the symbols in this sequence are function names, assume that
+ // there is no storage overlap, mostly because it would be impossible in
+ // general to determine what storage the function will access.
+ // Note: if f is pure, then two calls to f will access the same storage
+ // when called with the same arguments. This check is not done yet.
+
+ if (llvm::any_of(
+ baseSyms, [](const SymbolRef &s) { return s->IsSubprogram(); })) {
+ // If there is a function symbol in the chain then we can't infer much
+ // about the accessed storage.
+ return false;
+ }
+
+ auto isSubsequence{// Is u a subsequence of v.
+ [](const evaluate::SymbolVector &u, const evaluate::SymbolVector &v) {
+ size_t us{u.size()}, vs{v.size()};
+ if (us > vs) {
+ return false;
+ }
+ for (size_t off{0}; off != vs - us + 1; ++off) {
+ bool same{true};
+ for (size_t i{0}; i != us; ++i) {
+ if (u[i] != v[off + i]) {
+ same = false;
+ break;
+ }
+ }
+ if (same) {
+ return true;
+ }
+ }
+ return false;
+ }};
+
+ evaluate::SymbolVector otherSyms{evaluate::GetSymbolVector(other)};
+ return isSubsequence(baseSyms, otherSyms);
+}
+
+static bool HasCommonTopLevelDesignators(
+ const std::vector<SomeExpr> &baseDsgs, const SomeExpr &other) {
+ // Compare designators directly as expressions. This will ensure
+ // that x(y) and x(y+1) are not flagged as overlapping, whereas
+ // the symbol vectors for both of these would be identical.
+ std::vector<SomeExpr> otherDsgs{atomic::DesignatorCollector{}(other)};
+
+ for (auto &s : baseDsgs) {
+ if (llvm::any_of(otherDsgs, [&](auto &&t) { return s == t; })) {
+ return true;
}
- if (isIntrinsicProcedure) {
- std::string varName = var.GetSource().ToString();
- if (numOfSymbolMatches != 1)
- context_.Say(expr.source,
- "Intrinsic procedure"
- " arguments in atomic update statement"
- " must have exactly one occurence of '%s'"_err_en_US,
- varName);
- else if (varSymbol != exprSymbols.front() &&
- varSymbol != exprSymbols.back())
- context_.Say(expr.source,
- "Atomic update statement "
- "should be of the form `%s = intrinsic_procedure(%s, expr_list)` "
- "OR `%s = intrinsic_procedure(expr_list, %s)`"_err_en_US,
- varName, varName, varName, varName);
- } else if (isValidOperator) {
- if (numOfSymbolMatches != 1)
- context_.Say(expr.source,
- "Exactly one occurence of '%s' "
- "expected on the RHS of atomic update assignment statement"_err_en_US,
- var.GetSource().ToString());
+ }
+ return false;
+}
+
+static const SomeExpr *HasStorageOverlap(
+ const SomeExpr &base, llvm::ArrayRef<SomeExpr> exprs) {
+ evaluate::SymbolVector baseSyms{evaluate::GetSymbolVector(base)};
+ std::vector<SomeExpr> baseDsgs{atomic::DesignatorCollector{}(base)};
+
+ for (const SomeExpr &expr : exprs) {
+ if (!HasCommonDesignatorSymbols(baseSyms, expr)) {
+ continue;
+ }
+ if (HasCommonTopLevelDesignators(baseDsgs, expr)) {
+ return &expr;
}
}
+ return nullptr;
+}
- ErrIfAllocatableVariable(var);
+static bool IsMaybeAtomicWrite(const evaluate::Assignment &assign) {
+ // This ignores function calls, so it will accept "f(x) = f(x) + 1"
+ // for example.
+ return HasStorageOverlap(assign.lhs, assign.rhs) == nullptr;
}
-void OmpStructureChecker::CheckAtomicCompareConstruct(
- const parser::OmpAtomicCompare &atomicCompareConstruct) {
+static bool IsSubexpressionOf(const SomeExpr &sub, const SomeExpr &super) {
+ return atomic::VariableFinder{sub}(super);
+}
- // TODO: Check that the if-stmt is `if (var == expr) var = new`
- // [with or without then/end-do]
+static void SetExpr(parser::TypedExpr &expr, MaybeExpr value) {
+ if (value) {
+ expr.Reset(new evaluate::GenericExprWrapper(std::move(value)),
+ evaluate::GenericExprWrapper::Deleter);
+ }
+}
- unsigned version{context_.langOptions().OpenMPVersion};
- if (version < 51) {
- context_.Say(atomicCompareConstruct.source,
- "%s construct not allowed in %s, %s"_err_en_US,
- atomicCompareConstruct.source, ThisVersion(version), TryVersion(51));
- }
-
- // TODO: More work needed here. Some of the Update restrictions need to
- // be added, but Update isn't the same either.
-}
-
-// TODO: Allow cond-update-stmt once compare clause is supported.
-void OmpStructureChecker::CheckAtomicCaptureConstruct(
- const parser::OmpAtomicCapture &atomicCaptureConstruct) {
- const parser::AssignmentStmt &stmt1 =
- std::get<parser::OmpAtomicCapture::Stmt1>(atomicCaptureConstruct.t)
- .v.statement;
- const auto &stmt1Var{std::get<parser::Variable>(stmt1.t)};
- const auto &stmt1Expr{std::get<parser::Expr>(stmt1.t)};
- const auto *v1 = GetExpr(context_, stmt1Var);
- const auto *e1 = GetExpr(context_, stmt1Expr);
-
- const parser::AssignmentStmt &stmt2 =
- std::get<parser::OmpAtomicCapture::Stmt2>(atomicCaptureConstruct.t)
- .v.statement;
- const auto &stmt2Var{std::get<parser::Variable>(stmt2.t)};
- const auto &stmt2Expr{std::get<parser::Expr>(stmt2.t)};
- const auto *v2 = GetExpr(context_, stmt2Var);
- const auto *e2 = GetExpr(context_, stmt2Expr);
-
- if (e1 && v1 && e2 && v2) {
- if (parser::CheckForSingleVariableOnRHS(stmt1)) {
- CheckAtomicCaptureStmt(stmt1);
- if (CheckForSymbolMatch(v2, e2)) {
- // ATOMIC CAPTURE construct is of the form [capture-stmt, update-stmt]
- CheckAtomicUpdateStmt(stmt2);
+static void SetAssignment(parser::AssignmentStmt::TypedAssignment &assign,
+ std::optional<evaluate::Assignment> value) {
+ if (value) {
+ assign.Reset(new evaluate::GenericAssignmentWrapper(std::move(value)),
+ evaluate::GenericAssignmentWrapper::Deleter);
+ }
+}
+
+static parser::OpenMPAtomicConstruct::Analysis::Op MakeAtomicAnalysisOp(
+ int what,
+ const std::optional<evaluate::Assignment> &maybeAssign = std::nullopt) {
+ parser::OpenMPAtomicConstruct::Analysis::Op operation;
+ operation.what = what;
+ SetAssignment(operation.assign, maybeAssign);
+ return operation;
+}
+
+static parser::OpenMPAtomicConstruct::Analysis MakeAtomicAnalysis(
+ const SomeExpr &atom, const MaybeExpr &cond,
+ parser::OpenMPAtomicConstruct::Analysis::Op &&op0,
+ parser::OpenMPAtomicConstruct::Analysis::Op &&op1) {
+ // Defined in flang/include/flang/Parser/parse-tree.h
+ //
+ // struct Analysis {
+ // struct Kind {
+ // 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; // Bits containing N, R, W, U
+ // static constexpr int IfTrue = 4;
+ // static constexpr int IfFalse = 8;
+ // static constexpr int Condition = 12; // Bits containing IfTrue, IfFalse
+ // };
+ // struct Op {
+ // int what;
+ // TypedAssignment assign;
+ // };
+ // TypedExpr atom, cond;
+ // Op op0, op1;
+ // };
+
+ parser::OpenMPAtomicConstruct::Analysis an;
+ SetExpr(an.atom, atom);
+ SetExpr(an.cond, cond);
+ an.op0 = std::move(op0);
+ an.op1 = std::move(op1);
+ return an;
+}
+
+void OmpStructureChecker::CheckStorageOverlap(const SomeExpr &base,
+ llvm::ArrayRef<evaluate::Expr<evaluate::SomeType>> exprs,
+ parser::CharBlock source) {
+ if (auto *expr{HasStorageOverlap(base, exprs)}) {
+ context_.Say(source,
+ "Within atomic operation %s and %s access the same storage"_warn_en_US,
+ base.AsFortran(), expr->AsFortran());
+ }
+}
+
+void OmpStructureChecker::ErrorShouldBeVariable(
+ const MaybeExpr &expr, parser::CharBlock source) {
+ if (expr) {
+ context_.Say(source, "Atomic expression %s should be a variable"_err_en_US,
+ expr->AsFortran());
+ } else {
+ context_.Say(source, "Atomic expression should be a variable"_err_en_US);
+ }
+}
+
+/// Check if `expr` satisfies the following conditions for x and v:
+///
+/// [6.0:189:10-12]
+/// - x and v (as applicable) are either scalar variables or
+/// function references with scalar data pointer result of non-character
+/// intrinsic type or variables that are non-polymorphic scalar pointers
+/// and any length type parameter must be constant.
+void OmpStructureChecker::CheckAtomicType(
+ SymbolRef sym, parser::CharBlock source, std::string_view name) {
+ const DeclTypeSpec *typeSpec{sym->GetType()};
+ if (!typeSpec) {
+ return;
+ }
+
+ if (!IsPointer(sym)) {
+ using Category = DeclTypeSpec::Category;
+ Category cat{typeSpec->category()};
+ if (cat == Category::Character) {
+ context_.Say(source,
+ "Atomic variable %s cannot have CHARACTER type"_err_en_US, name);
+ } else if (cat != Category::Numeric && cat != Category::Logical) {
+ context_.Say(source,
+ "Atomic variable %s should have an intrinsic type"_err_en_US, name);
+ }
+ return;
+ }
+
+ // Variable is a pointer.
+ if (typeSpec->IsPolymorphic()) {
+ context_.Say(source,
+ "Atomic variable %s cannot be a pointer to a polymorphic type"_err_en_US,
+ name);
+ return;
+ }
+
+ // Go over all length parameters, if any, and check if they are
+ // explicit.
+ if (const DerivedTypeSpec *derived{typeSpec->AsDerived()}) {
+ if (llvm::any_of(derived->parameters(), [](auto &&entry) {
+ // "entry" is a map entry
+ return entry.second.isLen() && !entry.second.isExplicit();
+ })) {
+ context_.Say(source,
+ "Atomic variable %s is a pointer to a type with non-constant length parameter"_err_en_US,
+ name);
+ }
+ }
+}
+
+void OmpStructureChecker::CheckAtomicVariable(
+ const SomeExpr &atom, parser::CharBlock source) {
+ if (atom.Rank() != 0) {
+ context_.Say(source, "Atomic variable %s should be a scalar"_err_en_US,
+ atom.AsFortran());
+ }
+
+ std::vector<SomeExpr> dsgs{atomic::DesignatorCollector{}(atom)};
+ assert(dsgs.size() == 1 && "Should have a single top-level designator");
+ evaluate::SymbolVector syms{evaluate::GetSymbolVector(dsgs.front())};
+
+ CheckAtomicType(syms.back(), source, atom.AsFortran());
+
+ if (IsAllocatable(syms.back()) && !IsArrayElement(atom)) {
+ context_.Say(source, "Atomic variable %s cannot be ALLOCATABLE"_err_en_US,
+ atom.AsFortran());
+ }
+}
+
+std::pair<const parser::ExecutionPartConstruct *,
+ const parser::ExecutionPartConstruct *>
+OmpStructureChecker::CheckUpdateCapture(
+ const parser::ExecutionPartConstruct *ec1,
+ const parser::ExecutionPartConstruct *ec2, parser::CharBlock source) {
+ // Decide which statement is the atomic update and which is the capture.
+ //
+ // The two allowed cases are:
+ // x = ... atomic-var = ...
+ // ... = x capture-var = atomic-var (with optional converts)
+ // or
+ // ... = x capture-var = atomic-var (with optional converts)
+ // x = ... atomic-var = ...
+ //
+ // The case of 'a = b; b = a' is ambiguous, so pick the first one as capture
+ // (which makes more sense, as it captures the original value of the atomic
+ // variable).
+ //
+ // If the two statements don't fit these criteria, return a pair of default-
+ // constructed values.
+ using ReturnTy = std::pair<const parser::ExecutionPartConstruct *,
+ const parser::ExecutionPartConstruct *>;
+
+ SourcedActionStmt act1{GetActionStmt(ec1)};
+ SourcedActionStmt act2{GetActionStmt(ec2)};
+ auto maybeAssign1{GetEvaluateAssignment(act1.stmt)};
+ auto maybeAssign2{GetEvaluateAssignment(act2.stmt)};
+ if (!maybeAssign1 || !maybeAssign2) {
+ if (!IsAssignment(act1.stmt) || !IsAssignment(act2.stmt)) {
+ context_.Say(source,
+ "ATOMIC UPDATE operation with CAPTURE should contain two assignments"_err_en_US);
+ }
+ return std::make_pair(nullptr, nullptr);
+ }
+
+ auto as1{*maybeAssign1}, as2{*maybeAssign2};
+
+ auto isUpdateCapture{
+ [](const evaluate::Assignment &u, const evaluate::Assignment &c) {
+ return IsSameOrConvertOf(c.rhs, u.lhs);
+ }};
+
+ // Do some checks that narrow down the possible choices for the update
+ // and the capture statements. This will help to emit better diagnostics.
+ // 1. An assignment could be an update (cbu) if the left-hand side is a
+ // subexpression of the right-hand side.
+ // 2. An assignment could be a capture (cbc) if the right-hand side is
+ // a variable (or a function ref), with potential type conversions.
+ bool cbu1{IsSubexpressionOf(as1.lhs, as1.rhs)}; // Can as1 be an update?
+ bool cbu2{IsSubexpressionOf(as2.lhs, as2.rhs)}; // Can as2 be an update?
+ bool cbc1{IsVarOrFunctionRef(GetConvertInput(as1.rhs))}; // Can 1 be capture?
+ bool cbc2{IsVarOrFunctionRef(GetConvertInput(as2.rhs))}; // Can 2 be capture?
+
+ // We want to diagnose cases where both assignments cannot be an update,
+ // or both cannot be a capture, as well as cases where either assignment
+ // cannot be any of these two.
+ //
+ // If we organize these boolean values into a matrix
+ // |cbu1 cbu2|
+ // |cbc1 cbc2|
+ // then we want to diagnose cases where the matrix has a zero (i.e. "false")
+ // row or column, including the case where everything is zero. All these
+ // cases correspond to the determinant of the matrix being 0, which suggests
+ // that checking the det may be a convenient diagnostic check. There is only
+ // one additional case where the det is 0, which is when the matrix is all 1
+ // ("true"). The "all true" case represents the situation where both
+ // assignments could be an update as well as a capture. On the other hand,
+ // whenever det != 0, the roles of the update and the capture can be
+ // unambiguously assigned to as1 and as2 [1].
+ //
+ // [1] This can be easily verified by hand: there are 10 2x2 matrices with
+ // det = 0, leaving 6 cases where det != 0:
+ // 0 1 0 1 1 0 1 0 1 1 1 1
+ // 1 0 1 1 0 1 1 1 0 1 1 0
+ // In each case the classification is unambiguous.
+
+ // |cbu1 cbu2|
+ // det |cbc1 cbc2| = cbu1*cbc2 - cbu2*cbc1
+ int det{int(cbu1) * int(cbc2) - int(cbu2) * int(cbc1)};
+
+ auto errorCaptureShouldRead{[&](const parser::CharBlock &source,
+ const std::string &expr) {
+ context_.Say(source,
+ "In ATOMIC UPDATE operation with CAPTURE the right-hand side of the capture assignment should read %s"_err_en_US,
+ expr);
+ }};
+
+ auto errorNeitherWorks{[&]() {
+ context_.Say(source,
+ "In ATOMIC UPDATE operation with CAPTURE neither statement could be the update or the capture"_err_en_US);
+ }};
+
+ auto makeSelectionFromDet{[&](int det) -> ReturnTy {
+ // If det != 0, then the checks unambiguously suggest a specific
+ // categorization.
+ // If det == 0, then this function should be called only if the
+ // checks haven't ruled out any possibility, i.e. when both assigments
+ // could still be either updates or captures.
+ if (det > 0) {
+ // as1 is update, as2 is capture
+ if (isUpdateCapture(as1, as2)) {
+ return std::make_pair(/*Update=*/ec1, /*Capture=*/ec2);
} else {
- // ATOMIC CAPTURE construct is of the form [capture-stmt, write-stmt]
- CheckAtomicWriteStmt(stmt2);
+ errorCaptureShouldRead(act2.source, as1.lhs.AsFortran());
+ return std::make_pair(nullptr, nullptr);
}
- if (!(*e1 == *v2)) {
- context_.Say(stmt1Expr.source,
- "Captured variable/array element/derived-type component %s expected to be assigned in the second statement of ATOMIC CAPTURE construct"_err_en_US,
- stmt1Expr.source);
+ } else if (det < 0) {
+ // as2 is update, as1 is capture
+ if (isUpdateCapture(as2, as1)) {
+ return std::make_pair(/*Update=*/ec2, /*Capture=*/ec1);
+ } else {
+ errorCaptureShouldRead(act1.source, as2.lhs.AsFortran());
+ return std::make_pair(nullptr, nullptr);
+ }
+ } else {
+ bool updateFirst{isUpdateCapture(as1, as2)};
+ bool captureFirst{isUpdateCapture(as2, as1)};
+ if (updateFirst && captureFirst) {
+ // If both assignment could be the update and both could be the
+ // capture, emit a warning about the ambiguity.
+ context_.Say(act1.source,
+ "In ATOMIC UPDATE operation with CAPTURE either statement could be the update and the capture, assuming the first one is the capture statement"_warn_en_US);
+ return std::make_pair(/*Update=*/ec2, /*Capture=*/ec1);
}
- } else if (CheckForSymbolMatch(v1, e1) &&
- parser::CheckForSingleVariableOnRHS(stmt2)) {
- // ATOMIC CAPTURE construct is of the form [update-stmt, capture-stmt]
- CheckAtomicUpdateStmt(stmt1);
- CheckAtomicCaptureStmt(stmt2);
- // Variable updated in stmt1 should be captured in stmt2
- if (!(*v1 == *e2)) {
- context_.Say(stmt1Var.GetSource(),
- "Updated variable/array element/derived-type component %s expected to be captured in the second statement of ATOMIC CAPTURE construct"_err_en_US,
- stmt1Var.GetSource());
+ if (updateFirst != captureFirst) {
+ const parser::ExecutionPartConstruct *upd{updateFirst ? ec1 : ec2};
+ const parser::ExecutionPartConstruct *cap{captureFirst ? ec1 : ec2};
+ return std::make_pair(upd, cap);
}
+ assert(!updateFirst && !captureFirst);
+ errorNeitherWorks();
+ return std::make_pair(nullptr, nullptr);
+ }
+ }};
+
+ if (det != 0 || (cbu1 && cbu2 && cbc1 && cbc2)) {
+ return makeSelectionFromDet(det);
+ }
+ assert(det == 0 && "Prior checks should have covered det != 0");
+
+ // If neither of the statements is an RMW update, it could still be a
+ // "write" update. Pretty much any assignment can be a write update, so
+ // recompute det with cbu1 = cbu2 = true.
+ if (int writeDet{int(cbc2) - int(cbc1)}; writeDet || (cbc1 && cbc2)) {
+ return makeSelectionFromDet(writeDet);
+ }
+
+ // It's only errors from here on.
+
+ if (!cbu1 && !cbu2 && !cbc1 && !cbc2) {
+ errorNeitherWorks();
+ return std::make_pair(nullptr, nullptr);
+ }
+
+ // The remaining cases are that
+ // - no candidate for update, or for capture,
+ // - one of the assigments cannot be anything.
+
+ if (!cbu1 && !cbu2) {
+ context_.Say(source,
+ "In ATOMIC UPDATE operation with CAPTURE neither statement could be the update"_err_en_US);
+ return std::make_pair(nullptr, nullptr);
+ } else if (!cbc1 && !cbc2) {
+ context_.Say(source,
+ "In ATOMIC UPDATE operation with CAPTURE neither statement could be the capture"_err_en_US);
+ return std::make_pair(nullptr, nullptr);
+ }
+
+ if ((!cbu1 && !cbc1) || (!cbu2 && !cbc2)) {
+ auto &src = (!cbu1 && !cbc1) ? act1.source : act2.source;
+ context_.Say(src,
+ "In ATOMIC UPDATE operation with CAPTURE the statement could be neither the update nor the capture"_err_en_US);
+ return std::make_pair(nullptr, nullptr);
+ }
+
+ // All cases should have been covered.
+ llvm_unreachable("Unchecked condition");
+}
+
+void OmpStructureChecker::CheckAtomicCaptureAssignment(
+ const evaluate::Assignment &capture, const SomeExpr &atom,
+ parser::CharBlock source) {
+ auto [lsrc, rsrc]{SplitAssignmentSource(source)};
+ const SomeExpr &cap{capture.lhs};
+
+ if (!IsVarOrFunctionRef(atom)) {
+ ErrorShouldBeVariable(atom, rsrc);
+ } else {
+ CheckAtomicVariable(atom, rsrc);
+ // This part should have been checked prior to calling this function.
+ assert(*GetConvertInput(capture.rhs) == atom &&
+ "This cannot be a capture assignment");
+ CheckStorageOverlap(atom, {cap}, source);
+ }
+}
+
+void OmpStructureChecker::CheckAtomicReadAssignment(
+ const evaluate::Assignment &read, parser::CharBlock source) {
+ auto [lsrc, rsrc]{SplitAssignmentSource(source)};
+
+ if (auto maybe{GetConvertInput(read.rhs)}) {
+ const SomeExpr &atom{*maybe};
+
+ if (!IsVarOrFunctionRef(atom)) {
+ ErrorShouldBeVariable(atom, rsrc);
} else {
- context_.Say(stmt1Expr.source,
- "Invalid ATOMIC CAPTURE construct statements. Expected one of [update-stmt, capture-stmt], [capture-stmt, update-stmt], or [capture-stmt, write-stmt]"_err_en_US);
+ CheckAtomicVariable(atom, rsrc);
+ CheckStorageOverlap(atom, {read.lhs}, source);
}
+ } else {
+ ErrorShouldBeVariable(read.rhs, rsrc);
}
}
-void OmpStructureChecker::CheckAtomicMemoryOrderClause(
- const parser::OmpAtomicClauseList *leftHandClauseList,
- const parser::OmpAtomicClauseList *rightHandClauseList) {
- int numMemoryOrderClause{0};
- int numFailClause{0};
- auto checkForValidMemoryOrderClause = [&](const parser::OmpAtomicClauseList
- *clauseList) {
- for (const auto &clause : clauseList->v) {
- if (std::get_if<parser::OmpFailClause>(&clause.u)) {
- numFailClause++;
- if (numFailClause > 1) {
- context_.Say(clause.source,
- "More than one FAIL clause not allowed on OpenMP ATOMIC construct"_err_en_US);
- return;
+void OmpStructureChecker::CheckAtomicWriteAssignment(
+ const evaluate::Assignment &write, parser::CharBlock source) {
+ // [6.0:190:13-15]
+ // A write structured block is write-statement, a write statement that has
+ // one of the following forms:
+ // x = expr
+ // x => expr
+ auto [lsrc, rsrc]{SplitAssignmentSource(source)};
+ const SomeExpr &atom{write.lhs};
+
+ if (!IsVarOrFunctionRef(atom)) {
+ ErrorShouldBeVariable(atom, rsrc);
+ } else {
+ CheckAtomicVariable(atom, lsrc);
+ CheckStorageOverlap(atom, {write.rhs}, source);
+ }
+}
+
+void OmpStructureChecker::CheckAtomicUpdateAssignment(
+ const evaluate::Assignment &update, parser::CharBlock source) {
+ // [6.0:191:1-7]
+ // An update structured block is update-statement, an update statement
+ // that has one of the following forms:
+ // x = x operator expr
+ // x = expr operator x
+ // x = intrinsic-procedure-name (x)
+ // x = intrinsic-procedure-name (x, expr-list)
+ // x = intrinsic-procedure-name (expr-list, x)
+ auto [lsrc, rsrc]{SplitAssignmentSource(source)};
+ const SomeExpr &atom{update.lhs};
+
+ if (!IsVarOrFunctionRef(atom)) {
+ ErrorShouldBeVariable(atom, rsrc);
+ // Skip other checks.
+ return;
+ }
+
+ CheckAtomicVariable(atom, lsrc);
+
+ std::pair<operation::Operator, std::vector<SomeExpr>> top{
+ operation::Operator::Unknown, {}};
+ if (auto &&maybeInput{GetConvertInput(update.rhs)}) {
+ top = GetTopLevelOperation(*maybeInput);
+ }
+ switch (top.first) {
+ case operation::Operator::Add:
+ case operation::Operator::Sub:
+ case operation::Operator::Mul:
+ case operation::Operator::Div:
+ case operation::Operator::And:
+ case operation::Operator::Or:
+ case operation::Operator::Eqv:
+ case operation::Operator::Neqv:
+ case operation::Operator::Min:
+ case operation::Operator::Max:
+ case operation::Operator::Identity:
+ break;
+ case operation::Operator::Call:
+ context_.Say(source,
+ "A call to this function is not a valid ATOMIC UPDATE operation"_err_en_US);
+ return;
+ case operation::Operator::Convert:
+ context_.Say(source,
+ "An implicit or explicit type conversion is not a valid ATOMIC UPDATE operation"_err_en_US);
+ return;
+ case operation::Operator::Intrinsic:
+ context_.Say(source,
+ "This intrinsic function is not a valid ATOMIC UPDATE operation"_err_en_US);
+ return;
+ case operation::Operator::Constant:
+ case operation::Operator::Unknown:
+ context_.Say(
+ source, "This is not a valid ATOMIC UPDATE operation"_err_en_US);
+ return;
+ default:
+ assert(
+ top.first != operation::Operator::Identity && "Handle this separately");
+ context_.Say(source,
+ "The %s operator is not a valid ATOMIC UPDATE operation"_err_en_US,
+ operation::ToString(top.first));
+ return;
+ }
+ // Check if `atom` occurs exactly once in the argument list.
+ std::vector<SomeExpr> nonAtom;
+ auto unique{[&]() { // -> iterator
+ auto found{top.second.end()};
+ for (auto i{top.second.begin()}, e{top.second.end()}; i != e; ++i) {
+ if (IsSameOrConvertOf(*i, atom)) {
+ if (found != top.second.end()) {
+ return top.second.end();
}
+ found = i;
} else {
- if (std::get_if<parser::OmpMemoryOrderClause>(&clause.u)) {
- numMemoryOrderClause++;
- if (numMemoryOrderClause > 1) {
- context_.Say(clause.source,
- "More than one memory order clause not allowed on OpenMP ATOMIC construct"_err_en_US);
- return;
- }
+ nonAtom.push_back(*i);
+ }
+ }
+ return found;
+ }()};
+
+ if (unique == top.second.end()) {
+ if (top.first == operation::Operator::Identity) {
+ // This is "x = y".
+ context_.Say(rsrc,
+ "The atomic variable %s should appear as an argument in the update operation"_err_en_US,
+ atom.AsFortran());
+ } else {
+ assert(top.first != operation::Operator::Identity &&
+ "Handle this separately");
+ context_.Say(rsrc,
+ "The atomic variable %s should occur exactly once among the arguments of the top-level %s operator"_err_en_US,
+ atom.AsFortran(), operation::ToString(top.first));
+ }
+ } else {
+ CheckStorageOverlap(atom, nonAtom, source);
+ }
+}
+
+void OmpStructureChecker::CheckAtomicConditionalUpdateAssignment(
+ const SomeExpr &cond, parser::CharBlock condSource,
+ const evaluate::Assignment &assign, parser::CharBlock assignSource) {
+ auto [alsrc, arsrc]{SplitAssignmentSource(assignSource)};
+ const SomeExpr &atom{assign.lhs};
+
+ if (!IsVarOrFunctionRef(atom)) {
+ ErrorShouldBeVariable(atom, arsrc);
+ // Skip other checks.
+ return;
+ }
+
+ CheckAtomicVariable(atom, alsrc);
+
+ auto top{GetTopLevelOperation(cond)};
+ // Missing arguments to operations would have been diagnosed by now.
+
+ switch (top.first) {
+ case operation::Operator::Associated:
+ if (atom != top.second.front()) {
+ context_.Say(assignSource,
+ "The pointer argument to ASSOCIATED must be same as the target of the assignment"_err_en_US);
+ }
+ break;
+ // x equalop e | e equalop x (allowing "e equalop x" is an extension)
+ case operation::Operator::Eq:
+ case operation::Operator::Eqv:
+ // x ordop expr | expr ordop x
+ case operation::Operator::Lt:
+ case operation::Operator::Gt: {
+ const SomeExpr &arg0{top.second[0]};
+ const SomeExpr &arg1{top.second[1]};
+ if (IsSameOrConvertOf(arg0, atom)) {
+ CheckStorageOverlap(atom, {arg1}, condSource);
+ } else if (IsSameOrConvertOf(arg1, atom)) {
+ CheckStorageOverlap(atom, {arg0}, condSource);
+ } else {
+ assert(top.first != operation::Operator::Identity &&
+ "Handle this separately");
+ context_.Say(assignSource,
+ "An argument of the %s operator should be the target of the assignment"_err_en_US,
+ operation::ToString(top.first));
+ }
+ break;
+ }
+ case operation::Operator::Identity:
+ case operation::Operator::True:
+ case operation::Operator::False:
+ break;
+ default:
+ assert(
+ top.first != operation::Operator::Identity && "Handle this separately");
+ context_.Say(condSource,
+ "The %s operator is not a valid condition for ATOMIC operation"_err_en_US,
+ operation::ToString(top.first));
+ break;
+ }
+}
+
+void OmpStructureChecker::CheckAtomicConditionalUpdateStmt(
+ const AnalyzedCondStmt &update, parser::CharBlock source) {
+ // The condition/statements must be:
+ // - cond: x equalop e ift: x = d iff: -
+ // - cond: x ordop expr ift: x = expr iff: - (+ commute ordop)
+ // - cond: associated(x) ift: x => expr iff: -
+ // - cond: associated(x, e) ift: x => expr iff: -
+
+ // The if-true statement must be present, and must be an assignment.
+ auto maybeAssign{GetEvaluateAssignment(update.ift.stmt)};
+ if (!maybeAssign) {
+ if (update.ift.stmt && !IsAssignment(update.ift.stmt)) {
+ context_.Say(update.ift.source,
+ "In ATOMIC UPDATE COMPARE the update statement should be an assignment"_err_en_US);
+ } else {
+ context_.Say(
+ source, "Invalid body of ATOMIC UPDATE COMPARE operation"_err_en_US);
+ }
+ return;
+ }
+ const evaluate::Assignment assign{*maybeAssign};
+ const SomeExpr &atom{assign.lhs};
+
+ CheckAtomicConditionalUpdateAssignment(
+ update.cond, update.source, assign, update.ift.source);
+
+ CheckStorageOverlap(atom, {assign.rhs}, update.ift.source);
+
+ if (update.iff) {
+ context_.Say(update.iff.source,
+ "In ATOMIC UPDATE COMPARE the update statement should not have an ELSE branch"_err_en_US);
+ }
+}
+
+void OmpStructureChecker::CheckAtomicUpdateOnly(
+ const parser::OpenMPAtomicConstruct &x, const parser::Block &body,
+ parser::CharBlock source) {
+ if (body.size() == 1) {
+ SourcedActionStmt action{GetActionStmt(&body.front())};
+ if (auto maybeUpdate{GetEvaluateAssignment(action.stmt)}) {
+ const SomeExpr &atom{maybeUpdate->lhs};
+ CheckAtomicUpdateAssignment(*maybeUpdate, action.source);
+
+ using Analysis = parser::OpenMPAtomicConstruct::Analysis;
+ x.analysis = MakeAtomicAnalysis(atom, std::nullopt,
+ MakeAtomicAnalysisOp(Analysis::Update, maybeUpdate),
+ MakeAtomicAnalysisOp(Analysis::None));
+ } else if (!IsAssignment(action.stmt)) {
+ context_.Say(
+ source, "ATOMIC UPDATE operation should be an assignment"_err_en_US);
+ }
+ } else {
+ context_.Say(x.source,
+ "ATOMIC UPDATE operation should have a single statement"_err_en_US);
+ }
+}
+
+void OmpStructureChecker::CheckAtomicConditionalUpdate(
+ const parser::OpenMPAtomicConstruct &x, const parser::Block &body,
+ parser::CharBlock source) {
+ // Allowable forms are (single-statement):
+ // - if ...
+ // - x = (... ? ... : x)
+ // and two-statement:
+ // - r = cond ; if (r) ...
+
+ const parser::ExecutionPartConstruct *ust{nullptr}; // update
+ const parser::ExecutionPartConstruct *cst{nullptr}; // condition
+
+ if (body.size() == 1) {
+ ust = &body.front();
+ } else if (body.size() == 2) {
+ cst = &body.front();
+ ust = &body.back();
+ } else {
+ context_.Say(source,
+ "ATOMIC UPDATE COMPARE operation should contain one or two statements"_err_en_US);
+ return;
+ }
+
+ // Flang doesn't support conditional-expr yet, so all update statements
+ // are if-statements.
+
+ // IfStmt: if (...) ...
+ // IfConstruct: if (...) then ... endif
+ auto maybeUpdate{AnalyzeConditionalStmt(ust)};
+ if (!maybeUpdate) {
+ context_.Say(source,
+ "In ATOMIC UPDATE COMPARE the update statement should be a conditional statement"_err_en_US);
+ return;
+ }
+
+ AnalyzedCondStmt &update{*maybeUpdate};
+
+ if (SourcedActionStmt action{GetActionStmt(cst)}) {
+ // The "condition" statement must be `r = cond`.
+ if (auto maybeCond{GetEvaluateAssignment(action.stmt)}) {
+ if (maybeCond->lhs != update.cond) {
+ context_.Say(update.source,
+ "In ATOMIC UPDATE COMPARE the conditional statement must use %s as the condition"_err_en_US,
+ maybeCond->lhs.AsFortran());
+ } else {
+ // If it's "r = ...; if (r) ..." then put the original condition
+ // in `update`.
+ update.cond = maybeCond->rhs;
+ }
+ } else {
+ context_.Say(action.source,
+ "In ATOMIC UPDATE COMPARE with two statements the first statement should compute the condition"_err_en_US);
+ }
+ }
+
+ evaluate::Assignment assign{*GetEvaluateAssignment(update.ift.stmt)};
+
+ CheckAtomicConditionalUpdateStmt(update, source);
+ if (IsCheckForAssociated(update.cond)) {
+ if (!IsPointerAssignment(assign)) {
+ context_.Say(source,
+ "The assignment should be a pointer-assignment when the condition is ASSOCIATED"_err_en_US);
+ }
+ } else {
+ if (IsPointerAssignment(assign)) {
+ context_.Say(source,
+ "The assignment cannot be a pointer-assignment except when the condition is ASSOCIATED"_err_en_US);
+ }
+ }
+
+ using Analysis = parser::OpenMPAtomicConstruct::Analysis;
+ x.analysis = MakeAtomicAnalysis(assign.lhs, update.cond,
+ MakeAtomicAnalysisOp(Analysis::Update | Analysis::IfTrue, assign),
+ MakeAtomicAnalysisOp(Analysis::None));
+}
+
+void OmpStructureChecker::CheckAtomicUpdateCapture(
+ const parser::OpenMPAtomicConstruct &x, const parser::Block &body,
+ parser::CharBlock source) {
+ if (body.size() != 2) {
+ context_.Say(source,
+ "ATOMIC UPDATE operation with CAPTURE should contain two statements"_err_en_US);
+ return;
+ }
+
+ auto [uec, cec]{CheckUpdateCapture(&body.front(), &body.back(), source)};
+ if (!uec || !cec) {
+ // Diagnostics already emitted.
+ return;
+ }
+ SourcedActionStmt uact{GetActionStmt(uec)};
+ SourcedActionStmt cact{GetActionStmt(cec)};
+ // The "dereferences" of std::optional are guaranteed to be valid after
+ // CheckUpdateCapture.
+ evaluate::Assignment update{*GetEvaluateAssignment(uact.stmt)};
+ evaluate::Assignment capture{*GetEvaluateAssignment(cact.stmt)};
+
+ const SomeExpr &atom{update.lhs};
+
+ using Analysis = parser::OpenMPAtomicConstruct::Analysis;
+ int action;
+
+ if (IsMaybeAtomicWrite(update)) {
+ action = Analysis::Write;
+ CheckAtomicWriteAssignment(update, uact.source);
+ } else {
+ action = Analysis::Update;
+ CheckAtomicUpdateAssignment(update, uact.source);
+ }
+ CheckAtomicCaptureAssignment(capture, atom, cact.source);
+
+ if (IsPointerAssignment(update) != IsPointerAssignment(capture)) {
+ context_.Say(cact.source,
+ "The update and capture assignments should both be pointer-assignments or both be non-pointer-assignments"_err_en_US);
+ return;
+ }
+
+ if (GetActionStmt(&body.front()).stmt == uact.stmt) {
+ x.analysis = MakeAtomicAnalysis(atom, std::nullopt,
+ MakeAtomicAnalysisOp(action, update),
+ MakeAtomicAnalysisOp(Analysis::Read, capture));
+ } else {
+ x.analysis = MakeAtomicAnalysis(atom, std::nullopt,
+ MakeAtomicAnalysisOp(Analysis::Read, capture),
+ MakeAtomicAnalysisOp(action, update));
+ }
+}
+
+void OmpStructureChecker::CheckAtomicConditionalUpdateCapture(
+ const parser::OpenMPAtomicConstruct &x, const parser::Block &body,
+ parser::CharBlock source) {
+ // There are two
diff erent variants of this:
+ // (1) conditional-update and capture separately:
+ // This form only allows single-statement updates, i.e. the update
+ // form "r = cond; if (r) ..." is not allowed.
+ // (2) conditional-update combined with capture in a single statement:
+ // This form does allow the condition to be calculated separately,
+ // i.e. "r = cond; if (r) ...".
+ // Regardless of what form it is, the actual update assignment is a
+ // proper write, i.e. "x = d", where d does not depend on x.
+
+ AnalyzedCondStmt update;
+ SourcedActionStmt capture;
+ bool captureAlways{true}, captureFirst{true};
+
+ auto extractCapture{[&]() {
+ capture = update.iff;
+ captureAlways = false;
+ update.iff = SourcedActionStmt{};
+ }};
+
+ auto classifyNonUpdate{[&](const SourcedActionStmt &action) {
+ // The non-update statement is either "r = cond" or the capture.
+ if (auto maybeAssign{GetEvaluateAssignment(action.stmt)}) {
+ if (update.cond == maybeAssign->lhs) {
+ // If this is "r = cond; if (r) ...", then update the condition.
+ update.cond = maybeAssign->rhs;
+ update.source = action.source;
+ // In this form, the update and the capture are combined into
+ // an IF-THEN-ELSE statement.
+ extractCapture();
+ } else {
+ // Assume this is the capture-statement.
+ capture = action;
+ }
+ }
+ }};
+
+ if (body.size() == 2) {
+ // This could be
+ // - capture; conditional-update (in any order), or
+ // - r = cond; if (r) capture-update
+ const parser::ExecutionPartConstruct *st1{&body.front()};
+ const parser::ExecutionPartConstruct *st2{&body.back()};
+ // In either case, the conditional statement can be analyzed by
+ // AnalyzeConditionalStmt, whereas the other statement cannot.
+ if (auto maybeUpdate1{AnalyzeConditionalStmt(st1)}) {
+ update = *maybeUpdate1;
+ classifyNonUpdate(GetActionStmt(st2));
+ captureFirst = false;
+ } else if (auto maybeUpdate2{AnalyzeConditionalStmt(st2)}) {
+ update = *maybeUpdate2;
+ classifyNonUpdate(GetActionStmt(st1));
+ } else {
+ // None of the statements are conditional, this rules out the
+ // "r = cond; if (r) ..." and the "capture + conditional-update"
+ // variants. This could still be capture + write (which is classified
+ // as conditional-update-capture in the spec).
+ auto [uec, cec]{CheckUpdateCapture(st1, st2, source)};
+ if (!uec || !cec) {
+ // Diagnostics already emitted.
+ return;
+ }
+ SourcedActionStmt uact{GetActionStmt(uec)};
+ SourcedActionStmt cact{GetActionStmt(cec)};
+ update.ift = uact;
+ capture = cact;
+ if (uec == st1) {
+ captureFirst = false;
+ }
+ }
+ } else if (body.size() == 1) {
+ if (auto maybeUpdate{AnalyzeConditionalStmt(&body.front())}) {
+ update = *maybeUpdate;
+ // This is the form with update and capture combined into an IF-THEN-ELSE
+ // statement. The capture-statement is always the ELSE branch.
+ extractCapture();
+ } else {
+ goto invalid;
+ }
+ } else {
+ context_.Say(source,
+ "ATOMIC UPDATE COMPARE CAPTURE operation should contain one or two statements"_err_en_US);
+ return;
+ invalid:
+ context_.Say(source,
+ "Invalid body of ATOMIC UPDATE COMPARE CAPTURE operation"_err_en_US);
+ return;
+ }
+
+ // The update must have a form `x = d` or `x => d`.
+ if (auto maybeWrite{GetEvaluateAssignment(update.ift.stmt)}) {
+ const SomeExpr &atom{maybeWrite->lhs};
+ CheckAtomicWriteAssignment(*maybeWrite, update.ift.source);
+ if (auto maybeCapture{GetEvaluateAssignment(capture.stmt)}) {
+ CheckAtomicCaptureAssignment(*maybeCapture, atom, capture.source);
+
+ if (IsPointerAssignment(*maybeWrite) !=
+ IsPointerAssignment(*maybeCapture)) {
+ context_.Say(capture.source,
+ "The update and capture assignments should both be pointer-assignments or both be non-pointer-assignments"_err_en_US);
+ return;
+ }
+ } else {
+ if (!IsAssignment(capture.stmt)) {
+ context_.Say(capture.source,
+ "In ATOMIC UPDATE COMPARE CAPTURE the capture statement should be an assignment"_err_en_US);
+ }
+ return;
+ }
+ } else {
+ if (!IsAssignment(update.ift.stmt)) {
+ context_.Say(update.ift.source,
+ "In ATOMIC UPDATE COMPARE CAPTURE the update statement should be an assignment"_err_en_US);
+ }
+ return;
+ }
+
+ // update.iff should be empty here, the capture statement should be
+ // stored in "capture".
+
+ // Fill out the analysis in the AST node.
+ using Analysis = parser::OpenMPAtomicConstruct::Analysis;
+ bool condUnused{std::visit(
+ [](auto &&s) {
+ using BareS = llvm::remove_cvref_t<decltype(s)>;
+ if constexpr (std::is_same_v<BareS, evaluate::NullPointer>) {
+ return true;
+ } else {
+ return false;
}
+ },
+ update.cond.u)};
+
+ int updateWhen{!condUnused ? Analysis::IfTrue : 0};
+ int captureWhen{!captureAlways ? Analysis::IfFalse : 0};
+
+ evaluate::Assignment updAssign{*GetEvaluateAssignment(update.ift.stmt)};
+ evaluate::Assignment capAssign{*GetEvaluateAssignment(capture.stmt)};
+
+ if (captureFirst) {
+ x.analysis = MakeAtomicAnalysis(updAssign.lhs, update.cond,
+ MakeAtomicAnalysisOp(Analysis::Read | captureWhen, capAssign),
+ MakeAtomicAnalysisOp(Analysis::Write | updateWhen, updAssign));
+ } else {
+ x.analysis = MakeAtomicAnalysis(updAssign.lhs, update.cond,
+ MakeAtomicAnalysisOp(Analysis::Write | updateWhen, updAssign),
+ MakeAtomicAnalysisOp(Analysis::Read | captureWhen, capAssign));
+ }
+}
+
+void OmpStructureChecker::CheckAtomicRead(
+ const parser::OpenMPAtomicConstruct &x) {
+ // [6.0:190:5-7]
+ // A read structured block is read-statement, a read statement that has one
+ // of the following forms:
+ // v = x
+ // v => x
+ auto &dirSpec{std::get<parser::OmpDirectiveSpecification>(x.t)};
+ auto &block{std::get<parser::Block>(x.t)};
+
+ // Read cannot be conditional or have a capture statement.
+ if (x.IsCompare() || x.IsCapture()) {
+ context_.Say(dirSpec.source,
+ "ATOMIC READ cannot have COMPARE or CAPTURE clauses"_err_en_US);
+ return;
+ }
+
+ const parser::Block &body{GetInnermostExecPart(block)};
+
+ if (body.size() == 1) {
+ SourcedActionStmt action{GetActionStmt(&body.front())};
+ if (auto maybeRead{GetEvaluateAssignment(action.stmt)}) {
+ CheckAtomicReadAssignment(*maybeRead, action.source);
+
+ if (auto maybe{GetConvertInput(maybeRead->rhs)}) {
+ const SomeExpr &atom{*maybe};
+ using Analysis = parser::OpenMPAtomicConstruct::Analysis;
+ x.analysis = MakeAtomicAnalysis(atom, std::nullopt,
+ MakeAtomicAnalysisOp(Analysis::Read, maybeRead),
+ MakeAtomicAnalysisOp(Analysis::None));
}
+ } else if (!IsAssignment(action.stmt)) {
+ context_.Say(
+ x.source, "ATOMIC READ operation should be an assignment"_err_en_US);
}
- };
- if (leftHandClauseList) {
- checkForValidMemoryOrderClause(leftHandClauseList);
+ } else {
+ context_.Say(x.source,
+ "ATOMIC READ operation should have a single statement"_err_en_US);
+ }
+}
+
+void OmpStructureChecker::CheckAtomicWrite(
+ const parser::OpenMPAtomicConstruct &x) {
+ auto &dirSpec{std::get<parser::OmpDirectiveSpecification>(x.t)};
+ auto &block{std::get<parser::Block>(x.t)};
+
+ // Write cannot be conditional or have a capture statement.
+ if (x.IsCompare() || x.IsCapture()) {
+ context_.Say(dirSpec.source,
+ "ATOMIC WRITE cannot have COMPARE or CAPTURE clauses"_err_en_US);
+ return;
}
- if (rightHandClauseList) {
- checkForValidMemoryOrderClause(rightHandClauseList);
+
+ const parser::Block &body{GetInnermostExecPart(block)};
+
+ if (body.size() == 1) {
+ SourcedActionStmt action{GetActionStmt(&body.front())};
+ if (auto maybeWrite{GetEvaluateAssignment(action.stmt)}) {
+ const SomeExpr &atom{maybeWrite->lhs};
+ CheckAtomicWriteAssignment(*maybeWrite, action.source);
+
+ using Analysis = parser::OpenMPAtomicConstruct::Analysis;
+ x.analysis = MakeAtomicAnalysis(atom, std::nullopt,
+ MakeAtomicAnalysisOp(Analysis::Write, maybeWrite),
+ MakeAtomicAnalysisOp(Analysis::None));
+ } else if (!IsAssignment(action.stmt)) {
+ context_.Say(
+ x.source, "ATOMIC WRITE operation should be an assignment"_err_en_US);
+ }
+ } else {
+ context_.Say(x.source,
+ "ATOMIC WRITE operation should have a single statement"_err_en_US);
+ }
+}
+
+void OmpStructureChecker::CheckAtomicUpdate(
+ const parser::OpenMPAtomicConstruct &x) {
+ auto &block{std::get<parser::Block>(x.t)};
+
+ bool isConditional{x.IsCompare()};
+ bool isCapture{x.IsCapture()};
+ const parser::Block &body{GetInnermostExecPart(block)};
+
+ if (isConditional && isCapture) {
+ CheckAtomicConditionalUpdateCapture(x, body, x.source);
+ } else if (isConditional) {
+ CheckAtomicConditionalUpdate(x, body, x.source);
+ } else if (isCapture) {
+ CheckAtomicUpdateCapture(x, body, x.source);
+ } else { // update-only
+ CheckAtomicUpdateOnly(x, body, x.source);
}
}
void OmpStructureChecker::Enter(const parser::OpenMPAtomicConstruct &x) {
- common::visit(
- common::visitors{
- [&](const parser::OmpAtomic &atomicConstruct) {
- const auto &dir{std::get<parser::Verbatim>(atomicConstruct.t)};
- PushContextAndClauseSets(
- dir.source, llvm::omp::Directive::OMPD_atomic);
- CheckAtomicUpdateStmt(
- std::get<parser::Statement<parser::AssignmentStmt>>(
- atomicConstruct.t)
- .statement);
- CheckAtomicMemoryOrderClause(
- &std::get<parser::OmpAtomicClauseList>(atomicConstruct.t),
- nullptr);
- CheckHintClause<const parser::OmpAtomicClauseList>(
- &std::get<parser::OmpAtomicClauseList>(atomicConstruct.t),
- nullptr, "ATOMIC");
- },
- [&](const parser::OmpAtomicUpdate &atomicUpdate) {
- const auto &dir{std::get<parser::Verbatim>(atomicUpdate.t)};
- PushContextAndClauseSets(
- dir.source, llvm::omp::Directive::OMPD_atomic);
- CheckAtomicUpdateStmt(
- std::get<parser::Statement<parser::AssignmentStmt>>(
- atomicUpdate.t)
- .statement);
- CheckAtomicMemoryOrderClause(
- &std::get<0>(atomicUpdate.t), &std::get<2>(atomicUpdate.t));
- CheckHintClause<const parser::OmpAtomicClauseList>(
- &std::get<0>(atomicUpdate.t), &std::get<2>(atomicUpdate.t),
- "UPDATE");
- },
- [&](const parser::OmpAtomicRead &atomicRead) {
- const auto &dir{std::get<parser::Verbatim>(atomicRead.t)};
- PushContextAndClauseSets(
- dir.source, llvm::omp::Directive::OMPD_atomic);
- CheckAtomicMemoryOrderClause(
- &std::get<0>(atomicRead.t), &std::get<2>(atomicRead.t));
- CheckHintClause<const parser::OmpAtomicClauseList>(
- &std::get<0>(atomicRead.t), &std::get<2>(atomicRead.t), "READ");
- CheckAtomicCaptureStmt(
- std::get<parser::Statement<parser::AssignmentStmt>>(
- atomicRead.t)
- .statement);
- },
- [&](const parser::OmpAtomicWrite &atomicWrite) {
- const auto &dir{std::get<parser::Verbatim>(atomicWrite.t)};
- PushContextAndClauseSets(
- dir.source, llvm::omp::Directive::OMPD_atomic);
- CheckAtomicMemoryOrderClause(
- &std::get<0>(atomicWrite.t), &std::get<2>(atomicWrite.t));
- CheckHintClause<const parser::OmpAtomicClauseList>(
- &std::get<0>(atomicWrite.t), &std::get<2>(atomicWrite.t),
- "WRITE");
- CheckAtomicWriteStmt(
- std::get<parser::Statement<parser::AssignmentStmt>>(
- atomicWrite.t)
- .statement);
- },
- [&](const parser::OmpAtomicCapture &atomicCapture) {
- const auto &dir{std::get<parser::Verbatim>(atomicCapture.t)};
- PushContextAndClauseSets(
- dir.source, llvm::omp::Directive::OMPD_atomic);
- CheckAtomicMemoryOrderClause(
- &std::get<0>(atomicCapture.t), &std::get<2>(atomicCapture.t));
- CheckHintClause<const parser::OmpAtomicClauseList>(
- &std::get<0>(atomicCapture.t), &std::get<2>(atomicCapture.t),
- "CAPTURE");
- CheckAtomicCaptureConstruct(atomicCapture);
- },
- [&](const parser::OmpAtomicCompare &atomicCompare) {
- const auto &dir{std::get<parser::Verbatim>(atomicCompare.t)};
- PushContextAndClauseSets(
- dir.source, llvm::omp::Directive::OMPD_atomic);
- CheckAtomicMemoryOrderClause(
- &std::get<0>(atomicCompare.t), &std::get<2>(atomicCompare.t));
- CheckHintClause<const parser::OmpAtomicClauseList>(
- &std::get<0>(atomicCompare.t), &std::get<2>(atomicCompare.t),
- "CAPTURE");
- CheckAtomicCompareConstruct(atomicCompare);
- },
- },
- x.u);
+ // All of the following groups have the "exclusive" property, i.e. at
+ // most one clause from each group is allowed.
+ // The exclusivity-checking code should eventually be unified for all
+ // clauses, with clause groups defined in OMP.td.
+ std::array atomic{llvm::omp::Clause::OMPC_read,
+ llvm::omp::Clause::OMPC_update, llvm::omp::Clause::OMPC_write};
+ std::array memoryOrder{llvm::omp::Clause::OMPC_acq_rel,
+ llvm::omp::Clause::OMPC_acquire, llvm::omp::Clause::OMPC_relaxed,
+ llvm::omp::Clause::OMPC_release, llvm::omp::Clause::OMPC_seq_cst};
+
+ auto checkExclusive{[&](llvm::ArrayRef<llvm::omp::Clause> group,
+ std::string_view name,
+ const parser::OmpClauseList &clauses) {
+ const parser::OmpClause *present{nullptr};
+ for (const parser::OmpClause &clause : clauses.v) {
+ llvm::omp::Clause id{clause.Id()};
+ if (!llvm::is_contained(group, id)) {
+ continue;
+ }
+ if (present == nullptr) {
+ present = &clause;
+ continue;
+ } else if (id == present->Id()) {
+ // Ignore repetitions of the same clause, those will be diagnosed
+ // separately.
+ continue;
+ }
+ parser::MessageFormattedText txt(
+ "At most one clause from the '%s' group is allowed on ATOMIC construct"_err_en_US,
+ name.data());
+ parser::Message message(clause.source, txt);
+ message.Attach(present->source,
+ "Previous clause from this group provided here"_en_US);
+ context_.Say(std::move(message));
+ return;
+ }
+ }};
+
+ auto &dirSpec{std::get<parser::OmpDirectiveSpecification>(x.t)};
+ auto &dir{std::get<parser::OmpDirectiveName>(dirSpec.t)};
+ PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_atomic);
+ llvm::omp::Clause kind{x.GetKind()};
+
+ checkExclusive(atomic, "atomic", dirSpec.Clauses());
+ checkExclusive(memoryOrder, "memory-order", dirSpec.Clauses());
+
+ switch (kind) {
+ case llvm::omp::Clause::OMPC_read:
+ CheckAtomicRead(x);
+ break;
+ case llvm::omp::Clause::OMPC_write:
+ CheckAtomicWrite(x);
+ break;
+ case llvm::omp::Clause::OMPC_update:
+ CheckAtomicUpdate(x);
+ break;
+ default:
+ break;
+ }
}
void OmpStructureChecker::Leave(const parser::OpenMPAtomicConstruct &) {
@@ -3332,7 +4335,6 @@ CHECK_SIMPLE_CLAUSE(Final, OMPC_final)
CHECK_SIMPLE_CLAUSE(Flush, OMPC_flush)
CHECK_SIMPLE_CLAUSE(Full, OMPC_full)
CHECK_SIMPLE_CLAUSE(Grainsize, OMPC_grainsize)
-CHECK_SIMPLE_CLAUSE(Hint, OMPC_hint)
CHECK_SIMPLE_CLAUSE(Holds, OMPC_holds)
CHECK_SIMPLE_CLAUSE(Inclusive, OMPC_inclusive)
CHECK_SIMPLE_CLAUSE(Initializer, OMPC_initializer)
@@ -4014,40 +5016,6 @@ void OmpStructureChecker::CheckIsLoopIvPartOfClause(
}
}
}
-// Following clauses have a separate node in parse-tree.h.
-// Atomic-clause
-CHECK_SIMPLE_PARSER_CLAUSE(OmpAtomicRead, OMPC_read)
-CHECK_SIMPLE_PARSER_CLAUSE(OmpAtomicWrite, OMPC_write)
-CHECK_SIMPLE_PARSER_CLAUSE(OmpAtomicUpdate, OMPC_update)
-CHECK_SIMPLE_PARSER_CLAUSE(OmpAtomicCapture, OMPC_capture)
-
-void OmpStructureChecker::Leave(const parser::OmpAtomicRead &) {
- CheckNotAllowedIfClause(llvm::omp::Clause::OMPC_read,
- {llvm::omp::Clause::OMPC_release, llvm::omp::Clause::OMPC_acq_rel});
-}
-
-void OmpStructureChecker::Leave(const parser::OmpAtomicWrite &) {
- CheckNotAllowedIfClause(llvm::omp::Clause::OMPC_write,
- {llvm::omp::Clause::OMPC_acquire, llvm::omp::Clause::OMPC_acq_rel});
-}
-
-void OmpStructureChecker::Leave(const parser::OmpAtomicUpdate &) {
- CheckNotAllowedIfClause(llvm::omp::Clause::OMPC_update,
- {llvm::omp::Clause::OMPC_acquire, llvm::omp::Clause::OMPC_acq_rel});
-}
-
-// OmpAtomic node represents atomic directive without atomic-clause.
-// atomic-clause - READ,WRITE,UPDATE,CAPTURE.
-void OmpStructureChecker::Leave(const parser::OmpAtomic &) {
- if (const auto *clause{FindClause(llvm::omp::Clause::OMPC_acquire)}) {
- context_.Say(clause->source,
- "Clause ACQUIRE is not allowed on the ATOMIC directive"_err_en_US);
- }
- if (const auto *clause{FindClause(llvm::omp::Clause::OMPC_acq_rel)}) {
- context_.Say(clause->source,
- "Clause ACQ_REL is not allowed on the ATOMIC directive"_err_en_US);
- }
-}
// Restrictions specific to each clause are implemented apart from the
// generalized restrictions.
@@ -5026,21 +5994,6 @@ void OmpStructureChecker::Leave(const parser::OmpContextSelector &) {
ExitDirectiveNest(ContextSelectorNest);
}
-std::optional<evaluate::DynamicType> OmpStructureChecker::GetDynamicType(
- const common::Indirection<parser::Expr> &parserExpr) {
- // Indirection<parser::Expr> parserExpr
- // `- parser::Expr ^.value()
- const parser::TypedExpr &typedExpr{parserExpr.value().typedExpr};
- // ForwardOwningPointer typedExpr
- // `- GenericExprWrapper ^.get()
- // `- std::optional<Expr> ^->v
- if (auto maybeExpr{typedExpr.get()->v}) {
- return maybeExpr->GetType();
- } else {
- return std::nullopt;
- }
-}
-
const std::list<parser::OmpTraitProperty> &
OmpStructureChecker::GetTraitPropertyList(
const parser::OmpTraitSelector &trait) {
@@ -5430,7 +6383,7 @@ void OmpStructureChecker::CheckTraitCondition(
const parser::OmpTraitProperty &property{properties.front()};
auto &scalarExpr{std::get<parser::ScalarExpr>(property.u)};
- auto maybeType{GetDynamicType(scalarExpr.thing)};
+ auto maybeType{GetDynamicType(scalarExpr.thing.value())};
if (!maybeType || maybeType->category() != TypeCategory::Logical) {
context_.Say(property.source,
"%s trait requires a single LOGICAL expression"_err_en_US,
diff --git a/flang/lib/Semantics/check-omp-structure.h b/flang/lib/Semantics/check-omp-structure.h
index 1a8059d8548ed..2074ec611dc2a 100644
--- a/flang/lib/Semantics/check-omp-structure.h
+++ b/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 @@ class OmpStructureChecker
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 @@ class OmpStructureChecker
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 @@ class OmpStructureChecker
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 @@ class OmpStructureChecker
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 &);
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 3e133b156a9f3..7db447aee0026 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -1684,11 +1684,8 @@ class OmpVisitor : public virtual DeclarationVisitor {
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);
diff --git a/flang/lib/Semantics/rewrite-directives.cpp b/flang/lib/Semantics/rewrite-directives.cpp
index 104a77885d276..b4fef2c881b67 100644
--- a/flang/lib/Semantics/rewrite-directives.cpp
+++ b/flang/lib/Semantics/rewrite-directives.cpp
@@ -51,23 +51,21 @@ class OmpRewriteMutator : public DirectiveRewriteMutator {
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());
-
- assert(symbol &&
- "Atomic construct must be within a scope associated with a symbol");
- return symbol;
- },
- x.u)};
+ 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;
+ }()};
// 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);
+ }};
- // Add a memory order clause to the atomic directive.
+ auto &dirSpec{std::get<parser::OmpDirectiveSpecification>(x.t)};
+ auto &clauseList{std::get<std::optional<parser::OmpClauseList>>(dirSpec.t)};
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;
+ if (findMemOrderClause(*clauseList)) {
+ return false;
}
+ } else {
+ clauseList = parser::OmpClauseList(decltype(parser::OmpClauseList::v){});
+ }
+
+ // Add a memory order clause to the atomic directive.
+ 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;
diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp
index ac69e6ff5cb79..a1445187b1e98 100644
--- a/flang/lib/Semantics/tools.cpp
+++ b/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
\ No newline at end of file
diff --git a/flang/test/Examples/omp-atomic.f90 b/flang/test/Examples/omp-atomic.f90
index dcca34b633a3e..934f84f132484 100644
--- a/flang/test/Examples/omp-atomic.f90
+++ b/flang/test/Examples/omp-atomic.f90
@@ -26,25 +26,31 @@
! 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
diff --git a/flang/test/Lower/OpenMP/Todo/atomic-compare-fail.f90 b/flang/test/Lower/OpenMP/Todo/atomic-compare-fail.f90
index b82bd13622764..6f58e0939a787 100644
--- a/flang/test/Lower/OpenMP/Todo/atomic-compare-fail.f90
+++ b/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
diff --git a/flang/test/Lower/OpenMP/Todo/atomic-compare.f90 b/flang/test/Lower/OpenMP/Todo/atomic-compare.f90
index 88ec6fe910b9e..6729be6e5cf8b 100644
--- a/flang/test/Lower/OpenMP/Todo/atomic-compare.f90
+++ b/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
diff --git a/flang/test/Lower/OpenMP/atomic-capture.f90 b/flang/test/Lower/OpenMP/atomic-capture.f90
index 2f800d534dc36..14fd0c942a9b4 100644
--- a/flang/test/Lower/OpenMP/atomic-capture.f90
+++ b/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: }
diff --git a/flang/test/Lower/OpenMP/atomic-implicit-cast.f90 b/flang/test/Lower/OpenMP/atomic-implicit-cast.f90
index 4c1be1ca91ac0..5e00235b85e74 100644
--- a/flang/test/Lower/OpenMP/atomic-implicit-cast.f90
+++ b/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: }
diff --git a/flang/test/Lower/OpenMP/atomic-privatize.f90 b/flang/test/Lower/OpenMP/atomic-privatize.f90
index f922095264fca..c876266cf018c 100644
--- a/flang/test/Lower/OpenMP/atomic-privatize.f90
+++ b/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
diff --git a/flang/test/Lower/OpenMP/atomic-write.f90 b/flang/test/Lower/OpenMP/atomic-write.f90
index 13392ad76471f..6eded49b0b15d 100644
--- a/flang/test/Lower/OpenMP/atomic-write.f90
+++ b/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>>>
diff --git a/flang/test/Lower/OpenMP/dump-atomic-analysis.f90 b/flang/test/Lower/OpenMP/dump-atomic-analysis.f90
new file mode 100644
index 0000000000000..cbaf7bc9f2d8a
--- /dev/null
+++ b/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: }
diff --git a/flang/test/Parser/OpenMP/atomic-compare.f90 b/flang/test/Parser/OpenMP/atomic-compare.f90
index 5cd02698ff482..e09da4a359fcc 100644
--- a/flang/test/Parser/OpenMP/atomic-compare.f90
+++ b/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
-
- !CHECK: error: expected OpenMP construct
- !$omp atomic compare write
- r = i .eq. j + 1
-
- !CHECK: error: expected end of line
- !$omp atomic compare num_threads(4)
- r = i .eq. j
-end program main
+!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(a, b)
+ integer :: a, b
+ integer :: x
+ !$omp atomic update compare
+ if (x < a) x = b
+end
+
+!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
diff --git a/flang/test/Parser/OpenMP/atomic-end.f90 b/flang/test/Parser/OpenMP/atomic-end.f90
new file mode 100644
index 0000000000000..e5eac87517b1e
--- /dev/null
+++ b/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
diff --git a/flang/test/Semantics/OpenMP/atomic-compare.f90 b/flang/test/Semantics/OpenMP/atomic-compare.f90
index 54492bf6a22a6..11e23e062bce7 100644
--- a/flang/test/Semantics/OpenMP/atomic-compare.f90
+++ b/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
diff --git a/flang/test/Semantics/OpenMP/atomic-hint-clause.f90 b/flang/test/Semantics/OpenMP/atomic-hint-clause.f90
index c13a11a8dd5dc..8adb0f1a67409 100644
--- a/flang/test/Semantics/OpenMP/atomic-hint-clause.f90
+++ b/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
diff --git a/flang/test/Semantics/OpenMP/atomic-read.f90 b/flang/test/Semantics/OpenMP/atomic-read.f90
new file mode 100644
index 0000000000000..06c301cb78b77
--- /dev/null
+++ b/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
diff --git a/flang/test/Semantics/OpenMP/atomic-update-capture.f90 b/flang/test/Semantics/OpenMP/atomic-update-capture.f90
new file mode 100644
index 0000000000000..f808ed916fb7e
--- /dev/null
+++ b/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
diff --git a/flang/test/Semantics/OpenMP/atomic-update-only.f90 b/flang/test/Semantics/OpenMP/atomic-update-only.f90
new file mode 100644
index 0000000000000..28d0e264359cb
--- /dev/null
+++ b/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
diff --git a/flang/test/Semantics/OpenMP/atomic-update-overloaded-ops.f90 b/flang/test/Semantics/OpenMP/atomic-update-overloaded-ops.f90
index 21a9b87d26345..3084376b4275d 100644
--- a/flang/test/Semantics/OpenMP/atomic-update-overloaded-ops.f90
+++ b/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
diff --git a/flang/test/Semantics/OpenMP/atomic-write.f90 b/flang/test/Semantics/OpenMP/atomic-write.f90
new file mode 100644
index 0000000000000..7965ad2dc7dbf
--- /dev/null
+++ b/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
+
diff --git a/flang/test/Semantics/OpenMP/atomic.f90 b/flang/test/Semantics/OpenMP/atomic.f90
index 0e100871ea9b4..10b33a3ade22d 100644
--- a/flang/test/Semantics/OpenMP/atomic.f90
+++ b/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 @@
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 @@
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
diff --git a/flang/test/Semantics/OpenMP/atomic01.f90 b/flang/test/Semantics/OpenMP/atomic01.f90
index 173effe86b69c..f700c381cadd0 100644
--- a/flang/test/Semantics/OpenMP/atomic01.f90
+++ b/flang/test/Semantics/OpenMP/atomic01.f90
@@ -14,322 +14,277 @@
! 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 @@
! 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 @@
! 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
diff --git a/flang/test/Semantics/OpenMP/atomic02.f90 b/flang/test/Semantics/OpenMP/atomic02.f90
index c66085d00f157..45e41f2552965 100644
--- a/flang/test/Semantics/OpenMP/atomic02.f90
+++ b/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
diff --git a/flang/test/Semantics/OpenMP/atomic03.f90 b/flang/test/Semantics/OpenMP/atomic03.f90
index 76367495b9861..b3a3c0d5e7a14 100644
--- a/flang/test/Semantics/OpenMP/atomic03.f90
+++ b/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
diff --git a/flang/test/Semantics/OpenMP/atomic04.f90 b/flang/test/Semantics/OpenMP/atomic04.f90
index a9644ad95aa30..0f69befed1414 100644
--- a/flang/test/Semantics/OpenMP/atomic04.f90
+++ b/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
diff --git a/flang/test/Semantics/OpenMP/atomic05.f90 b/flang/test/Semantics/OpenMP/atomic05.f90
index 266268a212440..77ffc6e57f1a3 100644
--- a/flang/test/Semantics/OpenMP/atomic05.f90
+++ b/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
diff --git a/flang/test/Semantics/OpenMP/critical-hint-clause.f90 b/flang/test/Semantics/OpenMP/critical-hint-clause.f90
index 7ca8c858239f7..e9cfa49bf934e 100644
--- a/flang/test/Semantics/OpenMP/critical-hint-clause.f90
+++ b/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
diff --git a/flang/test/Semantics/OpenMP/omp-atomic-assignment-stmt.f90 b/flang/test/Semantics/OpenMP/omp-atomic-assignment-stmt.f90
index 505cbc48fef90..8fdd2aed3ec1f 100644
--- a/flang/test/Semantics/OpenMP/omp-atomic-assignment-stmt.f90
+++ b/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
diff --git a/flang/test/Semantics/OpenMP/requires-atomic01.f90 b/flang/test/Semantics/OpenMP/requires-atomic01.f90
index ae9fd086015dd..e8817c3f5ef61 100644
--- a/flang/test/Semantics/OpenMP/requires-atomic01.f90
+++ b/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
diff --git a/flang/test/Semantics/OpenMP/requires-atomic02.f90 b/flang/test/Semantics/OpenMP/requires-atomic02.f90
index 4976a9667eb78..a3724a83456fd 100644
--- a/flang/test/Semantics/OpenMP/requires-atomic02.f90
+++ b/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
More information about the flang-commits
mailing list