[flang-commits] [flang] [flang][OpenMP] Remove over-broad global scan for declare reduction symbols (PR #200329)
via flang-commits
flang-commits at lists.llvm.org
Thu Jun 4 16:50:45 PDT 2026
https://github.com/MattPD updated https://github.com/llvm/llvm-project/pull/200329
>From bea2a8a66330c344cbd04f3b079ed3738e3e2b22 Mon Sep 17 00:00:00 2001
From: "Matt P. Dziubinski" <matt-p.dziubinski at hpe.com>
Date: Thu, 28 May 2026 23:09:23 -0500
Subject: [PATCH 1/2] [flang][OpenMP] Fix USE-associated declare reduction
symbol resolution
When a declare reduction is accessed via USE association, the symbol in
the consuming scope has UseDetails rather than UserReductionDetails.
Calling detailsIf<UserReductionDetails>() directly on such a symbol
returns nullptr. This causes two distinct failure modes:
1. Operator/identifier validation (CheckReductionOperator): named
reductions and defined operators are rejected with "Invalid reduction
identifier" or "Invalid reduction operator".
2. Type validation (CheckSymbolSupportsType, IsReductionAllowedForType):
the type compatibility check cannot find UserReductionDetails for the
reduction, producing "The type of 'x' is incompatible with the
reduction operator".
This bug has existed since UserReductionDetails was introduced (June
2025). Only intrinsic operator reductions (like +) worked via USE,
because they bypass the operator validation check and their type checking
was handled by a global module scan workaround (added Feb 2026).
Add GetUltimate() at 4 locations in check-omp-structure.cpp to resolve
through UseDetails chains before checking for UserReductionDetails:
two in CheckReductionOperator (validation paths 1a and 1b above), one in
CheckSymbolSupportsType, and one in IsReductionAllowedForType.
Fixes https://github.com/llvm/llvm-project/issues/184932
Assisted-by: Claude Opus 4.6.
---
flang/lib/Semantics/check-omp-structure.cpp | 9 +-
.../declare-reduction-use-assoc-named.f90 | 82 +++++++++++++++++++
2 files changed, 87 insertions(+), 4 deletions(-)
create mode 100644 flang/test/Semantics/OpenMP/declare-reduction-use-assoc-named.f90
diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index ff41f49d88b32..c450c3fbfeb43 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -3847,7 +3847,7 @@ bool OmpStructureChecker::CheckReductionOperator(
std::string mangled{MangleDefinedOperator(definedOp->v.symbol->name())};
const Scope &scope{definedOp->v.symbol->owner()};
if (const Symbol *symbol{scope.FindSymbol(mangled)}) {
- if (symbol->detailsIf<UserReductionDetails>()) {
+ if (symbol->GetUltimate().detailsIf<UserReductionDetails>()) {
return true;
}
}
@@ -3865,7 +3865,7 @@ bool OmpStructureChecker::CheckReductionOperator(
valid =
llvm::is_contained({"max", "min", "iand", "ior", "ieor"}, realName);
if (!valid) {
- valid = name->symbol->detailsIf<UserReductionDetails>();
+ valid = name->symbol->GetUltimate().detailsIf<UserReductionDetails>();
}
}
if (!valid) {
@@ -3948,8 +3948,9 @@ void OmpStructureChecker::CheckReductionObjects(
static bool CheckSymbolSupportsType(const Scope &scope,
const parser::CharBlock &name, const DeclTypeSpec &type) {
if (const auto *symbol{scope.FindSymbol(name)}) {
+ const auto &ultimate{symbol->GetUltimate()};
if (const auto *reductionDetails{
- symbol->detailsIf<UserReductionDetails>()}) {
+ ultimate.detailsIf<UserReductionDetails>()}) {
return reductionDetails->SupportsType(type);
}
}
@@ -4063,7 +4064,7 @@ static bool IsReductionAllowedForType(
// if the symbol has UserReductionDetails, and if so, the type is
// supported.
if (const auto *reductionDetails{
- name->symbol->detailsIf<UserReductionDetails>()}) {
+ name->symbol->GetUltimate().detailsIf<UserReductionDetails>()}) {
return reductionDetails->SupportsType(type);
}
diff --git a/flang/test/Semantics/OpenMP/declare-reduction-use-assoc-named.f90 b/flang/test/Semantics/OpenMP/declare-reduction-use-assoc-named.f90
new file mode 100644
index 0000000000000..2b7b3864bdef2
--- /dev/null
+++ b/flang/test/Semantics/OpenMP/declare-reduction-use-assoc-named.f90
@@ -0,0 +1,82 @@
+! RUN: %flang_fc1 -fopenmp -fopenmp-version=52 -fsyntax-only %s
+! RUN: %flang_fc1 -fopenmp -fopenmp-version=52 -fdebug-dump-symbols %s 2>&1 | FileCheck %s
+
+! Test that USE-associated named reductions and user-defined operator
+! reductions are correctly resolved through UseDetails.
+
+module m_named_reduction
+ 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
+
+module m_defined_op_reduction
+ type :: dt
+ real :: x = 0.0
+ end type
+ interface operator(.combine.)
+ module procedure combine_fn
+ end interface
+ !$omp declare reduction(.combine.:dt:omp_out%x=omp_out%x+omp_in%x) &
+ !$omp initializer(omp_priv=dt(0.0))
+contains
+ type(dt) function combine_fn(a, b)
+ type(dt), intent(in) :: a, b
+ combine_fn%x = a%x + b%x
+ end function
+end module
+
+program test_use_assoc_reductions
+ use m_named_reduction
+ use m_defined_op_reduction
+ type(t) :: x
+ type(dt) :: y
+ integer :: i
+ x = t(0)
+ y = dt(0.0)
+ ! Both should compile without error: reductions are accessible via USE.
+ !$omp parallel do reduction(myred:x)
+ do i = 1, 10
+ x%val = x%val + 1
+ end do
+ !$omp end parallel do
+ !$omp parallel do reduction(.combine.:y)
+ do i = 1, 10
+ y%x = y%x + 1.0
+ end do
+ !$omp end parallel do
+ print *, x%val, y%x
+end program
+
+! Test defined operator with external interface via USE (issue #184932 pattern).
+! Uses !$omp parallel (not parallel do) to cover that variant.
+module m_external_op
+ type :: ty
+ integer :: ii
+ end type
+ interface operator(.x.)
+ function h(a, b)
+ import :: ty
+ type(ty), intent(in) :: a, b
+ end function
+ end interface
+ !$omp declare reduction(.x.:ty:omp_out=ty(1)) initializer(omp_priv=ty(0))
+end module
+
+subroutine test_external_op_reduction
+ use m_external_op
+ type(ty) :: v
+ v = ty(0)
+ !$omp parallel reduction(.x.:v)
+ v = ty(1)
+ !$omp end parallel
+end subroutine
+
+!CHECK: Module scope: m_named_reduction
+!CHECK: myred, PUBLIC: UserReductionDetails TYPE(t)
+!CHECK: Module scope: m_defined_op_reduction
+!CHECK: op.combine., PUBLIC: UserReductionDetails TYPE(dt)
+!CHECK: Module scope: m_external_op
+!CHECK: op.x., PUBLIC: UserReductionDetails TYPE(ty)
>From d9734318d7902528cb2f2c4d0b10e22842c5ec40 Mon Sep 17 00:00:00 2001
From: "Matt P. Dziubinski" <matt-p.dziubinski at hpe.com>
Date: Thu, 28 May 2026 23:09:59 -0500
Subject: [PATCH 2/2] [flang][OpenMP] Fix declare reduction lookup for
USE...ONLY imports
Replace the over-broad global scan in CheckSymbolSupportsType with
FindUserReduction(), which traces USE-associated operator symbols back
to their source module to locate the reduction. This handles bare USE,
USE...ONLY, defined operators, and merged generics from multiple modules.
Consolidate duplicated GetReductionFortranId() (formerly static in both
resolve-names.cpp and mod-file.cpp) into a shared utility, fixing a
latent bug where defined operators were not correctly reverse-mapped
(suffix.front() never matched; corrected to suffix.back()).
Fixes #200300.
Assisted-by: Claude Opus 4.6.
---
flang/lib/Semantics/check-omp-structure.cpp | 84 ++++++++++++-------
flang/lib/Semantics/mod-file.cpp | 28 +------
flang/lib/Semantics/resolve-names-utils.cpp | 35 ++++++++
flang/lib/Semantics/resolve-names-utils.h | 6 ++
flang/lib/Semantics/resolve-names.cpp | 34 +-------
.../declare-reduction-overbroad-lookup.f90 | 32 +++++++
.../declare-reduction-use-only-defined-op.f90 | 33 ++++++++
.../OpenMP/declare-reduction-use-only.f90 | 35 ++++++++
8 files changed, 199 insertions(+), 88 deletions(-)
create mode 100644 flang/test/Semantics/OpenMP/declare-reduction-overbroad-lookup.f90
create mode 100644 flang/test/Semantics/OpenMP/declare-reduction-use-only-defined-op.f90
create mode 100644 flang/test/Semantics/OpenMP/declare-reduction-use-only.f90
diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index c450c3fbfeb43..127b5d3bf0944 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -3816,6 +3816,58 @@ void OmpStructureChecker::Enter(const parser::OmpClause::TaskReduction &x) {
CheckReductionObjects(objects, llvm::omp::Clause::OMPC_task_reduction);
}
+// Find user reduction details for a mangled name, following USE associations
+// if the reduction is not directly visible in the scope.
+static const UserReductionDetails *FindUserReduction(
+ const Scope &scope, const parser::CharBlock &mangledName) {
+ // Direct lookup: works for bare USE or local declarations.
+ if (const auto *symbol{scope.FindSymbol(mangledName)}) {
+ const auto &ultimate{symbol->GetUltimate()};
+ if (const auto *details{ultimate.detailsIf<UserReductionDetails>()}) {
+ return details;
+ }
+ }
+ // Fallback: the operator/procedure was imported via USE...ONLY but the
+ // internal reduction symbol was not. Trace through the operator symbol
+ // to its source module scope.
+ std::string fortranName{GetReductionFortranId(mangledName)};
+ if (fortranName.empty()) {
+ return nullptr;
+ }
+ auto *opSymbol{scope.FindSymbol(fortranName)};
+ if (!opSymbol) {
+ return nullptr;
+ }
+ // Try following UseDetails/HostAssocDetails to the source module.
+ const Symbol &ultimate{opSymbol->GetUltimate()};
+ const Scope &sourceScope{ultimate.owner()};
+ if (sourceScope.kind() == Scope::Kind::Module) {
+ auto it{sourceScope.find(mangledName)};
+ if (it != sourceScope.end()) {
+ const Symbol &reductionSym{it->second->GetUltimate()};
+ if (!reductionSym.attrs().test(Attr::PRIVATE)) {
+ return reductionSym.detailsIf<UserReductionDetails>();
+ }
+ }
+ }
+ // Handle merged generics (operator imported from multiple modules).
+ if (const auto *generic{opSymbol->detailsIf<GenericDetails>()}) {
+ for (const Symbol &useSym : generic->uses()) {
+ const Scope &modScope{useSym.GetUltimate().owner()};
+ if (modScope.kind() == Scope::Kind::Module) {
+ auto it{modScope.find(mangledName)};
+ if (it != modScope.end()) {
+ const Symbol &reductionSym{it->second->GetUltimate()};
+ if (!reductionSym.attrs().test(Attr::PRIVATE)) {
+ return reductionSym.detailsIf<UserReductionDetails>();
+ }
+ }
+ }
+ }
+ }
+ return nullptr;
+}
+
bool OmpStructureChecker::CheckReductionOperator(
const parser::OmpReductionIdentifier &ident, parser::CharBlock source,
llvm::omp::Clause clauseId) {
@@ -3846,10 +3898,8 @@ 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 (const Symbol *symbol{scope.FindSymbol(mangled)}) {
- if (symbol->GetUltimate().detailsIf<UserReductionDetails>()) {
- return true;
- }
+ if (FindUserReduction(scope, mangled)) {
+ return true;
}
}
context_.Say(source, "Invalid reduction operator in %s clause."_err_en_US,
@@ -3947,30 +3997,8 @@ void OmpStructureChecker::CheckReductionObjects(
static bool CheckSymbolSupportsType(const Scope &scope,
const parser::CharBlock &name, const DeclTypeSpec &type) {
- if (const auto *symbol{scope.FindSymbol(name)}) {
- const auto &ultimate{symbol->GetUltimate()};
- if (const auto *reductionDetails{
- ultimate.detailsIf<UserReductionDetails>()}) {
- return reductionDetails->SupportsType(type);
- }
- }
- // Look through module scopes in the global scope.
- // This covers reductions declared in a module and used via USE association.
- const SemanticsContext &semCtx{scope.context()};
- Scope &global = const_cast<SemanticsContext &>(semCtx).globalScope();
- for (const Scope &child : global.children()) {
- if (child.kind() == Scope::Kind::Module) {
- if (const auto *symbol{child.FindSymbol(name)}) {
- // Skip PRIVATE reductions that aren't visible in the current scope.
- if (symbol->attrs().test(Attr::PRIVATE)) {
- continue;
- }
- if (const auto *reductionDetails{
- symbol->detailsIf<UserReductionDetails>()}) {
- return reductionDetails->SupportsType(type);
- }
- }
- }
+ if (const auto *details{FindUserReduction(scope, name)}) {
+ return details->SupportsType(type);
}
return false;
}
diff --git a/flang/lib/Semantics/mod-file.cpp b/flang/lib/Semantics/mod-file.cpp
index f5e66a04c3f11..209aca1093d86 100644
--- a/flang/lib/Semantics/mod-file.cpp
+++ b/flang/lib/Semantics/mod-file.cpp
@@ -7,6 +7,7 @@
//===----------------------------------------------------------------------===//
#include "mod-file.h"
+#include "resolve-names-utils.h"
#include "resolve-names.h"
#include "flang/Common/restorer.h"
#include "flang/Evaluate/tools.h"
@@ -1112,33 +1113,6 @@ void ModFileWriter::PutTypeParam(llvm::raw_ostream &os, const Symbol &symbol) {
os << '\n';
}
-// Map a mangled reduction name to a valid Fortran accessibility identifier
-// for module file serialization (e.g., op.+ → operator(+), op.max → max).
-// Non-mangled names (procedure designators) are returned as-is.
-static std::string GetReductionFortranId(const SourceName &mangledName) {
- llvm::StringRef name{mangledName.begin(), mangledName.size()};
- if (!name.starts_with("op.")) {
- return name.str();
- }
- llvm::StringRef suffix{name.drop_front(3)};
- if (suffix == "+" || suffix == "-" || suffix == "*") {
- return ("operator(" + suffix + ")").str();
- }
- llvm::StringRef logicalOp{llvm::StringSwitch<llvm::StringRef>(suffix)
- .Case("AND", ".and.")
- .Case("OR", ".or.")
- .Case("EQV", ".eqv.")
- .Case("NEQV", ".neqv.")
- .Default("")};
- if (!logicalOp.empty()) {
- return ("operator(" + logicalOp + ")").str();
- }
- if (suffix.size() > 2 && suffix.front() == '.' && suffix.back() == '.') {
- return ("operator(" + suffix + ")").str();
- }
- return suffix.str();
-}
-
void ModFileWriter::PutUserReduction(
llvm::raw_ostream &os, const Symbol &symbol) {
const auto &details{symbol.get<UserReductionDetails>()};
diff --git a/flang/lib/Semantics/resolve-names-utils.cpp b/flang/lib/Semantics/resolve-names-utils.cpp
index ef34c89182f7f..1fd5f6239ad4f 100644
--- a/flang/lib/Semantics/resolve-names-utils.cpp
+++ b/flang/lib/Semantics/resolve-names-utils.cpp
@@ -20,6 +20,7 @@
#include "flang/Semantics/tools.h"
#include "flang/Support/Fortran-features.h"
#include "flang/Support/Fortran.h"
+#include "llvm/ADT/StringRef.h"
#include <initializer_list>
#include <variant>
@@ -881,4 +882,38 @@ void MapSubprogramToNewSymbols(const Symbol &oldSymbol, Symbol &newSymbol,
newScope.InstantiateDerivedTypes();
}
+std::string GetReductionFortranId(const parser::CharBlock &mangledName) {
+ llvm::StringRef name{mangledName.begin(), mangledName.size()};
+ if (!name.starts_with("op.")) {
+ return name.str();
+ }
+ llvm::StringRef suffix{name.drop_front(3)};
+ // Intrinsic arithmetic operators: op.+ -> operator(+)
+ if (suffix == "+" || suffix == "-" || suffix == "*") {
+ return ("operator(" + suffix + ")").str();
+ }
+ // Intrinsic logical operators (mangled uppercase, scope uses lowercase)
+ if (suffix == "AND") {
+ return "operator(.and.)";
+ }
+ if (suffix == "OR") {
+ return "operator(.or.)";
+ }
+ if (suffix == "EQV") {
+ return "operator(.eqv.)";
+ }
+ if (suffix == "NEQV") {
+ return "operator(.neqv.)";
+ }
+ // Defined operators: op.combine. -> .combine.
+ // MangleDefinedOperator prepends "op" to the operator name (e.g.,
+ // ".combine.") so after stripping "op.", the suffix ends with '.' for defined
+ // operators.
+ if (!suffix.empty() && suffix.back() == '.') {
+ return ("." + suffix).str();
+ }
+ // Named functions: op.max -> max
+ return suffix.str();
+}
+
} // namespace Fortran::semantics
diff --git a/flang/lib/Semantics/resolve-names-utils.h b/flang/lib/Semantics/resolve-names-utils.h
index ee8113a3fda5e..a1bac72e45ca1 100644
--- a/flang/lib/Semantics/resolve-names-utils.h
+++ b/flang/lib/Semantics/resolve-names-utils.h
@@ -152,5 +152,11 @@ parser::CharBlock MakeNameFromOperator(
parser::CharBlock MangleSpecialFunctions(const parser::CharBlock &name);
std::string MangleDefinedOperator(const parser::CharBlock &name);
+// Map a mangled declare reduction name (e.g., "op.+", "op.combine.",
+// "op.max") back to the Fortran identifier used as the scope key for the
+// corresponding operator or procedure (e.g., "operator(+)", ".combine.",
+// "max"). Non-mangled names (procedure designators) are returned as-is.
+std::string GetReductionFortranId(const parser::CharBlock &mangledName);
+
} // namespace Fortran::semantics
#endif // FORTRAN_SEMANTICS_RESOLVE_NAMES_H_
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 26fd702e248ae..9ee431efe35a0 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -4470,38 +4470,6 @@ Scope *ModuleVisitor::FindModule(const parser::Name &name,
return scope;
}
-// Map a mangled declare reduction name (e.g., op.+, op.max, op..myop.) back
-// to the Fortran identifier that controls its accessibility in a module scope.
-// Intrinsic operators map to "operator(+)" etc., named functions to "max" etc.,
-// and defined operators to "operator(.myop.)" etc.
-static std::string GetReductionIdentifierName(const SourceName &mangledName) {
- llvm::StringRef name{mangledName.begin(), mangledName.size()};
- if (!name.starts_with("op.")) {
- return {};
- }
- llvm::StringRef suffix{name.drop_front(3)};
- // Intrinsic arithmetic operators: op.+ → operator(+)
- if (suffix == "+" || suffix == "-" || suffix == "*") {
- return ("operator(" + suffix + ")").str();
- }
- // Intrinsic logical operators (mangled uppercase, scope uses lowercase)
- llvm::StringRef logicalOp{llvm::StringSwitch<llvm::StringRef>(suffix)
- .Case("AND", ".and.")
- .Case("OR", ".or.")
- .Case("EQV", ".eqv.")
- .Case("NEQV", ".neqv.")
- .Default("")};
- if (!logicalOp.empty()) {
- return ("operator(" + logicalOp + ")").str();
- }
- // Defined operators: op..myop. → operator(.myop.)
- if (suffix.size() > 2 && suffix.front() == '.' && suffix.back() == '.') {
- return ("operator(" + suffix + ")").str();
- }
- // Named functions: op.max → max
- return suffix.str();
-}
-
void ModuleVisitor::ApplyDefaultAccess() {
const auto *moduleDetails{
DEREF(currScope().symbol()).detailsIf<ModuleDetails>()};
@@ -4528,7 +4496,7 @@ void ModuleVisitor::ApplyDefaultAccess() {
// a module has accessibility as if it were declared as a module entity.
// If the corresponding operator/procedure has explicit accessibility,
// the reduction inherits it.
- std::string opName{GetReductionIdentifierName(symbol.name())};
+ std::string opName{GetReductionFortranId(symbol.name())};
if (!opName.empty()) {
if (auto *opSym{FindInScope(currScope(), SourceName{opName})}) {
if (opSym->attrs().test(Attr::PUBLIC)) {
diff --git a/flang/test/Semantics/OpenMP/declare-reduction-overbroad-lookup.f90 b/flang/test/Semantics/OpenMP/declare-reduction-overbroad-lookup.f90
new file mode 100644
index 0000000000000..1db247b4eaff5
--- /dev/null
+++ b/flang/test/Semantics/OpenMP/declare-reduction-overbroad-lookup.f90
@@ -0,0 +1,32 @@
+! RUN: not %flang_fc1 -fopenmp -fopenmp-version=52 %s 2>&1 | FileCheck %s
+
+! Test that a declare reduction from a module that was not USE'd (or only
+! partially USE'd) is not incorrectly found during type checking.
+! Related: https://github.com/llvm/llvm-project/issues/200300
+
+module m_with_reduction
+ type :: t
+ integer :: val = 0
+ end type
+ !$omp declare reduction(+:t:omp_out%val=omp_out%val+omp_in%val) &
+ !$omp initializer(omp_priv=t(0))
+end module
+
+! proxy re-exports only the type, not the reduction
+module m_proxy
+ use m_with_reduction, only: t
+end module
+
+program test_overbroad_lookup
+ use m_proxy
+ type(t) :: x
+ integer :: i
+ x = t(0)
+ !CHECK: error: The type of 'x' is incompatible with the reduction operator.
+ !$omp parallel do reduction(+:x)
+ do i = 1, 10
+ x%val = x%val + 1
+ end do
+ !$omp end parallel do
+ print *, x%val
+end program
diff --git a/flang/test/Semantics/OpenMP/declare-reduction-use-only-defined-op.f90 b/flang/test/Semantics/OpenMP/declare-reduction-use-only-defined-op.f90
new file mode 100644
index 0000000000000..8e215e2b626a4
--- /dev/null
+++ b/flang/test/Semantics/OpenMP/declare-reduction-use-only-defined-op.f90
@@ -0,0 +1,33 @@
+! RUN: %flang_fc1 -fopenmp -fopenmp-version=52 -fsyntax-only %s
+
+! Test that declare reduction for a defined operator works correctly with
+! USE...ONLY when only the operator interface is imported.
+
+module m_defined_op_reduction
+ type :: dt2
+ real :: x = 0.0
+ end type
+ interface operator(.combine.)
+ module procedure combine_fn
+ end interface
+ !$omp declare reduction(.combine.:dt2:omp_out%x=omp_out%x+omp_in%x) &
+ !$omp initializer(omp_priv=dt2(0.0))
+contains
+ type(dt2) function combine_fn(a, b)
+ type(dt2), intent(in) :: a, b
+ combine_fn%x = a%x + b%x
+ end function
+end module
+
+subroutine test_defined_op_use_only()
+ use m_defined_op_reduction, only: dt2, operator(.combine.)
+ type(dt2) :: y
+ integer :: i
+ y = dt2(0.0)
+ ! Should compile without error: reduction is accessible via operator(.combine.)
+ !$omp parallel do reduction(.combine.:y)
+ do i = 1, 10
+ y%x = y%x + 1.0
+ end do
+ !$omp end parallel do
+end subroutine
diff --git a/flang/test/Semantics/OpenMP/declare-reduction-use-only.f90 b/flang/test/Semantics/OpenMP/declare-reduction-use-only.f90
new file mode 100644
index 0000000000000..655087144250c
--- /dev/null
+++ b/flang/test/Semantics/OpenMP/declare-reduction-use-only.f90
@@ -0,0 +1,35 @@
+! RUN: %flang_fc1 -fopenmp -fopenmp-version=52 -fsyntax-only %s
+
+! Test that declare reduction works correctly with USE...ONLY when
+! only the operator (not the internal reduction symbol) is imported.
+
+module m_with_reduction
+ type :: dt
+ integer :: val = 0
+ end type
+ interface operator(+)
+ module procedure add_dt
+ end interface
+ !$omp declare reduction(+:dt:omp_out%val=omp_out%val+omp_in%val) &
+ !$omp initializer(omp_priv=dt(0))
+contains
+ type(dt) function add_dt(a, b)
+ type(dt), intent(in) :: a, b
+ add_dt%val = a%val + b%val
+ end function
+end module
+
+! USE...ONLY imports operator(+) but not the internal op.+ symbol
+program test_use_only
+ use m_with_reduction, only: dt, operator(+)
+ type(dt) :: x
+ integer :: i
+ x = dt(0)
+ ! Should compile without error: reduction is accessible via operator(+)
+ !$omp parallel do reduction(+:x)
+ do i = 1, 10
+ x%val = x%val + 1
+ end do
+ !$omp end parallel do
+ print *, x%val
+end program
More information about the flang-commits
mailing list