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(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(c.t).source}; - return "atomic-" + - normalize_construct_name(source.ToString()); - }, - c.u); + auto &dirSpec = std::get(c.t); + auto &dirName = std::get(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 u; -}; - -// atomic-clause-list -> [atomic-clause, [atomic-clause], ...] -struct OmpAtomicClauseList { - WRAPPER_CLASS_BOILERPLATE(OmpAtomicClauseList, std::list); - CharBlock source; -}; - -// END ATOMIC -EMPTY_CLASS(OmpEndAtomic); - -// ATOMIC READ -struct OmpAtomicRead { - TUPLE_CLASS_BOILERPLATE(OmpAtomicRead); - CharBlock source; - std::tuple, std::optional> - t; -}; - -// ATOMIC WRITE -struct OmpAtomicWrite { - TUPLE_CLASS_BOILERPLATE(OmpAtomicWrite); - CharBlock source; - std::tuple, std::optional> - t; -}; - -// ATOMIC UPDATE -struct OmpAtomicUpdate { - TUPLE_CLASS_BOILERPLATE(OmpAtomicUpdate); - CharBlock source; - std::tuple, std::optional> - t; -}; - -// ATOMIC CAPTURE -struct OmpAtomicCapture { - TUPLE_CLASS_BOILERPLATE(OmpAtomicCapture); - CharBlock source; - WRAPPER_CLASS(Stmt1, Statement); - WRAPPER_CLASS(Stmt2, Statement); - std::tuple - t; -}; - -struct OmpAtomicCompareIfStmt { - UNION_CLASS_BOILERPLATE(OmpAtomicCompareIfStmt); - std::variant, common::Indirection> 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> + std::tuple> t; -}; -// ATOMIC -struct OmpAtomic { - TUPLE_CLASS_BOILERPLATE(OmpAtomic); - CharBlock source; - std::tuple, - std::optional> - 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 - 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 51df7c40f5b8b..69375a83dec25 100644 --- a/flang/include/flang/Semantics/tools.h +++ b/flang/include/flang/Semantics/tools.h @@ -758,5 +758,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 +Operator OperationCode( + const evaluate::Operation, 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 +Operator OperationCode( + const evaluate::Operation, 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 +Operator OperationCode(const evaluate::Operation, Ts...> &op) { + return Operator::Add; +} + +template +Operator OperationCode( + const evaluate::Operation, Ts...> &op) { + return Operator::Sub; +} + +template +Operator OperationCode( + const evaluate::Operation, Ts...> &op) { + return Operator::Mul; +} + +template +Operator OperationCode( + const evaluate::Operation, Ts...> &op) { + return Operator::Div; +} + +template +Operator OperationCode( + const evaluate::Operation, Ts...> &op) { + return Operator::Pow; +} + +template +Operator OperationCode( + const evaluate::Operation, Ts...> &op) { + return Operator::Pow; +} + +template +Operator OperationCode( + const evaluate::Operation, Ts...> &op) { + if constexpr (C == T::category) { + return Operator::Resize; + } else { + return Operator::Convert; + } +} + +template // +Operator OperationCode(const evaluate::Constant &x) { + return Operator::Constant; +} + +template // +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> 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(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 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 &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.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 &clauses) { + std::optional 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(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(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 - // omp.atomic.update %0 : !fir.ref { - // ^bb0(%arg0: i32): - // %3 = arith.addi %arg0, %2 : i32 - // omp.yield(%3 : i32) - // } - // return - // } - - auto getArgExpression = - [](std::list::const_iterator it) { - const auto &arg{std::get((*it).t)}; - const auto *parserExpr{ - std::get_if>(&arg.u)}; - return parserExpr; - }; + builder.restoreInsertionPoint(atomicAt); + mlir::Operation *op = builder.create( + 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(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 nonAtomicSubExprs; - common::visit( - common::visitors{ - [&](const common::Indirection &funcRef) - -> void { - const auto &args{std::get>( - funcRef.value().v.t)}; - std::list::const_iterator beginIt = - args.begin(); - std::list::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::const_iterator it; - for (it = beginIt; it != endIt; it++) { - const common::Indirection *expr = - getArgExpression(it); - if (expr) - nonAtomicSubExprs.push_back(semantics::GetExpr(*expr)); - } - }, - [&](const auto &op) -> void { - using T = std::decay_t; - if constexpr (std::is_base_of::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(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( - currentLocation, lhsAddr, hint, memoryOrder); - - processOmpAtomicTODO(varType, loc); - - llvm::SmallVector varTys = {varType}; - llvm::SmallVector 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( - currentLocation, - mlir::cast(exprType).getElementType(), rhsExpr, - firOpBuilder.getArrayAttr( - firOpBuilder.getIntegerAttr(firOpBuilder.getIndexType(), 0))); - mlir::Value convertResult = firOpBuilder.create( - currentLocation, varType, extract); - firOpBuilder.create(currentLocation, convertResult); - } else { - mlir::Value convertResult = - firOpBuilder.createConvert(currentLocation, varType, rhsExpr); - firOpBuilder.create(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( + 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 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>(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, !fir.ref, - type2`. This implicit casting will rather generate the following FIR: - - %alloca = fir.alloca type2 - omp.atomic.read %alloca = %x : !fir.ref, !fir.ref, type2 - %load = fir.load %alloca : !fir.ref - %cvt = fir.convert %load : (type2) -> type1 - fir.store %cvt to %v : !fir.ref - - 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(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( - loc, mlir::cast(fromType).getElementType(), load, - builder.getArrayAttr( - builder.getIntegerAttr(builder.getIndexType(), 0))); - auto cvt = builder.create(loc, toType, extract); - builder.create(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(loc, toType); - mlir::Type complexEleTy = - mlir::cast(toType).getElementType(); - mlir::Value cvt = builder.create(loc, complexEleTy, load); - mlir::Value zero = builder.createRealZeroConstant(loc, complexEleTy); - mlir::Value idx0 = builder.create( - loc, toType, undef, cvt, - builder.getArrayAttr( - builder.getIntegerAttr(builder.getIndexType(), 0))); - mlir::Value idx1 = builder.create( - loc, toType, idx0, zero, - builder.getArrayAttr( - builder.getIntegerAttr(builder.getIndexType(), 1))); - builder.create(loc, idx1, toAddress); - } else { - auto cvt = builder.create(loc, toType, load); - builder.create(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(loc, atomAddr, hint, memOrder); - const auto &assignmentStmtExpr = std::get( - std::get>(atomicRead.t) - .statement.t); - const auto &assignmentStmtVariable = std::get( - std::get>(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( - 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( - std::get>(atomicUpdate.t) - .statement.t); - const auto &assignmentStmtVariable = std::get( - std::get>(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(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(atomicConstruct.t); - const auto &assignmentStmtExpr = std::get( - std::get>(atomicConstruct.t) - .statement.t); - const auto &assignmentStmtVariable = std::get( - std::get>(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(atomicCapture.t).v.statement; - const evaluate::Assignment &assign1 = *stmt1.typedAssignment->v; - const auto &stmt1Var{std::get(stmt1.t)}; - const auto &stmt1Expr{std::get(stmt1.t)}; - const parser::AssignmentStmt &stmt2 = - std::get(atomicCapture.t).v.statement; - const evaluate::Assignment &assign2 = *stmt2.typedAssignment->v; - const auto &stmt2Var{std::get(stmt2.t)}; - const auto &stmt2Expr{std::get(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(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(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(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(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(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 ""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 ""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(construct.t); + List 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(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(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(64, state.BytesRemaining())); +} + constexpr auto startOmpLine = skipStuffBeforeStatement >> "!$OMP "_sptok; constexpr auto endOmpLine = space >> endOfLine; @@ -941,8 +947,10 @@ TYPE_PARSER( // parenthesized(Parser{}))) || "BIND" >> construct(construct( parenthesized(Parser{}))) || + "CAPTURE" >> construct(construct()) || "COLLAPSE" >> construct(construct( parenthesized(scalarIntConstantExpr))) || + "COMPARE" >> construct(construct()) || "CONTAINS" >> construct(construct( parenthesized(Parser{}))) || "COPYIN" >> construct(construct( @@ -1062,6 +1070,7 @@ TYPE_PARSER( // "TASK_REDUCTION" >> construct(construct( parenthesized(Parser{}))) || + "READ" >> construct(construct()) || "RELAXED" >> construct(construct()) || "RELEASE" >> construct(construct()) || "REVERSE_OFFLOAD" >> @@ -1105,6 +1114,7 @@ TYPE_PARSER( // maybe(Parser{}))) || "WHEN" >> construct(construct( parenthesized(Parser{}))) || + "WRITE" >> construct(construct()) || // Cancellable constructs construct(construct( Parser{}))) @@ -1223,6 +1233,155 @@ TYPE_PARSER(sourced(construct(first( TYPE_PARSER(sourced(construct( sourced(Parser{}), Parser{}))) +struct OmpEndDirectiveParser { + using resultType = OmpDirectiveSpecification; + + constexpr OmpEndDirectiveParser(llvm::omp::Directive dir) : dir_(dir) {} + + std::optional Parse(ParseState &state) const { + if ((startOmpLine >> "END"_sptok).Parse(state)) { + auto &&dirSpec{Parser{}.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 Parse(ParseState &state) const { + if (recursing_) { + return std::nullopt; + } + recursing_ = true; + + auto dirSpec{Parser{}.Parse(state)}; + if (!dirSpec || dirSpec->DirId() != llvm::omp::Directive::OMPD_atomic) { + recursing_ = false; + return std::nullopt; + } + + auto exec{Parser{}}; + 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>; + + // Parse either an ExecutionPartConstruct, or atomic end-directive. When + // successful, record the result in the "tail" provided, otherwise fail. + static std::optional ParseOne( // + Parser &exec, OmpEndDirectiveParser &end, + TailType &tail, ParseState &state) { + auto isRecovery{[](const ExecutionPartConstruct &e) { + return std::holds_alternative(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 Parse(ParseState &state) const { + auto exec{Parser{}}; + 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(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( "RELEASE" >> construct(construct()) || "SEQ_CST" >> construct(construct()))))) -// 2.17.7 Atomic construct -// atomic-clause -> memory-order-clause | HINT(hint-expression) -TYPE_PARSER(sourced(construct( - construct(Parser{}) || - construct( - "FAIL" >> parenthesized(Parser{})) || - construct( - "HINT" >> parenthesized(Parser{}))))) - -// atomic-clause-list -> [atomic-clause, [atomic-clause], ...] -TYPE_PARSER(sourced(construct( - many(maybe(","_tok) >> sourced(Parser{}))))) - 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(Parser{}) || construct(Parser{})) -// 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(startOmpLine >> "END ATOMIC"_tok)) - -// OMP ATOMIC [MEMORY-ORDER-CLAUSE-LIST] READ [MEMORY-ORDER-CLAUSE-LIST] -TYPE_PARSER("ATOMIC" >> - sourced(construct( - Parser{} / maybe(","_tok), verbatim("READ"_tok), - Parser{} / endOmpLine, statement(assignmentStmt), - maybe(Parser{} / endOmpLine)))) - -// OMP ATOMIC [MEMORY-ORDER-CLAUSE-LIST] CAPTURE [MEMORY-ORDER-CLAUSE-LIST] -TYPE_PARSER("ATOMIC" >> - sourced(construct( - Parser{} / maybe(","_tok), verbatim("CAPTURE"_tok), - Parser{} / endOmpLine, statement(assignmentStmt), - statement(assignmentStmt), Parser{} / endOmpLine))) - -TYPE_PARSER(construct(indirect(Parser{})) || - construct(indirect(Parser{}))) - -// OMP ATOMIC [MEMORY-ORDER-CLAUSE-LIST] COMPARE [MEMORY-ORDER-CLAUSE-LIST] -TYPE_PARSER("ATOMIC" >> - sourced(construct( - Parser{} / maybe(","_tok), verbatim("COMPARE"_tok), - Parser{} / endOmpLine, - Parser{}, - maybe(Parser{} / endOmpLine)))) - -// OMP ATOMIC [MEMORY-ORDER-CLAUSE-LIST] UPDATE [MEMORY-ORDER-CLAUSE-LIST] -TYPE_PARSER("ATOMIC" >> - sourced(construct( - Parser{} / maybe(","_tok), verbatim("UPDATE"_tok), - Parser{} / endOmpLine, statement(assignmentStmt), - maybe(Parser{} / endOmpLine)))) - -// OMP ATOMIC [atomic-clause-list] -TYPE_PARSER(sourced(construct(verbatim("ATOMIC"_tok), - Parser{} / endOmpLine, statement(assignmentStmt), - maybe(Parser{} / endOmpLine)))) - -// OMP ATOMIC [MEMORY-ORDER-CLAUSE-LIST] WRITE [MEMORY-ORDER-CLAUSE-LIST] -TYPE_PARSER("ATOMIC" >> - sourced(construct( - Parser{} / maybe(","_tok), verbatim("WRITE"_tok), - Parser{} / endOmpLine, statement(assignmentStmt), - maybe(Parser{} / endOmpLine)))) - -// Atomic Construct -TYPE_PARSER(construct(Parser{}) || - construct(Parser{}) || - construct(Parser{}) || - construct(Parser{}) || - construct(Parser{}) || - construct(Parser{})) - // 2.13.2 OMP CRITICAL TYPE_PARSER(startOmpLine >> sourced(construct( 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(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(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(t)}; + return llvm::any_of(dirSpec.Clauses().v, [](auto &clause) { + return clause.Id() == llvm::omp::Clause::OMPC_compare; + }); +} } // namespace Fortran::parser template 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(x.t)); - Put("\n"); - EndOpenMP(); - Walk(std::get>(x.t)); - BeginOpenMP(); - Walk(std::get>(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(x.t)); - Put("\n"); - Walk(std::get(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(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>(x.t)); - BeginOpenMP(); - Walk(std::get>(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>(x.t)); - BeginOpenMP(); - Walk(std::get>(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(x.t)); Put("\n"); EndOpenMP(); - Walk(std::get>(x.t)); - BeginOpenMP(); - Walk(std::get>(x.t), "!$OMP END ATOMIC\n"); - EndOpenMP(); + Walk(std::get(x.t), ""); + if (auto &end{std::get>(x.t)}) { + BeginOpenMP(); + Word("!$OMP END "); + Walk(*end); + Put("\n"); + EndOpenMP(); + } } + void Unparse(const OpenMPExecutableAllocate &x) { const auto &fields = std::get>>( @@ -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 namespace Fortran::semantics { +template +static bool operator!=(const evaluate::Expr &e, const evaluate::Expr &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 GetEvaluateExpr(const parser::Expr &parserExpr) { + const parser::TypedExpr &typedExpr{parserExpr.typedExpr}; + // ForwardOwningPointer typedExpr + // `- GenericExprWrapper ^.get() + // `- std::optional ^->v + return typedExpr.get()->v; +} + +static std::optional 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 -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) { - ompHintClause = std::get_if(&clause.u); - } else if constexpr (std::is_same_v) { - if (auto *hint{std::get_if(&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 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 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(x.t)}; + const auto &dirSource{std::get(dir.t).source}; const auto &endDir{std::get(x.t)}; - PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_critical); + PushContextAndClauseSets(dirSource, llvm::omp::Directive::OMPD_critical); const auto &block{std::get(x.t)}; CheckNoBranching(block, llvm::omp::Directive::OMPD_critical, dir.source); const auto &dirName{std::get>(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(&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>(var.u); - const auto *dataRef = - std::get_if(&designator.value().u); - const parser::Name *name = - dataRef ? std::get_if(&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(&ep.u)}) { + using BlockConstruct = common::Indirection; + if (auto *bc{std::get_if(&exec->u)}) { + iter = &std::get(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 *designator = - std::get_if>(&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 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(&x->u)}) { + using ActionStmt = parser::Statement; + if (auto *stmt{std::get_if(&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 GetEvaluateAssignment( + const parser::ActionStmt *x) { + if (x == nullptr) { + return std::nullopt; + } + + using AssignmentStmt = common::Indirection; + using PointerAssignmentStmt = + common::Indirection; + using TypedAssignment = parser::AssignmentStmt::TypedAssignment; + + return common::visit( + [](auto &&s) -> std::optional { + using BareS = llvm::remove_cvref_t; + if constexpr (std::is_same_v || + std::is_same_v) { + const TypedAssignment &typed{s.value().typedAssignment}; + // ForwardOwningPointer typedAssignment + // `- GenericAssignmentWrapper ^.get() + // `- std::optional ^->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; + using PointerAssignmentStmt = + common::Indirection; + + return common::visit( + [](auto &&s) -> bool { + using BareS = llvm::remove_cvref_t; + return std::is_same_v || + std::is_same_v; + }, + x->u); +} + +static std::optional 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>> + 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>( + &action.stmt->u)}) { + const parser::IfStmt &s{ifs->value()}; + auto &&maybeCond{ + getFromLogical(std::get(s.t))}; + auto &thenStmt{ + std::get>(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(&x->u)}) { + if (auto *ifc{ + std::get_if>(&exec->u)}) { + using ElseBlock = parser::IfConstruct::ElseBlock; + using ElseIfBlock = parser::IfConstruct::ElseIfBlock; + const parser::IfConstruct &s{ifc->value()}; + + if (!std::get>(s.t).empty()) { + // Not expecting any else-if statements. + return std::nullopt; + } + auto &stmt{std::get>(s.t)}; + auto &&maybeCond{getFromLogical( + std::get(stmt.statement.t))}; + if (!maybeCond) { + return std::nullopt; + } + + if (auto &maybeElse{std::get>(s.t)}) { + AnalyzedCondStmt result{std::move(*maybeCond), stmt.source, + GetActionStmt(std::get(s.t)), + GetActionStmt(std::get(maybeElse->t))}; + if (result.ift.stmt && result.iff.stmt) { + return result; + } + } else { + AnalyzedCondStmt result{std::move(*maybeCond), stmt.source, + GetActionStmt(std::get(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 -bool OmpStructureChecker::IsOperatorValid(const T &node, const D &variable) { - using AllowedBinaryOperators = - std::variant; - using BinaryOperators = std::variant; - - if constexpr (common::HasMember) { - 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; +static std::pair 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(assignmentStmt.t)}; - const auto &expr{std::get(assignmentStmt.t)}; - common::visit( - common::visitors{ - [&](const common::Indirection &designator) { - const auto *dataRef = - std::get_if(&designator.value().u); - const auto *name = - dataRef ? std::get_if(&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(assignmentStmt.t)}; - const auto &expr{std::get(assignmentStmt.t)}; - ErrIfAllocatableVariable(var); - ErrIfLHSAndRHSSymbolsMatch(var, expr); - ErrIfNonScalarAssignmentStmt(var, expr); -} - -void OmpStructureChecker::CheckAtomicUpdateStmt( - const parser::AssignmentStmt &assignment) { - const auto &expr{std::get(assignment.t)}; - const auto &var{std::get(assignment.t)}; - bool isIntrinsicProcedure{false}; - bool isValidOperator{false}; - common::visit( - common::visitors{ - [&](const common::Indirection &x) { - isIntrinsicProcedure = true; - const auto &procedureDesignator{ - std::get(x.value().v.t)}; - const parser::Name *name{ - std::get_if(&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, false> { + using Result = std::vector; + using Base = evaluate::Traverse; + DesignatorCollector() : Base(*this) {} + + Result Default() const { return {}; } + + using Base::operator(); + + template // + Result operator()(const evaluate::Designator &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 // + 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 { + using Base = evaluate::AnyTraverse; + VariableFinder(const SomeExpr &v) : Base(*this), var(v) {} + + using Base::operator(); + + template + bool operator()(const evaluate::Designator &x) const { + auto copy{x}; + return evaluate::AsGenericExpr(std::move(copy)) == var; + } + + template + bool operator()(const evaluate::FunctionRef &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(x.u) || + std::holds_alternative(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 different 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 &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 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 exprs) { + evaluate::SymbolVector baseSyms{evaluate::GetSymbolVector(base)}; + std::vector 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(atomicCaptureConstruct.t) - .v.statement; - const auto &stmt1Var{std::get(stmt1.t)}; - const auto &stmt1Expr{std::get(stmt1.t)}; - const auto *v1 = GetExpr(context_, stmt1Var); - const auto *e1 = GetExpr(context_, stmt1Expr); - - const parser::AssignmentStmt &stmt2 = - std::get(atomicCaptureConstruct.t) - .v.statement; - const auto &stmt2Var{std::get(stmt2.t)}; - const auto &stmt2Expr{std::get(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 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 &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> 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 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 +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; + + 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(&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> 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 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(&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 different 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; + if constexpr (std::is_same_v) { + 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(x.t)}; + auto &block{std::get(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(x.t)}; + auto &block{std::get(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(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(atomicConstruct.t)}; - PushContextAndClauseSets( - dir.source, llvm::omp::Directive::OMPD_atomic); - CheckAtomicUpdateStmt( - std::get>( - atomicConstruct.t) - .statement); - CheckAtomicMemoryOrderClause( - &std::get(atomicConstruct.t), - nullptr); - CheckHintClause( - &std::get(atomicConstruct.t), - nullptr, "ATOMIC"); - }, - [&](const parser::OmpAtomicUpdate &atomicUpdate) { - const auto &dir{std::get(atomicUpdate.t)}; - PushContextAndClauseSets( - dir.source, llvm::omp::Directive::OMPD_atomic); - CheckAtomicUpdateStmt( - std::get>( - atomicUpdate.t) - .statement); - CheckAtomicMemoryOrderClause( - &std::get<0>(atomicUpdate.t), &std::get<2>(atomicUpdate.t)); - CheckHintClause( - &std::get<0>(atomicUpdate.t), &std::get<2>(atomicUpdate.t), - "UPDATE"); - }, - [&](const parser::OmpAtomicRead &atomicRead) { - const auto &dir{std::get(atomicRead.t)}; - PushContextAndClauseSets( - dir.source, llvm::omp::Directive::OMPD_atomic); - CheckAtomicMemoryOrderClause( - &std::get<0>(atomicRead.t), &std::get<2>(atomicRead.t)); - CheckHintClause( - &std::get<0>(atomicRead.t), &std::get<2>(atomicRead.t), "READ"); - CheckAtomicCaptureStmt( - std::get>( - atomicRead.t) - .statement); - }, - [&](const parser::OmpAtomicWrite &atomicWrite) { - const auto &dir{std::get(atomicWrite.t)}; - PushContextAndClauseSets( - dir.source, llvm::omp::Directive::OMPD_atomic); - CheckAtomicMemoryOrderClause( - &std::get<0>(atomicWrite.t), &std::get<2>(atomicWrite.t)); - CheckHintClause( - &std::get<0>(atomicWrite.t), &std::get<2>(atomicWrite.t), - "WRITE"); - CheckAtomicWriteStmt( - std::get>( - atomicWrite.t) - .statement); - }, - [&](const parser::OmpAtomicCapture &atomicCapture) { - const auto &dir{std::get(atomicCapture.t)}; - PushContextAndClauseSets( - dir.source, llvm::omp::Directive::OMPD_atomic); - CheckAtomicMemoryOrderClause( - &std::get<0>(atomicCapture.t), &std::get<2>(atomicCapture.t)); - CheckHintClause( - &std::get<0>(atomicCapture.t), &std::get<2>(atomicCapture.t), - "CAPTURE"); - CheckAtomicCaptureConstruct(atomicCapture); - }, - [&](const parser::OmpAtomicCompare &atomicCompare) { - const auto &dir{std::get(atomicCompare.t)}; - PushContextAndClauseSets( - dir.source, llvm::omp::Directive::OMPD_atomic); - CheckAtomicMemoryOrderClause( - &std::get<0>(atomicCompare.t), &std::get<2>(atomicCompare.t)); - CheckHintClause( - &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 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(x.t)}; + auto &dir{std::get(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 OmpStructureChecker::GetDynamicType( - const common::Indirection &parserExpr) { - // Indirection parserExpr - // `- parser::Expr ^.value() - const parser::TypedExpr &typedExpr{parserExpr.value().typedExpr}; - // ForwardOwningPointer typedExpr - // `- GenericExprWrapper ^.get() - // `- std::optional ^->v - if (auto maybeExpr{typedExpr.get()->v}) { - return maybeExpr->GetType(); - } else { - return std::nullopt; - } -} - const std::list & OmpStructureChecker::GetTraitPropertyList( const parser::OmpTraitSelector &trait) { @@ -5430,7 +6383,7 @@ void OmpStructureChecker::CheckTraitCondition( const parser::OmpTraitProperty &property{properties.front()}; auto &scalarExpr{std::get(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 &); - std::optional GetDynamicType( - const common::Indirection &); const std::list &GetTraitPropertyList( const parser::OmpTraitSelector &); std::optional GetClauseFromProperty( @@ -265,14 +255,44 @@ class OmpStructureChecker void CheckDoWhile(const parser::OpenMPLoopConstruct &x); void CheckAssociatedLoopConstraints(const parser::OpenMPLoopConstruct &x); template 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 &, + llvm::ArrayRef>, 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 &, parser::CharBlock); + std::pair + 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 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(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(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 defaultMemOrder; @@ -86,66 +84,48 @@ bool OmpRewriteMutator::Pre(parser::OpenMPAtomicConstruct &x) { return false; } - auto findMemOrderClause = - [](const std::list &clauses) { - return llvm::any_of(clauses, [](const auto &clause) { - return std::get_if(&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 *clauseList = common::visit( - common::visitors{[&](parser::OmpAtomic &atomicConstruct) { - // OmpAtomic only has a single list of clauses. - auto &clauses{std::get( - 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(x.t)}; + auto &clauseList{std::get>(dirSpec.t)}; if (clauseList) { - atomicDirectiveDefaultOrderFound_ = true; - switch (*defaultMemOrder) { - case common::OmpMemoryOrderType::Acq_Rel: - clauseList->emplace_back(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::OmpClause{parser::OmpClause::Relaxed{}}); - break; - case common::OmpMemoryOrderType::Seq_Cst: - clauseList->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; + 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 ea5ab2d455b54..bf520d04a50cc 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 #include @@ -1802,4 +1803,318 @@ bool CheckForSymbolMatch(const SomeExpr *lhs, const SomeExpr *rhs) { } return false; } -} // namespace Fortran::semantics + +namespace operation { +template // +SomeExpr asSomeExpr(const T &x) { + auto copy{x}; + return AsGenericExpr(std::move(copy)); +} + +template // +struct ArgumentExtractor + : public evaluate::Traverse, + std::pair>, false> { + using Arguments = std::vector; + using Result = std::pair; + using Base = evaluate::Traverse, + 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 // + Result operator()( + const evaluate::Constant> &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 // + Result operator()(const evaluate::FunctionRef &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 + Result operator()(const evaluate::Operation &x) const { + if constexpr (std::is_same_v>) { + // Ignore top-level parentheses. + return (*this)(x.template operand<0>()); + } + if constexpr (IgnoreResizes && + std::is_same_v>) { + // 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{})); + } + } + + template // + Result operator()(const evaluate::Designator &x) const { + return {operation::Operator::Identity, {asSomeExpr(x)}}; + } + + template // + Result operator()(const evaluate::Constant &x) const { + return {operation::Operator::Identity, {asSomeExpr(x)}}; + } + + template // + 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 + Arguments OperationArgs(const evaluate::Operation &x, + std::index_sequence) const { + return Arguments{SomeExpr(x.template operand())...}; + } +}; +} // 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(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> GetTopLevelOperation( + const SomeExpr &expr) { + return operation::ArgumentExtractor{}(expr); +} + +namespace operation { +struct ConvertCollector + : public evaluate::Traverse>, false> { + using Result = std::pair>; + using Base = evaluate::Traverse; + ConvertCollector() : Base(*this) {} + + Result Default() const { return {}; } + + using Base::operator(); + + template // + Result operator()(const evaluate::Designator &x) const { + return {asSomeExpr(x), {}}; + } + + template // + Result operator()(const evaluate::FunctionRef &x) const { + return {asSomeExpr(x), {}}; + } + + template // + Result operator()(const evaluate::Constant &x) const { + return {asSomeExpr(x), {}}; + } + + template + Result operator()(const evaluate::Operation &x) const { + if constexpr (std::is_same_v>) { + // Ignore parentheses. + return (*this)(x.template operand<0>()); + } else if constexpr (is_convert_v) { + // 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) { + // 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 // + 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 // + static bool IsZero(const T &x) { + return false; + } + template // + static bool IsZero(const evaluate::Expr &x) { + return common::visit([](auto &&s) { return IsZero(s); }, x.u); + } + template // + static bool IsZero(const evaluate::Constant &x) { + if (auto &&maybeScalar{x.GetScalarValue()}) { + return maybeScalar->IsZero(); + } else { + return false; + } + } + + template // + struct is_convert { + static constexpr bool value{false}; + }; + template // + struct is_convert> { + static constexpr bool value{true}; + }; + template // + struct is_convert> { + // Conversion from complex to real. + static constexpr bool value{true}; + }; + template // + static constexpr bool is_convert_v = is_convert::value; + + template // + struct is_complex_constructor { + static constexpr bool value{false}; + }; + template // + struct is_complex_constructor> { + static constexpr bool value{true}; + }; + template // + static constexpr bool is_complex_constructor_v = + is_complex_constructor::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 !CHECK: %[[VAL_B_LOADED:.*]] = fir.load %[[VAL_B_DECLARE]]#0 : !fir.ref>> !CHECK: %[[VAL_B_BOX_ADDR:.*]] = fir.box_addr %[[VAL_B_LOADED]] : (!fir.box>) -> !fir.ptr +!CHECK: %[[VAL_B:.*]] = fir.load %[[VAL_B_BOX_ADDR]] : !fir.ptr !CHECK: %[[VAL_B_LOADED_2:.*]] = fir.load %[[VAL_B_DECLARE]]#0 : !fir.ref>> !CHECK: %[[VAL_B_BOX_ADDR_2:.*]] = fir.box_addr %[[VAL_B_LOADED_2]] : (!fir.box>) -> !fir.ptr -!CHECK: %[[VAL_B:.*]] = fir.load %[[VAL_B_BOX_ADDR_2]] : !fir.ptr !CHECK: omp.atomic.capture { !CHECK: omp.atomic.update %[[VAL_A_BOX_ADDR]] : !fir.ptr { !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, !fir.ptr, i32 +!CHECK: omp.atomic.read %[[VAL_B_BOX_ADDR_2]] = %[[VAL_A_BOX_ADDR]] : !fir.ptr, !fir.ptr, 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, !fir.ref, i32 ! CHECK: %[[LOAD:.*]] = fir.load %[[ALLOCA6]] : !fir.ref -! CHECK: %[[UNDEF:.*]] = fir.undefined complex ! CHECK: %[[CVT:.*]] = fir.convert %[[LOAD]] : (i32) -> f32 ! CHECK: %[[CST:.*]] = arith.constant 0.000000e+00 : f32 +! CHECK: %[[UNDEF:.*]] = fir.undefined complex ! CHECK: %[[IDX1:.*]] = fir.insert_value %[[UNDEF]], %[[CVT]], [0 : index] : (complex, f32) -> complex ! CHECK: %[[IDX2:.*]] = fir.insert_value %[[IDX1]], %[[CST]], [1 : index] : (complex, f32) -> complex ! CHECK: fir.store %[[IDX2]] to %[[W_DECL]]#0 : !fir.ref> @@ -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> { -! CHECK: ^bb0(%[[ARG:.*]]: complex): ! CHECK: %[[CST1:.*]] = arith.constant 1.000000e+00 : f64 ! CHECK: %[[CST2:.*]] = arith.constant 0.000000e+00 : f64 ! CHECK: %[[UNDEF:.*]] = fir.undefined complex ! CHECK: %[[IDX1:.*]] = fir.insert_value %[[UNDEF]], %[[CST1]], [0 : index] : (complex, f64) -> complex ! CHECK: %[[IDX2:.*]] = fir.insert_value %[[IDX1]], %[[CST2]], [1 : index] : (complex, f64) -> complex +! CHECK: omp.atomic.capture { +! CHECK: omp.atomic.update %[[M_DECL]]#0 : !fir.ref> { +! CHECK: ^bb0(%[[ARG:.*]]: complex): ! CHECK: %[[RESULT:.*]] = fir.addc %[[ARG]], %[[IDX2]] {fastmath = #arith.fastmath} : complex ! CHECK: omp.yield(%[[RESULT]] : complex) ! 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> {bindc_name = "x", uniq_name = "_QFatomic_write_pointerEx"} !CHECK: %[[X_DECL:.*]]:2 = hlfir.declare %[[X_REF]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFatomic_write_pointerEx"} : (!fir.ref>>) -> (!fir.ref>>, !fir.ref>>) -!CHECK: %[[C1:.*]] = arith.constant 1 : i32 !CHECK: %[[X_ADDR_BOX:.*]] = fir.load %[[X_DECL]]#0 : !fir.ref>> !CHECK: %[[X_POINTEE_ADDR:.*]] = fir.box_addr %[[X_ADDR_BOX]] : (!fir.box>) -> !fir.ptr +!CHECK: %[[C1:.*]] = arith.constant 1 : i32 !CHECK: omp.atomic.write %[[X_POINTEE_ADDR]] = %[[C1]] : !fir.ptr, i32 !CHECK: %[[C2:.*]] = arith.constant 2 : i32 !CHECK: %[[X_ADDR_BOX:.*]] = fir.load %[[X_DECL]]#0 : !fir.ref>> 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: +!CHECK-NEXT: op0 { +!CHECK-NEXT: what: Read +!CHECK-NEXT: assign: v=x +!CHECK-NEXT: } +!CHECK-NEXT: op1 { +!CHECK-NEXT: what: None +!CHECK-NEXT: assign: +!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: +!CHECK-NEXT: op0 { +!CHECK-NEXT: what: Write +!CHECK-NEXT: assign: x=v +!CHECK-NEXT: } +!CHECK-NEXT: op1 { +!CHECK-NEXT: what: None +!CHECK-NEXT: assign: +!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: +!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: +!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: +!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 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 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 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 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 ExecutableConstruct -> ActionStmt -> AssignmentStmt = 'c=x DataRef -> Name = 'c' +!PARSE-TREE: | Expr = 'x 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 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 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 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 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 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 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