[flang-commits] [flang] [flang][OpenMP] Lower cross-module operator declare reduction (PR #207493)
via flang-commits
flang-commits at lists.llvm.org
Mon Jul 6 10:49:11 PDT 2026
https://github.com/MattPD updated https://github.com/llvm/llvm-project/pull/207493
>From 7cf4240e36485a7bc82e3ba9b3b9c01acc075eed Mon Sep 17 00:00:00 2001
From: "Matt P. Dziubinski" <matt-p.dziubinski at hpe.com>
Date: Thu, 2 Jul 2026 22:25:14 -0500
Subject: [PATCH 1/5] [flang][OpenMP] Keep hermetic embedded module parse tree
alive
Fix a use-after-free when lowering materializes an imported declare mapper or
declare reduction owned by a module embedded in a hermetic module file
(-fhermetic-module-files).
ModFileReader::Read resolved the embedded modules from a local parser::Program
that was destroyed when Read returned, leaving the symbols resolved from it
dangling. MapperDetails and UserReductionDetails hold raw parse-tree pointers, so
a consumer that later materializes such an imported declaration dereferenced
freed memory.
Retain the embedded parse tree in the SemanticsContext with SaveParseTree, as the
primary module's tree already is, so those pointers stay valid through lowering.
The new test covers materializing an imported declare mapper from an embedded
module.
Assisted-by: Claude Opus 4.8, GPT-5.5.
---
flang/lib/Semantics/mod-file.cpp | 7 +++-
.../Lower/OpenMP/declare-mapper-hermetic.f90 | 38 +++++++++++++++++++
2 files changed, 44 insertions(+), 1 deletion(-)
create mode 100644 flang/test/Lower/OpenMP/declare-mapper-hermetic.f90
diff --git a/flang/lib/Semantics/mod-file.cpp b/flang/lib/Semantics/mod-file.cpp
index fd1b1caa7fce1..96d749a571342 100644
--- a/flang/lib/Semantics/mod-file.cpp
+++ b/flang/lib/Semantics/mod-file.cpp
@@ -1727,7 +1727,12 @@ Scope *ModFileReader::Read(SourceName name, std::optional<bool> isIntrinsic,
// within the module file.
Scope *previousHermetic{context_.currentHermeticModuleFileScope()};
if (parseTree.v.size() > 1) {
- parser::Program hermeticModules{std::move(parseTree.v)};
+ // Retain the embedded modules' parse tree for the lifetime of the
+ // SemanticsContext: symbols resolved from it (e.g. UserReductionDetails and
+ // MapperDetails, which hold raw parse-tree pointers) outlive this function
+ // and are dereferenced later, including at lowering time.
+ parser::Program &hermeticModules{
+ context_.SaveParseTree(parser::Program{std::move(parseTree.v)})};
parseTree.v.emplace_back(std::move(hermeticModules.v.front()));
hermeticModules.v.pop_front();
Scope &hermeticScope{topScope.MakeScope(Scope::Kind::Global)};
diff --git a/flang/test/Lower/OpenMP/declare-mapper-hermetic.f90 b/flang/test/Lower/OpenMP/declare-mapper-hermetic.f90
new file mode 100644
index 0000000000000..334c8d25a8189
--- /dev/null
+++ b/flang/test/Lower/OpenMP/declare-mapper-hermetic.f90
@@ -0,0 +1,38 @@
+! Hermetic module files embed the modules a module uses into its own .mod. A
+! consumer that materializes an imported declare mapper owned by such an embedded
+! module dereferences parse-tree pointers (MapperDetails) into it, so the embedded
+! module's parse tree must stay live past module-file reading. map_wrap re-exports
+! map_base (which owns the mapper) and is compiled hermetically; map_base.mod is
+! then removed so the consumer can only reach the mapper through the embedding.
+
+! RUN: rm -rf %t && split-file %s %t && cd %t
+! RUN: %flang_fc1 -fsyntax-only -fopenmp -fopenmp-version=50 map_base.f90
+! RUN: %flang_fc1 -fhermetic-module-files -fsyntax-only -fopenmp -fopenmp-version=50 map_wrap.f90
+! RUN: rm map_base.mod
+! RUN: %flang_fc1 -emit-hlfir -fopenmp -fopenmp-version=50 map.use.f90 -o - | FileCheck map.use.f90
+
+!--- map_base.f90
+module map_base
+ type :: t
+ integer :: x = 0
+ end type
+ !$omp declare mapper(mymapper : t :: v) map(v%x)
+end module
+
+!--- map_wrap.f90
+module map_wrap
+ use map_base
+end module
+
+!--- map.use.f90
+! CHECK: omp.declare_mapper @[[MAPPER:_QQMmap_base[A-Za-z0-9_.]*mymapper]]
+! CHECK: mapper(@[[MAPPER]])
+program main
+ use map_wrap
+ type(t) :: obj
+ obj%x = 0
+ !$omp target map(mapper(mymapper), tofrom: obj)
+ obj%x = obj%x + 1
+ !$omp end target
+ print *, obj%x
+end program
\ No newline at end of file
>From 3c80fea887fa3aeab3df39fb058b1dfc6fbd3d53 Mon Sep 17 00:00:00 2001
From: "Matt P. Dziubinski" <matt-p.dziubinski at hpe.com>
Date: Mon, 6 Jul 2026 12:13:58 -0500
Subject: [PATCH 2/5] [flang][OpenMP] Do not emit a use-only item for an
operator reduction in a module file
Stop writing a module file that cannot be re-parsed (reading it crashes) when a
module re-exports a USE-associated user-defined operator declare reduction.
Such a reduction is represented by an internal symbol whose name is the mangled
operator (e.g. "op.remote." or "op.+"), which is not valid Fortran. The
module-file writer emitted it as a `use MODULE, only: op.remote.` item, which the
reader cannot parse. This affected both a plain re-export facade and an embedded
module in a hermetic module file.
Skip the use-only item for a reduction whose operator is itself re-exported (a
defined operator, or an intrinsic operator with a user interface): the reduction
is re-exported implicitly with that operator, which is emitted, and the reduction
resolver recovers it from there (FindUserReductionSymbol). This covers a
derived-type `operator(+)` reduction as well as a defined operator like
`.remote.`.
The test checks the re-exporting module file round-trips and that a consumer
reading it resolves the reduction through the operator.
Assisted-by: Claude Opus 4.8, GPT-5.5.
---
flang/lib/Semantics/mod-file.cpp | 22 +++
...re-reduction-operator-modfile-reexport.f90 | 150 ++++++++++++++++++
2 files changed, 172 insertions(+)
create mode 100644 flang/test/Semantics/OpenMP/declare-reduction-operator-modfile-reexport.f90
diff --git a/flang/lib/Semantics/mod-file.cpp b/flang/lib/Semantics/mod-file.cpp
index 96d749a571342..96e5c520fd071 100644
--- a/flang/lib/Semantics/mod-file.cpp
+++ b/flang/lib/Semantics/mod-file.cpp
@@ -890,6 +890,28 @@ void ModFileWriter::PutGeneric(const Symbol &symbol) {
}
void ModFileWriter::PutUse(const Symbol &symbol) {
+ // A declare reduction named by an operator has an internal mangled symbol name
+ // ("op.remote.", "op.+") that is not valid Fortran and cannot be emitted as a
+ // "use,only:" item (that module file could not be re-parsed, and reading it
+ // crashed, both for a plain re-export and for an embedded module in a hermetic
+ // module file). Its operator is itself re-exported as a valid item, and the
+ // resolver recovers the reduction through it (FindUserReductionSymbol /
+ // SearchOperatorReduction), keeping one shared reduction symbol, so skip the
+ // reduction's own use item. This covers a defined operator (which always has a
+ // mandatory "interface operator(.x.)") and an intrinsic operator with a 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.
+ const Symbol &ultimate{symbol.GetUltimate()};
+ if (ultimate.has<UserReductionDetails>()) {
+ std::string opId{GetReductionFortranId(ultimate.name())};
+ const Symbol *opSym{
+ opId.empty() ? nullptr : ultimate.owner().FindSymbol(opId)};
+ if (opSym && opSym->GetUltimate().has<GenericDetails>()) {
+ return;
+ }
+ }
auto &details{symbol.get<UseDetails>()};
auto &use{details.symbol()};
const Symbol &module{GetUsedModule(details)};
diff --git a/flang/test/Semantics/OpenMP/declare-reduction-operator-modfile-reexport.f90 b/flang/test/Semantics/OpenMP/declare-reduction-operator-modfile-reexport.f90
new file mode 100644
index 0000000000000..35b1756b2a3ef
--- /dev/null
+++ b/flang/test/Semantics/OpenMP/declare-reduction-operator-modfile-reexport.f90
@@ -0,0 +1,150 @@
+! RUN: rm -rf %t && split-file %s %t && cd %t
+! A module that uses another module's user-defined declare reduction re-exports
+! it. A reduction named by an operator has an internal mangled symbol name
+! ("op.remote.", "op.+") that is not valid Fortran, so it must not be written as
+! a "use,only:" item (that module file could not be re-parsed and reading it
+! crashed); it is recovered through the re-exported operator instead. This holds
+! for both a defined operator (".remote.") and an intrinsic operator ("+") with a
+! user "interface operator(+)", including when a consumer reaches the reduction
+! through both the base and the facade. A reduction named by a plain identifier
+! ("myred") has a valid name and is re-exported as a normal "use,only:" item.
+
+! RUN: %flang_fc1 -fsyntax-only -fopenmp rx_base.f90
+! RUN: %flang_fc1 -fsyntax-only -fopenmp rx_wrap.f90
+! RUN: FileCheck --check-prefix=OPMOD --input-file=rx_wrap.mod %s
+! RUN: %flang_fc1 -fsyntax-only -fopenmp rx_use.f90
+
+! RUN: %flang_fc1 -fsyntax-only -fopenmp io_base.f90
+! RUN: %flang_fc1 -fsyntax-only -fopenmp io_wrap.f90
+! RUN: FileCheck --check-prefix=IOPMOD --input-file=io_wrap.mod %s
+! RUN: %flang_fc1 -fsyntax-only -fopenmp io_use.f90
+! RUN: %flang_fc1 -fsyntax-only -fopenmp io_dual.f90
+
+! RUN: %flang_fc1 -fsyntax-only -fopenmp nm_base.f90
+! RUN: %flang_fc1 -fsyntax-only -fopenmp nm_wrap.f90
+! RUN: FileCheck --check-prefix=NMMOD --input-file=nm_wrap.mod %s
+! RUN: %flang_fc1 -fsyntax-only -fopenmp nm_use.f90
+
+! The defined operator is re-exported; the mangled reduction symbol is not.
+! OPMOD: use rx_base,only:operator(.remote.)
+! OPMOD-NOT: only:op.remote.
+! The intrinsic operator is re-exported; the mangled reduction symbol is not, and
+! the directive is not re-emitted (no facade-owned duplicate reduction).
+! IOPMOD: use io_base,only:operator(+)
+! IOPMOD-NOT: only:op.+
+! IOPMOD-NOT: DECLARE REDUCTION
+! The plainly-named reduction is re-exported as a normal use item.
+! NMMOD: use nm_base,only:myred
+
+!--- 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
+module rx_wrap
+ use rx_base
+end module
+
+!--- rx_use.f90
+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
+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
+
+!--- io_base.f90
+module io_base
+ type :: t
+ integer :: val = 0
+ end type
+ interface operator(+)
+ module procedure add_t
+ end interface
+ !$omp declare reduction(+:t:omp_out=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
+end module
+
+!--- io_wrap.f90
+module io_wrap
+ use io_base
+end module
+
+!--- io_use.f90
+program main
+ use io_wrap
+ type(t) :: x
+ integer :: i
+ x = t(0)
+ !$omp parallel do reduction(+:x)
+ do i = 1, 100
+ x%val = x%val + 1
+ end do
+ print *, x%val
+end program
+
+!--- io_dual.f90
+! Reaching the reduction through both the base and the facade must bind one
+! reduction, not a facade-owned duplicate.
+program main
+ use io_base
+ use io_wrap
+ type(t) :: x
+ integer :: i
+ x = t(0)
+ !$omp parallel do reduction(+:x)
+ do i = 1, 100
+ x%val = x%val + 1
+ end do
+ print *, x%val
+end program
>From ce5b7178d23d17eaaec9678eea2a1860224be6ca Mon Sep 17 00:00:00 2001
From: "Matt P. Dziubinski" <matt-p.dziubinski at hpe.com>
Date: Fri, 3 Jul 2026 22:24:56 -0500
Subject: [PATCH 3/5] [flang][OpenMP] Lower cross-module operator declare
reduction
Lower a reduction clause naming a USE-associated, renamed, or merged-generic
user-defined operator, which currently aborts lowering with a "not yet
implemented" TODO. Semantics already accepts these programs (since #200329).
Fixes #207255.
Resolve the use-site operator to its source reduction symbol through the shared
semantic resolver (Fortran::semantics::omp::FindOperatorUserReductionSymbol),
extracted here from check-omp-structure.cpp into Semantics/openmp-utils so the
lowering and the semantic checks share one resolution authority. Name the
omp.declare_reduction op from the resolved symbol's (ultimate name,
owning-module) via getScopedUserReductionName, on both the clause and directive
sides so the two cannot drift. Because the name carries the owning module, 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.
For separate compilation, materializeOpenMPDeclareReductions walks module scopes
read from .mod files and lowers each imported operator reduction through
genOpenMPDeclareReductionImpl, mirroring imported declare-mapper materialization.
Mod-file reading runs only ResolveNames, so an imported combiner and initializer
carry bound names but no typed expressions; the materializer runs the
expression-analysis pass over each imported directive before lowering. An unused
import that lowering does not yet support is skipped rather than aborting the
consumer.
Single-declaration, single-type operator reductions. Multiple declarations or
types are the stacked follow-up.
Assisted-by: Claude Opus 4.8, GPT-5.5.
---
flang/include/flang/Lower/OpenMP.h | 8 +
flang/include/flang/Semantics/openmp-utils.h | 18 ++
flang/lib/Lower/Bridge.cpp | 9 +
flang/lib/Lower/OpenMP/OpenMP.cpp | 150 ++++++++++++++--
.../lib/Lower/Support/ReductionProcessor.cpp | 45 +++--
flang/lib/Semantics/check-omp-structure.cpp | 133 +-------------
flang/lib/Semantics/openmp-utils.cpp | 139 +++++++++++++++
.../declare-reduction-operator-use-assoc.f90 | 36 ----
.../declare-reduction-operator-collide.f90 | 79 +++++++++
.../declare-reduction-operator-merged.f90 | 75 ++++++++
.../declare-reduction-operator-renamed.f90 | 45 +++++
...-reduction-operator-separate-combiners.f90 | 106 ++++++++++++
...e-reduction-operator-separate-hermetic.f90 | 56 ++++++
...e-reduction-operator-separate-reexport.f90 | 93 ++++++++++
...n-operator-separate-unused-unsupported.f90 | 86 ++++++++++
.../declare-reduction-operator-separate.f90 | 162 ++++++++++++++++++
.../declare-reduction-operator-use-assoc.f90 | 47 +++++
17 files changed, 1088 insertions(+), 199 deletions(-)
delete mode 100644 flang/test/Lower/OpenMP/Todo/declare-reduction-operator-use-assoc.f90
create mode 100644 flang/test/Lower/OpenMP/declare-reduction-operator-collide.f90
create mode 100644 flang/test/Lower/OpenMP/declare-reduction-operator-merged.f90
create mode 100644 flang/test/Lower/OpenMP/declare-reduction-operator-renamed.f90
create mode 100644 flang/test/Lower/OpenMP/declare-reduction-operator-separate-combiners.f90
create mode 100644 flang/test/Lower/OpenMP/declare-reduction-operator-separate-hermetic.f90
create mode 100644 flang/test/Lower/OpenMP/declare-reduction-operator-separate-reexport.f90
create mode 100644 flang/test/Lower/OpenMP/declare-reduction-operator-separate-unused-unsupported.f90
create mode 100644 flang/test/Lower/OpenMP/declare-reduction-operator-separate.f90
create mode 100644 flang/test/Lower/OpenMP/declare-reduction-operator-use-assoc.f90
diff --git a/flang/include/flang/Lower/OpenMP.h b/flang/include/flang/Lower/OpenMP.h
index 882ebad9071bc..90d0e7010c033 100644
--- a/flang/include/flang/Lower/OpenMP.h
+++ b/flang/include/flang/Lower/OpenMP.h
@@ -105,6 +105,14 @@ void materializeOpenMPDeclareMappers(
Fortran::lower::AbstractConverter &, Fortran::semantics::SemanticsContext &,
const Fortran::semantics::Scope *scope = nullptr);
+// 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/Semantics/openmp-utils.h b/flang/include/flang/Semantics/openmp-utils.h
index 75bab5f6cb8ec..6e91ed4019b3d 100644
--- a/flang/include/flang/Semantics/openmp-utils.h
+++ b/flang/include/flang/Semantics/openmp-utils.h
@@ -35,6 +35,7 @@
#include <vector>
namespace Fortran::semantics {
+class DeclTypeSpec;
class Scope;
class SemanticsContext;
class Symbol;
@@ -116,6 +117,23 @@ 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).
+const Symbol *FindUserReductionSymbol(const Scope &scope,
+ const parser::CharBlock &mangledName, const DeclTypeSpec *type = nullptr);
+
+// Resolve the user-defined reduction associated with the defined-operator
+// symbol operatorSym. Delegates to FindUserReductionSymbol starting from the
+// operator's owning scope with the operator's mangled ("op...") name; type
+// filters by supported type as above.
+const Symbol *FindOperatorUserReductionSymbol(
+ 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 27fa06362a1a8..1bd92049211c7 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/OpenMP.cpp b/flang/lib/Lower/OpenMP/OpenMP.cpp
index d630d825062b7..a45b52b53212f 100644
--- a/flang/lib/Lower/OpenMP/OpenMP.cpp
+++ b/flang/lib/Lower/OpenMP/OpenMP.cpp
@@ -42,6 +42,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"
@@ -4680,12 +4681,17 @@ 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 combiner's stylized declaration
+// symbol, without checking whether lowering supports it. 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) {
+computeReductionType(lower::AbstractConverter &converter,
+ const parser::OmpReductionSpecifier &specifier) {
const auto &combinerExpression =
std::get<std::optional<parser::OmpCombinerExpression>>(specifier.t)
.value();
@@ -4696,8 +4702,15 @@ getReductionType(lower::AbstractConverter &converter,
const parser::OmpStylizedDeclaration &decl = declList.front();
const auto &name = std::get<parser::ObjectName>(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::OmpReductionSpecifier &specifier) {
+ mlir::Type reductionType = computeReductionType(converter, specifier);
if (!isSimpleReductionType(reductionType))
TODO(converter.getCurrentLocation(),
"declare reduction currently only supports trivial types, "
@@ -4733,10 +4746,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;
@@ -4802,13 +4821,17 @@ 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<spelling>". Only single-declaration, single-type
- // reductions are supported; otherwise emit a clean
+ // ReductionProcessor::processReductionArguments). Name
+ // the op via getScopedUserReductionName from the
+ // symbol's ultimate (name, owner), byte-identical to
+ // the clause reference. symOpt supplies the source
+ // symbol for separate compilation, else opName.v.sym().
+ // Single-declaration, single-type only; otherwise a
+ // clean
// TODO.
const semantics::Symbol &redSym =
- opName.v.sym()->GetUltimate();
+ symOpt ? symOpt->GetUltimate()
+ : opName.v.sym()->GetUltimate();
const auto *userDetails =
redSym.detailsIf<semantics::UserReductionDetails>();
if (!userDetails || typeNameList.v.size() != 1 ||
@@ -4916,6 +4939,18 @@ static void genOMP(lower::AbstractConverter &converter, lower::SymMap &symTable,
}
}
+// 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,
@@ -6077,3 +6112,88 @@ 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<semantics::UserReductionDetails>();
+ 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 or unsupported-shape (multiple
+ // declarations/types) reduction would trip the impl's TODO and abort an
+ // unused import; a program that references it still gets the clause-side
+ // TODO.
+ if (ultimate.attrs().test(semantics::Attr::PRIVATE) ||
+ userDetails->GetDeclList().size() != 1 ||
+ userDetails->GetTypeList().size() != 1)
+ continue;
+ for (const auto *decl : userDetails->GetDeclList()) {
+ if (const auto *reductionDecl =
+ std::get_if<parser::OmpDeclareReductionDirective>(&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
+ // / multiple declarations / types).
+ const auto &specifier =
+ DEREF(parser::omp::GetFirstArgument<parser::OmpReductionSpecifier>(
+ 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<std::optional<parser::OmpCombinerExpression>>(specifier.t)
+ .has_value())
+ continue;
+ // A reduction type lowering does not yet support: mirror the impl's
+ // getReductionType check with the shared predicate.
+ if (!isSimpleReductionType(computeReductionType(converter, specifier)))
+ 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 e1b4684bd8871..54a9ffe642613 100644
--- a/flang/lib/Lower/Support/ReductionProcessor.cpp
+++ b/flang/lib/Lower/Support/ReductionProcessor.cpp
@@ -22,6 +22,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 <type_traits>
@@ -825,37 +826,43 @@ bool ReductionProcessor::processReductionArguments(
std::get_if<omp::clause::DefinedOperator::DefinedOpName>(
&redDefinedOp->u)) {
// User-defined operator reduction (e.g. reduction(.myop.:x)). Resolve
- // the use-site operator to its reduction symbol, which semantics
- // names "op<spelling>" (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 (following USE 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. Single-declaration,
+ // single-type only; anything else, or an operator with no reduction
+ // for the variable's 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(*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<semantics::UserReductionDetails>()
: nullptr;
- const semantics::DeclTypeSpec *varType =
- reductionSymbols[idx]->GetUltimate().GetType();
- if (!redSym || ultimate != redSym || !userDetails ||
+ if (!varType || !resolvedSym || !userDetails ||
userDetails->GetDeclList().size() != 1 ||
- userDetails->GetTypeList().size() != 1 || !varType ||
- !userDetails->SupportsType(*varType)) {
+ userDetails->GetTypeList().size() != 1) {
TODO(currentLocation,
"OpenMP user-defined operator reduction is not yet supported "
"for imported, renamed, or multiple-declaration/type "
"reductions");
}
std::string opName = ReductionProcessor::getScopedUserReductionName(
- converter, *redSym);
+ converter, *resolvedSym);
mlir::ModuleOp module = builder.getModule();
auto existingDecl = module.lookupSymbol<OpType>(opName);
// The MLIR verifier does not type-check these ops (they have no
diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index 4e514223b388a..7ee83236b32f4 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -3820,131 +3820,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<UserReductionDetails>()};
- 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<HostAssocDetails>()}) {
- s = &host->symbol();
- }
- return !s->detailsIf<UseDetails>();
-}
-
-// 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<const Symbol *> &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<UserReductionDetails>() &&
- IsLocalReduction(reductionSym)) {
- return nullptr;
- }
- }
- }
- }
- // Follow a USE-associated operator to the module it was imported from.
- if (const auto *use{opSym.detailsIf<UseDetails>()}) {
- 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<GenericDetails>()}) {
- 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<UserReductionDetails>() &&
- 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<const Symbol *, 8> visited;
- return SearchOperatorReduction(
- *opSymbol, mangledName, opSymbol->name(), type, visited);
-}
-
bool OmpStructureChecker::CheckReductionOperator(
const parser::OmpReductionIdentifier &ident, parser::CharBlock source,
llvm::omp::Clause clauseId) {
@@ -3975,7 +3850,7 @@ bool OmpStructureChecker::CheckReductionOperator(
if (const auto *definedOp{std::get_if<parser::DefinedOpName>(&dOpr.u)}) {
std::string mangled{MangleDefinedOperator(definedOp->v.symbol->name())};
const Scope &scope{definedOp->v.symbol->owner()};
- if (FindUserReduction(scope, mangled)) {
+ if (omp::FindUserReductionSymbol(scope, mangled)) {
return true;
}
}
@@ -4063,9 +3938,9 @@ 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;
}
static bool IsReductionAllowedForType(
diff --git a/flang/lib/Semantics/openmp-utils.cpp b/flang/lib/Semantics/openmp-utils.cpp
index 8cf174a0139af..46efa3b3e5336 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,7 @@
#include "llvm/ADT/ArrayRef.h"
#include "llvm/ADT/DenseSet.h"
#include "llvm/ADT/STLExtras.h"
+#include "llvm/ADT/SmallPtrSet.h"
#include "llvm/ADT/StringExtras.h"
#include "llvm/Frontend/OpenMP/OMPContext.h"
@@ -2419,4 +2422,140 @@ std::optional<DynamicUserCondition> MakeVariantMatchInfo(
}
return dynamicCond;
}
+
+// 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<UserReductionDetails>()};
+ 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<HostAssocDetails>()}) {
+ s = &host->symbol();
+ }
+ return !s->detailsIf<UseDetails>();
+}
+
+// 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 Symbol *SearchOperatorReduction(const Symbol &opSym,
+ const parser::CharBlock &mangledName, const parser::CharBlock &localName,
+ const DeclTypeSpec *type, llvm::SmallPtrSetImpl<const Symbol *> &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 (AcceptReduction(reductionUltimate, type)) {
+ return &reductionSym;
+ }
+ // A locally declared reduction here shadows reductions reachable
+ // further along this branch.
+ if (reductionUltimate.detailsIf<UserReductionDetails>() &&
+ IsLocalReduction(reductionSym)) {
+ return nullptr;
+ }
+ }
+ }
+ }
+ // Follow a USE-associated operator to the module it was imported from.
+ if (const auto *use{opSym.detailsIf<UseDetails>()}) {
+ 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<GenericDetails>()}) {
+ for (const Symbol &useSym : generic->uses()) {
+ if (const Symbol *result{SearchOperatorReduction(
+ useSym, mangledName, localName, type, visited)}) {
+ return result;
+ }
+ }
+ }
+ 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.
+const Symbol *FindUserReductionSymbol(const Scope &scope,
+ const parser::CharBlock &mangledName, const DeclTypeSpec *type) {
+ // Direct lookup: a reduction directly visible via bare USE or a local
+ // declaration.
+ const Symbol *directSymbol{scope.FindSymbol(mangledName)};
+ if (directSymbol) {
+ if (AcceptReduction(*directSymbol, type)) {
+ return 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.
+ if (directSymbol->GetUltimate().detailsIf<UserReductionDetails>() &&
+ 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<const Symbol *, 8> visited;
+ return SearchOperatorReduction(
+ *opSymbol, mangledName, opSymbol->name(), type, visited);
+}
+
+const Symbol *FindOperatorUserReductionSymbol(
+ const Symbol &operatorSym, const DeclTypeSpec *type) {
+ return FindUserReductionSymbol(
+ operatorSym.owner(), MangleDefinedOperator(operatorSym.name()), type);
+}
} // namespace Fortran::semantics::omp
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<spelling>" 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/declare-reduction-operator-collide.f90 b/flang/test/Lower/OpenMP/declare-reduction-operator-collide.f90
new file mode 100644
index 0000000000000..45ac1ba7ee495
--- /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\.]] : !fir.ref
+! CHECK-DAG: omp.declare_reduction @[[REDMUL:_QQ[A-Za-z0-9_.]*mod_mul[A-Za-z0-9_.]*op\.remote\.]] : !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-merged.f90 b/flang/test/Lower/OpenMP/declare-reduction-operator-merged.f90
new file mode 100644
index 0000000000000..2ef1c2d6cc231
--- /dev/null
+++ b/flang/test/Lower/OpenMP/declare-reduction-operator-merged.f90
@@ -0,0 +1,75 @@
+! 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. 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\.]] : !fir.ref
+! CHECK-DAG: omp.declare_reduction @[[REDREAL:_QQ[A-Za-z0-9_.]*m_real[A-Za-z0-9_.]*op\.remote\.]] : !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-renamed.f90 b/flang/test/Lower/OpenMP/declare-reduction-operator-renamed.f90
new file mode 100644
index 0000000000000..3bc153bba84a3
--- /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\.]] : !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..14454701204e7
--- /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\.]] : !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\.]] : !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..ffe61e27d1e34
--- /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\.]] : !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..6e1019863e09b
--- /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:_QQ[A-Za-z0-9_.]*base[A-Za-z0-9_.]*op\.remote\.]] : !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:_QQ[A-Za-z0-9_.]*nm_base[A-Za-z0-9_.]*myred]] : !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..6864c8249d8b6
--- /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\.]] : !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\.]] : !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\.}} : !fir.ref
+! CHECK-DAG: omp.declare_reduction @{{_QQ[A-Za-z0-9_.]*mulmod[A-Za-z0-9_.]*op\.remote\.}} : !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..78f370518e0c1
--- /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\.]] : !fir.ref
+! CHECK-NOT: omp.declare_reduction @op.plus.
+! CHECK: omp.wsloop
+! CHECK-SAME: reduction(byref @[[RED]]
+! CHECK-NOT: not yet implemented
>From 779f0862d68da995459704bd213c5fffaeaa191f Mon Sep 17 00:00:00 2001
From: "Matt P. Dziubinski" <matt-p.dziubinski at hpe.com>
Date: Mon, 6 Jul 2026 03:00:15 -0500
Subject: [PATCH 4/5] [flang][OpenMP] Re-export an operator-less declare
reduction via a plain USE
An operator-less declare reduction (a special function such as max/min, or an
intrinsic operator such as `+` on an intrinsic type) has an internal mangled
symbol name ("op.max", "op.+") that is not valid Fortran, and, unlike an operator
reduction, no re-exported operator to recover through. When a module re-exports
it through a facade (`use base` in a module that is itself used), the module-file
writer could not emit it as a "use,only:" item; the resulting module file failed
to re-parse and reading it crashed.
Such a reduction 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 with a plain `use base`. The
reduction then comes in as a single shared use-association owned by the defining
module: reaching it through both the base and the facade binds one reduction with
the user's combiner rather than a facade-owned duplicate that would silently fall
back to the intrinsic, and nothing re-resolves the combiner in the facade scope.
Entities the facade renames or makes private keep their own use/rename/private
items, which the reader honors, so the plain USE does not widen their visibility.
A private reduction is not re-exported (the plain USE would otherwise re-import
the module publicly and silently change a consumer from the intrinsic reduction
to the private one across a round-trip). The plain USE is emitted once per
defining module even when several operator-less reductions come from it.
Assisted-by: Claude Opus 4.8, GPT-5.5.
---
flang/lib/Semantics/mod-file.cpp | 36 +++-
flang/lib/Semantics/mod-file.h | 4 +
...re-reduction-special-separate-reexport.f90 | 169 ++++++++++++++++++
3 files changed, 207 insertions(+), 2 deletions(-)
create mode 100644 flang/test/Lower/OpenMP/declare-reduction-special-separate-reexport.f90
diff --git a/flang/lib/Semantics/mod-file.cpp b/flang/lib/Semantics/mod-file.cpp
index 96e5c520fd071..065a2c0fe2547 100644
--- a/flang/lib/Semantics/mod-file.cpp
+++ b/flang/lib/Semantics/mod-file.cpp
@@ -213,6 +213,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();
@@ -901,8 +904,9 @@ void ModFileWriter::PutUse(const Symbol &symbol) {
// mandatory "interface operator(.x.)") and an intrinsic operator with a 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.
+ // (a special function, or an intrinsic operator on an intrinsic 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<UserReductionDetails>()) {
std::string opId{GetReductionFortranId(ultimate.name())};
@@ -911,6 +915,34 @@ void ModFileWriter::PutUse(const Symbol &symbol) {
if (opSym && opSym->GetUltimate().has<GenericDetails>()) {
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<UseDetails>()};
+ 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<UseDetails>()};
auto &use{details.symbol()};
diff --git a/flang/lib/Semantics/mod-file.h b/flang/lib/Semantics/mod-file.h
index 9e5724089b3c5..c2680fec76d44 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/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
>From 897bd98cbc422cba2fd11239407f8bf8c0d87805 Mon Sep 17 00:00:00 2001
From: "Matt P. Dziubinski" <matt-p.dziubinski at hpe.com>
Date: Mon, 6 Jul 2026 04:34:01 -0500
Subject: [PATCH 5/5] [flang][OpenMP] Diagnose an ambiguous user-defined
reduction identifier
When a reduction identifier in a REDUCTION clause resolves to more than one
distinct user-defined reduction for the list item's type, the compiler accepted
the program and selected a combiner silently by USE order. Swapping two USE
statements could change which combiner a reduction applied, with no diagnostic.
This happens when two distinguishable user-defined operators are merged into one
local operator (by rename or by a shared name) and each declares a reduction for
the same type, and when an intrinsic-operator or special-function reduction name
collides across modules (e.g. two modules each with `reduction(+:integer)`).
Resolve the reduction by collecting every distinct reduction the identifier
reaches, rather than stopping at the first: explore every branch of a merged
generic operator and enumerate a mangled name that collides into a USE error.
Distinctness is by canonical identity (defining-module name and reduction name),
not ultimate-symbol pointer, so one reduction reached through several
USE/rename/facade paths (a diamond, or a hermetic facade that embeds the defining
module) collapses to one candidate while genuinely different reductions stay
separate. When more than one distinct reduction supports the type, the reduction
clause is rejected as ambiguous. Lowering is unaffected: it does not check
ambiguity, and an ambiguous program is rejected in semantics before lowering.
A same-named module loaded at two different versions (a stale hermetic embed vs.
a rebuilt module) is not distinguished, because only the combiner body differs;
such an inconsistent build collapses to one candidate and is resolved by USE
order without a diagnostic, matching the pre-existing behavior. This limitation
is documented at the dedup key and pinned by a known-limitation test.
Assisted-by: Claude Opus 4.8, GPT-5.5.
---
flang/include/flang/Semantics/openmp-utils.h | 9 +-
flang/lib/Semantics/check-omp-structure.cpp | 57 +++++
flang/lib/Semantics/openmp-utils.cpp | 152 ++++++++++---
.../declare-reduction-merge-hermetic.f90 | 53 +++++
.../declare-reduction-merge-version-skew.f90 | 72 ++++++
.../OpenMP/declare-reduction-ambiguous.f90 | 205 ++++++++++++++++++
6 files changed, 511 insertions(+), 37 deletions(-)
create mode 100644 flang/test/Lower/OpenMP/declare-reduction-merge-hermetic.f90
create mode 100644 flang/test/Lower/OpenMP/declare-reduction-merge-version-skew.f90
create mode 100644 flang/test/Semantics/OpenMP/declare-reduction-ambiguous.f90
diff --git a/flang/include/flang/Semantics/openmp-utils.h b/flang/include/flang/Semantics/openmp-utils.h
index 6e91ed4019b3d..cd98ab407dceb 100644
--- a/flang/include/flang/Semantics/openmp-utils.h
+++ b/flang/include/flang/Semantics/openmp-utils.h
@@ -123,9 +123,14 @@ const Symbol *GetHostSymbol(const Symbol &sym);
// 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).
+// 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);
+ 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 starting from the
diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index 7ee83236b32f4..9beb7d4ef3043 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -3943,6 +3943,59 @@ static bool CheckSymbolSupportsType(const Scope &scope,
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<parser::CharBlock> MangledReductionIdentifier(
+ const parser::OmpReductionIdentifier &ident, SemanticsContext &context,
+ std::string &buffer) {
+ return common::visit(
+ common::visitors{
+ [&](const parser::DefinedOperator &dOpr)
+ -> std::optional<parser::CharBlock> {
+ if (const auto *intrinsicOp{
+ std::get_if<parser::DefinedOperator::IntrinsicOperator>(
+ &dOpr.u)}) {
+ return MakeNameFromOperator(*intrinsicOp, context);
+ }
+ if (const auto *definedOp{
+ std::get_if<parser::DefinedOpName>(&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<parser::CharBlock> {
+ if (const auto *name{std::get_if<parser::Name>(&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(
const parser::OmpReductionIdentifier &ident, const DeclTypeSpec &type,
bool cannotBeBuiltinReduction, const Scope &scope,
@@ -4069,6 +4122,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/openmp-utils.cpp b/flang/lib/Semantics/openmp-utils.cpp
index 46efa3b3e5336..6d870b3b8a816 100644
--- a/flang/lib/Semantics/openmp-utils.cpp
+++ b/flang/lib/Semantics/openmp-utils.cpp
@@ -39,6 +39,7 @@
#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"
@@ -2466,18 +2467,67 @@ static bool IsLocalReduction(const Symbol &symbol) {
return !s->detailsIf<UseDetails>();
}
-// 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 Symbol *SearchOperatorReduction(const Symbol &opSym,
+// 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<const Symbol *> &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<const Symbol *> &visited) {
+ const DeclTypeSpec *type, llvm::SmallPtrSetImpl<const Symbol *> &visited,
+ llvm::SmallVectorImpl<const Symbol *> &matches) {
if (!visited.insert(&opSym).second) {
- return nullptr;
+ return;
}
const Scope &scope{opSym.owner()};
if (scope.kind() == Scope::Kind::Module) {
@@ -2489,33 +2539,34 @@ static const Symbol *SearchOperatorReduction(const Symbol &opSym,
const Symbol &reductionUltimate{reductionSym.GetUltimate()};
if (!reductionUltimate.attrs().test(Attr::PRIVATE)) {
if (AcceptReduction(reductionUltimate, type)) {
- return &reductionSym;
+ AddDistinctReduction(matches, reductionSym);
+ return;
}
// A locally declared reduction here shadows reductions reachable
// further along this branch.
if (reductionUltimate.detailsIf<UserReductionDetails>() &&
IsLocalReduction(reductionSym)) {
- return nullptr;
+ return;
}
}
}
}
// Follow a USE-associated operator to the module it was imported from.
if (const auto *use{opSym.detailsIf<UseDetails>()}) {
- return SearchOperatorReduction(
- use->symbol(), mangledName, localName, type, visited);
+ CollectOperatorReductions(
+ use->symbol(), mangledName, localName, type, visited, matches);
+ return;
}
- // Search each module merged into a generic operator (recursing through
- // re-exporting facade modules).
+ // 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<GenericDetails>()}) {
for (const Symbol &useSym : generic->uses()) {
- if (const Symbol *result{SearchOperatorReduction(
- useSym, mangledName, localName, type, visited)}) {
- return result;
- }
+ CollectOperatorReductions(
+ useSym, mangledName, localName, type, visited, matches);
}
}
- return nullptr;
}
// Find user reduction details for a mangled name, following USE associations
@@ -2523,21 +2574,49 @@ static const Symbol *SearchOperatorReduction(const Symbol &opSym,
// 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.
+// 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) {
+ const parser::CharBlock &mangledName, const DeclTypeSpec *type,
+ bool *ambiguous) {
+ if (ambiguous) {
+ *ambiguous = false;
+ }
+ llvm::SmallVector<const Symbol *, 2> matches;
// Direct lookup: a reduction directly visible via bare USE or a local
// declaration.
const Symbol *directSymbol{scope.FindSymbol(mangledName)};
if (directSymbol) {
- if (AcceptReduction(*directSymbol, type)) {
- return 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.
- if (directSymbol->GetUltimate().detailsIf<UserReductionDetails>() &&
+ if (const auto *useError{directSymbol->detailsIf<UseErrorDetails>()}) {
+ // 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<UserReductionDetails>() &&
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;
}
}
@@ -2545,12 +2624,15 @@ const Symbol *FindUserReductionSymbol(const Scope &scope,
std::string fortranName{GetReductionFortranId(mangledName)};
const Symbol *opSymbol{
fortranName.empty() ? nullptr : scope.FindSymbol(fortranName)};
- if (!opSymbol) {
- return nullptr;
+ if (opSymbol) {
+ llvm::SmallPtrSet<const Symbol *, 8> visited;
+ CollectOperatorReductions(
+ *opSymbol, mangledName, opSymbol->name(), type, visited, matches);
+ }
+ if (ambiguous) {
+ *ambiguous = matches.size() > 1;
}
- llvm::SmallPtrSet<const Symbol *, 8> visited;
- return SearchOperatorReduction(
- *opSymbol, mangledName, opSymbol->name(), type, visited);
+ return matches.empty() ? nullptr : matches.front();
}
const Symbol *FindOperatorUserReductionSymbol(
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/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
More information about the flang-commits
mailing list