diff --git a/flang/include/flang/Lower/OpenMP.h b/flang/include/flang/Lower/OpenMP.h index c5fb801d4b01c..1bfbbb008b633 100644 --- a/flang/include/flang/Lower/OpenMP.h +++ b/flang/include/flang/Lower/OpenMP.h @@ -113,6 +113,14 @@ resolveDeclareVariantCallee(const Fortran::semantics::Symbol &base, AbstractConverter &converter); } // namespace omp +// Materialize omp.declare_reduction ops for user-defined operator reduction +// declarations found in imported modules (separate compilation). If scope +// is null, materialize for the whole semantics global scope; otherwise, operate +// recursively starting at scope. +void materializeOpenMPDeclareReductions( + Fortran::lower::AbstractConverter &, Fortran::semantics::SemanticsContext &, + const Fortran::semantics::Scope *scope = nullptr); + } // namespace lower } // namespace Fortran diff --git a/flang/include/flang/Lower/Support/ReductionProcessor.h b/flang/include/flang/Lower/Support/ReductionProcessor.h index 7173fa9e33a31..f06cea8326395 100644 --- a/flang/include/flang/Lower/Support/ReductionProcessor.h +++ b/flang/include/flang/Lower/Support/ReductionProcessor.h @@ -98,15 +98,19 @@ class ReductionProcessor { const fir::KindMapping &kindMap, mlir::Type ty, bool isByRef); - /// Returns the module-unique name of the omp.declare_reduction op that - /// materializes a user-defined reduction (named or operator). The name is - /// derived from the reduction symbol's ultimate name, qualified with its - /// owning scope via AbstractConverter::mangleName, so that reductions with - /// the same spelling in different modules do not collide. The directive and - /// clause lowering must both use this to agree on the op's symbol name. + /// Returns the module-unique name of the omp.declare_reduction op for a + /// user-defined reduction (named or operator). Derived from the reduction + /// symbol's ultimate name, qualified with its owning scope via + /// AbstractConverter::mangleName so same-spelling reductions in different + /// modules do not collide, then suffixed with the reduction type (via + /// getReductionName) so a reduction listing several types produces one op per + /// type (single-type is N=1). The directive and clause sides must both call + /// this with the same unwrapped type and isByRef, since both tokens are part + /// of the name, or the names diverge. static std::string getScopedUserReductionName(AbstractConverter &converter, - const semantics::Symbol &reductionSymbol); + const semantics::Symbol &reductionSymbol, + mlir::Type reductionType, bool isByRef); /// This function returns the identity value of the operator \p /// reductionOpName. For example: diff --git a/flang/include/flang/Semantics/openmp-utils.h b/flang/include/flang/Semantics/openmp-utils.h index 6fc65c5e71765..e1b5b1b0c3f03 100644 --- a/flang/include/flang/Semantics/openmp-utils.h +++ b/flang/include/flang/Semantics/openmp-utils.h @@ -33,6 +33,7 @@ #include namespace Fortran::semantics { +class DeclTypeSpec; class Scope; class SemanticsContext; class Symbol; @@ -114,6 +115,31 @@ bool IsArrayElement(const parser::OmpObject &object, SemanticsContext *semaCtx); const Symbol *GetHostSymbol(const Symbol &sym); +// Resolve a user-defined reduction visible in scope under the mangled name +// mangledName (e.g. "op.myop." for operator(.myop.), or a named reduction). +// Follows USE associations, operator renames, private visibility, and merged +// generics exactly as the OpenMP semantic checks do, returning the found +// (non-ultimate) reduction symbol, or null if none is visible. When type is +// non-null, only a reduction that supports that type is accepted (used to +// disambiguate an operator that carries reductions for several types). When +// ambiguous is non-null, it is set true if more than one distinct reduction +// supports the type (an operator merged from several modules that each declare +// a reduction for it, or a mangled reduction name that collides across +// modules). +const Symbol *FindUserReductionSymbol(const Scope &scope, + const parser::CharBlock &mangledName, const DeclTypeSpec *type = nullptr, + bool *ambiguous = nullptr); + +// Resolve the user-defined reduction associated with the defined-operator +// symbol operatorSym. Delegates to FindUserReductionSymbol from scope (the +// scope where the reduction clause appears) with the operator's mangled +// ("op...") name. Searching from the clause scope, not the operator's owning +// scope, finds a reduction that is local, host-, or use-associated there (a +// reduction may be declared in a contained procedure that host-associates the +// operator from an enclosing module). type filters by supported type as above. +const Symbol *FindOperatorUserReductionSymbol(const Scope &scope, + const Symbol &operatorSym, const DeclTypeSpec *type = nullptr); + bool IsMapEnteringType(parser::OmpMapType::Value type); bool IsMapExitingType(parser::OmpMapType::Value type); diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index e2c895351c977..b27044956bd8a 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -580,6 +580,15 @@ class FirConverter : public Fortran::lower::AbstractConverter { *this, bridge.getSemanticsContext()); }); + // Ensure imported OpenMP user-defined operator declare reductions are + // materialized at module scope before lowering any reduction clauses that + // may reference them (the separate-compilation counterpart of same-file + // module reduction lowering). + createBuilderOutsideOfFuncOpAndDo([&]() { + Fortran::lower::materializeOpenMPDeclareReductions( + *this, bridge.getSemanticsContext()); + }); + // Create definitions of intrinsic module constants. createBuilderOutsideOfFuncOpAndDo( [&]() { createIntrinsicModuleDefinitions(pft); }); diff --git a/flang/lib/Lower/OpenMP/ClauseProcessor.cpp b/flang/lib/Lower/OpenMP/ClauseProcessor.cpp index 26438ef968008..1ccca2bfa3024 100644 --- a/flang/lib/Lower/OpenMP/ClauseProcessor.cpp +++ b/flang/lib/Lower/OpenMP/ClauseProcessor.cpp @@ -537,7 +537,8 @@ bool ClauseProcessor::processInclusive( bool ClauseProcessor::processInitializer( lower::SymMap &symMap, ReductionProcessor::GenInitValueCBTy &genInitValueCB, - const parser::OmpStylizedInstance *parserInitInstance) const { + const parser::OmpStylizedInstance *parserInitInstance, + unsigned instanceIdx) const { if (auto *clause = findUniqueClause()) { // Extract the typed assignment from the parser-level instance, if // the initializer is an assignment statement (as opposed to a call). @@ -552,13 +553,21 @@ bool ClauseProcessor::processInitializer( assign = &*wrapper->v; } } - genInitValueCB = [&, clause, assign](fir::FirOpBuilder &builder, - mlir::Location loc, mlir::Type type, - mlir::Value moldArg, - mlir::Value privArg) { + // A multi-type declare reduction carries one initializer instance per + // listed type (parallel to the combiner instances and typeNameList); select + // the one for the type being lowered (index instanceIdx). Single-type is + // index 0 of one. Capture instanceIdx by value: the callback runs later + // (during createDeclareReductionHelper), after this parameter's lifetime + // ends. + assert(instanceIdx < clause->v.size() && + "initializer instance index out of range"); + genInitValueCB = [&, clause, assign, + instanceIdx](fir::FirOpBuilder &builder, + mlir::Location loc, mlir::Type type, + mlir::Value moldArg, mlir::Value privArg) { lower::SymMapScope scope(symMap); mlir::Value ompPrivVar; - const StylizedInstance &inst = clause->v.front(); + const StylizedInstance &inst = clause->v[instanceIdx]; for (const Object &object : std::get(inst.t)) { diff --git a/flang/lib/Lower/OpenMP/ClauseProcessor.h b/flang/lib/Lower/OpenMP/ClauseProcessor.h index ff62d0ead8dc9..cb42b6524e2e7 100644 --- a/flang/lib/Lower/OpenMP/ClauseProcessor.h +++ b/flang/lib/Lower/OpenMP/ClauseProcessor.h @@ -97,7 +97,8 @@ class ClauseProcessor { bool processInitializer( lower::SymMap &symMap, ReductionProcessor::GenInitValueCBTy &genInitValueCB, - const parser::OmpStylizedInstance *parserInitInstance = nullptr) const; + const parser::OmpStylizedInstance *parserInitInstance = nullptr, + unsigned instanceIdx = 0) const; bool processMergeable(mlir::omp::MergeableClauseOps &result) const; bool processNogroup(mlir::omp::NogroupClauseOps &result) const; bool processNotinbranch(mlir::omp::NotinbranchClauseOps &result) const; diff --git a/flang/lib/Lower/OpenMP/OpenMP.cpp b/flang/lib/Lower/OpenMP/OpenMP.cpp index ed3e989daab7e..9f55f712ccd86 100644 --- a/flang/lib/Lower/OpenMP/OpenMP.cpp +++ b/flang/lib/Lower/OpenMP/OpenMP.cpp @@ -41,6 +41,7 @@ #include "flang/Parser/openmp-utils.h" #include "flang/Parser/parse-tree.h" #include "flang/Parser/tools.h" +#include "flang/Semantics/expression.h" #include "flang/Semantics/openmp-directive-sets.h" #include "flang/Semantics/openmp-utils.h" #include "flang/Semantics/tools.h" @@ -4798,7 +4799,7 @@ genOMP(lower::AbstractConverter &converter, lower::SymMap &symTable, static ReductionProcessor::GenCombinerCBTy processReductionCombiner( lower::AbstractConverter &converter, lower::SymMap &symTable, - semantics::SemanticsContext &semaCtx, const clause::Combiner &combiner, + semantics::SemanticsContext &semaCtx, const StylizedInstance &combinerInst, const parser::OmpStylizedInstance &parserInst) { // Extract the typed assignment from the parser-level instance, if // the combiner is an assignment statement (as opposed to a call). @@ -4812,7 +4813,11 @@ static ReductionProcessor::GenCombinerCBTy processReductionCombiner( assign = &*wrapper->v; } ReductionProcessor::GenCombinerCBTy genCombinerCB; - const StylizedInstance &inst = combiner.v.front(); + // Use the combiner instance for the type currently being lowered (one per + // listed type, in typeNameList order): a multi-type declare reduction carries + // a distinct stylized instance per type so omp_out/omp_in are re-typed for + // each. Single-type is index 0 of one. + const StylizedInstance &inst = combinerInst; semantics::SomeExpr evalExpr = std::get(inst.t); genCombinerCB = [&, evalExpr, assign](fir::FirOpBuilder &builder, @@ -4973,24 +4978,33 @@ static bool isSimpleReductionType(mlir::Type reductionType) { return false; } -// Getting the type from a symbol compared to a DeclSpec is simpler since we do -// not need to consider derived vs intrinsic types. Semantics is guaranteed to -// generate these symbols. +// Compute the reduction's element type from the given combiner instance's +// stylized declaration symbol (omp_out), without checking whether lowering +// supports it. A multi-type declare reduction carries one combiner instance per +// listed type (typeNameList order), so the caller passes the instance for the +// type being lowered. Shared by getReductionType (same-file, enforces support +// with a TODO) and materializeOpenMPDeclareReductions (skips an unsupported +// unused import via isSimpleReductionType instead of aborting the consumer). +// Getting the type from that symbol compared to the declared type-list (a +// DeclarationTypeSpec) is simpler since we do not need to consider derived vs +// intrinsic types. Semantics is guaranteed to generate these symbols. static mlir::Type -getReductionType(lower::AbstractConverter &converter, - const parser::OmpReductionSpecifier &specifier) { - const auto &combinerExpression = - std::get>(specifier.t) - .value(); - const parser::OmpStylizedInstance &combinerInstance = - combinerExpression.v.front(); +computeReductionType(lower::AbstractConverter &converter, + const parser::OmpStylizedInstance &combinerInstance) { const std::list &declList = std::get>(combinerInstance.t); const parser::OmpStylizedDeclaration &decl = declList.front(); const auto &name = std::get(decl.var.t); const auto &symbol = semantics::SymbolRef(*name.symbol); - mlir::Type reductionType = converter.genType(symbol); + return converter.genType(symbol); +} +// Return the reduction's element type, emitting a TODO if lowering does not +// support it. +static mlir::Type +getReductionType(lower::AbstractConverter &converter, + const parser::OmpStylizedInstance &combinerInstance) { + mlir::Type reductionType = computeReductionType(converter, combinerInstance); if (!isSimpleReductionType(reductionType)) TODO(converter.getCurrentLocation(), "declare reduction currently only supports trivial types, " @@ -5026,10 +5040,16 @@ appendCombiner(const parser::OmpDeclareReductionDirective &construct, llvm_unreachable("Expecting reduction combiner"); } -static void genOMP(lower::AbstractConverter &converter, lower::SymMap &symTable, - semantics::SemanticsContext &semaCtx, - lower::pft::Evaluation &eval, - const parser::OmpDeclareReductionDirective &construct) { +// Lower a single declare-reduction directive. Serves both same-file lowering +// (symOpt null) and separate-compilation materialization of an imported +// reduction (symOpt is the source symbol from +// materializeOpenMPDeclareReductions, with a fresh SymMap). Mirrors +// genOpenMPDeclareMapperImpl. +static void genOpenMPDeclareReductionImpl( + lower::AbstractConverter &converter, lower::SymMap &symTable, + semantics::SemanticsContext &semaCtx, + const parser::OmpDeclareReductionDirective &construct, + const semantics::Symbol *symOpt = nullptr) { if (semaCtx.langOptions().OpenMPSimd) return; @@ -5067,6 +5087,10 @@ static void genOMP(lower::AbstractConverter &converter, lower::SymMap &symTable, initExpr ? initExpr->v.begin() : std::list::const_iterator{}; + // Index of the type currently being lowered within the parallel per-type + // lists: typeNameList.v, the clause-level combiner instances (combiner.v), + // and the clause-level initializer instances. Single-type is index 0 of one. + unsigned instanceIdx = 0; for (const auto &typeSpec : typeNameList.v) { (void)typeSpec; // Currently unused @@ -5074,7 +5098,7 @@ static void genOMP(lower::AbstractConverter &converter, lower::SymMap &symTable, "Mismatched combiner instance count"); const parser::OmpStylizedInstance &parserInst = *parserInstIt++; - mlir::Type reductionType = getReductionType(converter, specifier); + mlir::Type reductionType = getReductionType(converter, parserInst); bool isByRef = ReductionProcessor::doReductionByRef(reductionType); // Compute the canonical reduction name the same way // processReductionArguments does. @@ -5095,41 +5119,54 @@ static void genOMP(lower::AbstractConverter &converter, lower::SymMap &symTable, -> std::string { // Directive side of the user-defined operator reduction // naming contract (the clause side is in - // ReductionProcessor::processReductionArguments). - // opName.v.sym() is the reduction symbol - // "op". Only single-declaration, single-type - // reductions are supported; otherwise emit a clean - // TODO. + // ReductionProcessor::processReductionArguments). Name + // the op via getScopedUserReductionName from the + // symbol's ultimate (name, owner) plus the per-type + // suffix, byte-identical to the clause reference. + // symOpt supplies the source symbol for separate + // compilation, else opName.v.sym(). Runs once per + // listed type (the enclosing loop walks typeNameList in + // lockstep with the per-type combiner/initializer + // instances), emitting one op per (operator, type); + // single-type is N=1. const semantics::Symbol &redSym = - opName.v.sym()->GetUltimate(); + symOpt ? symOpt->GetUltimate() + : opName.v.sym()->GetUltimate(); const auto *userDetails = redSym.detailsIf(); - if (!userDetails || typeNameList.v.size() != 1 || - userDetails->GetDeclList().size() != 1 || - userDetails->GetTypeList().size() != 1) + if (!userDetails) TODO(converter.getCurrentLocation(), "OpenMP user-defined operator declare reduction " - "with multiple declarations or multiple types"); + "without user reduction details"); return ReductionProcessor::getScopedUserReductionName( - converter, redSym); + converter, redSym, reductionType, isByRef); }, }, defOp.u); }, [&](const clause::ProcedureDesignator &pd) -> std::string { - // Qualify the name with the scope in which the user-defined - // reduction is declared so that reductions with the same name - // in different scopes produce distinct omp.declare_reduction ops. - const semantics::Symbol *sym = pd.v.sym(); - std::string name = sym->name().ToString(); - return converter.mangleName(name, sym->GetUltimate().owner()); + // Directive side of the named-reduction naming contract (clause + // side in ReductionProcessor::processReductionArguments). Name + // the op via getScopedUserReductionName from the source symbol's + // ultimate (name, owner) plus the per-type suffix, byte-identical + // to the clause reference. symOpt supplies the source symbol for + // separate compilation, else pd.v.sym(); GetUltimate keeps the + // name stable across a plain `use`. reductionType is the declared + // element type (already canonical), so unlike the clause side it + // needs no namingType normalization. + const semantics::Symbol &redSym = + (symOpt ? *symOpt : *pd.v.sym()).GetUltimate(); + return ReductionProcessor::getScopedUserReductionName( + converter, redSym, reductionType, isByRef); }, }, redOp.u); + assert(instanceIdx < combiner.v.size() && + "Mismatched combiner instance count"); ReductionProcessor::GenCombinerCBTy genCombinerCB = - processReductionCombiner(converter, symTable, semaCtx, combiner, - parserInst); + processReductionCombiner(converter, symTable, semaCtx, + combiner.v[instanceIdx], parserInst); const parser::OmpStylizedInstance *parserInitInst = nullptr; if (initExpr) { assert(parserInitInstIt != initExpr->v.end() && @@ -5153,7 +5190,8 @@ static void genOMP(lower::AbstractConverter &converter, lower::SymMap &symTable, ReductionProcessor::GenInitValueCBTy genInitValueCB; ClauseProcessor cp(converter, semaCtx, clauses); - if (!cp.processInitializer(symTable, genInitValueCB, parserInitInst)) { + if (!cp.processInitializer(symTable, genInitValueCB, parserInitInst, + instanceIdx)) { // No initializer clause provided. Per OpenMP, initialize as // default-initialized using the shared inline init helper. const semantics::DerivedTypeSpec *derivedTypeSpec = nullptr; @@ -5206,9 +5244,22 @@ static void genOMP(lower::AbstractConverter &converter, lower::SymMap &symTable, mlir::omp::DeclareReductionOp>( converter, reductionNameStr, redType, converter.getCurrentLocation(), isByRef, genCombinerCB, genInitValueCB, reductionSym); + ++instanceIdx; } } +// Same-file delegator for a declare-reduction directive. Mirrors the +// declare-mapper delegator: it forwards the enclosing SymMap so the combiner/ +// initializer callbacks share the current scope. Separate-compilation +// materialization instead calls genOpenMPDeclareReductionImpl directly with a +// fresh SymMap and the source reduction symbol. +static void genOMP(lower::AbstractConverter &converter, lower::SymMap &symTable, + semantics::SemanticsContext &semaCtx, + lower::pft::Evaluation &eval, + const parser::OmpDeclareReductionDirective &construct) { + genOpenMPDeclareReductionImpl(converter, symTable, semaCtx, construct); +} + static void genOMP(lower::AbstractConverter &converter, lower::SymMap &symTable, semantics::SemanticsContext &semaCtx, lower::pft::Evaluation &eval, @@ -6372,3 +6423,105 @@ void Fortran::lower::materializeOpenMPDeclareMappers( } } } + +// Walk scopes and materialize omp.declare_reduction ops for user-defined +// operator reductions imported from modules. If scope is null, start from the +// global scope. Mirrors materializeOpenMPDeclareMappers: gating on mod-file +// module scopes restricts this to separate compilation (a same-file module's op +// is emitted by the primary translation pass). +void Fortran::lower::materializeOpenMPDeclareReductions( + Fortran::lower::AbstractConverter &converter, + semantics::SemanticsContext &semaCtx, const semantics::Scope *scope) { + const semantics::Scope &root = scope ? *scope : semaCtx.globalScope(); + + // Recurse into child scopes first (modules, submodules, etc.). + for (const semantics::Scope &child : root.children()) + materializeOpenMPDeclareReductions(converter, semaCtx, &child); + + // Only consider module scopes to avoid duplicating local constructs. + if (!root.IsModule()) + return; + + // Only materialize for modules coming from mod files to avoid duplicates. + if (!root.symbol() || !root.symbol()->test(semantics::Symbol::Flag::ModFile)) + return; + + // Scan symbols in this module scope for UserReductionDetails. + for (auto &it : root) { + const semantics::Symbol &sym = *it.second; + const semantics::Symbol &ultimate = sym.GetUltimate(); + const auto *userDetails = + ultimate.detailsIf(); + if (!userDetails) + continue; + // Skip without calling the impl: a consumer that merely uses this module + // must compile even when the reduction is out of the clause-side resolver's + // reach. Eagerly lowering a private-ultimate reduction would trip the + // impl's + // TODO and abort an unused import; a program that references it still gets + // the clause-side TODO. The impl's typeNameList loop materializes multiple + // declarations and types (one op per type); the per-declaration skips below + // guard the remaining unsupported shapes (combiner-in-clause and + // unsupported element types). + if (ultimate.attrs().test(semantics::Attr::PRIVATE)) + continue; + for (const auto *decl : userDetails->GetDeclList()) { + if (const auto *reductionDecl = + std::get_if(&decl->u)) { + // An unused import must not abort the consumer, so skip a shape the + // impl cannot lower (a program that references it still gets the + // clause-side + // TODO), completing the mandatory skip above (which covers only + // private). + const auto &specifier = + DEREF(parser::omp::GetFirstArgument( + reductionDecl->v)); + // The combiner-in-clause form (declare reduction(id:type) + // combiner(...), OpenMP 6.0) is not yet lowered even in the same-file + // path; computeReductionType and the impl both read the combiner from + // the specifier. + if (!std::get>(specifier.t) + .has_value()) + continue; + // A reduction type lowering does not yet support: mirror the impl's + // getReductionType check with the shared predicate. A single + // declaration may list several types (Form A), each with its own + // combiner instance; the impl emits one op per type in a single call, + // so skip the whole declaration if any listed type is unsupported + // (materializing only a subset is not expressible through the impl's + // all-types loop). + const parser::OmpCombinerExpression &combinerExpr = + std::get>(specifier.t) + .value(); + bool anyUnsupportedType = false; + for (const parser::OmpStylizedInstance &combinerInst : combinerExpr.v) { + if (!isSimpleReductionType( + computeReductionType(converter, combinerInst))) { + anyUnsupportedType = true; + break; + } + } + if (anyUnsupportedType) + continue; + // Mod-file reading runs only ResolveNames, so an imported combiner and + // initializer carry bound names but null + // typedExpr/typedCall/typedAssignment (the same-file path fills these + // later in PerformStatementSemantics, which mod-file reading skips). + // Lowering below reads the typed forms, so run expression analysis over + // this imported directive now. Doing it here rather than in the + // mod-file reader scopes the analysis to the reductions actually + // materialized and leaves mod-file reading unchanged for other + // consumers. + semantics::ExprChecker checker{semaCtx}; + parser::Walk(*reductionDecl, checker); + // Fresh, materialization-local SymMap: the combiner/initializer + // callbacks created inside the impl capture it by reference and run + // synchronously during createDeclareReductionHelper, so it must + // outlive the impl call (do not reuse Bridge's localSymbols). + lower::SymMap materializeSymTable; + genOpenMPDeclareReductionImpl(converter, materializeSymTable, semaCtx, + *reductionDecl, &sym); + } + } + } +} diff --git a/flang/lib/Lower/Support/ReductionProcessor.cpp b/flang/lib/Lower/Support/ReductionProcessor.cpp index b0a2fe63ef81f..350353e7ad1c0 100644 --- a/flang/lib/Lower/Support/ReductionProcessor.cpp +++ b/flang/lib/Lower/Support/ReductionProcessor.cpp @@ -23,6 +23,7 @@ #include "flang/Optimizer/Builder/Todo.h" #include "flang/Optimizer/Dialect/FIRType.h" #include "flang/Optimizer/HLFIR/HLFIROps.h" +#include "flang/Semantics/openmp-utils.h" #include "mlir/Dialect/OpenMP/OpenMPDialect.h" #include "llvm/Support/CommandLine.h" #include @@ -220,14 +221,27 @@ ReductionProcessor::getReductionName(ReductionIdentifier redId, } std::string ReductionProcessor::getScopedUserReductionName( - AbstractConverter &converter, const semantics::Symbol &reductionSymbol) { + AbstractConverter &converter, const semantics::Symbol &reductionSymbol, + mlir::Type reductionType, bool isByRef) { // Qualify the reduction symbol's ultimate name with its owning scope so that // user-defined reductions with the same spelling in different modules get // distinct op names. Use the (name, scope) mangleName overload: the // (symbol) overload does not handle UserReductionDetails. const semantics::Symbol &ultimate = reductionSymbol.GetUltimate(); std::string name = ultimate.name().ToString(); - return converter.mangleName(name, ultimate.owner()); + std::string scopedName = converter.mangleName(name, ultimate.owner()); + // Append the type and by-ref suffix, as the intrinsic reductions do, so a + // declare reduction listing several types produces one op per type and every + // name ends in a type-grammar token. Suffix unconditionally, even for one + // type: otherwise a multi-type myred's per-type op "myred_i32" would collide + // with a single-type reduction named "myred_i32", and the by-name dedup would + // bind one reduction's clause to the other's combiner (a silent miscompile). + // The by-ref token also gives an allocatable/pointer trivial reduction (a + // boxed by-ref operand of a by-value declared type) a name the directive + // never emitted, so it reaches a clean TODO instead of binding a by-value op + // to a box (handled by llvm-project#186765). + return getReductionName(scopedName, converter.getFirOpBuilder().getKindMap(), + reductionType, isByRef); } mlir::Value @@ -710,25 +724,17 @@ bool ReductionProcessor::processReductionArguments( redOperatorList.front(); if (!std::holds_alternative(redOperator.u)) { - if (const auto *reductionIntrinsic = - std::get_if(&redOperator.u)) { - if (!ReductionProcessor::supportedIntrinsicProcReduction( - *reductionIntrinsic)) { - // If not an intrinsic is has to be a custom reduction op, and should - // be available in the module. The op is named using the scope in - // which the user-defined reduction was declared, so qualify the - // lookup name the same way the declaration and use sides do. - semantics::Symbol *sym = reductionIntrinsic->v.sym(); - mlir::ModuleOp module = builder.getModule(); - std::string declName = getRealName(sym).ToString(); - declName = converter.mangleName(declName, sym->GetUltimate().owner()); - auto decl = module.lookupSymbol(declName); - if (!decl) - return false; - } - } else { - return false; - } + // A named (procedure-designator) reduction, the only other alternative. + // Defer validation to the per-variable loop below: a named reduction's op + // is named per the variable's type (getScopedUserReductionName appends + // the type suffix), so its existence and type can only be checked once + // the variable type is known. The loop resolves the symbol, confirms its + // ultimate has UserReductionDetails, looks the op up by the type-specific + // name, and emits a clean TODO if missing or type-mismatched. + assert(std::holds_alternative( + redOperator.u) && + "ReductionIdentifier variant has only DefinedOperator and " + "ProcedureDesignator"); } } @@ -857,52 +863,89 @@ bool ReductionProcessor::processReductionArguments( omp::clause::ReductionOperatorList>) { const Fortran::lower::omp::clause::ReductionOperator &redOperator = redOperatorList.front(); + // Name user-defined reduction ops from the canonical element type, not + // the raw lowered variable type. An allocatable/pointer variable lowers + // to a boxed reference (!fir.ref>>>), but + // the directive names its op from the declared element type + // (!fir.char<1>); getReductionName unwraps only one reference level, so + // without stripping the ref/box/heap/pointer wrappers the by-ref suffix + // diverges and a valid allocatable-character reduction is wrongly + // rejected. Keep any array fir::SequenceType. Only naming and the type + // check use namingType; redType stays intact for op binding. + mlir::Type namingType = + fir::unwrapPassByRefType(fir::unwrapRefType(redType)); + // An allocatable/pointer reduction of a trivial element type is a case + // the directive does not materialize: it emits the scalar by-value op, + // and binding the boxed by-ref operand to it is invalid IR. In the + // default mode the by-ref name suffix diverges (boxed clause by-ref, + // scalar op by-value), the lookup misses, and it is a clean TODO. Under + // -mmlir + // --force-byref-reduction both sides are forced by-ref, the names match, + // and the element-only type check (i32 == i32) would bind the box to the + // scalar op. Guard on the inherent triviality of the element type, not + // doReductionByRef (which the flag forces), so it is a clean TODO in + // every mode; boxed character and derived reductions (genuinely by-ref) + // still bind. Deferred to flang PR #186765. + const bool isBoxedTrivialReduction = + mlir::isa(fir::unwrapRefType(redType)) && + fir::isa_trivial(namingType); if (const auto &redDefinedOp = std::get_if(&redOperator.u)) { if (const auto *definedOpName = std::get_if( &redDefinedOp->u)) { // User-defined operator reduction (e.g. reduction(.myop.:x)). Resolve - // the use-site operator to its reduction symbol, which semantics - // names "op" (MangleDefinedOperator in resolve-names), in - // the current scope, then reference the omp.declare_reduction op the - // directive materialized for it. Only a locally-declared, - // single-declaration, single-type reduction whose type the variable - // supports is handled here; anything else (imported, renamed, merged, - // or multiple declarations/types) is a clean TODO rather than a crash - // or a wrong binding. + // the use-site operator to the source reduction symbol as the OpenMP + // semantic checks do (resolving from the clause scope, so it follows + // USE and host association, operator renames, private visibility, and + // merged generics), then reference the + // omp.declare_reduction op named from that symbol's scoped (name, + // owner). Reductions in different source modules have distinct owner + // scopes, so a same-spelling/same-type operator reduction imported + // from two modules yields two distinct ops, each clause binding its + // own combiner instead of colliding onto one. The variable's type + // selects the matching per-type op name (getScopedUserReductionName + // appends the type), so a multiple-declaration/multiple-type operator + // is handled (one op per type). An operator with no reduction for the + // variable's type, or a variable with no type, is a clean TODO rather + // than a crash or a wrong binding. const semantics::Symbol *opSym = definedOpName->v.sym(); - std::string mangledName = "op" + opSym->name().ToString(); - const semantics::Symbol *redSym = - converter.getCurrentScope().FindSymbol( - parser::CharBlock{mangledName}); + const semantics::DeclTypeSpec *varType = + reductionSymbols[idx]->GetUltimate().GetType(); + // The variable's type disambiguates an operator that carries + // reductions for several types (e.g. a generic merged from multiple + // single-type modules): the resolver returns only a reduction that + // supports varType. + const semantics::Symbol *resolvedSym = + semantics::omp::FindOperatorUserReductionSymbol( + converter.getCurrentScope(), *opSym, varType); + // resolvedSym is the found symbol, which may be a USE-associated + // wrapper; take its ultimate before reading the reduction details. const semantics::Symbol *ultimate = - redSym ? &redSym->GetUltimate() : nullptr; + resolvedSym ? &resolvedSym->GetUltimate() : nullptr; const semantics::UserReductionDetails *userDetails = ultimate ? ultimate->detailsIf() : nullptr; - const semantics::DeclTypeSpec *varType = - reductionSymbols[idx]->GetUltimate().GetType(); - if (!redSym || ultimate != redSym || !userDetails || - userDetails->GetDeclList().size() != 1 || - userDetails->GetTypeList().size() != 1 || !varType || - !userDetails->SupportsType(*varType)) { + if (!varType || !resolvedSym || !userDetails) { TODO(currentLocation, "OpenMP user-defined operator reduction is not yet supported " - "for imported, renamed, or multiple-declaration/type " - "reductions"); + "when the variable has no type or no matching reduction is " + "visible for its type"); } std::string opName = ReductionProcessor::getScopedUserReductionName( - converter, *redSym); + converter, *resolvedSym, namingType, isByRef); mlir::ModuleOp module = builder.getModule(); auto existingDecl = module.lookupSymbol(opName); // The MLIR verifier does not type-check these ops (they have no // atomic region), so this is the only guard against binding a - // mismatched declaration. Compare unwrapped types: the clause redType - // is always a reference type, while the op stores the unwrapped type - // for by-value reductions. - if (!existingDecl || fir::unwrapRefType(existingDecl.getType()) != - fir::unwrapRefType(redType)) { + // mismatched declaration. Compare unwrapped element types: namingType + // is the canonical reduction element type (allocatable/pointer + // storage wrappers stripped), matching the type the op was named and + // created from on the directive side. + if (!existingDecl || + fir::unwrapRefType(existingDecl.getType()) != + fir::unwrapRefType(namingType) || + isBoxedTrivialReduction) { TODO(currentLocation, "OpenMP user-defined operator reduction declaration was not " "materialized for this type"); @@ -946,17 +989,47 @@ bool ReductionProcessor::processReductionArguments( &redOperator.u)) { if (!ReductionProcessor::supportedIntrinsicProcReduction( *reductionIntrinsic)) { - // Custom reductions we can just add to the symbols without - // generating the declare reduction op. + // A user-defined named reduction (declare reduction(myred: ...)). The + // clause references the (possibly USE-associated) reduction symbol; + // bind its pre-materialized omp.declare_reduction op instead of + // generating a new one. semantics::Symbol *sym = reductionIntrinsic->v.sym(); - // Qualify the name with the scope in which the user-defined - // reduction was declared so that reductions with the same name in - // different scopes refer to distinct omp.declare_reduction ops. - std::string reductionName = getRealName(sym).ToString(); - reductionName = - converter.mangleName(reductionName, sym->GetUltimate().owner()); - reductionDeclSymbols.push_back( - mlir::SymbolRefAttr::get(builder.getContext(), reductionName)); + if (!sym->GetUltimate() + .detailsIf()) { + // Not a supported intrinsic proc (checked just above) and not a + // user-defined reduction: a clean TODO, never a wrong binding. (A + // named reduction reusing an intrinsic spelling such as `max` is + // handled by the supportedIntrinsicProcReduction branch, not here.) + TODO(currentLocation, "Lowering unrecognised reduction type"); + } + // Name the op from the resolved symbol's scoped ultimate (name, + // owner) plus the per-type suffix, byte-identical to the + // directive/materializer side, via getScopedUserReductionName. + // Reductions of the same spelling in different scopes refer to + // distinct ops, and a named reduction listing several types binds the + // op for the variable's type instead of colliding on the first type's + // op. namingType is the canonical element type (storage wrappers + // stripped) so the by-ref suffix matches the directive. + std::string reductionName = + ReductionProcessor::getScopedUserReductionName( + converter, *sym, namingType, isByRef); + mlir::ModuleOp module = builder.getModule(); + auto existingDecl = module.lookupSymbol(reductionName); + // The MLIR verifier does not type-check these ops, so this is the + // only guard against binding a missing or mismatched declaration + // (e.g. a named declare reduction that does not list the variable's + // type). Compare unwrapped element types against namingType, the type + // the op was named and created from. + if (!existingDecl || + fir::unwrapRefType(existingDecl.getType()) != + fir::unwrapRefType(namingType) || + isBoxedTrivialReduction) { + TODO(currentLocation, + "OpenMP user-defined named reduction declaration was not " + "materialized for the variable's type"); + } + reductionDeclSymbols.push_back(mlir::SymbolRefAttr::get( + builder.getContext(), existingDecl.getSymName())); ++idx; continue; } @@ -984,21 +1057,25 @@ bool ReductionProcessor::processReductionArguments( // implicit intrinsic reduction still applies, so fall through to it. if (userDetails && varType && userDetails->SupportsType(*varType)) { // The user declaration takes precedence over the intrinsic for this - // type. Only a locally-declared, single-declaration, single-type - // reduction is currently supported. - if (&ultimate != redSym || userDetails->GetDeclList().size() != 1 || - userDetails->GetTypeList().size() != 1) { - TODO(currentLocation, - "OpenMP user-defined reduction shadowing an intrinsic " - "reduction is not yet supported for imported, renamed, or " - "multiple-declaration/type reductions."); - } + // type. A declaration listing several types (or several merged + // declarations) is handled the same way as the operator and named + // paths: the directive emits one op per type and the variable's + // type selects the matching per-type name below. A USE-associated + // shadowing reduction is found by FindSymbol as a use wrapper; + // naming from its ultimate (name, owner) below binds the source + // module's op, which materializeOpenMPDeclareReductions emits, + // exactly as the named path does. A renamed shadowing intrinsic + // does not reach here: the renamed name resolves to the intrinsic + // rather than the user reduction, so semantics rejects the clause + // with a type-incompatibility error before lowering. std::string opName = ReductionProcessor::getScopedUserReductionName( - converter, ultimate); + converter, ultimate, namingType, isByRef); mlir::ModuleOp module = builder.getModule(); auto existingDecl = module.lookupSymbol(opName); - if (!existingDecl || fir::unwrapRefType(existingDecl.getType()) != - fir::unwrapRefType(redType)) { + if (!existingDecl || + fir::unwrapRefType(existingDecl.getType()) != + fir::unwrapRefType(namingType) || + isBoxedTrivialReduction) { TODO(currentLocation, "OpenMP user-defined reduction declaration was not " "materialized for this type"); diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp index 68d7a166be0fb..467b9c9696170 100644 --- a/flang/lib/Semantics/check-omp-structure.cpp +++ b/flang/lib/Semantics/check-omp-structure.cpp @@ -3838,131 +3838,6 @@ void OmpStructureChecker::Enter(const parser::OmpClause::TaskReduction &x) { CheckReductionObjects(objects, llvm::omp::Clause::OMPC_task_reduction); } -// Compute the mangled reduction name to look up in a reduction's source module. -// If the operator was renamed on import (e.g. USE m, ONLY: operator(.local.) => -// operator(.remote.)), the local mangled name will not match in the source -// module; re-derive the lookup name from the source operator's ultimate name. -// Only defined operators can be renamed (intrinsic operators and named -// reductions cannot), so a detected rename always has a ".op." source name. -// For non-renamed lookups the original mangled name is returned unchanged. -static std::string SourceReductionName(const parser::CharBlock &mangledName, - const parser::CharBlock &localName, const parser::CharBlock &sourceName) { - if (sourceName != localName && sourceName.size() >= 3 && - sourceName.front() == '.' && sourceName.back() == '.') { - return MangleDefinedOperator(sourceName); - } - return mangledName.ToString(); -} - -// Return the reduction details of `symbol` if it is a user reduction that -// supports `type` (any type when `type` is null). -static const UserReductionDetails *AcceptReduction( - const Symbol &symbol, const DeclTypeSpec *type) { - const auto *details{symbol.GetUltimate().detailsIf()}; - if (details && (!type || details->SupportsType(*type))) { - return details; - } - return nullptr; -} - -// A reduction symbol is locally declared (authoritative) when it is not reached -// through any USE association, even via host association. Such a reduction -// shadows reductions imported or reachable through its operator. -static bool IsLocalReduction(const Symbol &symbol) { - const Symbol *s{&symbol}; - while (const auto *host{s->detailsIf()}) { - s = &host->symbol(); - } - return !s->detailsIf(); -} - -// Search for a user reduction supporting `type` by following the operator/ -// procedure symbol `opSym` through its USE associations and merged generic -// sources. Each module the operator passes through is checked for a (possibly -// renamed) reduction; `localName` is the operator name written at the use site, -// used to detect renames. A locally declared reduction in a module is -// authoritative: it is returned if it supports the type, otherwise it shadows -// reductions reachable further along that branch. -static const UserReductionDetails *SearchOperatorReduction(const Symbol &opSym, - const parser::CharBlock &mangledName, const parser::CharBlock &localName, - const DeclTypeSpec *type, llvm::SmallPtrSetImpl &visited) { - if (!visited.insert(&opSym).second) { - return nullptr; - } - const Scope &scope{opSym.owner()}; - if (scope.kind() == Scope::Kind::Module) { - std::string lookupName{ - SourceReductionName(mangledName, localName, opSym.name())}; - auto it{scope.find(parser::CharBlock{lookupName})}; - if (it != scope.end()) { - const Symbol &reductionSym{*it->second}; - const Symbol &reductionUltimate{reductionSym.GetUltimate()}; - if (!reductionUltimate.attrs().test(Attr::PRIVATE)) { - if (const auto *details{AcceptReduction(reductionUltimate, type)}) { - return details; - } - // A locally declared reduction here shadows reductions reachable - // further along this branch. - if (reductionUltimate.detailsIf() && - IsLocalReduction(reductionSym)) { - return nullptr; - } - } - } - } - // Follow a USE-associated operator to the module it was imported from. - if (const auto *use{opSym.detailsIf()}) { - return SearchOperatorReduction( - use->symbol(), mangledName, localName, type, visited); - } - // Search each module merged into a generic operator (recursing through - // re-exporting facade modules). - if (const auto *generic{opSym.detailsIf()}) { - for (const Symbol &useSym : generic->uses()) { - if (const auto *details{SearchOperatorReduction( - useSym, mangledName, localName, type, visited)}) { - return details; - } - } - } - return nullptr; -} - -// Find user reduction details for a mangled name, following USE associations -// when the reduction is not directly visible in the scope. A type may be -// supplied to disambiguate an operator that carries reductions for several -// types (e.g. a generic merged from multiple modules); a candidate is accepted -// only if it supports that type. A locally declared reduction is authoritative -// for its operator in its scope and shadows USE-associated reductions. -static const UserReductionDetails *FindUserReduction(const Scope &scope, - const parser::CharBlock &mangledName, const DeclTypeSpec *type = nullptr) { - // Direct lookup: a reduction directly visible via bare USE or a local - // declaration. - const Symbol *directSymbol{scope.FindSymbol(mangledName)}; - if (directSymbol) { - if (const auto *details{AcceptReduction(*directSymbol, type)}) { - return details; - } - // A locally declared reduction that does not support the requested type is - // authoritative: it shadows USE-associated reductions (ProcessReduction- - // Specifier erases the latter), so do not resurrect them via the operator. - if (directSymbol->GetUltimate().detailsIf() && - IsLocalReduction(*directSymbol)) { - return nullptr; - } - } - // Trace the operator/procedure to the modules that declare its reduction. - std::string fortranName{GetReductionFortranId(mangledName)}; - const Symbol *opSymbol{ - fortranName.empty() ? nullptr : scope.FindSymbol(fortranName)}; - if (!opSymbol) { - return nullptr; - } - llvm::SmallPtrSet visited; - return SearchOperatorReduction( - *opSymbol, mangledName, opSymbol->name(), type, visited); -} - bool OmpStructureChecker::CheckReductionOperator( const parser::OmpReductionIdentifier &ident, parser::CharBlock source, llvm::omp::Clause clauseId) { @@ -3993,12 +3868,12 @@ bool OmpStructureChecker::CheckReductionOperator( if (const auto *definedOp{std::get_if(&dOpr.u)}) { std::string mangled{MangleDefinedOperator(definedOp->v.symbol->name())}; // Look up the user-defined reduction in the scope where the clause - // appears (FindUserReduction searches enclosing scopes for host + // appears (FindUserReductionSymbol searches enclosing scopes for host // association), not in the scope where the operator itself is declared: // the DECLARE REDUCTION may be local to a procedure that host-associates // the operator from an enclosing module or program unit. const Scope &scope{context_.FindScope(source)}; - if (FindUserReduction(scope, mangled)) { + if (omp::FindUserReductionSymbol(scope, mangled)) { return true; } } @@ -4086,9 +3961,62 @@ void OmpStructureChecker::CheckReductionObjects( static bool CheckSymbolSupportsType(const Scope &scope, const parser::CharBlock &name, const DeclTypeSpec &type) { - // FindUserReduction only returns a reduction that supports the requested - // type. - return FindUserReduction(scope, name, &type) != nullptr; + // FindUserReductionSymbol only returns a reduction that supports the + // requested type. + return omp::FindUserReductionSymbol(scope, name, &type) != nullptr; +} + +// Compute the mangled reduction symbol name for a reduction identifier (a +// defined or intrinsic operator, or a special function / named reduction), so a +// declared reduction can be looked up. A defined operator mangles to a +// dynamically built name kept alive in `buffer`; the other kinds return a +// pointer to stable storage. +static std::optional MangledReductionIdentifier( + const parser::OmpReductionIdentifier &ident, SemanticsContext &context, + std::string &buffer) { + return common::visit( + common::visitors{ + [&](const parser::DefinedOperator &dOpr) + -> std::optional { + if (const auto *intrinsicOp{ + std::get_if( + &dOpr.u)}) { + return MakeNameFromOperator(*intrinsicOp, context); + } + if (const auto *definedOp{ + std::get_if(&dOpr.u)}; + definedOp && definedOp->v.symbol) { + buffer = MangleDefinedOperator(definedOp->v.symbol->name()); + return parser::CharBlock{buffer}; + } + return std::nullopt; + }, + [&](const parser::ProcedureDesignator &procD) + -> std::optional { + if (const auto *name{std::get_if(&procD.u)}) { + return MangleSpecialFunctions(name->source); + } + return std::nullopt; + }, + }, + ident.u); +} + +// Diagnose a reduction whose identifier resolves to more than one distinct +// user-defined reduction for `type` (e.g. an operator merged from two modules +// that each declare a reduction for the type, or a mangled reduction name that +// collides across modules). Without this the resolver would silently pick one +// by USE order. +static bool IsAmbiguousUserReduction( + const parser::OmpReductionIdentifier &ident, const DeclTypeSpec &type, + const Scope &scope, SemanticsContext &context) { + std::string buffer; + if (auto mangled{MangledReductionIdentifier(ident, context, buffer)}) { + bool ambiguous{false}; + omp::FindUserReductionSymbol(scope, *mangled, &type, &ambiguous); + return ambiguous; + } + return false; } static bool IsReductionAllowedForType( @@ -4217,6 +4145,10 @@ void OmpStructureChecker::CheckReductionObjectTypes( context_.Say(source, "The type of '%s' is incompatible with the reduction operator."_err_en_US, symbol->name()); + } else if (IsAmbiguousUserReduction(ident, *type, scope, context_)) { + context_.Say(source, + "The reduction for '%s' is ambiguous: more than one user-defined reduction for its type is accessible."_err_en_US, + symbol->name()); } } else { assert(IsProcedurePointer(*symbol) && "Unexpected symbol properties"); diff --git a/flang/lib/Semantics/mod-file.cpp b/flang/lib/Semantics/mod-file.cpp index 75bb32c5a25a5..bba7acac5005c 100644 --- a/flang/lib/Semantics/mod-file.cpp +++ b/flang/lib/Semantics/mod-file.cpp @@ -210,6 +210,9 @@ std::string ModFileWriter::GetAsString(const Symbol &symbol) { } all << '\n' << uses_.str(); uses_.str().clear(); + // Re-exported reduction modules are tracked per module file, so reset the set + // (like usedNonIntrinsicModules_) now that this module's uses are emitted. + reexportedReductionModules_.clear(); all << useExtraAttrs_.str(); useExtraAttrs_.str().clear(); all << decls_.str(); @@ -900,7 +903,8 @@ void ModFileWriter::PutUse(const Symbol &symbol) { // user "interface operator(+)". A reduction named by a plain identifier // ("myred") has a valid name and is emitted normally below. An operator-less // reduction (a special function, or an intrinsic operator on an intrinsic - // type) has no operator to recover through and is left to the normal path. + // type) has an unwritable name and no operator to recover through; it is + // re-exported by a plain USE of the defining module (see below). const Symbol &ultimate{symbol.GetUltimate()}; if (ultimate.has()) { std::string opId{GetReductionFortranId(ultimate.name())}; @@ -909,6 +913,35 @@ void ModFileWriter::PutUse(const Symbol &symbol) { if (opSym && opSym->GetUltimate().has()) { return; } + // An operator-less reduction (a special function, or an intrinsic operator + // on an intrinsic type) has an unwritable mangled name and no operator to + // recover through. It can only have been re-exported by a plain USE of the + // defining module (a mangled name cannot appear in an only-list, and there + // is no operator surrogate to name), so re-export the whole module. The + // reduction then comes in as a shared use-association, with no facade-owned + // duplicate and no re-resolved directive text. Any entities the facade + // renames or makes private are still emitted with their own use/rename/ + // private items, which the reader honors, so the plain USE does not widen + // their visibility. + llvm::StringRef mangled{ultimate.name().begin(), ultimate.name().size()}; + if (mangled.starts_with("op.")) { + // Only a PUBLIC operator-less reduction is re-exported. If the facade + // made it private, it must not be re-exported at all: emitting the plain + // use would re-import the whole module publicly and, because the mangled + // name is otherwise unwritable, silently change a consumer from the + // intrinsic reduction to this private one across a module-file + // round-trip. + if (!symbol.attrs().test(Attr::PRIVATE)) { + auto &reductionUse{symbol.get()}; + const Symbol &reexportModule{GetUsedModule(reductionUse)}; + if (!reductionUse.symbol().owner().parent().IsIntrinsicModules() && + reexportedReductionModules_.insert(reexportModule).second) { + uses_ << "use " << reexportModule.name() << '\n'; + usedNonIntrinsicModules_.insert(reexportModule); + } + } + return; + } } auto &details{symbol.get()}; auto &use{details.symbol()}; diff --git a/flang/lib/Semantics/mod-file.h b/flang/lib/Semantics/mod-file.h index 9e5724089b3c5..83834671adac5 100644 --- a/flang/lib/Semantics/mod-file.h +++ b/flang/lib/Semantics/mod-file.h @@ -53,6 +53,10 @@ class ModFileWriter { // Tracks nested DEC structures and fields of that type UnorderedSymbolSet emittedDECStructures_, emittedDECFields_; UnorderedSymbolSet usedNonIntrinsicModules_; + // Modules already re-exported by a plain USE for an operator-less declare + // reduction, so the USE is written once even when several such reductions + // come from the same module. + UnorderedSymbolSet reexportedReductionModules_; llvm::raw_string_ostream needs_{needsBuf_}; llvm::raw_string_ostream uses_{usesBuf_}; diff --git a/flang/lib/Semantics/openmp-utils.cpp b/flang/lib/Semantics/openmp-utils.cpp index 3503eb0e3a004..9a648308d43b4 100644 --- a/flang/lib/Semantics/openmp-utils.cpp +++ b/flang/lib/Semantics/openmp-utils.cpp @@ -12,6 +12,8 @@ #include "flang/Semantics/openmp-utils.h" +#include "resolve-names-utils.h" + #include "flang/Common/Fortran-consts.h" #include "flang/Common/idioms.h" #include "flang/Common/indirection.h" @@ -36,6 +38,8 @@ #include "llvm/ADT/ArrayRef.h" #include "llvm/ADT/DenseSet.h" #include "llvm/ADT/STLExtras.h" +#include "llvm/ADT/SmallPtrSet.h" +#include "llvm/ADT/SmallVector.h" #include "llvm/ADT/StringExtras.h" #include "llvm/Frontend/OpenMP/OMPContext.h" @@ -2453,4 +2457,221 @@ bool OmpVariantMatchContext::matchesISATrait(llvm::StringRef rawString) const { tokens, ',', /*MaxSplit=*/-1, /*KeepEmpty=*/false); return llvm::is_contained(tokens, want); } + +// User-defined reduction resolution, shared between the OpenMP semantic checks +// and lowering. The two public entry points (FindUserReductionSymbol and +// FindOperatorUserReductionSymbol) return the resolved (non-ultimate) reduction +// symbol; the caller reads its UserReductionDetails. + +// Compute the mangled reduction name to look up in a reduction's source module. +// If the operator was renamed on import (e.g. USE m, ONLY: operator(.local.) => +// operator(.remote.)), the local mangled name will not match in the source +// module; re-derive the lookup name from the source operator's ultimate name. +// Only defined operators can be renamed (intrinsic operators and named +// reductions cannot), so a detected rename always has a ".op." source name. +// For non-renamed lookups the original mangled name is returned unchanged. +static std::string SourceReductionName(const parser::CharBlock &mangledName, + const parser::CharBlock &localName, const parser::CharBlock &sourceName) { + if (sourceName != localName && sourceName.size() >= 3 && + sourceName.front() == '.' && sourceName.back() == '.') { + return MangleDefinedOperator(sourceName); + } + return mangledName.ToString(); +} + +// Return the reduction details of `symbol` if it is a user reduction that +// supports `type` (any type when `type` is null). +static const UserReductionDetails *AcceptReduction( + const Symbol &symbol, const DeclTypeSpec *type) { + const auto *details{symbol.GetUltimate().detailsIf()}; + if (details && (!type || details->SupportsType(*type))) { + return details; + } + return nullptr; +} + +// A reduction symbol is locally declared (authoritative) when it is not reached +// through any USE association, even via host association. Such a reduction +// shadows reductions imported or reachable through its operator. +static bool IsLocalReduction(const Symbol &symbol) { + const Symbol *s{&symbol}; + while (const auto *host{s->detailsIf()}) { + s = &host->symbol(); + } + return !s->detailsIf(); +} + +// A reduction's canonical identity is its own (mangled) name together with the +// name of the module that defines it. Pointer identity of the ultimate symbol +// is not sufficient: a hermetic module file embeds a private copy of its +// dependencies, so a reduction reached both through a direct USE of its module +// and through a facade that embeds that module has two distinct ultimate +// symbols living in two module scopes of the same name; keying on the module +// name and reduction name collapses them. +// +// Known limitation: this cannot distinguish two genuinely different versions of +// a same-named module (a stale hermetic embed of an old module vs. a rebuilt +// one), because the module name and mangled reduction name are identical and +// only the combiner body differs. Such an inconsistent build collapses to one +// candidate and the reduction is resolved by USE order without a diagnostic, +// matching the pre-existing behavior (Flang does not reject a same-named module +// loaded at two different versions either). The module-file hash does not help: +// a consistent hermetic embed and its directly used module are already distinct +// module instances with different hashes, so hashing would wrongly report the +// common, valid case as ambiguous. +static parser::CharBlock DefiningModuleName(const Symbol &ultimate) { + const Scope &owner{ultimate.owner()}; + return owner.symbol() ? owner.symbol()->name() : parser::CharBlock{}; +} + +// Add `reductionSym` to `matches` unless a reduction with the same canonical +// identity (defining module name + reduction name) is already present. Keying +// on this identity, rather than ultimate-symbol pointer, collapses one +// reduction reached through several USE/rename/facade paths (a diamond, or a +// hermetic facade that embeds the defining module) to a single entry, while +// genuinely different reductions declared in different modules remain separate. +static void AddDistinctReduction(llvm::SmallVectorImpl &matches, + const Symbol &reductionSym) { + const Symbol &ultimate{reductionSym.GetUltimate()}; + parser::CharBlock reductionName{ultimate.name()}; + parser::CharBlock moduleName{DefiningModuleName(ultimate)}; + for (const Symbol *match : matches) { + const Symbol &matchUltimate{match->GetUltimate()}; + if (matchUltimate.name() == reductionName && + DefiningModuleName(matchUltimate) == moduleName) { + return; + } + } + matches.push_back(&reductionSym); +} + +// Collect every distinct user reduction supporting `type` reachable by +// following the operator/procedure symbol `opSym` through its USE associations +// and merged generic sources. Each module the operator passes through is +// checked for a (possibly renamed) reduction; `localName` is the operator name +// written at the use site, used to detect renames. Unlike a first-match search, +// every branch of a merged generic is explored and the results are unioned +// (deduped by canonical identity), so an operator merged from two modules that +// each declare a reduction for `type` is detected as ambiguous rather than +// silently resolved by USE order. A locally declared reduction in a module is +// authoritative: it settles that branch (it is collected if it supports the +// type, otherwise it shadows reductions reachable further along that branch). +static void CollectOperatorReductions(const Symbol &opSym, + const parser::CharBlock &mangledName, const parser::CharBlock &localName, + const DeclTypeSpec *type, llvm::SmallPtrSetImpl &visited, + llvm::SmallVectorImpl &matches) { + if (!visited.insert(&opSym).second) { + return; + } + const Scope &scope{opSym.owner()}; + if (scope.kind() == Scope::Kind::Module) { + std::string lookupName{ + SourceReductionName(mangledName, localName, opSym.name())}; + auto it{scope.find(parser::CharBlock{lookupName})}; + if (it != scope.end()) { + const Symbol &reductionSym{*it->second}; + const Symbol &reductionUltimate{reductionSym.GetUltimate()}; + if (!reductionUltimate.attrs().test(Attr::PRIVATE)) { + if (AcceptReduction(reductionUltimate, type)) { + AddDistinctReduction(matches, reductionSym); + return; + } + // A locally declared reduction here shadows reductions reachable + // further along this branch. + if (reductionUltimate.detailsIf() && + IsLocalReduction(reductionSym)) { + return; + } + } + } + } + // Follow a USE-associated operator to the module it was imported from. + if (const auto *use{opSym.detailsIf()}) { + CollectOperatorReductions( + use->symbol(), mangledName, localName, type, visited, matches); + return; + } + // Search every module merged into a generic operator (recursing through + // re-exporting facade modules). Every branch is explored, not just the first + // to match: two branches that reach distinct reductions make the merged + // operator ambiguous. + if (const auto *generic{opSym.detailsIf()}) { + for (const Symbol &useSym : generic->uses()) { + CollectOperatorReductions( + useSym, mangledName, localName, type, visited, matches); + } + } +} + +// Find user reduction details for a mangled name, following USE associations +// when the reduction is not directly visible in the scope. A type may be +// supplied to disambiguate an operator that carries reductions for several +// types (e.g. a generic merged from multiple modules); a candidate is accepted +// only if it supports that type. A locally declared reduction is authoritative +// for its operator in its scope and shadows USE-associated reductions. When +// `ambiguous` is non-null it is set true if more than one distinct reduction +// supports the type; the first match is still returned so that callers that do +// not check ambiguity (lowering) are unchanged, since an ambiguous program is +// rejected in semantics before lowering runs. +const Symbol *FindUserReductionSymbol(const Scope &scope, + const parser::CharBlock &mangledName, const DeclTypeSpec *type, + bool *ambiguous) { + if (ambiguous) { + *ambiguous = false; + } + llvm::SmallVector matches; + // Direct lookup: a reduction directly visible via bare USE or a local + // declaration. + const Symbol *directSymbol{scope.FindSymbol(mangledName)}; + if (directSymbol) { + if (const auto *useError{directSymbol->detailsIf()}) { + // Several modules declare a reduction with the same mangled name (e.g. + // two modules each with `reduction(+:integer)`, or the same special + // function): the name collides into a USE error. Each colliding source + // that supports the type is a distinct candidate. + for (const auto &[occurrenceName, occurrenceSym] : + useError->occurrences()) { + if (occurrenceSym && + AcceptReduction(occurrenceSym->GetUltimate(), type)) { + AddDistinctReduction(matches, *occurrenceSym); + } + } + } else if (AcceptReduction(*directSymbol, type)) { + AddDistinctReduction(matches, *directSymbol); + // A locally declared reduction is authoritative: it shadows any + // USE-associated reduction reachable through the operator, so stop here. + if (IsLocalReduction(*directSymbol)) { + return matches.front(); + } + // A USE-associated direct match is only one candidate: continue through + // the operator to detect a second, distinct reduction merged under it. + } else if (directSymbol->GetUltimate().detailsIf() && + IsLocalReduction(*directSymbol)) { + // A locally declared reduction that does not support the requested type + // is authoritative: it shadows USE-associated reductions + // (ProcessReduction- Specifier erases the latter), so do not resurrect + // them via the operator. + return nullptr; + } + } + // Trace the operator/procedure to the modules that declare its reduction. + std::string fortranName{GetReductionFortranId(mangledName)}; + const Symbol *opSymbol{ + fortranName.empty() ? nullptr : scope.FindSymbol(fortranName)}; + if (opSymbol) { + llvm::SmallPtrSet visited; + CollectOperatorReductions( + *opSymbol, mangledName, opSymbol->name(), type, visited, matches); + } + if (ambiguous) { + *ambiguous = matches.size() > 1; + } + return matches.empty() ? nullptr : matches.front(); +} + +const Symbol *FindOperatorUserReductionSymbol( + const Scope &scope, const Symbol &operatorSym, const DeclTypeSpec *type) { + return FindUserReductionSymbol( + scope, MangleDefinedOperator(operatorSym.name()), type); +} } // namespace Fortran::semantics::omp diff --git a/flang/test/Lower/OpenMP/Todo/declare-reduction-allocatable-trivial.f90 b/flang/test/Lower/OpenMP/Todo/declare-reduction-allocatable-trivial.f90 new file mode 100644 index 0000000000000..0adfb07ddde3e --- /dev/null +++ b/flang/test/Lower/OpenMP/Todo/declare-reduction-allocatable-trivial.f90 @@ -0,0 +1,33 @@ +! A user-defined reduction on an allocatable (or pointer) variable of a trivial +! by-value type (integer/real) is not yet lowered: the directive materializes a +! by-value op (e.g. @..._i32) from the declared element type, but the reduction +! operand is a boxed, by-ref allocatable, so the clause looks up a by-ref name +! (@..._byref_i32) the directive never emitted and reaches a clean TODO rather +! than binding a by-value op to a boxed operand (which produced invalid IR +! before). Creating the boxed-type op for such operands is tracked by +! https://github.com/llvm/llvm-project/pull/186765. Character and derived-type +! allocatable reductions (by-ref op and by-ref operand) do lower and are covered +! by declare-reduction-character-allocatable.f90. + +! RUN: %not_todo_cmd %flang_fc1 -emit-hlfir -fopenmp -o - %s 2>&1 | FileCheck %s + +! CHECK: not yet implemented: OpenMP user-defined named reduction declaration was not materialized for the variable's type + +program p + integer, allocatable :: a + real, allocatable :: b + integer :: i + !$omp declare reduction(myadd: integer, real : omp_out = omp_out + omp_in) & + !$omp initializer(omp_priv = 0) + allocate(a); a = 0 + allocate(b); b = 0.0 + !$omp parallel do reduction(myadd: a) + do i = 1, 5 + a = a + i + end do + !$omp parallel do reduction(myadd: b) + do i = 1, 5 + b = b + real(i) + end do + print *, a, b +end program diff --git a/flang/test/Lower/OpenMP/Todo/declare-reduction-operator-multiple-types.f90 b/flang/test/Lower/OpenMP/Todo/declare-reduction-operator-multiple-types.f90 deleted file mode 100644 index 626316221af1b..0000000000000 --- a/flang/test/Lower/OpenMP/Todo/declare-reduction-operator-multiple-types.f90 +++ /dev/null @@ -1,38 +0,0 @@ -! A user-defined operator declare reduction listing multiple types reaches -! lowering but is not yet supported (the op name is not type-specific, so the -! per-type ops would collide). It must emit a clean TODO rather than ICE or -! miscompile (#204299). The guard is on the directive side, which is lowered -! before any reduction clause. - -! RUN: %not_todo_cmd %flang_fc1 -emit-hlfir -fopenmp -o - %s 2>&1 | FileCheck %s - -! CHECK: not yet implemented: OpenMP user-defined operator declare reduction with multiple declarations or multiple types - -program p - type :: t1 - integer :: v = 0 - end type - type :: t2 - integer :: w = 0 - end type - interface operator(.mt.) - function f1(a, b) - import :: t1 - type(t1), intent(in) :: a, b - type(t1) :: f1 - end function f1 - function f2(a, b) - import :: t2 - type(t2), intent(in) :: a, b - type(t2) :: f2 - end function f2 - end interface - !$omp declare reduction(.mt.:t1,t2:omp_out=omp_in) - type(t1) :: x1 - integer :: i - !$omp parallel do reduction(.mt.:x1) - do i = 1, 5 - x1 = x1 .mt. t1(1) - end do - !$omp end parallel do -end program p diff --git a/flang/test/Lower/OpenMP/Todo/declare-reduction-operator-use-assoc.f90 b/flang/test/Lower/OpenMP/Todo/declare-reduction-operator-use-assoc.f90 deleted file mode 100644 index 68be5781ce5cf..0000000000000 --- a/flang/test/Lower/OpenMP/Todo/declare-reduction-operator-use-assoc.f90 +++ /dev/null @@ -1,36 +0,0 @@ -! A user-defined operator reduction whose declaration is USE-associated from a -! module (plain USE, so the "op" reduction symbol is imported) reaches -! lowering but is not yet supported: lowering does not materialize imported -! declare reductions. It must emit a clean TODO rather than ICE (#204299). - -! RUN: %not_todo_cmd %flang_fc1 -emit-hlfir -fopenmp -o - %s 2>&1 | FileCheck %s - -! CHECK: not yet implemented: OpenMP user-defined operator reduction is not yet supported for imported, renamed, or multiple-declaration/type reductions - -module m_use_op - type :: t - integer :: val = 0 - end type - interface operator(.plus.) - module procedure add_t - end interface - !$omp declare reduction(.plus.:t:omp_out%val=omp_out%val+omp_in%val) & - !$omp initializer(omp_priv=t(0)) -contains - type(t) function add_t(a, b) - type(t), intent(in) :: a, b - add_t%val = a%val + b%val - end function add_t -end module m_use_op - -program p - use m_use_op - type(t) :: x - integer :: i - x = t(0) - !$omp parallel do reduction(.plus.:x) - do i = 1, 100 - x = x .plus. t(1) - end do - !$omp end parallel do -end program p diff --git a/flang/test/Lower/OpenMP/Todo/multiple-types-declare_reduction.f90 b/flang/test/Lower/OpenMP/Todo/multiple-types-declare_reduction.f90 deleted file mode 100644 index aa83d7f832c9b..0000000000000 --- a/flang/test/Lower/OpenMP/Todo/multiple-types-declare_reduction.f90 +++ /dev/null @@ -1,51 +0,0 @@ -! Test OpenMP declare reduction with integer and real types. -! This test verifies correct lowering of user-defined reductions -! to HLFIR and their use in OpenMP parallel loops. - -! RUN: %flang_fc1 -emit-hlfir -fopenmp %s -o - | FileCheck %s - -program main - implicit none - integer :: i, isum - real :: rsum - - !$omp declare reduction(myred: integer, real : & - !$omp omp_out = omp_out + omp_in) initializer(omp_priv = 0) - - isum = 0 - rsum = 0.0 - - !$omp parallel do reduction(myred:isum) - do i = 1, 3 - isum = isum + i - end do - - !$omp parallel do reduction(myred:rsum) - do i = 1, 3 - rsum = rsum + real(i) - end do - - print *, isum, rsum -end program main - -! Verify declare reduction is created for integer -! CHECK-LABEL: omp.declare_reduction @_QQFmyred : i32 -! CHECK: init { -! CHECK: arith.constant 0 : i32 -! CHECK: omp.yield - -! Verify integer combiner uses addi -! CHECK: combiner { -! CHECK: arith.addi -! CHECK: omp.yield - -! Verify reduction is used in first parallel loop (integer) -! CHECK: omp.parallel -! CHECK: omp.wsloop -! CHECK-SAME: reduction(@_QQFmyred - -! Verify reduction is used in second parallel loop (real) -! CHECK: omp.parallel -! CHECK: omp.wsloop -! CHECK-SAME: reduction(@_QQFmyred -! CHECK: arith.addf diff --git a/flang/test/Lower/OpenMP/declare-reduction-character-allocatable.f90 b/flang/test/Lower/OpenMP/declare-reduction-character-allocatable.f90 index e4af5818ecb71..8220452213cc9 100644 --- a/flang/test/Lower/OpenMP/declare-reduction-character-allocatable.f90 +++ b/flang/test/Lower/OpenMP/declare-reduction-character-allocatable.f90 @@ -19,7 +19,7 @@ program test_character_reduction end program test_character_reduction ! Verify the declare_reduction is generated with reference type for character -! CHECK-LABEL: omp.declare_reduction @_QQFchar_max : !fir.ref> +! CHECK-LABEL: omp.declare_reduction @_QQFchar_max_byref_c8 : !fir.ref> ! CHECK: init { ! CHECK: omp.yield @@ -30,4 +30,4 @@ end program test_character_reduction ! Verify the reduction is used in the parallel sections ! CHECK: omp.parallel -! CHECK: omp.sections reduction(byref @_QQFchar_max +! CHECK: omp.sections reduction(byref @_QQFchar_max_byref_c8 diff --git a/flang/test/Lower/OpenMP/declare-reduction-initializer-component.f90 b/flang/test/Lower/OpenMP/declare-reduction-initializer-component.f90 index 39f1eb6e71f44..afd4ab7db29af 100644 --- a/flang/test/Lower/OpenMP/declare-reduction-initializer-component.f90 +++ b/flang/test/Lower/OpenMP/declare-reduction-initializer-component.f90 @@ -25,7 +25,7 @@ subroutine test_component_init() !$omp end parallel do end subroutine -!CHECK: omp.declare_reduction @_QQFtest_component_initadd_member : !fir.ref> +!CHECK: omp.declare_reduction @_QQFtest_component_initadd_member_byref_rec__QFtest_component_initTt : !fir.ref> !CHECK-SAME: alloc { !CHECK: %[[ALLOCA:.*]] = fir.alloca !fir.type<_QFtest_component_initTt{member:i32}> !CHECK: omp.yield(%[[ALLOCA]] : !fir.ref>) diff --git a/flang/test/Lower/OpenMP/declare-reduction-initializer-defined-assign.f90 b/flang/test/Lower/OpenMP/declare-reduction-initializer-defined-assign.f90 index 366d28c47b706..40571beb20b81 100644 --- a/flang/test/Lower/OpenMP/declare-reduction-initializer-defined-assign.f90 +++ b/flang/test/Lower/OpenMP/declare-reduction-initializer-defined-assign.f90 @@ -41,7 +41,7 @@ subroutine test_defined_assign_init() !$omp end parallel do end subroutine -!CHECK: omp.declare_reduction @_QQFtest_defined_assign_initadd_t : +!CHECK: omp.declare_reduction @_QQFtest_defined_assign_initadd_t_byref_rec__QMm_defined_assignTt : !CHECK-SAME: alloc { !CHECK: %[[ALLOCA:.*]] = fir.alloca !CHECK: omp.yield(%[[ALLOCA]] : diff --git a/flang/test/Lower/OpenMP/declare-reduction-initializer-rhs-call.f90 b/flang/test/Lower/OpenMP/declare-reduction-initializer-rhs-call.f90 index 988219d65b1a6..e1c67f61dd8a5 100644 --- a/flang/test/Lower/OpenMP/declare-reduction-initializer-rhs-call.f90 +++ b/flang/test/Lower/OpenMP/declare-reduction-initializer-rhs-call.f90 @@ -36,7 +36,7 @@ subroutine test_rhs_call() !$omp end parallel do end subroutine -!CHECK: omp.declare_reduction @_QQFtest_rhs_calladd_t : +!CHECK: omp.declare_reduction @_QQFtest_rhs_calladd_t_byref_rec__QMmTt : !CHECK-SAME: alloc { !CHECK: %[[ALLOCA:.*]] = fir.alloca !fir.type<_QMmTt{member:i32}> !CHECK: omp.yield(%[[ALLOCA]] : diff --git a/flang/test/Lower/OpenMP/declare-reduction-logical-init.f90 b/flang/test/Lower/OpenMP/declare-reduction-logical-init.f90 index c8c7bdaa48f13..9720cf8f3d523 100644 --- a/flang/test/Lower/OpenMP/declare-reduction-logical-init.f90 +++ b/flang/test/Lower/OpenMP/declare-reduction-logical-init.f90 @@ -14,7 +14,7 @@ subroutine test_logical(r) end do end subroutine -! CHECK: omp.declare_reduction @[[RED:_QQFtest_logicalmy_and]] : !fir.logical<4> init { +! CHECK: omp.declare_reduction @[[RED:_QQFtest_logicalmy_and_l32]] : !fir.logical<4> init { ! CHECK: %[[FALSE:.*]] = arith.constant false ! CHECK: %[[CONV:.*]] = fir.convert %[[FALSE]] : (i1) -> !fir.logical<4> ! CHECK: omp.yield(%[[CONV]] : !fir.logical<4>) diff --git a/flang/test/Lower/OpenMP/declare-reduction-merge-hermetic.f90 b/flang/test/Lower/OpenMP/declare-reduction-merge-hermetic.f90 new file mode 100644 index 0000000000000..7bc1e8fdd5bbd --- /dev/null +++ b/flang/test/Lower/OpenMP/declare-reduction-merge-hermetic.f90 @@ -0,0 +1,53 @@ +! A user-defined operator reduction re-exported through a HERMETIC facade (which +! embeds a private copy of the defining module) and reached both directly and +! through that facade must resolve to a single reduction, not be reported as +! ambiguous: the direct and embedded copies are the same reduction. This guards +! the reduction ambiguity check, whose distinctness is by defining-module name +! and reduction name rather than by symbol pointer (a hermetic embed gives the +! same reduction two distinct ultimate symbols). +! https://github.com/llvm/llvm-project/issues/207255 + +! RUN: rm -rf %t && split-file %s %t && cd %t +! RUN: %flang_fc1 -fsyntax-only -fopenmp hm_base.f90 +! RUN: %flang_fc1 -fsyntax-only -fhermetic-module-files -fopenmp hm_facade.f90 +! RUN: %flang_fc1 -emit-hlfir -fopenmp hm_use.f90 -o - | FileCheck hm_use.f90 + +!--- hm_base.f90 +module hm_base + implicit none + interface operator(.myop.) + module procedure hm_f + end interface + !$omp declare reduction(.myop.:integer:omp_out=omp_out*omp_in) & + !$omp initializer(omp_priv=1) +contains + integer function hm_f(x, y) + integer, intent(in) :: x, y + hm_f = x * y + end function +end module + +!--- hm_facade.f90 +module hm_facade + use hm_base +end module + +!--- hm_use.f90 +! Reaching the reduction through both the base and the hermetic facade binds ONE +! reduction with the user combiner (muli), not a spurious ambiguity error. +! CHECK: omp.declare_reduction @[[RED:_QQMhm_baseop\.myop\._i32]] : i32 +! CHECK: arith.muli +! CHECK-NOT: not yet implemented +! CHECK: omp.wsloop +! CHECK-SAME: reduction(@[[RED]] +program main + use hm_base + use hm_facade + integer :: x, i + x = 1 + !$omp parallel do reduction(.myop.:x) + do i = 1, 5 + x = hm_f(x, i) + end do + print *, x +end program diff --git a/flang/test/Lower/OpenMP/declare-reduction-merge-version-skew.f90 b/flang/test/Lower/OpenMP/declare-reduction-merge-version-skew.f90 new file mode 100644 index 0000000000000..6dc929340ddf5 --- /dev/null +++ b/flang/test/Lower/OpenMP/declare-reduction-merge-version-skew.f90 @@ -0,0 +1,72 @@ +! Known limitation: two hermetic module files that embed DIFFERENT versions of a +! same-named module (an inconsistent build) each carry a reduction with the same +! operator and type but a different combiner. The reduction ambiguity check keys +! a reduction on (defining-module name, reduction name), which is identical for +! the two versions, so the clause is not diagnosed as ambiguous and the reduction +! is resolved by USE order. This matches the pre-existing behavior: Flang does not +! reject a same-named module loaded at two different versions. A stronger, +! content-based key would diagnose it; this test is the regression anchor for that +! future change. https://github.com/llvm/llvm-project/issues/207255 + +! RUN: rm -rf %t && split-file %s %t && cd %t +! RUN: %flang_fc1 -fopenmp vs_base_v1.f90 +! RUN: %flang_fc1 -fhermetic-module-files -fopenmp vs_facade_a.f90 +! RUN: %flang_fc1 -fopenmp vs_base_v2.f90 +! RUN: %flang_fc1 -fhermetic-module-files -fopenmp vs_facade_b.f90 +! The inconsistent build currently compiles with no ambiguity diagnostic (the +! known limitation). If a future content-based key starts diagnosing it, update +! this test. +! RUN: %flang_fc1 -fsyntax-only -fopenmp vs_use.f90 + +!--- vs_base_v1.f90 +module vs_base + implicit none + interface operator(.myop.) + module procedure vs_f + end interface + !$omp declare reduction(.myop.:integer:omp_out=omp_out+omp_in) & + !$omp initializer(omp_priv=0) +contains + integer function vs_f(x, y) + integer, intent(in) :: x, y + vs_f = x + y + end function +end module + +!--- vs_facade_a.f90 +module vs_facade_a + use vs_base +end module + +!--- vs_base_v2.f90 +module vs_base + implicit none + interface operator(.myop.) + module procedure vs_f + end interface + !$omp declare reduction(.myop.:integer:omp_out=omp_out*omp_in) & + !$omp initializer(omp_priv=1) +contains + integer function vs_f(x, y) + integer, intent(in) :: x, y + vs_f = x * y + end function +end module + +!--- vs_facade_b.f90 +module vs_facade_b + use vs_base +end module + +!--- vs_use.f90 +program main + use vs_facade_a + use vs_facade_b + integer :: x, i + x = 1 + !$omp parallel do reduction(.myop.:x) + do i = 1, 5 + x = x + i + end do + print *, x +end program diff --git a/flang/test/Lower/OpenMP/declare-reduction-name-type-token-collision.f90 b/flang/test/Lower/OpenMP/declare-reduction-name-type-token-collision.f90 new file mode 100644 index 0000000000000..70524aa803b1e --- /dev/null +++ b/flang/test/Lower/OpenMP/declare-reduction-name-type-token-collision.f90 @@ -0,0 +1,43 @@ +! A single-type user reduction whose name happens to end in a type token +! (myred_i32) must not collide with a multi-type reduction (myred: integer, real) +! whose per-type integer op is also spelled with an _i32 suffix. Because the +! per-type suffix is appended unconditionally, the single-type reduction becomes +! @_QQFmyred_i32_i32, distinct from the multi-type reduction's @_QQFmyred_i32, so +! the by-name op dedup cannot silently fold one reduction onto the other. A +! conditional suffix (bare single-type name) would collide here and silently bind +! myred_i32's clause to myred's combiner (a miscompile). +! See https://github.com/llvm/llvm-project/issues/207255. + +! RUN: %flang_fc1 -emit-hlfir -fopenmp %s -o - | FileCheck %s + +program p + integer :: a, b, i + !$omp declare reduction(myred: integer, real : omp_out = omp_out + omp_in) & + !$omp initializer(omp_priv = 0) + !$omp declare reduction(myred_i32: integer : omp_out = omp_out * omp_in) & + !$omp initializer(omp_priv = 1) + a = 0 + b = 1 + !$omp parallel do reduction(myred:a) + do i = 1, 4 + a = a + i + end do + !$omp parallel do reduction(myred_i32:b) + do i = 1, 4 + b = b * i + end do + print *, a, b +end program + +! Three distinct ops: the multi-type reduction's two per-type ops, and the +! single-type reduction's own (double-suffixed) op. Under a conditional suffix +! only two ops would exist and the single-type reduction would silently reuse +! the multi-type add op; three distinct ops here proves there is no collision. +! CHECK-DAG: omp.declare_reduction @[[MYRED_I32:_QQFmyred_i32]] : i32 +! CHECK-DAG: omp.declare_reduction @[[MYRED_F32:_QQFmyred_f32]] : f32 +! CHECK-DAG: omp.declare_reduction @[[MYREDI32_I32:_QQFmyred_i32_i32]] : i32 + +! Each loop binds its own reduction's op, by full name. Loop 2 (myred_i32) binds +! its own @_QQFmyred_i32_i32, not the multi-type reduction's @_QQFmyred_i32. +! CHECK-DAG: reduction(@[[MYRED_I32]] %{{[^)]*}}!fir.ref +! CHECK-DAG: reduction(@[[MYREDI32_I32]] %{{[^)]*}}!fir.ref diff --git a/flang/test/Lower/OpenMP/declare-reduction-named-renamed.f90 b/flang/test/Lower/OpenMP/declare-reduction-named-renamed.f90 new file mode 100644 index 0000000000000..3fe9ae0cb6385 --- /dev/null +++ b/flang/test/Lower/OpenMP/declare-reduction-named-renamed.f90 @@ -0,0 +1,38 @@ +! A named user-defined declare reduction imported under a rename +! (myadd_alias => myadd) must lower to the source module's op, not the local +! alias spelling. The reduction op is named from the module scope and the source +! ultimate name (myadd), and the use-site clause (which spells the alias) binds +! that same source op. This is the named analogue of +! declare-reduction-operator-renamed.f90; the shared owner-qualified naming +! helper resolves the alias to the source by taking the symbol's ultimate. +! Reproducer runs to 55 (repro/xmod-named/xmn.f90). + +! RUN: %flang_fc1 -emit-hlfir -fopenmp %s -o - | FileCheck %s + +module m + type :: t + integer :: v = 0 + end type + !$omp declare reduction(myadd : t : omp_out%v = omp_out%v + omp_in%v) & + !$omp initializer(omp_priv = t(0)) +end module + +program p + use m, only : t, myadd_alias => myadd + type(t) :: x + integer :: i + x = t(0) + !$omp parallel do reduction(myadd_alias : x) + do i = 1, 10 + x%v = x%v + i + end do + print *, x%v ! expected 55 +end program + +! The op is named from the module owner (_QQMm) and the source name (myadd), +! never the alias (myadd_alias). The clause spelled with the alias binds the +! same source op. +! CHECK: omp.declare_reduction @[[RED:_QQMmmyadd_byref_rec__QMmTt]] : !fir.ref]*}}t{v:i32}>> +! CHECK-NOT: myadd_alias +! CHECK: omp.wsloop +! CHECK-SAME: reduction(byref @[[RED]] diff --git a/flang/test/Lower/OpenMP/declare-reduction-named-use-assoc.f90 b/flang/test/Lower/OpenMP/declare-reduction-named-use-assoc.f90 new file mode 100644 index 0000000000000..844fa5a732977 --- /dev/null +++ b/flang/test/Lower/OpenMP/declare-reduction-named-use-assoc.f90 @@ -0,0 +1,37 @@ +! A named user-defined declare reduction declared in a module and used in a +! separate program unit must lower correctly cross-scope: the reduction op is +! named from the module scope (owner-qualified) and the use-site clause binds +! that same op. The materializer (materializeOpenMPDeclareReductions) emits the +! imported op for separate compilation; here the module and program share a file, +! but the naming contract is the same. Single-type reductions are named without a +! type suffix, so this locks the un-suffixed cross-scope spelling. +! https://github.com/llvm/llvm-project/issues/207255 + +! RUN: %flang_fc1 -emit-hlfir -fopenmp %s -o - | FileCheck %s + +module m + type :: t + integer :: v = 0 + end type + !$omp declare reduction(myadd: t: omp_out%v = omp_out%v + omp_in%v) & + !$omp initializer(omp_priv=t(0)) +end module + +program main + use m + type(t) :: x + integer :: i + x = t(0) + !$omp parallel do reduction(myadd:x) + do i = 1, 5 + x%v = x%v + i + end do + print *, x%v +end program + +! The op is owner-qualified to the module scope (_QQMm...) and carries the +! type/byref suffix. The use-site clause binds the same op. +! CHECK: omp.declare_reduction @[[RED:_QQMmmyadd_byref_rec__QMmTt]] : !fir.ref]*}}t{v:i32}>> +! CHECK-NOT: omp.declare_reduction @{{.*}}myadd{{.*}}myadd +! CHECK: omp.wsloop +! CHECK-SAME: reduction(byref @[[RED]] diff --git a/flang/test/Lower/OpenMP/declare-reduction-no-initializer-intrinsic.f90 b/flang/test/Lower/OpenMP/declare-reduction-no-initializer-intrinsic.f90 index cb768d3b92744..5bb0a57b0dedd 100644 --- a/flang/test/Lower/OpenMP/declare-reduction-no-initializer-intrinsic.f90 +++ b/flang/test/Lower/OpenMP/declare-reduction-no-initializer-intrinsic.f90 @@ -3,7 +3,7 @@ ! Test declare reduction without initializer clause for intrinsic types. ! Without an initializer, the private variable should be zero-initialized. -! CHECK-DAG: omp.declare_reduction @_QQFchar_max : !fir.ref> +! CHECK-DAG: omp.declare_reduction @_QQFchar_max_byref_c8x10 : !fir.ref> ! CHECK: init { ! CHECK: %[[CHZERO:.*]] = fir.zero_bits !fir.char<1,10> ! CHECK: fir.store %[[CHZERO]] @@ -72,7 +72,7 @@ program test_no_init_intrinsic !$omp end parallel do ! Test fixed-length character reduction without initializer - ! CHECK: omp.wsloop {{.*}} reduction(byref @_QQFchar_max + ! CHECK: omp.wsloop {{.*}} reduction(byref @_QQFchar_max_byref_c8x10 !$omp parallel do reduction(char_max: s) do i = 1, 10 continue diff --git a/flang/test/Lower/OpenMP/declare-reduction-operator-collide.f90 b/flang/test/Lower/OpenMP/declare-reduction-operator-collide.f90 new file mode 100644 index 0000000000000..899689174faa8 --- /dev/null +++ b/flang/test/Lower/OpenMP/declare-reduction-operator-collide.f90 @@ -0,0 +1,79 @@ +! Cross-module user-defined operator declare reduction, a regression against a +! silent miscompile. Two modules (mod_add, mod_mul) declare operator(.remote.) +! and a declare reduction for the same derived type t (from tmod), but with +! different combiners (sum vs product) and matching identity initializers +! (0 vs 1). The program imports both, each renamed to a distinct use-site +! spelling (.addop., .mulop.), and reduces one variable with each. +! +! The reduction op name keys on the resolved source symbol's (name, owner), so +! the two same-spelling same-type reductions get distinct module-scoped op names +! and each clause binds its own combiner. Binding both clauses to one op would +! run one variable through the other's combiner. The test asserts the two ops +! are distinct (different owning-module qualifier) and that each clause binds its +! own; a collision would emit a single op or cross-bind, which FileCheck catches. +! https://github.com/llvm/llvm-project/issues/207255 + +! RUN: %flang_fc1 -emit-hlfir -fopenmp %s -o - | FileCheck %s + +module tmod + type :: t + integer :: val = 0 + end type +end module + +module mod_add + use tmod + interface operator(.remote.) + module procedure add_t + end interface + !$omp declare reduction(.remote.:t:omp_out%val=omp_out%val+omp_in%val) & + !$omp initializer(omp_priv=t(0)) +contains + type(t) function add_t(a, b) + type(t), intent(in) :: a, b + add_t%val = a%val + b%val + end function +end module + +module mod_mul + use tmod + interface operator(.remote.) + module procedure mul_t + end interface + !$omp declare reduction(.remote.:t:omp_out%val=omp_out%val*omp_in%val) & + !$omp initializer(omp_priv=t(1)) +contains + type(t) function mul_t(a, b) + type(t), intent(in) :: a, b + mul_t%val = a%val * b%val + end function +end module + +program main + use tmod, only: t + use mod_add, only: operator(.addop.) => operator(.remote.) + use mod_mul, only: operator(.mulop.) => operator(.remote.) + type(t) :: x, y + integer :: i + x = t(0) + !$omp parallel do reduction(.addop.:x) + do i = 1, 5 + x%val = x%val + i + end do + y = t(1) + !$omp parallel do reduction(.mulop.:y) + do i = 1, 5 + y%val = y%val * i + end do + print '(I0,1X,I0)', x%val, y%val +end program + +! Two distinct module-scoped ops (mod_add vs mod_mul owner qualifier), each bound +! by its own clause (the addop loop is emitted first, then the mulop loop). +! loose captures (R1) keyed on the owning module name; the two qualifiers differ. +! CHECK-DAG: omp.declare_reduction @[[REDADD:_QQ[A-Za-z0-9_.]*mod_add[A-Za-z0-9_.]*op\.remote\.[A-Za-z0-9_.]*]] : !fir.ref +! CHECK-DAG: omp.declare_reduction @[[REDMUL:_QQ[A-Za-z0-9_.]*mod_mul[A-Za-z0-9_.]*op\.remote\.[A-Za-z0-9_.]*]] : !fir.ref +! CHECK: omp.wsloop +! CHECK-SAME: reduction(byref @[[REDADD]] +! CHECK: omp.wsloop +! CHECK-SAME: reduction(byref @[[REDMUL]] diff --git a/flang/test/Lower/OpenMP/declare-reduction-operator-derived.f90 b/flang/test/Lower/OpenMP/declare-reduction-operator-derived.f90 index 62b30cb5d4542..4a40af8aac629 100644 --- a/flang/test/Lower/OpenMP/declare-reduction-operator-derived.f90 +++ b/flang/test/Lower/OpenMP/declare-reduction-operator-derived.f90 @@ -30,7 +30,7 @@ end subroutine red_derived ! The op name must be module-scoped (a mangled "_QQ..." generated name), NOT the ! bare operator spelling. The directive and clause must reference the same name. -! CHECK: omp.declare_reduction @[[RED:_QQ[A-Za-z0-9_.]*op\.myop\.]] : !fir.ref +! CHECK: omp.declare_reduction @[[RED:_QQ[A-Za-z0-9_.]*op\.myop\.[A-Za-z0-9_.]*]] : !fir.ref ! CHECK-NOT: omp.declare_reduction @op.myop. ! CHECK: omp.wsloop ! CHECK-SAME: reduction(byref @[[RED]] diff --git a/flang/test/Lower/OpenMP/declare-reduction-operator-host-assoc.f90 b/flang/test/Lower/OpenMP/declare-reduction-operator-host-assoc.f90 index ea1167e2bbdd4..bac74aa673a06 100644 --- a/flang/test/Lower/OpenMP/declare-reduction-operator-host-assoc.f90 +++ b/flang/test/Lower/OpenMP/declare-reduction-operator-host-assoc.f90 @@ -29,9 +29,9 @@ subroutine s(r, a) end module ! The reduction is materialized with a name qualified by the declaring scope -! (module m, subroutine s), and the clause binds to it. +! (module m, subroutine s) and the reduction type, and the clause binds to it. -! CHECK: omp.declare_reduction @[[RED:_QQMmFsop.myadd.]] : !fir.ref> +! CHECK: omp.declare_reduction @[[RED:_QQ[A-Za-z0-9_.]*op\.myadd\.[A-Za-z0-9_.]*]] : !fir.ref> ! CHECK-LABEL: func.func @_QMmPs ! CHECK: omp.wsloop {{.*}}reduction(byref @[[RED]] %{{.*}} -> %{{.*}} : !fir.ref>) diff --git a/flang/test/Lower/OpenMP/declare-reduction-operator-merged.f90 b/flang/test/Lower/OpenMP/declare-reduction-operator-merged.f90 new file mode 100644 index 0000000000000..93f148fda8b69 --- /dev/null +++ b/flang/test/Lower/OpenMP/declare-reduction-operator-merged.f90 @@ -0,0 +1,76 @@ +! Cross-module user-defined operator declare reduction via a merged generic. Two +! modules each declare operator(.remote.) and a single-type declare reduction: +! m_int for t_int, m_real for t_real. The program imports both with USE, ONLY, +! renaming operator(.remote.) to a common operator(.local.), so .local. is one +! merged generic; each reduction clause is disambiguated by the variable's type +! back to its own source module's reduction op (named from the source spelling +! op.remote., not the use-site rename op.local.). Each source declare is +! single-type; the multi-type-in-one-declare case (Form A) is covered by +! declare-reduction-operator-multiple-types.f90. Lowering counterpart of the +! semantics test Semantics/OpenMP/declare-reduction-use-only-merged.f90. +! https://github.com/llvm/llvm-project/issues/207255 + +! RUN: %flang_fc1 -emit-hlfir -fopenmp %s -o - | FileCheck %s + +module m_int + type :: t_int + integer :: v = 0 + end type + interface operator(.remote.) + module procedure add_int + end interface + !$omp declare reduction(.remote.:t_int:omp_out%v=omp_out%v+omp_in%v) & + !$omp initializer(omp_priv=t_int(0)) +contains + type(t_int) function add_int(a, b) + type(t_int), intent(in) :: a, b + add_int%v = a%v + b%v + end function +end module + +module m_real + type :: t_real + real :: v = 0.0 + end type + interface operator(.remote.) + module procedure add_real + end interface + !$omp declare reduction(.remote.:t_real:omp_out%v=omp_out%v+omp_in%v) & + !$omp initializer(omp_priv=t_real(0.0)) +contains + type(t_real) function add_real(a, b) + type(t_real), intent(in) :: a, b + add_real%v = a%v + b%v + end function +end module + +program main + use m_int, only: t_int, operator(.local.) => operator(.remote.) + use m_real, only: t_real, operator(.local.) => operator(.remote.) + type(t_int) :: xi + type(t_real) :: xr + integer :: i + xi = t_int(0) + !$omp parallel do reduction(.local.:xi) + do i = 1, 5 + xi%v = xi%v + i + end do + xr = t_real(0.0) + !$omp parallel do reduction(.local.:xr) + do i = 1, 4 + xr%v = xr%v + real(i) + end do + print '(I0,1X,F0.1)', xi%v, xr%v +end program + +! Two source-scoped ops (m_int vs m_real owner), named from the source spelling +! op.remote. and disambiguated by type; the t_int loop is emitted first, then the +! t_real loop. Because the CHECK-DAG names require op.remote., an op wrongly keyed +! on the use-site rename op.local. would fail these checks. +! loose captures (R1) keyed on the owning module name; the two qualifiers differ. +! CHECK-DAG: omp.declare_reduction @[[REDINT:_QQ[A-Za-z0-9_.]*m_int[A-Za-z0-9_.]*op\.remote\.[A-Za-z0-9_.]*]] : !fir.ref +! CHECK-DAG: omp.declare_reduction @[[REDREAL:_QQ[A-Za-z0-9_.]*m_real[A-Za-z0-9_.]*op\.remote\.[A-Za-z0-9_.]*]] : !fir.ref +! CHECK: omp.wsloop +! CHECK-SAME: reduction(byref @[[REDINT]] +! CHECK: omp.wsloop +! CHECK-SAME: reduction(byref @[[REDREAL]] diff --git a/flang/test/Lower/OpenMP/declare-reduction-operator-multiple-types.f90 b/flang/test/Lower/OpenMP/declare-reduction-operator-multiple-types.f90 new file mode 100644 index 0000000000000..142b218b3da40 --- /dev/null +++ b/flang/test/Lower/OpenMP/declare-reduction-operator-multiple-types.f90 @@ -0,0 +1,66 @@ +! A user-defined operator declare reduction that lists several types in a single +! declaration (Form A: `declare reduction(.op.:t1,t2:...)`) must lower to one +! omp.declare_reduction op per listed type, each with its own element type, +! combiner and initializer. Folding every type onto the first type's op is a +! silent miscompile (a real reduction lowered through an integer combiner). See +! https://github.com/llvm/llvm-project/issues/207255. +! +! t1 is integer-valued and t2 is real-valued, so a fold onto one op is glaring: +! the two ops must carry distinct element types (i32 vs f32) and each loop must +! bind its own type's op. + +! RUN: %flang_fc1 -emit-hlfir -fopenmp %s -o - | FileCheck %s + +module m + type :: t1 + integer :: v = 0 + end type + type :: t2 + real :: v = 0.0 + end type + interface operator(.op.) + module procedure a1, a2 + end interface + !$omp declare reduction(.op.:t1,t2:omp_out%v=omp_out%v+omp_in%v) +contains + type(t1) function a1(a,b) + type(t1), intent(in) :: a,b + a1%v=a%v+b%v + end function + type(t2) function a2(a,b) + type(t2), intent(in) :: a,b + a2%v=a%v+b%v + end function +end module + +program main + use m + type(t1) :: x + type(t2) :: y + integer :: i + x = t1(0) + !$omp parallel do reduction(.op.:x) + do i=1,5 + x%v = x%v + i + end do + y = t2(0.0) + !$omp parallel do reduction(.op.:y) + do i=1,4 + y%v = y%v + real(i) + end do + print *, x%v, y%v +end program + +! One distinct op per listed type, each with its own element type. The op name +! carries the owning scope (mangled "_QQ...") plus a per-type suffix, so the two +! types get two ops rather than colliding. +! CHECK-DAG: omp.declare_reduction @[[REDT1:_QQ[A-Za-z0-9_.]*op\.op\.[A-Za-z0-9_.]*t1]] : !fir.ref]*}}t1{v:i32}>> +! CHECK-DAG: omp.declare_reduction @[[REDT2:_QQ[A-Za-z0-9_.]*op\.op\.[A-Za-z0-9_.]*t2]] : !fir.ref]*}}t2{v:f32}>> + +! The bare operator spelling must never be a declare_reduction name (it would +! collide across scopes/types). +! CHECK-NOT: omp.declare_reduction @op.op. + +! Each parallel loop binds the op for its own variable's type. +! CHECK-DAG: reduction(byref @[[REDT1]] {{[^)]*}}t1{v:i32} +! CHECK-DAG: reduction(byref @[[REDT2]] {{[^)]*}}t2{v:f32} diff --git a/flang/test/Lower/OpenMP/declare-reduction-operator-renamed.f90 b/flang/test/Lower/OpenMP/declare-reduction-operator-renamed.f90 new file mode 100644 index 0000000000000..57cb88dfda917 --- /dev/null +++ b/flang/test/Lower/OpenMP/declare-reduction-operator-renamed.f90 @@ -0,0 +1,45 @@ +! Cross-module user-defined operator declare reduction, renamed on import +! (USE m, ONLY: operator(.local.) => operator(.remote.)). The declare-reduction +! op must be named from the source operator spelling (.remote.), never the +! use-site rename (.local.): lowering resolves the renamed clause operator back +! to the module's source reduction symbol. Reproducer prints 100 at run time +! (repro/B_renamed.f90). https://github.com/llvm/llvm-project/issues/207255 + +! RUN: %flang_fc1 -emit-hlfir -fopenmp %s -o - | FileCheck %s + +module m + type :: t + integer :: val = 0 + end type + interface operator(.remote.) + module procedure add_t + end interface + !$omp declare reduction(.remote.:t:omp_out%val=omp_out%val+omp_in%val) & + !$omp initializer(omp_priv=t(0)) +contains + type(t) function add_t(a, b) + type(t), intent(in) :: a, b + add_t%val = a%val + b%val + end function +end module + +program main + use m, only: t, operator(.local.) => operator(.remote.) + type(t) :: x + integer :: i + x = t(0) + !$omp parallel do reduction(.local.:x) + do i = 1, 100 + x%val = x%val + 1 + end do + print *, x%val +end program + +! The op keys on the source spelling op.remote. (module-scoped); the use-site +! rename op.local. must never appear as an op name. +! loose capture (R1): the exact mangled qualifier is pinned after building. +! CHECK-NOT: op.local. +! CHECK: omp.declare_reduction @[[RED:_QQ[A-Za-z0-9_.]*op\.remote\.[A-Za-z0-9_.]*]] : !fir.ref +! CHECK: omp.wsloop +! CHECK-SAME: reduction(byref @[[RED]] +! CHECK-NOT: op.local. diff --git a/flang/test/Lower/OpenMP/declare-reduction-operator-separate-combiners.f90 b/flang/test/Lower/OpenMP/declare-reduction-operator-separate-combiners.f90 new file mode 100644 index 0000000000000..a698f97ce631a --- /dev/null +++ b/flang/test/Lower/OpenMP/declare-reduction-operator-separate-combiners.f90 @@ -0,0 +1,106 @@ +! Separate-compilation user-defined operator declare reductions whose combiner is +! not a plain intrinsic-assignment expression. These exercise the two typed forms +! (CallStmt::typedCall and AssignmentStmt::typedAssignment) that mod-file reading +! leaves null and the materializer must repopulate before lowering, in addition +! to the parser::Expr::typedExpr form covered by the plain cases. Both run to 100 +! out of tree. https://github.com/llvm/llvm-project/issues/207255 + +! RUN: rm -rf %t && split-file %s %t && cd %t + +! Case 1: the combiner is a subroutine call (combine_sub), so lowering reads the +! reduction combiner's CallStmt::typedCall. A null typedCall trips an assertion. +! RUN: %flang_fc1 -emit-hlfir -fopenmp call.mod.f90 -o - > /dev/null +! RUN: %flang_fc1 -emit-hlfir -fopenmp call.use.f90 -o - | FileCheck call.use.f90 + +! Case 2: the combiner assigns a whole derived-type result through a defined +! assignment, so lowering reads AssignmentStmt::typedAssignment and takes the +! user-defined-assignment path. +! RUN: %flang_fc1 -emit-hlfir -fopenmp asgn.mod.f90 -o - > /dev/null +! RUN: %flang_fc1 -emit-hlfir -fopenmp asgn.use.f90 -o - | FileCheck asgn.use.f90 + +!--- call.mod.f90 +module red_call + type :: t + integer :: val = 0 + end type + interface operator(.remote.) + module procedure add_t + end interface + !$omp declare reduction(.remote.:t:combine_sub(omp_out, omp_in)) & + !$omp initializer(omp_priv=t(0)) +contains + type(t) function add_t(a, b) + type(t), intent(in) :: a, b + add_t%val = a%val + b%val + end function + subroutine combine_sub(x, y) + type(t), intent(inout) :: x + type(t), intent(in) :: y + x%val = x%val + y%val + end subroutine +end module + +!--- call.use.f90 +! The combiner region must lower to a call of the imported subroutine. +! CHECK: omp.declare_reduction @[[RED:_QQ[A-Za-z0-9_.]*op\.remote\.[A-Za-z0-9_.]*]] : !fir.ref +! CHECK: combiner +! CHECK: fir.call @_QMred_callPcombine_sub +! CHECK: omp.wsloop +! CHECK-SAME: reduction(byref @[[RED]] +! CHECK-NOT: not yet implemented +program main + use red_call, only: t, operator(.local.) => operator(.remote.) + type(t) :: x + integer :: i + x = t(0) + !$omp parallel do reduction(.local.:x) + do i = 1, 100 + x%val = x%val + 1 + end do + print *, x%val +end program + +!--- asgn.mod.f90 +module red_asgn + type :: t + integer :: val = 0 + end type + interface operator(.remote.) + module procedure add_t + end interface + interface assignment(=) + module procedure assign_t + end interface + !$omp declare reduction(.remote.:t:omp_out = add_t(omp_out, omp_in)) & + !$omp initializer(omp_priv=t(0)) +contains + type(t) function add_t(a, b) + type(t), intent(in) :: a, b + add_t%val = a%val + b%val + end function + subroutine assign_t(lhs, rhs) + type(t), intent(out) :: lhs + type(t), intent(in) :: rhs + lhs%val = rhs%val + end subroutine +end module + +!--- asgn.use.f90 +! The combiner region must lower a call to the imported defined assignment. +! CHECK: omp.declare_reduction @[[RED:_QQ[A-Za-z0-9_.]*op\.remote\.[A-Za-z0-9_.]*]] : !fir.ref +! CHECK: combiner +! CHECK: fir.call @_QMred_asgnPassign_t +! CHECK: omp.wsloop +! CHECK-SAME: reduction(byref @[[RED]] +! CHECK-NOT: not yet implemented +program main + use red_asgn, only: t, operator(.local.) => operator(.remote.) + type(t) :: x + integer :: i + x = t(0) + !$omp parallel do reduction(.local.:x) + do i = 1, 100 + x%val = x%val + 1 + end do + print *, x%val +end program diff --git a/flang/test/Lower/OpenMP/declare-reduction-operator-separate-hermetic.f90 b/flang/test/Lower/OpenMP/declare-reduction-operator-separate-hermetic.f90 new file mode 100644 index 0000000000000..856e52fca6a70 --- /dev/null +++ b/flang/test/Lower/OpenMP/declare-reduction-operator-separate-hermetic.f90 @@ -0,0 +1,56 @@ +! Hermetic module files (-fhermetic-module-files) embed a module's USEd modules +! into its own .mod. This exercises an imported operator declare reduction that +! lives in such an embedded module: the wrapper herm_wrap re-exports herm_base +! (which owns the reduction) and is compiled hermetically, then herm_base.mod is +! removed so the consumer can only reach the reduction through the embedding. +! Materializing it requires (a) the embedded module's parse tree to stay live at +! lowering time, and (b) the reduction's module file to round-trip (its internal +! symbol is not written as an invalid use-only item). Runtime verified out of +! tree (runs to 100). https://github.com/llvm/llvm-project/issues/207255 + +! RUN: rm -rf %t && split-file %s %t && cd %t +! RUN: %flang_fc1 -fsyntax-only -fopenmp herm_base.f90 +! RUN: %flang_fc1 -fhermetic-module-files -fsyntax-only -fopenmp herm_wrap.f90 +! RUN: rm herm_base.mod +! RUN: %flang_fc1 -emit-hlfir -fopenmp herm.use.f90 -o - | FileCheck herm.use.f90 + +!--- herm_base.f90 +module herm_base + type :: t + integer :: val = 0 + end type + interface operator(.remote.) + module procedure add_t + end interface + !$omp declare reduction(.remote.:t:omp_out%val=omp_out%val+omp_in%val) & + !$omp initializer(omp_priv=t(0)) +contains + type(t) function add_t(a, b) + type(t), intent(in) :: a, b + add_t%val = a%val + b%val + end function +end module + +!--- herm_wrap.f90 +module herm_wrap + use herm_base +end module + +!--- herm.use.f90 +! The reduction lives in the embedded herm_base; materialization must reach it +! through the hermetic herm_wrap.mod and name it from its source module. +! CHECK: omp.declare_reduction @[[RED:_QQ[A-Za-z0-9_.]*base[A-Za-z0-9_.]*op\.remote\.[A-Za-z0-9_.]*]] : !fir.ref +! CHECK: omp.wsloop +! CHECK-SAME: reduction(byref @[[RED]] +! CHECK-NOT: not yet implemented +program main + use herm_wrap, only: t, operator(.local.) => operator(.remote.) + type(t) :: x + integer :: i + x = t(0) + !$omp parallel do reduction(.local.:x) + do i = 1, 100 + x%val = x%val + 1 + end do + print *, x%val +end program diff --git a/flang/test/Lower/OpenMP/declare-reduction-operator-separate-reexport.f90 b/flang/test/Lower/OpenMP/declare-reduction-operator-separate-reexport.f90 new file mode 100644 index 0000000000000..2dfd5b6451c05 --- /dev/null +++ b/flang/test/Lower/OpenMP/declare-reduction-operator-separate-reexport.f90 @@ -0,0 +1,93 @@ +! Facade re-export: a module (rx_wrap) merely uses another module (rx_base) that +! declares an operator reduction, and a consumer uses the wrapper. rx_wrap must +! re-export the reduction so the consumer's clause binds. This also pins the +! module-file round-trip: the reduction's internal symbol (mangled "op.remote.") +! must not be written into rx_wrap.mod as an invalid use-only item that would +! make rx_wrap.mod fail to re-parse. The reduction is recovered through the +! re-exported operator. +! https://github.com/llvm/llvm-project/issues/207255 + +! RUN: rm -rf %t && split-file %s %t && cd %t +! RUN: %flang_fc1 -fsyntax-only -fopenmp rx_base.f90 +! RUN: %flang_fc1 -fsyntax-only -fopenmp rx_wrap.f90 +! The wrapper module file must round-trip: no invalid "op.remote." use-only item. +! RUN: FileCheck --check-prefix=MODFILE --input-file=rx_wrap.mod rx_wrap.f90 +! RUN: %flang_fc1 -emit-hlfir -fopenmp rx.use.f90 -o - | FileCheck rx.use.f90 + +! A plainly-named reduction ("myred") has a valid name, so it is re-exported as a +! normal use item and must still lower through the facade. +! RUN: %flang_fc1 -fsyntax-only -fopenmp nm_base.f90 +! RUN: %flang_fc1 -fsyntax-only -fopenmp nm_wrap.f90 +! RUN: %flang_fc1 -emit-hlfir -fopenmp nm.use.f90 -o - | FileCheck nm.use.f90 + +!--- rx_base.f90 +module rx_base + type :: t + integer :: val = 0 + end type + interface operator(.remote.) + module procedure add_t + end interface + !$omp declare reduction(.remote.:t:omp_out%val=omp_out%val+omp_in%val) & + !$omp initializer(omp_priv=t(0)) +contains + type(t) function add_t(a, b) + type(t), intent(in) :: a, b + add_t%val = a%val + b%val + end function +end module + +!--- rx_wrap.f90 +! MODFILE: use rx_base,only:operator(.remote.) +! MODFILE-NOT: only:op.remote. +module rx_wrap + use rx_base +end module + +!--- rx.use.f90 +! CHECK: omp.declare_reduction @[[RED:_QQMrx_baseop\.remote\._byref_rec__QMrx_baseTt]] : !fir.ref +! CHECK: omp.wsloop +! CHECK-SAME: reduction(byref @[[RED]] +! CHECK-NOT: not yet implemented +program main + use rx_wrap, only: t, operator(.local.) => operator(.remote.) + type(t) :: x + integer :: i + x = t(0) + !$omp parallel do reduction(.local.:x) + do i = 1, 100 + x%val = x%val + 1 + end do + print *, x%val +end program + +!--- nm_base.f90 +module nm_base + type :: t + integer :: val = 0 + end type + !$omp declare reduction(myred:t:omp_out%val=omp_out%val+omp_in%val) & + !$omp initializer(omp_priv=t(0)) +end module + +!--- nm_wrap.f90 +module nm_wrap + use nm_base +end module + +!--- nm.use.f90 +! CHECK: omp.declare_reduction @[[RED:_QQMnm_basemyred_byref_rec__QMnm_baseTt]] : !fir.ref +! CHECK: omp.wsloop +! CHECK-SAME: reduction(byref @[[RED]] +! CHECK-NOT: not yet implemented +program main + use nm_wrap + type(t) :: x + integer :: i + x = t(0) + !$omp parallel do reduction(myred:x) + do i = 1, 100 + x%val = x%val + 1 + end do + print *, x%val +end program \ No newline at end of file diff --git a/flang/test/Lower/OpenMP/declare-reduction-operator-separate-unused-unsupported.f90 b/flang/test/Lower/OpenMP/declare-reduction-operator-separate-unused-unsupported.f90 new file mode 100644 index 0000000000000..5c1ef78339820 --- /dev/null +++ b/flang/test/Lower/OpenMP/declare-reduction-operator-separate-unused-unsupported.f90 @@ -0,0 +1,86 @@ +! An unused import of an operator declare reduction over a type lowering does not +! yet support must not abort the consumer. The materializer eagerly walks every +! imported module reduction; without a support prefilter it would call the +! lowering path for this reduction and hit getReductionType's "not yet +! implemented" TODO, aborting a program that merely USEs the module. The +! materializer's isSimpleReductionType prefilter skips it, so nothing is emitted +! and the program compiles. A program that actually named this reduction in a +! clause would still get the clean clause-side TODO. +! https://github.com/llvm/llvm-project/issues/207255 + +! RUN: rm -rf %t && split-file %s %t && cd %t + +! Produce the .mod with -fsyntax-only: lowering the module's own reduction would +! hit the same-file TODO (expected for the unsupported type), but semantics and +! the .mod write succeed. +! RUN: %flang_fc1 -fsyntax-only -fopenmp unsup.mod.f90 +! The consumer USEs the type but never the reduction; it must lower cleanly. +! RUN: %flang_fc1 -emit-hlfir -fopenmp unsup.use.f90 -o - 2>&1 | FileCheck unsup.use.f90 + +! An unused import of the OpenMP 6.0 combiner-in-clause form (the combiner is in +! a clause, not the reduction specifier) must also compile: the materializer +! reads the combiner from the specifier (computeReductionType and the impl both +! do), so it cannot lower this form and skips it instead of crashing on the empty +! specifier combiner. +! RUN: %flang_fc1 -fsyntax-only -fopenmp -fopenmp-version=60 clause.mod.f90 +! RUN: %flang_fc1 -emit-hlfir -fopenmp clause.use.f90 -o - 2>&1 | FileCheck clause.use.f90 + +!--- unsup.mod.f90 +module red_unsup + type :: tarr + integer :: a(4) = 0 + end type + interface operator(.remote.) + module procedure add_tarr + end interface + !$omp declare reduction(.remote.:tarr:omp_out%a=omp_out%a+omp_in%a) & + !$omp initializer(omp_priv=tarr()) +contains + type(tarr) function add_tarr(a, b) + type(tarr), intent(in) :: a, b + add_tarr%a = a%a + b%a + end function +end module + +!--- unsup.use.f90 +! No reduction op is materialized for the unused unsupported import, and no TODO +! aborts the compile; the program lowers normally. +! CHECK-NOT: omp.declare_reduction +! CHECK-NOT: not yet implemented +! CHECK: func.func @_QQmain +program main + use red_unsup, only: tarr + type(tarr) :: x + x%a = 0 + print *, sum(x%a) +end program + +!--- clause.mod.f90 +module red_clause + type :: t + integer :: val = 0 + end type + interface operator(.remote.) + module procedure add_t + end interface + !$omp declare reduction(.remote.:t) combiner(omp_out%val=omp_out%val+omp_in%val) & + !$omp initializer(omp_priv=t(0)) +contains + type(t) function add_t(a, b) + type(t), intent(in) :: a, b + add_t%val = a%val + b%val + end function +end module + +!--- clause.use.f90 +! No op is materialized for the unused combiner-in-clause import, and no TODO or +! crash aborts the compile. +! CHECK-NOT: omp.declare_reduction +! CHECK-NOT: not yet implemented +! CHECK: func.func @_QQmain +program main + use red_clause, only: t + type(t) :: x + x%val = 0 + print *, x%val +end program diff --git a/flang/test/Lower/OpenMP/declare-reduction-operator-separate.f90 b/flang/test/Lower/OpenMP/declare-reduction-operator-separate.f90 new file mode 100644 index 0000000000000..38665f864fa60 --- /dev/null +++ b/flang/test/Lower/OpenMP/declare-reduction-operator-separate.f90 @@ -0,0 +1,162 @@ +! Separate-compilation user-defined operator declare reduction: the declare +! reduction lives in a module compiled on its own to a .mod, and a different +! translation unit uses the module and names the operator in a reduction clause. +! The module is not a unit of the consumer TU, so the primary lowering pass never +! emits its omp.declare_reduction op; lowering the consumer must materialize the +! imported reduction (mirroring imported declare mappers) for the clause to bind, +! rather than hit a clean "not yet implemented" TODO. +! https://github.com/llvm/llvm-project/issues/207255 + +! RUN: rm -rf %t && split-file %s %t && cd %t + +! Case 1 (plain USE). The materialized op name must be byte-identical to the +! clause reference; the shared [[RED1]] capture pins that. A .mod re-parse that +! resolved to the operator generic instead of the reduction symbol would name a +! different op and fall through to the CHECK-NOT TODO. +! RUN: %flang_fc1 -emit-hlfir -fopenmp plain.mod.f90 -o - > /dev/null +! RUN: %flang_fc1 -emit-hlfir -fopenmp plain.use.f90 -o - | FileCheck plain.use.f90 + +! Case 2 (renamed operator, .local. => .remote.). The reduction is still named +! from the source module operator, so the clause reference and the materialized +! op agree. +! RUN: %flang_fc1 -emit-hlfir -fopenmp rename.mod.f90 -o - > /dev/null +! RUN: %flang_fc1 -emit-hlfir -fopenmp rename.use.f90 -o - | FileCheck rename.use.f90 + +! Case 3 (collision). Two modules define operator(.remote.) with a reduction on +! the same type. Imported under different local names, they must lower to two +! distinct ops keyed by their source module, not a single shared op that would +! run one variable through the other's combiner. +! RUN: %flang_fc1 -emit-hlfir -fopenmp collide_ty.mod.f90 -o - > /dev/null +! RUN: %flang_fc1 -emit-hlfir -fopenmp collide_add.mod.f90 -o - > /dev/null +! RUN: %flang_fc1 -emit-hlfir -fopenmp collide_mul.mod.f90 -o - > /dev/null +! RUN: %flang_fc1 -emit-hlfir -fopenmp collide.use.f90 -o - | FileCheck collide.use.f90 + +!--- plain.mod.f90 +module red_plain + type :: t + integer :: val = 0 + end type + interface operator(.plus.) + module procedure add_t + end interface + !$omp declare reduction(.plus.:t:omp_out%val=omp_out%val+omp_in%val) & + !$omp initializer(omp_priv=t(0)) +contains + type(t) function add_t(a, b) + type(t), intent(in) :: a, b + add_t%val = a%val + b%val + end function +end module + +!--- plain.use.f90 +! CHECK: omp.declare_reduction @[[RED1:_QQ[A-Za-z0-9_.]*op\.plus\.[A-Za-z0-9_.]*]] : !fir.ref +! CHECK: omp.wsloop +! CHECK-SAME: reduction(byref @[[RED1]] +! CHECK-NOT: not yet implemented +program main + use red_plain + type(t) :: x + integer :: i + x = t(0) + !$omp parallel do reduction(.plus.:x) + do i = 1, 100 + x%val = x%val + 1 + end do + print *, x%val +end program + +!--- rename.mod.f90 +module red_rename + type :: t + integer :: val = 0 + end type + interface operator(.remote.) + module procedure add_t + end interface + !$omp declare reduction(.remote.:t:omp_out%val=omp_out%val+omp_in%val) & + !$omp initializer(omp_priv=t(0)) +contains + type(t) function add_t(a, b) + type(t), intent(in) :: a, b + add_t%val = a%val + b%val + end function +end module + +!--- rename.use.f90 +! CHECK: omp.declare_reduction @[[RED2:_QQ[A-Za-z0-9_.]*op\.remote\.[A-Za-z0-9_.]*]] : !fir.ref +! CHECK: omp.wsloop +! CHECK-SAME: reduction(byref @[[RED2]] +! CHECK-NOT: not yet implemented +program main + use red_rename, only: t, operator(.local.) => operator(.remote.) + type(t) :: x + integer :: i + x = t(0) + !$omp parallel do reduction(.local.:x) + do i = 1, 100 + x%val = x%val + 1 + end do + print *, x%val +end program + +!--- collide_ty.mod.f90 +module red_ty + type :: t + integer :: val = 0 + end type +end module + +!--- collide_add.mod.f90 +module red_addmod + use red_ty + interface operator(.remote.) + module procedure add_t + end interface + !$omp declare reduction(.remote.:t:omp_out%val=omp_out%val+omp_in%val) & + !$omp initializer(omp_priv=t(0)) +contains + type(t) function add_t(a, b) + type(t), intent(in) :: a, b + add_t%val = a%val + b%val + end function +end module + +!--- collide_mul.mod.f90 +module red_mulmod + use red_ty + interface operator(.remote.) + module procedure mul_t + end interface + !$omp declare reduction(.remote.:t:omp_out%val=omp_out%val*omp_in%val) & + !$omp initializer(omp_priv=t(1)) +contains + type(t) function mul_t(a, b) + type(t), intent(in) :: a, b + mul_t%val = a%val * b%val + end function +end module + +!--- collide.use.f90 +! The two ops are distinguished by their source module (addmod vs mulmod) in the +! mangled name, so pinning one op to each module proves they are distinct. +! CHECK-DAG: omp.declare_reduction @{{_QQ[A-Za-z0-9_.]*addmod[A-Za-z0-9_.]*op\.remote\.[A-Za-z0-9_.]*}} : !fir.ref +! CHECK-DAG: omp.declare_reduction @{{_QQ[A-Za-z0-9_.]*mulmod[A-Za-z0-9_.]*op\.remote\.[A-Za-z0-9_.]*}} : !fir.ref +! CHECK-NOT: not yet implemented +program main + use red_ty, only: t + use red_addmod, only: operator(.addop.) => operator(.remote.) + use red_mulmod, only: operator(.mulop.) => operator(.remote.) + type(t) :: x, y + integer :: i + x = t(0) + !$omp parallel do reduction(.addop.:x) + do i = 1, 5 + x%val = x%val + i + end do + y = t(1) + !$omp parallel do reduction(.mulop.:y) + do i = 1, 5 + y%val = y%val * i + end do + print *, x%val, y%val +end program diff --git a/flang/test/Lower/OpenMP/declare-reduction-operator-use-assoc.f90 b/flang/test/Lower/OpenMP/declare-reduction-operator-use-assoc.f90 new file mode 100644 index 0000000000000..e34d02d057083 --- /dev/null +++ b/flang/test/Lower/OpenMP/declare-reduction-operator-use-assoc.f90 @@ -0,0 +1,47 @@ +! Cross-module USE-associated user-defined operator declare reduction (plain USE). +! The reduction clause names an operator (.plus.) whose declare reduction is +! imported from a module; lowering resolves it to the module's source reduction +! op and binds the clause to it. This used to be a clean TODO and was asserted by +! Todo/declare-reduction-operator-use-assoc.f90 (now removed / flipped to this +! positive test). Reproducer prints 100 at run time (repro/A_use_assoc.f90). +! https://github.com/llvm/llvm-project/issues/207255 + +! RUN: %flang_fc1 -emit-hlfir -fopenmp %s -o - | FileCheck %s + +module m + type :: t + integer :: val = 0 + end type + interface operator(.plus.) + module procedure add_t + end interface + !$omp declare reduction(.plus.:t:omp_out%val=omp_out%val+omp_in%val) & + !$omp initializer(omp_priv=t(0)) +contains + type(t) function add_t(a, b) + type(t), intent(in) :: a, b + add_t%val = a%val + b%val + end function +end module + +program main + use m + type(t) :: x + integer :: i + x = t(0) + !$omp parallel do reduction(.plus.:x) + do i = 1, 100 + x%val = x%val + 1 + end do + print *, x%val +end program + +! The op is named from the source module reduction symbol (module-scoped mangled +! "_QQ...op.plus.", not the bare use-site spelling), and the wsloop clause binds +! that same op. +! loose captures (R1): the exact mangled qualifier is pinned after building. +! CHECK: omp.declare_reduction @[[RED:_QQ[A-Za-z0-9_.]*op\.plus\.[A-Za-z0-9_.]*]] : !fir.ref +! CHECK-NOT: omp.declare_reduction @op.plus. +! CHECK: omp.wsloop +! CHECK-SAME: reduction(byref @[[RED]] +! CHECK-NOT: not yet implemented diff --git a/flang/test/Lower/OpenMP/declare-reduction-operator.f90 b/flang/test/Lower/OpenMP/declare-reduction-operator.f90 index 11897212078eb..1f18693bc399b 100644 --- a/flang/test/Lower/OpenMP/declare-reduction-operator.f90 +++ b/flang/test/Lower/OpenMP/declare-reduction-operator.f90 @@ -25,7 +25,7 @@ end subroutine red_integer ! The op name must be module-scoped (a mangled "_QQ..." generated name), NOT the ! bare operator spelling, so reductions with the same spelling in different ! modules do not collide. The directive and clause must reference the same name. -! CHECK: omp.declare_reduction @[[RED:_QQ[A-Za-z0-9_.]*op\.zzzz\.]] : i32 +! CHECK: omp.declare_reduction @[[RED:_QQ[A-Za-z0-9_.]*op\.zzzz\.[A-Za-z0-9_.]*]] : i32 ! CHECK-NOT: omp.declare_reduction @op.zzzz. ! CHECK: omp.parallel ! CHECK-SAME: reduction(@[[RED]] diff --git a/flang/test/Lower/OpenMP/declare-reduction-same-name-different-scope.f90 b/flang/test/Lower/OpenMP/declare-reduction-same-name-different-scope.f90 index 066758ae746e9..84b5f65f658f6 100644 --- a/flang/test/Lower/OpenMP/declare-reduction-same-name-different-scope.f90 +++ b/flang/test/Lower/OpenMP/declare-reduction-same-name-different-scope.f90 @@ -23,11 +23,11 @@ subroutine test end subroutine test end module m -! CHECK: omp.declare_reduction @[[TEST_RED:_QQMmFtesta]] : i32 init { +! CHECK: omp.declare_reduction @[[TEST_RED:_QQMmFtesta_i32]] : i32 init { ! CHECK: %[[C0:.*]] = arith.constant 0 : i32 ! CHECK: omp.yield(%[[C0]] : i32) -! CHECK: omp.declare_reduction @[[DUMMY_RED:_QQMmFdummya]] : i32 init { +! CHECK: omp.declare_reduction @[[DUMMY_RED:_QQMmFdummya_i32]] : i32 init { ! CHECK: %[[C10000:.*]] = arith.constant 10000 : i32 ! CHECK: omp.yield(%[[C10000]] : i32) diff --git a/flang/test/Lower/OpenMP/declare-reduction-shadows-intrinsic-multiple-types.f90 b/flang/test/Lower/OpenMP/declare-reduction-shadows-intrinsic-multiple-types.f90 new file mode 100644 index 0000000000000..aa346cf8eb261 --- /dev/null +++ b/flang/test/Lower/OpenMP/declare-reduction-shadows-intrinsic-multiple-types.f90 @@ -0,0 +1,45 @@ +! A user-defined declare reduction whose identifier shadows an intrinsic +! reduction name (max/min/iand/ior/ieor) and lists several types must lower to +! one omp.declare_reduction op per listed type, and each reduction clause must +! bind the op for its variable's type (rather than falling back to the built-in +! intrinsic reduction). This is the intrinsic-shadowing counterpart of the +! operator and named multi-type paths. Single-type shadowing is handled by +! declare-reduction-shadows-intrinsic.f90; here the declaration lists both +! integer and real. See https://github.com/llvm/llvm-project/issues/207255. + +! RUN: %flang_fc1 -emit-hlfir -fopenmp %s -o - | FileCheck %s + +program p + integer :: i, isum + real :: rsum + + !$omp declare reduction(max: integer, real : omp_out = max(omp_out, omp_in)) & + !$omp initializer(omp_priv = omp_orig) + + isum = 0 + rsum = 0.0 + + !$omp parallel do reduction(max: isum) + do i = 1, 5 + isum = max(isum, i) + end do + + !$omp parallel do reduction(max: rsum) + do i = 1, 5 + rsum = max(rsum, real(i)) + end do + + print *, isum, rsum +end program + +! The shadowing user reduction is named "op.max" (MangleSpecialFunctions), and +! being multi-type it gets one type-suffixed op per listed type. There must be +! no single type-less op that both types fold onto. +! CHECK-NOT: omp.declare_reduction @_QQFop.max : +! CHECK-DAG: omp.declare_reduction @[[MAXI:_QQFop.max_i32]] : i32 +! CHECK-DAG: omp.declare_reduction @[[MAXR:_QQFop.max_f32]] : f32 + +! Each loop binds the op for its own variable's type, by full name (not the +! shared @_QQFop.max_ prefix, and not the built-in max reduction). +! CHECK-DAG: reduction(@[[MAXI]] {{[^)]*}}!fir.ref +! CHECK-DAG: reduction(@[[MAXR]] {{[^)]*}}!fir.ref diff --git a/flang/test/Lower/OpenMP/declare-reduction-shadows-intrinsic-use-assoc.f90 b/flang/test/Lower/OpenMP/declare-reduction-shadows-intrinsic-use-assoc.f90 new file mode 100644 index 0000000000000..b39219f25e413 --- /dev/null +++ b/flang/test/Lower/OpenMP/declare-reduction-shadows-intrinsic-use-assoc.f90 @@ -0,0 +1,37 @@ +! A user-defined declare reduction whose name shadows an intrinsic +! (max/min/iand/ior/ieor), declared in a module and used through USE +! association, must lower cross-scope like the named path: the op is named from +! the module scope and the source ultimate (op.max), and the use-site clause +! binds that same op. This used to be a clean TODO ("not yet supported for +! imported or renamed reductions"); the imported case is now handled by naming +! from the found symbol's ultimate, and the renamed case is rejected by +! semantics before lowering (the renamed name resolves to the intrinsic, not the +! user reduction). Reproducer runs to 10 (repro/xmod-shadow/xsh.f90). + +! RUN: %flang_fc1 -emit-hlfir -fopenmp %s -o - | FileCheck %s + +module m + type :: t + integer :: v = 0 + end type + !$omp declare reduction(max : t : omp_out%v = max(omp_out%v, omp_in%v)) & + !$omp initializer(omp_priv = t(-2147483647)) +end module + +program p + use m + type(t) :: x + integer :: i + x = t(-2147483647) + !$omp parallel do reduction(max : x) + do i = 1, 10 + x%v = max(x%v, i) + end do + print *, x%v ! expected 10 +end program + +! The op is owner-qualified to the module (_QQMm) and carries the mangled +! shadowing name (op.max). The USE-associated clause binds the same op. +! CHECK: omp.declare_reduction @[[RED:_QQMmop.max_byref_rec__QMmTt]] : !fir.ref]*}}t{v:i32}>> +! CHECK: omp.wsloop +! CHECK-SAME: reduction(byref @[[RED]] diff --git a/flang/test/Lower/OpenMP/declare-reduction-shadows-intrinsic.f90 b/flang/test/Lower/OpenMP/declare-reduction-shadows-intrinsic.f90 index 212909c242222..509a96343ceb4 100644 --- a/flang/test/Lower/OpenMP/declare-reduction-shadows-intrinsic.f90 +++ b/flang/test/Lower/OpenMP/declare-reduction-shadows-intrinsic.f90 @@ -20,7 +20,7 @@ subroutine test_max(x) ! @max_reduction / @max_i32 op should be generated. ! CHECK-NOT: omp.declare_reduction @max -! CHECK: omp.declare_reduction @[[RED:_QQFtest_maxop.max]] : i32 init { +! CHECK: omp.declare_reduction @[[RED:_QQFtest_maxop\.max_i32]] : i32 init { ! CHECK: combiner { ! CHECK: arith.addi ! CHECK: omp.yield diff --git a/flang/test/Lower/OpenMP/declare-reduction-special-separate-reexport.f90 b/flang/test/Lower/OpenMP/declare-reduction-special-separate-reexport.f90 new file mode 100644 index 0000000000000..835546fbebdcd --- /dev/null +++ b/flang/test/Lower/OpenMP/declare-reduction-special-separate-reexport.f90 @@ -0,0 +1,169 @@ +! Facade re-export of an operator-less declare reduction (a special function such +! as max/min, or an intrinsic operator on an intrinsic type). Such a reduction has +! a mangled symbol name that is not valid Fortran and, unlike a defined-operator +! reduction, has no re-exported operator to recover through. It is re-exported by +! a plain USE of the defining module, so it comes in as a single shared +! use-association rather than a facade-owned duplicate: reaching it through both +! the base and the facade must bind ONE reduction with the user's combiner (not a +! silent fallback to the intrinsic), and a re-exporting module must not re-emit a +! directive that would re-resolve in the wrong scope. +! https://github.com/llvm/llvm-project/issues/207255 + +! RUN: rm -rf %t && split-file %s %t && cd %t +! RUN: %flang_fc1 -fsyntax-only -fopenmp sp_base.f90 +! RUN: %flang_fc1 -fsyntax-only -fopenmp sp_wrap.f90 +! The mangled reduction is re-exported by a plain USE, not an invalid item or a +! re-emitted directive (which would fork a facade-owned duplicate). +! RUN: FileCheck --check-prefix=MODFILE --input-file=sp_wrap.mod sp_wrap.f90 +! RUN: %flang_fc1 -emit-hlfir -fopenmp sp_use.f90 -o - | FileCheck sp_use.f90 +! RUN: %flang_fc1 -emit-hlfir -fopenmp sp_dual.f90 -o - | FileCheck sp_dual.f90 + +!--- sp_base.f90 +! The combiner is deliberately not the intrinsic max, so a silent fallback to the +! intrinsic reduction would be observable. +module sp_base + !$omp declare reduction(max:integer:omp_out=omp_out*omp_in) & + !$omp initializer(omp_priv=1) +end module + +!--- sp_wrap.f90 +! MODFILE: use sp_base +! MODFILE-NOT: only:op.max +! MODFILE-NOT: DECLARE REDUCTION +module sp_wrap + use sp_base +end module + +!--- sp_use.f90 +! The user's product combiner is preserved (muli), and the op is owned by the +! defining module, not the facade. +! CHECK: omp.declare_reduction @[[RED:_QQMsp_baseop\.max_i32]] : i32 +! CHECK: arith.muli +! CHECK: omp.wsloop +! CHECK-SAME: reduction(@[[RED]] +! CHECK-NOT: not yet implemented +program main + use sp_wrap + integer :: x, i + x = 1 + !$omp parallel do reduction(max:x) + do i = 1, 5 + x = x * i + end do + print *, x +end program + +!--- sp_dual.f90 +! Reaching the reduction through both the base and the facade binds ONE reduction +! with the user combiner (muli), not the intrinsic (maxsi). +! CHECK: omp.declare_reduction @[[RED:_QQMsp_baseop\.max_i32]] : i32 +! CHECK: arith.muli +! CHECK-NOT: arith.maxsi +! CHECK: omp.wsloop +! CHECK-SAME: reduction(@[[RED]] +program main + use sp_base + use sp_wrap + integer :: x, i + x = 1 + !$omp parallel do reduction(max:x) + do i = 1, 5 + x = x * i + end do + print *, x +end program + +! A facade that makes the reduction PRIVATE must not re-export it: a consumer must +! fall back to the intrinsic reduction, exactly as without a module-file +! round-trip (not silently bind the private base reduction). +! RUN: %flang_fc1 -fsyntax-only -fopenmp pr_base.f90 +! RUN: %flang_fc1 -fsyntax-only -fopenmp pr_facade.f90 +! RUN: FileCheck --check-prefix=PRIVMOD --input-file=pr_facade.mod pr_facade.f90 +! RUN: %flang_fc1 -emit-hlfir -fopenmp pr_use.f90 -o - | FileCheck pr_use.f90 + +!--- pr_base.f90 +module pr_base + !$omp declare reduction(max:integer:omp_out=omp_out*omp_in) & + !$omp initializer(omp_priv=1) +end module + +!--- pr_facade.f90 +! The private reduction is not re-exported: no bare `use pr_base`. +! PRIVMOD-NOT: use pr_base +! PRIVMOD-NOT: DECLARE REDUCTION +module pr_facade + use pr_base + private +end module + +!--- pr_use.f90 +! The consumer binds the intrinsic max reduction, not the private base one. +! CHECK: omp.declare_reduction @[[RED:max_i32]] : i32 +! CHECK: arith.maxsi +! CHECK-NOT: arith.muli +! CHECK-NOT: op.max +! CHECK: omp.wsloop +! CHECK-SAME: reduction(@[[RED]] +program main + use pr_facade + integer :: x, i + x = 1 + !$omp parallel do reduction(max:x) + do i = 1, 5 + x = max(x, i) + end do + print *, x +end program + +! Two facades of the SAME base compiled in ONE invocation must each re-export the +! reduction (the per-module re-export bookkeeping must reset between module +! files); otherwise the second facade silently drops it and its consumers fall +! back to the intrinsic. +! RUN: %flang_fc1 -fsyntax-only -fopenmp two.f90 +! RUN: FileCheck --check-prefix=FA --input-file=xfa.mod two.f90 +! RUN: FileCheck --check-prefix=FB --input-file=xfb.mod two.f90 +! RUN: %flang_fc1 -emit-hlfir -fopenmp xfa_use.f90 -o - | FileCheck --check-prefix=UA xfa_use.f90 +! RUN: %flang_fc1 -emit-hlfir -fopenmp xfb_use.f90 -o - | FileCheck --check-prefix=UB xfb_use.f90 + +!--- two.f90 +! FA: use xb +! FB: use xb +module xb + !$omp declare reduction(max:integer:omp_out=omp_out*omp_in) & + !$omp initializer(omp_priv=1) +end module +module xfa + use xb +end module +module xfb + use xb +end module + +!--- xfa_use.f90 +! UA: omp.wsloop +! UA-SAME: reduction(@_QQMxbop.max_i32 +program main + use xfa + integer :: x, i + x = 1 + !$omp parallel do reduction(max:x) + do i = 1, 5 + x = x * i + end do + print *, x +end program + +!--- xfb_use.f90 +! The second facade must bind the SAME user reduction, not the intrinsic. +! UB: omp.wsloop +! UB-SAME: reduction(@_QQMxbop.max_i32 +program main + use xfb + integer :: x, i + x = 1 + !$omp parallel do reduction(max:x) + do i = 1, 5 + x = x * i + end do + print *, x +end program diff --git a/flang/test/Lower/OpenMP/declare-reduction-target-intrinsic.f90 b/flang/test/Lower/OpenMP/declare-reduction-target-intrinsic.f90 index 43caea5e2dfd4..d7f3d20a7a04a 100644 --- a/flang/test/Lower/OpenMP/declare-reduction-target-intrinsic.f90 +++ b/flang/test/Lower/OpenMP/declare-reduction-target-intrinsic.f90 @@ -4,21 +4,21 @@ ! These should generate inline constant initialization (no runtime calls), ! so they work on GPU targets without requiring the device Fortran runtime. -! CHECK-LABEL: omp.declare_reduction @_QQFaddc : complex init { +! CHECK-LABEL: omp.declare_reduction @_QQFaddc_z32 : complex init { ! CHECK: %[[CZERO:.*]] = fir.zero_bits complex ! CHECK: omp.yield(%[[CZERO]] : complex) ! CHECK: } combiner { ! CHECK: fir.addc ! CHECK: } -! CHECK-LABEL: omp.declare_reduction @_QQFaddr : f32 init { +! CHECK-LABEL: omp.declare_reduction @_QQFaddr_f32 : f32 init { ! CHECK: %[[FZERO:.*]] = fir.zero_bits f32 ! CHECK: omp.yield(%[[FZERO]] : f32) ! CHECK: } combiner { ! CHECK: arith.addf ! CHECK: } -! CHECK-LABEL: omp.declare_reduction @_QQFaddi : i32 init { +! CHECK-LABEL: omp.declare_reduction @_QQFaddi_i32 : i32 init { ! CHECK: %[[IZERO:.*]] = fir.zero_bits i32 ! CHECK: omp.yield(%[[IZERO]] : i32) ! CHECK: } combiner { @@ -26,16 +26,16 @@ ! CHECK: } ! CHECK: omp.target -! CHECK: omp.teams reduction(@_QQFaddi -! CHECK: omp.wsloop reduction(@_QQFaddi +! CHECK: omp.teams reduction(@_QQFaddi_i32 +! CHECK: omp.wsloop reduction(@_QQFaddi_i32 ! CHECK: omp.target -! CHECK: omp.teams reduction(@_QQFaddr -! CHECK: omp.wsloop reduction(@_QQFaddr +! CHECK: omp.teams reduction(@_QQFaddr_f32 +! CHECK: omp.wsloop reduction(@_QQFaddr_f32 ! CHECK: omp.target -! CHECK: omp.teams reduction(@_QQFaddc -! CHECK: omp.wsloop reduction(@_QQFaddc +! CHECK: omp.teams reduction(@_QQFaddc_z32 +! CHECK: omp.wsloop reduction(@_QQFaddc_z32 program test_target_named_reduction implicit none diff --git a/flang/test/Lower/OpenMP/multiple-types-declare_reduction.f90 b/flang/test/Lower/OpenMP/multiple-types-declare_reduction.f90 new file mode 100644 index 0000000000000..3d614e9d07027 --- /dev/null +++ b/flang/test/Lower/OpenMP/multiple-types-declare_reduction.f90 @@ -0,0 +1,55 @@ +! A named user-defined declare reduction that lists several types in a single +! declaration (declare reduction(myred: integer, real: ...)) must lower to one +! omp.declare_reduction op per listed type, each with its own element type and +! combiner, and each reduction clause must bind the op for its variable's type. +! Folding the whole declaration onto a single type-less op would bind a real +! reduction to an integer-typed op (an !fir.ref reduction on an i32 op, an +! IR type mismatch the verifier does not catch) and silently miscompile. See https://github.com/llvm/llvm-project/issues/207255. +! +! This test uses a strong oracle: it pins the full type-suffixed op names, checks +! each op's combiner arithmetic inside the combiner region (so a matching +! arith.addf/addi in the loop body cannot satisfy it), and binds each loop to the +! full type-specific name (the shared @_QQFmyred_ prefix must not let a substring +! match accept the wrong op). + +! RUN: %flang_fc1 -emit-hlfir -fopenmp %s -o - | FileCheck %s + +program main + integer :: i, isum + real :: rsum + + !$omp declare reduction(myred: integer, real : omp_out = omp_out + omp_in) + + isum = 0 + rsum = 0.0 + + !$omp parallel do reduction(myred:isum) + do i = 1, 3 + isum = isum + i + end do + + !$omp parallel do reduction(myred:rsum) + do i = 1, 3 + rsum = rsum + real(i) + end do + + print *, isum, rsum +end program main + +! There must be no single type-less op that both types fold onto. +! CHECK-NOT: omp.declare_reduction @_QQFmyred : + +! One op per listed type, each with its own combiner arithmetic anchored inside +! the combiner region (the real op adds f32, the integer op adds i32). +! CHECK-LABEL: omp.declare_reduction @_QQFmyred_f32 : f32 +! CHECK: combiner { +! CHECK: arith.addf +! CHECK-LABEL: omp.declare_reduction @_QQFmyred_i32 : i32 +! CHECK: combiner { +! CHECK: arith.addi + +! Each loop binds the op for its own variable's type, by full name. +! CHECK: omp.wsloop +! CHECK-SAME: reduction(@_QQFmyred_i32 +! CHECK: omp.wsloop +! CHECK-SAME: reduction(@_QQFmyred_f32 diff --git a/flang/test/Lower/OpenMP/omp-declare-reduction-combsub.f90 b/flang/test/Lower/OpenMP/omp-declare-reduction-combsub.f90 index ae1eb9747bd40..ad7fe60f138c8 100644 --- a/flang/test/Lower/OpenMP/omp-declare-reduction-combsub.f90 +++ b/flang/test/Lower/OpenMP/omp-declare-reduction-combsub.f90 @@ -17,7 +17,7 @@ subroutine combine_me(out, in) integer out, in end subroutine combine_me end interface -!CHECK: omp.declare_reduction @_QQFfuncred_add : i32 init { +!CHECK: omp.declare_reduction @_QQFfuncred_add_i32 : i32 init { !CHECK: ^bb0(%[[OMP_ORIG_ARG_I:.*]]: i32): !CHECK: %[[OMP_PRIV:.*]] = fir.alloca i32 !CHECK: %[[OMP_ORIG:.*]] = fir.alloca i32 @@ -57,4 +57,3 @@ end subroutine combine_me enddo func=res end function func - diff --git a/flang/test/Lower/OpenMP/omp-declare-reduction-derivedtype.f90 b/flang/test/Lower/OpenMP/omp-declare-reduction-derivedtype.f90 index b92f42e2e25de..34412f87ac569 100644 --- a/flang/test/Lower/OpenMP/omp-declare-reduction-derivedtype.f90 +++ b/flang/test/Lower/OpenMP/omp-declare-reduction-derivedtype.f90 @@ -41,7 +41,7 @@ function func(x, n, init) end function func end module maxtype_mod -!CHECK: omp.declare_reduction @_QQMmaxtype_modFfuncred_add_max : !fir.ref<[[MAXTYPE:.*]]> {{.*}} alloc { +!CHECK: omp.declare_reduction @_QQMmaxtype_modFfuncred_add_max_byref_rec__QMmaxtype_modTmaxtype : !fir.ref<[[MAXTYPE:.*]]> {{.*}} alloc { !CHECK: %[[ALLOCA:.*]] = fir.alloca [[MAXTYPE:.*]] !CHECK: omp.yield(%[[ALLOCA]] : !fir.ref<[[MAXTYPE]]>) !CHECK: } init { diff --git a/flang/test/Lower/OpenMP/omp-declare-reduction-initsub.f90 b/flang/test/Lower/OpenMP/omp-declare-reduction-initsub.f90 index 2f6e432a72b13..333df70c5e989 100644 --- a/flang/test/Lower/OpenMP/omp-declare-reduction-initsub.f90 +++ b/flang/test/Lower/OpenMP/omp-declare-reduction-initsub.f90 @@ -17,7 +17,7 @@ subroutine initme(x,n) integer x,n end subroutine initme end interface -!CHECK: omp.declare_reduction @_QQFfuncred_add : i32 init { +!CHECK: omp.declare_reduction @_QQFfuncred_add_i32 : i32 init { !CHECK: ^bb0(%[[OMP_ORIG_ARG_I:.*]]: i32): !CHECK: %[[OMP_PRIV:.*]] = fir.alloca i32 !CHECK: %[[OMP_ORIG:.*]] = fir.alloca i32 diff --git a/flang/test/Lower/OpenMP/omp-declare-reduction.f90 b/flang/test/Lower/OpenMP/omp-declare-reduction.f90 index 73e3c28622a58..5257560e51443 100644 --- a/flang/test/Lower/OpenMP/omp-declare-reduction.f90 +++ b/flang/test/Lower/OpenMP/omp-declare-reduction.f90 @@ -4,7 +4,7 @@ subroutine declare_red() integer :: my_var -!CHECK: omp.declare_reduction @_QQFdeclare_redmy_red : i32 init { +!CHECK: omp.declare_reduction @_QQFdeclare_redmy_red_i32 : i32 init { !CHECK: ^bb0(%[[OMP_ORIG_ARG_I:.*]]: i32): !CHECK: %[[OMP_PRIV:.*]] = fir.alloca i32 !CHECK: %[[OMP_ORIG:.*]] = fir.alloca i32 diff --git a/flang/test/Semantics/OpenMP/declare-reduction-ambiguous.f90 b/flang/test/Semantics/OpenMP/declare-reduction-ambiguous.f90 new file mode 100644 index 0000000000000..18ed96086ea2e --- /dev/null +++ b/flang/test/Semantics/OpenMP/declare-reduction-ambiguous.f90 @@ -0,0 +1,205 @@ +! RUN: %python %S/../test_errors.py %s %flang_fc1 -fopenmp + +! A reduction identifier that resolves to more than one distinct user-defined +! reduction for the list item's type is ambiguous: the reduction to apply would +! otherwise be selected silently by USE order. This covers user-defined +! operators merged under one local name (by rename or by a shared name) and +! intrinsic-operator / special-function reduction names that collide across +! modules. https://github.com/llvm/llvm-project/issues/207255 + +! Two distinguishable defined operators renamed to one local operator, each with +! a reduction for the same type: ambiguous. +module ren_a + interface operator(.aop.) + module procedure ren_af + end interface + !$omp declare reduction(.aop.:integer:omp_out=omp_out+omp_in) & + !$omp initializer(omp_priv=0) +contains + integer function ren_af(x, y) + integer, intent(in) :: x, y + ren_af = x + y + end function +end module +module ren_b + interface operator(.bop.) + module procedure ren_bf + end interface + !$omp declare reduction(.bop.:integer:omp_out=omp_out*omp_in) & + !$omp initializer(omp_priv=1) +contains + real function ren_bf(x, y) + real, intent(in) :: x, y + ren_bf = x * y + end function +end module +subroutine ren_sub + use ren_a, operator(.local.) => operator(.aop.) + use ren_b, operator(.local.) => operator(.bop.) + integer :: x, i + x = 0 + !ERROR: The reduction for 'x' is ambiguous: more than one user-defined reduction for its type is accessible. + !$omp parallel do reduction(.local.:x) + do i = 1, 5 + x = x + i + end do + !$omp end parallel do +end subroutine + +! Two distinguishable defined operators that SHARE a name (no rename), each with +! a reduction for the same type: also ambiguous (also order-dependent). +module sam_a + interface operator(.xop.) + module procedure sam_af + end interface + !$omp declare reduction(.xop.:integer:omp_out=omp_out+omp_in) & + !$omp initializer(omp_priv=0) +contains + integer function sam_af(x, y) + integer, intent(in) :: x, y + sam_af = x + y + end function +end module +module sam_b + interface operator(.xop.) + module procedure sam_bf + end interface + !$omp declare reduction(.xop.:integer:omp_out=omp_out*omp_in) & + !$omp initializer(omp_priv=1) +contains + real function sam_bf(x, y) + real, intent(in) :: x, y + sam_bf = x * y + end function +end module +subroutine sam_sub + use sam_a + use sam_b + integer :: x, i + x = 0 + !ERROR: The reduction for 'x' is ambiguous: more than one user-defined reduction for its type is accessible. + !$omp parallel do reduction(.xop.:x) + do i = 1, 5 + x = x + i + end do + !$omp end parallel do +end subroutine + +! Two modules each declaring a reduction for the intrinsic operator + on the same +! type: the mangled name collides, ambiguous. +module int_a + !$omp declare reduction(+:integer:omp_out=omp_out+2*omp_in) & + !$omp initializer(omp_priv=0) +end module +module int_b + !$omp declare reduction(+:integer:omp_out=omp_out+3*omp_in) & + !$omp initializer(omp_priv=0) +end module +subroutine int_sub + use int_a + use int_b + integer :: x, i + x = 0 + !ERROR: The reduction for 'x' is ambiguous: more than one user-defined reduction for its type is accessible. + !$omp parallel do reduction(+:x) + do i = 1, 5 + x = x + i + end do + !$omp end parallel do +end subroutine + +! Two modules each declaring a reduction for the special function max on the same +! type: ambiguous. +module spc_a + !$omp declare reduction(max:integer:omp_out=omp_out+omp_in) & + !$omp initializer(omp_priv=0) +end module +module spc_b + !$omp declare reduction(max:integer:omp_out=omp_out*omp_in) & + !$omp initializer(omp_priv=1) +end module +subroutine spc_sub + use spc_a + use spc_b + integer :: x, i + x = 1 + !ERROR: The reduction for 'x' is ambiguous: more than one user-defined reduction for its type is accessible. + !$omp parallel do reduction(max:x) + do i = 1, 5 + x = max(x, i) + end do + !$omp end parallel do +end subroutine + +! Negative: a single renamed user-defined operator reduction is not ambiguous. +module one_a + interface operator(.gop.) + module procedure one_af + end interface + !$omp declare reduction(.gop.:integer:omp_out=omp_out+omp_in) & + !$omp initializer(omp_priv=0) +contains + integer function one_af(x, y) + integer, intent(in) :: x, y + one_af = x + y + end function +end module +subroutine one_sub + use one_a, operator(.local.) => operator(.gop.) + integer :: x, i + x = 0 + !$omp parallel do reduction(.local.:x) + do i = 1, 5 + x = x + i + end do + !$omp end parallel do +end subroutine + +! Negative: two operators of DIFFERENT types (only one supports the integer list +! item) is not ambiguous for an integer reduction. +module typ_a + interface operator(.top.) + module procedure typ_af + end interface + !$omp declare reduction(.top.:integer:omp_out=omp_out+omp_in) & + !$omp initializer(omp_priv=0) +contains + integer function typ_af(x, y) + integer, intent(in) :: x, y + typ_af = x + y + end function +end module +module typ_b + interface operator(.uop.) + module procedure typ_bf + end interface + !$omp declare reduction(.uop.:real:omp_out=omp_out*omp_in) & + !$omp initializer(omp_priv=1.0) +contains + real function typ_bf(x, y) + real, intent(in) :: x, y + typ_bf = x * y + end function +end module +subroutine typ_sub + use typ_a, operator(.local.) => operator(.top.) + use typ_b, operator(.local.) => operator(.uop.) + integer :: x, i + x = 0 + !$omp parallel do reduction(.local.:x) + do i = 1, 5 + x = x + i + end do + !$omp end parallel do +end subroutine + +! Negative: a plain intrinsic reduction with no user-defined reduction in scope. +subroutine plain_sub + integer :: x, i + x = 0 + !$omp parallel do reduction(+:x) + do i = 1, 5 + x = x + i + end do + !$omp end parallel do +end subroutine