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 254236b510544..b45baf9180ffc 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 f25babb3c1f6d..9be2feb8ae064 100644 --- a/flang/include/flang/Semantics/tools.h +++ b/flang/include/flang/Semantics/tools.h @@ -782,5 +782,22 @@ inline bool checkForSymbolMatch( } return false; } + +/// If the top-level operation (ignoring parentheses) is either an +/// evaluate::FunctionRef, or a specialization of evaluate::Operation, +/// then return the list of arguments (wrapped in SomeExpr). Otherwise, +/// return the "expr" but with top-level parentheses stripped. +std::vector GetOpenMPTopLevelArguments(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, +/// is 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 7eec598645eac..497095553dad3 100644 --- a/flang/lib/Lower/OpenMP/DataSharingProcessor.cpp +++ b/flang/lib/Lower/OpenMP/DataSharingProcessor.cpp @@ -334,26 +334,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 61bbc709872fd..0f553541c5ef0 100644 --- a/flang/lib/Lower/OpenMP/OpenMP.cpp +++ b/flang/lib/Lower/OpenMP/OpenMP.cpp @@ -2673,644 +2673,211 @@ genTeamsOp(lower::AbstractConverter &converter, lower::SymMap &symTable, //===----------------------------------------------------------------------===// // Code generation for atomic operations //===----------------------------------------------------------------------===// - -/// 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 +getInsertionPointBefore(mlir::Operation *op) { + return fir::FirOpBuilder::InsertPoint(op->getBlock(), + mlir::Block::iterator(op)); } -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(); - - 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(); +static fir::FirOpBuilder::InsertPoint +getInsertionPointAfter(mlir::Operation *op) { + return fir::FirOpBuilder::InsertPoint(op->getBlock(), + ++mlir::Block::iterator(op)); +} - 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(); +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; +} - // 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; - }; +static mlir::omp::ClauseMemoryOrderKindAttr +getAtomicMemoryOrder(lower::AbstractConverter &converter, + semantics::SemanticsContext &semaCtx, + const List &clauses) { + std::optional kind; + unsigned version = semaCtx.langOptions().OpenMPVersion; - // 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); + 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; } - if (atomicCaptureOp) - firOpBuilder.restoreInsertionPoint(insertionPoint); } - 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); - } - converter.resetExprOverrides(); + // 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; } - 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); + 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"); + }(); + + 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(); + + builder.create(loc, value, storeAddr); } + return op; } -/// 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); +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; +} - const auto &assignmentStmtExpr = std::get( - std::get>(atomicRead.t) - .statement.t); - const auto &assignmentStmtVariable = std::get( - std::get>(atomicRead.t) - .statement.t); +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::GetOpenMPTopLevelArguments(input)}; + 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); + } + } - 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); + builder.restoreInsertionPoint(atomicAt); + auto updateOp = + builder.create(loc, atomAddr, hint, memOrder); - 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(); + 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); - 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 (semantics::checkForSingleVariableOnRHS(stmt1)) { - if (semantics::checkForSymbolMatch(stmt2)) { - // 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); - } + 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(); - 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); - } + builder.restoreInsertionPoint(postAt); // For naCtx cleanups + return updateOp; +} + +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) { + // 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); } //===----------------------------------------------------------------------===// @@ -4216,10 +3783,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, @@ -4227,38 +3790,161 @@ static void genOMP(lower::AbstractConverter &converter, lower::SymMap &symTable, TODO(converter.getCurrentLocation(), "OpenMPAllocatorsConstruct"); } +//===----------------------------------------------------------------------===// +// OpenMPConstruct visitors +//===----------------------------------------------------------------------===// + +[[maybe_unused]] static void +dumpAnalysis(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; + 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 52d3a5844c969..961918118843e 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"_id).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: @@ -1401,67 +1547,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 a626888b7dfe5..5aabbbf090fa2 100644 --- a/flang/lib/Parser/unparse.cpp +++ b/flang/lib/Parser/unparse.cpp @@ -2567,83 +2567,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>>( @@ -2915,23 +2854,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 5ae4bc29b72f7..edd8525c118bd 100644 --- a/flang/lib/Semantics/check-omp-structure.cpp +++ b/flang/lib/Semantics/check-omp-structure.cpp @@ -16,10 +16,18 @@ #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 { +static_assert(std::is_same_v>); + +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 &) { \ @@ -78,6 +86,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 { @@ -584,51 +618,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); } } @@ -2379,8 +2388,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)}; @@ -2413,7 +2423,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 &) { @@ -2650,526 +2659,1858 @@ 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()); - } - } else { - 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{}; } -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 SourcedActionStmt GetActionStmt(const parser::Block &block) { + if (block.size() == 1) { + return GetActionStmt(&block.front()); } - return false; + return SourcedActionStmt{}; } -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++; - } - } - 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()); - } +// 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. +static std::optional GetEvaluateAssignment( + const parser::ActionStmt *x) { + if (x == nullptr) { + return std::nullopt; } - ErrIfAllocatableVariable(var); + 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 { + return std::nullopt; + } + }, + x->u); } -void OmpStructureChecker::CheckAtomicCompareConstruct( - const parser::OmpAtomicCompare &atomicCompareConstruct) { +static std::optional AnalyzeConditionalStmt( + const parser::ExecutionPartConstruct *x) { + if (x == nullptr) { + return std::nullopt; + } - // TODO: Check that the if-stmt is `if (var == expr) var = new` - // [with or without then/end-do] + // 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); + }}; - 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 parser::AssignmentStmt &stmt2 = - std::get(atomicCaptureConstruct.t) - .v.statement; - const auto &stmt2Var{std::get(stmt2.t)}; - const auto &stmt2Expr{std::get(stmt2.t)}; - - if (semantics::checkForSingleVariableOnRHS(stmt1)) { - CheckAtomicCaptureStmt(stmt1); - if (semantics::checkForSymbolMatch(stmt2)) { - // ATOMIC CAPTURE construct is of the form [capture-stmt, update-stmt] - CheckAtomicUpdateStmt(stmt2); - } else { - // ATOMIC CAPTURE construct is of the form [capture-stmt, write-stmt] - CheckAtomicWriteStmt(stmt2); - } - auto *v{stmt2Var.typedExpr.get()}; - auto *e{stmt1Expr.typedExpr.get()}; - if (v && e && !(v->v == e->v)) { - 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 (semantics::checkForSymbolMatch(stmt1) && - semantics::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 - auto *v{stmt1Var.typedExpr.get()}; - auto *e{stmt2Expr.typedExpr.get()}; - if (v && e && !(v->v == e->v)) { - 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()); + // 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{}}; + } } - } 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); + return std::nullopt; } -} -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; + 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 { - 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; - } + AnalyzedCondStmt result{std::move(*maybeCond), stmt.source, + GetActionStmt(std::get(s.t))}; + if (result.ift.stmt) { + return result; } } } - }; - if (leftHandClauseList) { - checkForValidMemoryOrderClause(leftHandClauseList); - } - if (rightHandClauseList) { - checkForValidMemoryOrderClause(rightHandClauseList); + return std::nullopt; } -} -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); + return std::nullopt; } -void OmpStructureChecker::Leave(const parser::OpenMPAtomicConstruct &) { - dirContext_.pop_back(); +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)); + } + + // 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"); +} + +namespace atomic { + +template static void MoveAppend(V &accum, V &&other) { + for (auto &&s : other) { + accum.push_back(std::move(s)); + } +} + +enum class Operator { + Unk, + // Operators that are officially allowed in the update operation + Add, + And, + Associated, + Div, + Eq, + Eqv, + Ge, // extension + Gt, + Identity, // extension: x = x is allowed (*), but we should never print + // "identity" as the name of the operator + Le, // extension + Lt, + Max, + Min, + Mul, + Ne, // extension + Neqv, + Or, + Sub, + // Operators that we recognize for technical reasons + True, + False, + Not, + Convert, + Resize, + Intrinsic, + Call, + Pow, + + // (*): "x = x + 0" is a valid update statement, but it will be folded + // to "x = x" by the time we look at it. Since the source statements + // "x = x" and "x = x + 0" will end up looking the same, accept the + // former as an extension. +}; + +std::string ToString(Operator op) { + switch (op) { + case Operator::Add: + return "+"; + case Operator::And: + return "AND"; + case Operator::Associated: + return "ASSOCIATED"; + case Operator::Div: + return "/"; + case Operator::Eq: + return "=="; + case Operator::Eqv: + return "EQV"; + case Operator::Ge: + return ">="; + case Operator::Gt: + return ">"; + case Operator::Identity: + return "identity"; + case Operator::Le: + return "<="; + case Operator::Lt: + return "<"; + case Operator::Max: + return "MAX"; + case Operator::Min: + return "MIN"; + case Operator::Mul: + return "*"; + case Operator::Neqv: + return "NEQV/EOR"; + case Operator::Ne: + return "/="; + case Operator::Or: + return "OR"; + case Operator::Sub: + return "-"; + case Operator::True: + return ".TRUE."; + case Operator::False: + return ".FALSE."; + case Operator::Not: + return "NOT"; + case Operator::Convert: + return "type-conversion"; + case Operator::Resize: + return "resize"; + case Operator::Intrinsic: + return "intrinsic"; + case Operator::Call: + return "function-call"; + case Operator::Pow: + return "**"; + default: + return "??"; + } } -// Clauses -// Mainly categorized as -// 1. Checks on 'OmpClauseList' from 'parse-tree.h'. -// 2. Checks on clauses which fall under 'struct OmpClause' from parse-tree.h. -// 3. Checks on clauses which are not in 'struct OmpClause' from parse-tree.h. +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) {} -void OmpStructureChecker::Leave(const parser::OmpClauseList &) { - // 2.7.1 Loop Construct Restriction - if (llvm::omp::allDoSet.test(GetContext().directive)) { - if (auto *clause{FindClause(llvm::omp::Clause::OMPC_schedule)}) { - // only one schedule clause is allowed - const auto &schedClause{std::get(clause->u)}; - auto &modifiers{OmpGetModifiers(schedClause.v)}; - auto *ordering{ - OmpGetUniqueModifier(modifiers)}; - if (ordering && - ordering->v == parser::OmpOrderingModifier::Value::Nonmonotonic) { - if (FindClause(llvm::omp::Clause::OMPC_ordered)) { - context_.Say(clause->source, - "The NONMONOTONIC modifier cannot be specified " - "if an ORDERED clause is specified"_err_en_US); - } + 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(Operator::True, Arguments{}) + : std::make_pair(Operator::False, Arguments{}); + } + return Default(); + } + + template // + Result operator()(const evaluate::FunctionRef &x) const { + Result result{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; + } - if (auto *clause{FindClause(llvm::omp::Clause::OMPC_ordered)}) { - // only one ordered clause is allowed - const auto &orderedClause{ - std::get(clause->u)}; + 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( + OperationCode(x), OperationArgs(x, std::index_sequence_for{})); + } + } - if (orderedClause.v) { - CheckNotAllowedIfClause( - llvm::omp::Clause::OMPC_ordered, {llvm::omp::Clause::OMPC_linear}); + template // + Result operator()(const evaluate::Designator &x) const { + evaluate::Designator copy{x}; + Result result{Operator::Identity, {AsGenericExpr(std::move(copy))}}; + return result; + } - if (auto *clause2{FindClause(llvm::omp::Clause::OMPC_collapse)}) { - const auto &collapseClause{ - std::get(clause2->u)}; - // ordered and collapse both have parameters - if (const auto orderedValue{GetIntValue(orderedClause.v)}) { - if (const auto collapseValue{GetIntValue(collapseClause.v)}) { - if (*orderedValue > 0 && *orderedValue < *collapseValue) { - context_.Say(clause->source, - "The parameter of the ORDERED clause must be " - "greater than or equal to " - "the parameter of the COLLAPSE clause"_err_en_US); - } - } - } - } + 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)...); } + } + } - // TODO: ordered region binding check (requires nesting implementation) +private: + template + Operator OperationCode( + const evaluate::Operation, Ts...> &op) + const { + 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::Unk; + } + template + Operator OperationCode( + const evaluate::Operation, Ts...> &op) const { + 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::Unk; + } + template + Operator OperationCode( + const evaluate::Operation, Ts...> &op) const { + return Operator::Add; + } + template + Operator OperationCode( + const evaluate::Operation, Ts...> &op) const { + return Operator::Sub; + } + template + Operator OperationCode( + const evaluate::Operation, Ts...> &op) const { + return Operator::Mul; + } + template + Operator OperationCode( + const evaluate::Operation, Ts...> &op) const { + return Operator::Div; + } + template + Operator OperationCode( + const evaluate::Operation, Ts...> &op) const { + return Operator::Pow; + } + template + Operator OperationCode( + const evaluate::Operation, Ts...> &op) const { + return Operator::Pow; + } + template + Operator OperationCode( + const evaluate::Operation, Ts...> &op) const { + if constexpr (C == T::category) { + return Operator::Resize; + } else { + return Operator::Convert; } - } // doSet + } + Operator OperationCode(const evaluate::ProcedureDesignator &proc) const { + 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; + } + template // + Operator OperationCode(const T &) const { + return Operator::Unk; + } - // 2.8.1 Simd Construct Restriction - if (llvm::omp::allSimdSet.test(GetContext().directive)) { - if (auto *clause{FindClause(llvm::omp::Clause::OMPC_simdlen)}) { - if (auto *clause2{FindClause(llvm::omp::Clause::OMPC_safelen)}) { - const auto &simdlenClause{ - std::get(clause->u)}; - const auto &safelenClause{ - std::get(clause2->u)}; - // simdlen and safelen both have parameters - if (const auto simdlenValue{GetIntValue(simdlenClause.v)}) { - if (const auto safelenValue{GetIntValue(safelenClause.v)}) { - if (*safelenValue > 0 && *simdlenValue > *safelenValue) { - context_.Say(clause->source, - "The parameter of the SIMDLEN clause must be less than or " - "equal to the parameter of the SAFELEN clause"_err_en_US); - } - } - } + template + Arguments OperationArgs(const evaluate::Operation &x, + std::index_sequence) const { + return Arguments{SomeExpr(x.template operand())...}; + } +}; + +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)); + (MoveAppend(v, std::move(results)), ...); + return v; + } +}; + +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 asSomeExpr(const T &x) const { + auto copy{x}; + return {AsGenericExpr(std::move(copy)), {}}; + } + + 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()); } + } - // 2.11.5 Simd construct restriction (OpenMP 5.1) - if (auto *sl_clause{FindClause(llvm::omp::Clause::OMPC_safelen)}) { - if (auto *o_clause{FindClause(llvm::omp::Clause::OMPC_order)}) { - const auto &orderClause{ - std::get(o_clause->u)}; - if (std::get(orderClause.v.t) == - parser::OmpOrderClause::Ordering::Concurrent) { - context_.Say(sl_clause->source, - "The `SAFELEN` clause cannot appear in the `SIMD` directive " - "with `ORDER(CONCURRENT)` clause"_err_en_US); - } + 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); } + }}; + (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; } - } // SIMD + } - // Semantic checks related to presence of multiple list items within the same - // clause - CheckMultListItems(); + 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; - if (GetContext().directive == llvm::omp::Directive::OMPD_task) { - if (auto *detachClause{FindClause(llvm::omp::Clause::OMPC_detach)}) { - unsigned version{context_.langOptions().OpenMPVersion}; - if (version == 50 || version == 51) { - // OpenMP 5.0: 2.10.1 Task construct restrictions + 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; +}; + +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 IsAllocatable(const SomeExpr &expr) { + std::vector dsgs{atomic::DesignatorCollector{}(expr)}; + assert(dsgs.size() == 1 && "Should have a single top-level designator"); + evaluate::SymbolVector syms{evaluate::GetSymbolVector(dsgs.front())}; + return !syms.empty() && IsAllocatable(syms.back()); +} + +static std::pair> GetTopLevelOperation( + const SomeExpr &expr) { + return atomic::ArgumentExtractor{}(expr); +} + +std::vector GetOpenMPTopLevelArguments(const SomeExpr &expr) { + return GetTopLevelOperation(expr).second; +} + +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 == atomic::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; + } + } + 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; +} + +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; +} + +MaybeExpr GetConvertInput(const SomeExpr &x) { + // This returns SomeExpr(x) when x is a designator/functionref/constant. + return atomic::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; + } +} + +bool IsSubexpressionOf(const SomeExpr &sub, const SomeExpr &super) { + return atomic::VariableFinder{sub}(super); +} + +static void SetExpr(parser::TypedExpr &expr, MaybeExpr value) { + if (value) { + expr.Reset(new evaluate::GenericExprWrapper(std::move(value)), + evaluate::GenericExprWrapper::Deleter); + } +} + +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::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()); + } + + if (std::optional dtype{atom.GetType()}) { + if (dtype->category() == TypeCategory::Character) { + context_.Say(source, + "Atomic variable %s cannot have CHARACTER type"_err_en_US, + atom.AsFortran()); + } else if (dtype->IsPolymorphic()) { + context_.Say(source, + "Atomic variable %s cannot have a polymorphic type"_err_en_US, + atom.AsFortran()); + } + // TODO: Check non-constant type parameters for non-character types. + // At the moment there don't seem to be any. + } + + if (IsAllocatable(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) { + 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)}; + bool cbu2{IsSubexpressionOf(as2.lhs, as2.rhs)}; + bool cbc1{IsVarOrFunctionRef(GetConvertInput(as1.rhs))}; + bool cbc2{IsVarOrFunctionRef(GetConvertInput(as2.rhs))}; + + // |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 { + errorCaptureShouldRead(act2.source, as1.lhs.AsFortran()); + return std::make_pair(nullptr, nullptr); + } + } 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); + } + 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 canont 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 { + CheckAtomicVariable(atom, rsrc); + CheckStorageOverlap(atom, {read.lhs}, source); + } + } else { + ErrorShouldBeVariable(read.rhs, rsrc); + } +} + +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{ + atomic::Operator::Unk, {}}; + if (auto &&maybeInput{GetConvertInput(update.rhs)}) { + top = GetTopLevelOperation(*maybeInput); + } + switch (top.first) { + case atomic::Operator::Add: + case atomic::Operator::Sub: + case atomic::Operator::Mul: + case atomic::Operator::Div: + case atomic::Operator::And: + case atomic::Operator::Or: + case atomic::Operator::Eqv: + case atomic::Operator::Neqv: + case atomic::Operator::Min: + case atomic::Operator::Max: + case atomic::Operator::Identity: + break; + case atomic::Operator::Call: + context_.Say(source, + "A call to this function is not a valid ATOMIC UPDATE operation"_err_en_US); + return; + case atomic::Operator::Convert: + context_.Say(source, + "An implicit or explicit type conversion is not a valid ATOMIC UPDATE operation"_err_en_US); + return; + case atomic::Operator::Intrinsic: + context_.Say(source, + "This intrinsic function is not a valid ATOMIC UPDATE operation"_err_en_US); + return; + case atomic::Operator::Unk: + context_.Say( + source, "This is not a valid ATOMIC UPDATE operation"_err_en_US); + return; + default: + context_.Say(source, + "The %s operator is not a valid ATOMIC UPDATE operation"_err_en_US, + atomic::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 { + nonAtom.push_back(*i); + } + } + return found; + }()}; + + if (unique == top.second.end()) { + if (top.first == atomic::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 { + 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(), atomic::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 atomic::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 atomic::Operator::Eq: + case atomic::Operator::Eqv: + // x ordop expr | expr ordop x + case atomic::Operator::Lt: + case atomic::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 { + context_.Say(assignSource, + "An argument of the %s operator should be the target of the assignment"_err_en_US, + atomic::ToString(top.first)); + } + break; + } + case atomic::Operator::True: + case atomic::Operator::False: + break; + default: + context_.Say(condSource, + "The %s operator is not a valid condition for ATOMIC operation"_err_en_US, + atomic::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) { + 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 { + 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)}; + auto maybeUpdate{GetEvaluateAssignment(uact.stmt)}; + auto maybeCapture{GetEvaluateAssignment(cact.stmt)}; + + if (!maybeUpdate || !maybeCapture) { + context_.Say(source, + "ATOMIC UPDATE CAPTURE operation both statements should be assignments"_err_en_US); + return; + } + + const evaluate::Assignment &update{*maybeUpdate}; + const evaluate::Assignment &capture{*maybeCapture}; + 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 { + context_.Say(capture.source, + "In ATOMIC UPDATE COMPARE CAPTURE the capture statement should be an assignment"_err_en_US); + return; + } + } else { + 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 { + context_.Say( + x.source, "ATOMIC READ operation should be an assignment"_err_en_US); + } + } 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; + } + + 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 { + 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) { + // 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 &) { + dirContext_.pop_back(); +} + +// Clauses +// Mainly categorized as +// 1. Checks on 'OmpClauseList' from 'parse-tree.h'. +// 2. Checks on clauses which fall under 'struct OmpClause' from parse-tree.h. +// 3. Checks on clauses which are not in 'struct OmpClause' from parse-tree.h. + +void OmpStructureChecker::Leave(const parser::OmpClauseList &) { + // 2.7.1 Loop Construct Restriction + if (llvm::omp::allDoSet.test(GetContext().directive)) { + if (auto *clause{FindClause(llvm::omp::Clause::OMPC_schedule)}) { + // only one schedule clause is allowed + const auto &schedClause{std::get(clause->u)}; + auto &modifiers{OmpGetModifiers(schedClause.v)}; + auto *ordering{ + OmpGetUniqueModifier(modifiers)}; + if (ordering && + ordering->v == parser::OmpOrderingModifier::Value::Nonmonotonic) { + if (FindClause(llvm::omp::Clause::OMPC_ordered)) { + context_.Say(clause->source, + "The NONMONOTONIC modifier cannot be specified " + "if an ORDERED clause is specified"_err_en_US); + } + } + } + + if (auto *clause{FindClause(llvm::omp::Clause::OMPC_ordered)}) { + // only one ordered clause is allowed + const auto &orderedClause{ + std::get(clause->u)}; + + if (orderedClause.v) { + CheckNotAllowedIfClause( + llvm::omp::Clause::OMPC_ordered, {llvm::omp::Clause::OMPC_linear}); + + if (auto *clause2{FindClause(llvm::omp::Clause::OMPC_collapse)}) { + const auto &collapseClause{ + std::get(clause2->u)}; + // ordered and collapse both have parameters + if (const auto orderedValue{GetIntValue(orderedClause.v)}) { + if (const auto collapseValue{GetIntValue(collapseClause.v)}) { + if (*orderedValue > 0 && *orderedValue < *collapseValue) { + context_.Say(clause->source, + "The parameter of the ORDERED clause must be " + "greater than or equal to " + "the parameter of the COLLAPSE clause"_err_en_US); + } + } + } + } + } + + // TODO: ordered region binding check (requires nesting implementation) + } + } // doSet + + // 2.8.1 Simd Construct Restriction + if (llvm::omp::allSimdSet.test(GetContext().directive)) { + if (auto *clause{FindClause(llvm::omp::Clause::OMPC_simdlen)}) { + if (auto *clause2{FindClause(llvm::omp::Clause::OMPC_safelen)}) { + const auto &simdlenClause{ + std::get(clause->u)}; + const auto &safelenClause{ + std::get(clause2->u)}; + // simdlen and safelen both have parameters + if (const auto simdlenValue{GetIntValue(simdlenClause.v)}) { + if (const auto safelenValue{GetIntValue(safelenClause.v)}) { + if (*safelenValue > 0 && *simdlenValue > *safelenValue) { + context_.Say(clause->source, + "The parameter of the SIMDLEN clause must be less than or " + "equal to the parameter of the SAFELEN clause"_err_en_US); + } + } + } + } + } + + // 2.11.5 Simd construct restriction (OpenMP 5.1) + if (auto *sl_clause{FindClause(llvm::omp::Clause::OMPC_safelen)}) { + if (auto *o_clause{FindClause(llvm::omp::Clause::OMPC_order)}) { + const auto &orderClause{ + std::get(o_clause->u)}; + if (std::get(orderClause.v.t) == + parser::OmpOrderClause::Ordering::Concurrent) { + context_.Say(sl_clause->source, + "The `SAFELEN` clause cannot appear in the `SIMD` directive " + "with `ORDER(CONCURRENT)` clause"_err_en_US); + } + } + } + } // SIMD + + // Semantic checks related to presence of multiple list items within the same + // clause + CheckMultListItems(); + + if (GetContext().directive == llvm::omp::Directive::OMPD_task) { + if (auto *detachClause{FindClause(llvm::omp::Clause::OMPC_detach)}) { + unsigned version{context_.langOptions().OpenMPVersion}; + if (version == 50 || version == 51) { + // OpenMP 5.0: 2.10.1 Task construct restrictions CheckNotAllowedIfClause(llvm::omp::Clause::OMPC_detach, {llvm::omp::Clause::OMPC_mergeable}); } else if (version >= 52) { @@ -3313,7 +4654,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) @@ -3942,40 +5282,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. @@ -4956,21 +6262,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) { @@ -5360,7 +6651,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 587959f7d506f..5fe64d35c9e4a 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 &); @@ -191,8 +183,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( @@ -264,14 +254,42 @@ 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 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); @@ -323,7 +341,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 bdafc03ad2c05..aa0f1ee9c2e59 100644 --- a/flang/lib/Semantics/resolve-names.cpp +++ b/flang/lib/Semantics/resolve-names.cpp @@ -1657,11 +1657,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/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-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/Parser/OpenMP/atomic-compare.f90 b/flang/test/Parser/OpenMP/atomic-compare.f90 deleted file mode 100644 index 5cd02698ff482..0000000000000 --- a/flang/test/Parser/OpenMP/atomic-compare.f90 +++ /dev/null @@ -1,16 +0,0 @@ -! 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 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..73899a9ff37f2 --- /dev/null +++ b/flang/test/Semantics/OpenMP/atomic-read.f90 @@ -0,0 +1,89 @@ +!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 + 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..2caa161507d49 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 -J /work2/kparzysz/git/llvm.org/b/x86/runtimes/runtimes-bins/openmp/runtime/src 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..d603ba8b3937c 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: This is not a valid ATOMIC 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..e0103be4cae4a 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: This is not a valid ATOMIC 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