[flang-commits] [flang] [flang][openmp]Add UserReductionDetails and use in DECLARE REDUCTION (PR #131628)
Mats Petersson via flang-commits
flang-commits at lists.llvm.org
Fri Apr 4 09:24:34 PDT 2025
https://github.com/Leporacanthicus updated https://github.com/llvm/llvm-project/pull/131628
>From 0a59fb00704c5fa7f7ddf718132a4830966ebea6 Mon Sep 17 00:00:00 2001
From: Mats Petersson <mats.petersson at arm.com>
Date: Thu, 6 Mar 2025 10:41:59 +0000
Subject: [PATCH 1/4] [flang][openmp]Add UserReductionDetails and use in
DECLARE REDUCTION
This adds another puzzle piece for the support of OpenMP DECLARE
REDUCTION functionality.
This adds support for operators with derived types, as well as declaring
multiple different types with the same name or operator.
A new detail class for UserReductionDetials is introduced to hold
the list of types supported for a given reduction declaration.
Tests for parsing and symbol generation added.
Declare reduction is still not supported to lowering, it
will generate a "Not yet implemented" fatal error.
---
flang/include/flang/Semantics/symbol.h | 21 ++-
flang/lib/Semantics/check-omp-structure.cpp | 63 ++++++--
flang/lib/Semantics/resolve-names-utils.h | 4 +
flang/lib/Semantics/resolve-names.cpp | 77 +++++++++-
flang/lib/Semantics/symbol.cpp | 12 +-
.../Parser/OpenMP/declare-reduction-multi.f90 | 134 ++++++++++++++++++
.../OpenMP/declare-reduction-operator.f90 | 59 ++++++++
.../OpenMP/declare-reduction-functions.f90 | 126 ++++++++++++++++
.../OpenMP/declare-reduction-mangled.f90 | 51 +++++++
.../OpenMP/declare-reduction-operators.f90 | 55 +++++++
.../OpenMP/declare-reduction-typeerror.f90 | 30 ++++
.../Semantics/OpenMP/declare-reduction.f90 | 4 +-
12 files changed, 616 insertions(+), 20 deletions(-)
create mode 100644 flang/test/Parser/OpenMP/declare-reduction-multi.f90
create mode 100644 flang/test/Parser/OpenMP/declare-reduction-operator.f90
create mode 100644 flang/test/Semantics/OpenMP/declare-reduction-functions.f90
create mode 100644 flang/test/Semantics/OpenMP/declare-reduction-mangled.f90
create mode 100644 flang/test/Semantics/OpenMP/declare-reduction-operators.f90
create mode 100644 flang/test/Semantics/OpenMP/declare-reduction-typeerror.f90
diff --git a/flang/include/flang/Semantics/symbol.h b/flang/include/flang/Semantics/symbol.h
index 715811885c219..12867a5f8ec6f 100644
--- a/flang/include/flang/Semantics/symbol.h
+++ b/flang/include/flang/Semantics/symbol.h
@@ -701,6 +701,25 @@ class GenericDetails {
};
llvm::raw_ostream &operator<<(llvm::raw_ostream &, const GenericDetails &);
+class UserReductionDetails : public WithBindName {
+public:
+ using TypeVector = std::vector<const DeclTypeSpec *>;
+ UserReductionDetails() = default;
+
+ void AddType(const DeclTypeSpec *type) { typeList_.push_back(type); }
+ const TypeVector &GetTypeList() const { return typeList_; }
+
+ bool SupportsType(const DeclTypeSpec *type) const {
+ for (auto t : typeList_)
+ if (t == type)
+ return true;
+ return false;
+ }
+
+private:
+ TypeVector typeList_;
+};
+
class UnknownDetails {};
using Details = std::variant<UnknownDetails, MainProgramDetails, ModuleDetails,
@@ -708,7 +727,7 @@ using Details = std::variant<UnknownDetails, MainProgramDetails, ModuleDetails,
ObjectEntityDetails, ProcEntityDetails, AssocEntityDetails,
DerivedTypeDetails, UseDetails, UseErrorDetails, HostAssocDetails,
GenericDetails, ProcBindingDetails, NamelistDetails, CommonBlockDetails,
- TypeParamDetails, MiscDetails>;
+ TypeParamDetails, MiscDetails, UserReductionDetails>;
llvm::raw_ostream &operator<<(llvm::raw_ostream &, const Details &);
std::string DetailsToString(const Details &);
diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index 5fcebdca0bc5f..fc8b6f1021b02 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -8,6 +8,7 @@
#include "check-omp-structure.h"
#include "definable.h"
+#include "resolve-names-utils.h"
#include "flang/Evaluate/check-expression.h"
#include "flang/Evaluate/expression.h"
#include "flang/Evaluate/type.h"
@@ -3361,8 +3362,8 @@ bool OmpStructureChecker::CheckReductionOperator(
valid =
llvm::is_contained({"max", "min", "iand", "ior", "ieor"}, realName);
if (!valid) {
- auto *misc{name->symbol->detailsIf<MiscDetails>()};
- valid = misc && misc->kind() == MiscDetails::Kind::ConstructName;
+ auto *reductionDetails{name->symbol->detailsIf<UserReductionDetails>()};
+ valid = reductionDetails != nullptr;
}
}
if (!valid) {
@@ -3444,7 +3445,8 @@ void OmpStructureChecker::CheckReductionObjects(
}
static bool IsReductionAllowedForType(
- const parser::OmpReductionIdentifier &ident, const DeclTypeSpec &type) {
+ const parser::OmpReductionIdentifier &ident, const DeclTypeSpec &type,
+ const Scope &scope) {
auto isLogical{[](const DeclTypeSpec &type) -> bool {
return type.category() == DeclTypeSpec::Logical;
}};
@@ -3464,9 +3466,11 @@ static bool IsReductionAllowedForType(
case parser::DefinedOperator::IntrinsicOperator::Multiply:
case parser::DefinedOperator::IntrinsicOperator::Add:
case parser::DefinedOperator::IntrinsicOperator::Subtract:
- return type.IsNumeric(TypeCategory::Integer) ||
+ if (type.IsNumeric(TypeCategory::Integer) ||
type.IsNumeric(TypeCategory::Real) ||
- type.IsNumeric(TypeCategory::Complex);
+ type.IsNumeric(TypeCategory::Complex))
+ return true;
+ break;
case parser::DefinedOperator::IntrinsicOperator::AND:
case parser::DefinedOperator::IntrinsicOperator::OR:
@@ -3479,8 +3483,18 @@ static bool IsReductionAllowedForType(
DIE("This should have been caught in CheckIntrinsicOperator");
return false;
}
+ parser::CharBlock name{MakeNameFromOperator(*intrinsicOp)};
+ Symbol *symbol{scope.FindSymbol(name)};
+ if (symbol) {
+ const auto *reductionDetails{symbol->detailsIf<UserReductionDetails>()};
+ assert(reductionDetails && "Expected to find reductiondetails");
+
+ return reductionDetails->SupportsType(&type);
+ }
+ return false;
}
- return true;
+ assert(0 && "Intrinsic Operator not found - parsing gone wrong?");
+ return false; // Reject everything else.
}};
auto checkDesignator{[&](const parser::ProcedureDesignator &procD) {
@@ -3493,18 +3507,42 @@ static bool IsReductionAllowedForType(
// IAND: arguments must be integers: F2023 16.9.100
// IEOR: arguments must be integers: F2023 16.9.106
// IOR: arguments must be integers: F2023 16.9.111
- return type.IsNumeric(TypeCategory::Integer);
+ if (type.IsNumeric(TypeCategory::Integer)) {
+ return true;
+ }
} else if (realName == "max" || realName == "min") {
// MAX: arguments must be integer, real, or character:
// F2023 16.9.135
// MIN: arguments must be integer, real, or character:
// F2023 16.9.141
- return type.IsNumeric(TypeCategory::Integer) ||
- type.IsNumeric(TypeCategory::Real) || isCharacter(type);
+ if (type.IsNumeric(TypeCategory::Integer) ||
+ type.IsNumeric(TypeCategory::Real) || isCharacter(type)) {
+ return true;
+ }
}
+
+ // If we get here, it may be a user declared reduction, so check
+ // if the symbol has UserReductionDetails, and if so, the type is
+ // supported.
+ if (const auto *reductionDetails{
+ name->symbol->detailsIf<UserReductionDetails>()}) {
+ return reductionDetails->SupportsType(&type);
+ }
+
+ // We also need to check for mangled names (max, min, iand, ieor and ior)
+ // and then check if the type is there.
+ parser::CharBlock mangledName = MangleSpecialFunctions(name->source);
+ if (const auto &symbol{scope.FindSymbol(mangledName)}) {
+ if (const auto *reductionDetails{
+ symbol->detailsIf<UserReductionDetails>()}) {
+ return reductionDetails->SupportsType(&type);
+ }
+ }
+ // Everything else is "not matching type".
+ return false;
}
- // TODO: user defined reduction operators. Just allow everything for now.
- return true;
+ assert(0 && "name and name->symbol should be set here...");
+ return false;
}};
return common::visit(
@@ -3519,7 +3557,8 @@ void OmpStructureChecker::CheckReductionObjectTypes(
for (auto &[symbol, source] : symbols) {
if (auto *type{symbol->GetType()}) {
- if (!IsReductionAllowedForType(ident, *type)) {
+ const auto &scope{context_.FindScope(symbol->name())};
+ if (!IsReductionAllowedForType(ident, *type, scope)) {
context_.Say(source,
"The type of '%s' is incompatible with the reduction operator."_err_en_US,
symbol->name());
diff --git a/flang/lib/Semantics/resolve-names-utils.h b/flang/lib/Semantics/resolve-names-utils.h
index 64784722ff4f8..de0991d69b61b 100644
--- a/flang/lib/Semantics/resolve-names-utils.h
+++ b/flang/lib/Semantics/resolve-names-utils.h
@@ -146,5 +146,9 @@ struct SymbolAndTypeMappings;
void MapSubprogramToNewSymbols(const Symbol &oldSymbol, Symbol &newSymbol,
Scope &newScope, SymbolAndTypeMappings * = nullptr);
+parser::CharBlock MakeNameFromOperator(
+ const parser::DefinedOperator::IntrinsicOperator &op);
+parser::CharBlock MangleSpecialFunctions(const parser::CharBlock name);
+
} // 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 fcd4ba6a51907..825ab36d2e800 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -1748,15 +1748,75 @@ void OmpVisitor::ProcessMapperSpecifier(const parser::OmpMapperSpecifier &spec,
PopScope();
}
+parser::CharBlock MakeNameFromOperator(
+ const parser::DefinedOperator::IntrinsicOperator &op) {
+ switch (op) {
+ case parser::DefinedOperator::IntrinsicOperator::Multiply:
+ return parser::CharBlock{"op.*", 4};
+ case parser::DefinedOperator::IntrinsicOperator::Add:
+ return parser::CharBlock{"op.+", 4};
+ case parser::DefinedOperator::IntrinsicOperator::Subtract:
+ return parser::CharBlock{"op.-", 4};
+
+ case parser::DefinedOperator::IntrinsicOperator::AND:
+ return parser::CharBlock{"op.AND", 6};
+ case parser::DefinedOperator::IntrinsicOperator::OR:
+ return parser::CharBlock{"op.OR", 6};
+ case parser::DefinedOperator::IntrinsicOperator::EQV:
+ return parser::CharBlock{"op.EQV", 7};
+ case parser::DefinedOperator::IntrinsicOperator::NEQV:
+ return parser::CharBlock{"op.NEQV", 8};
+
+ default:
+ assert(0 && "Unsupported operator...");
+ return parser::CharBlock{"op.?", 4};
+ }
+}
+
+parser::CharBlock MangleSpecialFunctions(const parser::CharBlock name) {
+ if (name == "max") {
+ return parser::CharBlock{"op.max", 6};
+ }
+ if (name == "min") {
+ return parser::CharBlock{"op.min", 6};
+ }
+ if (name == "iand") {
+ return parser::CharBlock{"op.iand", 7};
+ }
+ if (name == "ior") {
+ return parser::CharBlock{"op.ior", 6};
+ }
+ if (name == "ieor") {
+ return parser::CharBlock{"op.ieor", 7};
+ }
+ // All other names: return as is.
+ return name;
+}
+
void OmpVisitor::ProcessReductionSpecifier(
const parser::OmpReductionSpecifier &spec,
const std::optional<parser::OmpClauseList> &clauses) {
+ const parser::Name *name{nullptr};
+ parser::Name mangledName{};
+ UserReductionDetails reductionDetailsTemp{};
const auto &id{std::get<parser::OmpReductionIdentifier>(spec.t)};
if (auto procDes{std::get_if<parser::ProcedureDesignator>(&id.u)}) {
- if (auto *name{std::get_if<parser::Name>(&procDes->u)}) {
- name->symbol =
- &MakeSymbol(*name, MiscDetails{MiscDetails::Kind::ConstructName});
+ name = std::get_if<parser::Name>(&procDes->u);
+ if (name) {
+ mangledName.source = MangleSpecialFunctions(name->source);
}
+ } else {
+ const auto &defOp{std::get<parser::DefinedOperator>(id.u)};
+ mangledName.source = MakeNameFromOperator(
+ std::get<parser::DefinedOperator::IntrinsicOperator>(defOp.u));
+ name = &mangledName;
+ }
+
+ UserReductionDetails *reductionDetails{&reductionDetailsTemp};
+ Symbol *symbol{name ? name->symbol : nullptr};
+ symbol = FindSymbol(mangledName);
+ if (symbol) {
+ reductionDetails = symbol->detailsIf<UserReductionDetails>();
}
auto &typeList{std::get<parser::OmpTypeNameList>(spec.t)};
@@ -1788,6 +1848,10 @@ void OmpVisitor::ProcessReductionSpecifier(
const DeclTypeSpec *typeSpec{GetDeclTypeSpec()};
assert(typeSpec && "We should have a type here");
+ if (reductionDetails) {
+ reductionDetails->AddType(typeSpec);
+ }
+
for (auto &nm : ompVarNames) {
ObjectEntityDetails details{};
details.set_type(*typeSpec);
@@ -1798,6 +1862,13 @@ void OmpVisitor::ProcessReductionSpecifier(
Walk(clauses);
PopScope();
}
+
+ if (name) {
+ if (!symbol) {
+ symbol = &MakeSymbol(mangledName, Attrs{}, std::move(*reductionDetails));
+ }
+ name->symbol = symbol;
+ }
}
bool OmpVisitor::Pre(const parser::OmpDirectiveSpecification &x) {
diff --git a/flang/lib/Semantics/symbol.cpp b/flang/lib/Semantics/symbol.cpp
index 32eb6c2c5a188..e627dd293ba7c 100644
--- a/flang/lib/Semantics/symbol.cpp
+++ b/flang/lib/Semantics/symbol.cpp
@@ -246,7 +246,7 @@ void GenericDetails::CopyFrom(const GenericDetails &from) {
// This is primarily for debugging.
std::string DetailsToString(const Details &details) {
return common::visit(
- common::visitors{
+ common::visitors{//
[](const UnknownDetails &) { return "Unknown"; },
[](const MainProgramDetails &) { return "MainProgram"; },
[](const ModuleDetails &) { return "Module"; },
@@ -266,7 +266,7 @@ std::string DetailsToString(const Details &details) {
[](const TypeParamDetails &) { return "TypeParam"; },
[](const MiscDetails &) { return "Misc"; },
[](const AssocEntityDetails &) { return "AssocEntity"; },
- },
+ [](const UserReductionDetails &) { return "UserReductionDetails"; }},
details);
}
@@ -300,6 +300,9 @@ bool Symbol::CanReplaceDetails(const Details &details) const {
[&](const HostAssocDetails &) {
return this->has<HostAssocDetails>();
},
+ [&](const UserReductionDetails &) {
+ return this->has<UserReductionDetails>();
+ },
[](const auto &) { return false; },
},
details);
@@ -598,6 +601,11 @@ llvm::raw_ostream &operator<<(llvm::raw_ostream &os, const Details &details) {
[&](const MiscDetails &x) {
os << ' ' << MiscDetails::EnumToString(x.kind());
},
+ [&](const UserReductionDetails &x) {
+ for (auto &type : x.GetTypeList()) {
+ DumpType(os, type);
+ }
+ },
[&](const auto &x) { os << x; },
},
details);
diff --git a/flang/test/Parser/OpenMP/declare-reduction-multi.f90 b/flang/test/Parser/OpenMP/declare-reduction-multi.f90
new file mode 100644
index 0000000000000..0e1adcc9958d7
--- /dev/null
+++ b/flang/test/Parser/OpenMP/declare-reduction-multi.f90
@@ -0,0 +1,134 @@
+! RUN: %flang_fc1 -fdebug-unparse -fopenmp %s | FileCheck --ignore-case %s
+! RUN: %flang_fc1 -fdebug-dump-parse-tree -fopenmp %s | FileCheck --check-prefix="PARSE-TREE" %s
+
+!! Test multiple declarations for the same type, with different operations.
+module mymod
+ type :: tt
+ real r
+ end type tt
+contains
+ function mymax(a, b)
+ type(tt) :: a, b, mymax
+ if (a%r > b%r) then
+ mymax = a
+ else
+ mymax = b
+ end if
+ end function mymax
+end module mymod
+
+program omp_examples
+!CHECK-LABEL: PROGRAM omp_examples
+ use mymod
+ implicit none
+ integer, parameter :: n = 100
+ integer :: i
+ type(tt) :: values(n), sum, prod, big, small
+
+ !$omp declare reduction(+:tt:omp_out%r = omp_out%r + omp_in%r) initializer(omp_priv%r = 0)
+!CHECK: !$OMP DECLARE REDUCTION (+:tt: omp_out%r=omp_out%r+omp_in%r
+!CHECK-NEXT: ) INITIALIZER(omp_priv%r=0_4)
+!PARSE-TREE: DeclarationConstruct -> SpecificationConstruct -> OpenMPDeclarativeConstruct -> OpenMPDeclareReductionConstruct
+!PARSE-TREE: Verbatim
+!PARSE-TREE: OmpReductionSpecifier
+!PARSE-TREE-NEXT: OmpReductionIdentifier -> DefinedOperator -> IntrinsicOperator = Add
+!PARSE-TREE: OmpTypeNameList -> OmpTypeSpecifier -> TypeSpec -> DerivedTypeSpec
+!PARSE-TREE-NEXT: Name = 'tt'
+!PARSE-TREE: OmpReductionCombiner -> AssignmentStmt = 'omp_out%r=omp_out%r+omp_in%r'
+!PARSE-TREE: OmpClauseList -> OmpClause -> Initializer -> OmpInitializerClause -> AssignmentStmt = 'omp_priv%r=0._4
+ !$omp declare reduction(*:tt:omp_out%r = omp_out%r * omp_in%r) initializer(omp_priv%r = 1)
+!CHECK-NEXT: !$OMP DECLARE REDUCTION (*:tt: omp_out%r=omp_out%r*omp_in%r
+!CHECK-NEXT: ) INITIALIZER(omp_priv%r=1_4)
+!PARSE-TREE: DeclarationConstruct -> SpecificationConstruct -> OpenMPDeclarativeConstruct -> OpenMPDeclareReductionConstruct
+!PARSE-TREE: Verbatim
+!PARSE-TREE: OmpReductionSpecifier
+!PARSE-TREE: OmpReductionIdentifier -> DefinedOperator -> IntrinsicOperator = Multiply
+!PARSE-TREE: OmpTypeNameList -> OmpTypeSpecifier -> TypeSpec -> DerivedTypeSpec
+!PARSE-TREE-NEXT: Name = 'tt'
+!PARSE-TREE: OmpReductionCombiner -> AssignmentStmt = 'omp_out%r=omp_out%r*omp_in%r'
+!PARSE-TREE: OmpClauseList -> OmpClause -> Initializer -> OmpInitializerClause -> AssignmentStmt = 'omp_priv%r=1._4'
+ !$omp declare reduction(max:tt:omp_out = mymax(omp_out, omp_in)) initializer(omp_priv%r = 0)
+!CHECK-NEXT: !$OMP DECLARE REDUCTION (max:tt: omp_out=mymax(omp_out,omp_in)
+!CHECK-NEXT: ) INITIALIZER(omp_priv%r=0_4)
+!PARSE-TREE: DeclarationConstruct -> SpecificationConstruct -> OpenMPDeclarativeConstruct -> OpenMPDeclareReductionConstruct
+!PARSE-TREE: Verbatim
+!PARSE-TREE: OmpReductionSpecifier
+!PARSE-TREE: OmpReductionIdentifier -> ProcedureDesignator -> Name = 'max'
+!PARSE-TREE: OmpTypeNameList -> OmpTypeSpecifier -> TypeSpec -> DerivedTypeSpec
+!PARSE-TREE: Name = 'tt'
+!PARSE-TREE: OmpReductionCombiner -> AssignmentStmt = 'omp_out=mymax(omp_out,omp_in)'
+!PARSE-TREE: OmpClauseList -> OmpClause -> Initializer -> OmpInitializerClause -> AssignmentStmt = 'omp_priv%r=0._4'
+ !$omp declare reduction(min:tt:omp_out%r = min(omp_out%r, omp_in%r)) initializer(omp_priv%r = 1)
+!CHECK-NEXT: !$OMP DECLARE REDUCTION (min:tt: omp_out%r=min(omp_out%r,omp_in%r)
+!CHECK-NEXT: ) INITIALIZER(omp_priv%r=1_4)
+!PARSE-TREE: DeclarationConstruct -> SpecificationConstruct -> OpenMPDeclarativeConstruct -> OpenMPDeclareReductionConstruct
+!PARSE-TREE: Verbatim
+!PARSE-TREE: OmpReductionSpecifier
+!PARSE-TREE: OmpReductionIdentifier -> ProcedureDesignator -> Name = 'min'
+!PARSE-TREE: OmpTypeNameList -> OmpTypeSpecifier -> TypeSpec -> DerivedTypeSpec
+!PARSE-TREE: Name = 'tt'
+!PARSE-TREE: OmpReductionCombiner -> AssignmentStmt = 'omp_out%r=min(omp_out%r,omp_in%r)'
+!PARSE-TREE: OmpClauseList -> OmpClause -> Initializer -> OmpInitializerClause -> AssignmentStmt = 'omp_priv%r=1._4'
+ call random_number(values%r)
+
+ sum%r = 0
+ !$omp parallel do reduction(+:sum)
+!CHECK: !$OMP PARALLEL DO REDUCTION(+: sum)
+!PARSE-TREE: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OpenMPLoopConstruct
+!PARSE-TREE: OmpBeginLoopDirective
+!PARSE-TREE: OmpLoopDirective -> llvm::omp::Directive = parallel do
+!PARSE-TREE: OmpClauseList -> OmpClause -> Reduction -> OmpReductionClause
+!PARSE-TREE: Modifier -> OmpReductionIdentifier -> DefinedOperator -> IntrinsicOperator = Add
+!PARSE-TREE: OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'sum
+!PARSE-TREE: DoConstruct
+ do i = 1, n
+ sum%r = sum%r + values(i)%r
+ end do
+
+ prod%r = 1
+ !$omp parallel do reduction(*:prod)
+!CHECK: !$OMP PARALLEL DO REDUCTION(*: prod)
+!PARSE-TREE: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OpenMPLoopConstruct
+!PARSE-TREE: OmpBeginLoopDirective
+!PARSE-TREE: OmpLoopDirective -> llvm::omp::Directive = parallel do
+!PARSE-TREE: OmpClauseList -> OmpClause -> Reduction -> OmpReductionClause
+!PARSE-TREE: Modifier -> OmpReductionIdentifier -> DefinedOperator -> IntrinsicOperator = Multiply
+!PARSE-TREE: OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'prod'
+!PARSE-TREE: DoConstruct
+ do i = 1, n
+ prod%r = prod%r * (values(i)%r+0.6)
+ end do
+
+ big%r = 0
+ !$omp parallel do reduction(max:big)
+!CHECK: $OMP PARALLEL DO REDUCTION(max: big)
+!PARSE-TREE: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OpenMPLoopConstruct
+!PARSE-TREE: OmpBeginLoopDirective
+!PARSE-TREE: OmpLoopDirective -> llvm::omp::Directive = parallel do
+!PARSE-TREE: OmpClauseList -> OmpClause -> Reduction -> OmpReductionClause
+!PARSE-TREE: Modifier -> OmpReductionIdentifier -> ProcedureDesignator -> Name = 'max'
+!PARSE-TREE: OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'big'
+!PARSE-TREE: DoConstruct
+ do i = 1, n
+ big = mymax(values(i), big)
+ end do
+
+ small%r = 1
+ !$omp parallel do reduction(min:small)
+!CHECK: !$OMP PARALLEL DO REDUCTION(min: small)
+!CHECK-TREE: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OpenMPLoopConstruct
+!CHECK-TREE: OmpBeginLoopDirective
+!CHECK-TREE: OmpLoopDirective -> llvm::omp::Directive = parallel do
+!CHECK-TREE: OmpClauseList -> OmpClause -> Reduction -> OmpReductionClause
+!CHECK-TREE: Modifier -> OmpReductionIdentifier -> ProcedureDesignator -> Name = 'min'
+!CHECK-TREE: OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'small'
+!CHECK-TREE: DoConstruct
+ do i = 1, n
+ small%r = min(values(i)%r, small%r)
+ end do
+
+ print *, values%r
+ print *, "sum=", sum%r
+ print *, "prod=", prod%r
+ print *, "small=", small%r, " big=", big%r
+end program omp_examples
diff --git a/flang/test/Parser/OpenMP/declare-reduction-operator.f90 b/flang/test/Parser/OpenMP/declare-reduction-operator.f90
new file mode 100644
index 0000000000000..7bfb78115b10d
--- /dev/null
+++ b/flang/test/Parser/OpenMP/declare-reduction-operator.f90
@@ -0,0 +1,59 @@
+! RUN: %flang_fc1 -fdebug-unparse -fopenmp %s | FileCheck --ignore-case %s
+! RUN: %flang_fc1 -fdebug-dump-parse-tree -fopenmp %s | FileCheck --check-prefix="PARSE-TREE" %s
+
+!CHECK-LABEL: SUBROUTINE reduce_1 (n, tts)
+subroutine reduce_1 ( n, tts )
+ type :: tt
+ integer :: x
+ integer :: y
+ end type tt
+ type :: tt2
+ real(8) :: x
+ real(8) :: y
+ end type
+
+ integer :: n
+ type(tt) :: tts(n)
+ type(tt2) :: tts2(n)
+
+!CHECK: !$OMP DECLARE REDUCTION (+:tt: omp_out=tt(x=omp_out%x-omp_in%x,y=omp_out%y-omp_in%y)
+!CHECK: ) INITIALIZER(omp_priv=tt(x=0_4,y=0_4))
+!PARSE-TREE: DeclarationConstruct -> SpecificationConstruct -> OpenMPDeclarativeConstruct -> OpenMPDeclareReductionConstruct
+!PARSE-TREE: Verbatim
+!PARSE-TREE: OmpReductionSpecifier
+!PARSE-TREE: OmpReductionIdentifier -> DefinedOperator -> IntrinsicOperator = Add
+!PARSE-TREE: OmpReductionCombiner -> AssignmentStmt = 'omp_out=tt(x=omp_out%x-omp_in%x,y=omp_out%y-omp_in%y)'
+!PARSE-TREE: OmpInitializerClause -> AssignmentStmt = 'omp_priv=tt(x=0_4,y=0_4)'
+
+ !$omp declare reduction(+ : tt : omp_out = tt(omp_out%x - omp_in%x , omp_out%y - omp_in%y)) initializer(omp_priv = tt(0,0))
+
+
+!CHECK: !$OMP DECLARE REDUCTION (+:tt2: omp_out=tt2(x=omp_out%x-omp_in%x,y=omp_out%y-omp_in%y)
+!CHECK: ) INITIALIZER(omp_priv=tt2(x=0._8,y=0._8)
+!PARSE-TREE: DeclarationConstruct -> SpecificationConstruct -> OpenMPDeclarativeConstruct -> OpenMPDeclareReductionConstruct
+!PARSE-TREE: Verbatim
+!PARSE-TREE: OmpReductionSpecifier
+!PARSE-TREE: OmpReductionIdentifier -> DefinedOperator -> IntrinsicOperator = Add
+!PARSE-TREE: OmpReductionCombiner -> AssignmentStmt = 'omp_out=tt2(x=omp_out%x-omp_in%x,y=omp_out%y-omp_in%y)'
+!PARSE-TREE: OmpInitializerClause -> AssignmentStmt = 'omp_priv=tt2(x=0._8,y=0._8)'
+
+ !$omp declare reduction(+ :tt2 : omp_out = tt2(omp_out%x - omp_in%x , omp_out%y - omp_in%y)) initializer(omp_priv = tt2(0,0))
+
+ type(tt) :: diffp = tt( 0, 0 )
+ type(tt2) :: diffp2 = tt2( 0, 0 )
+ integer :: i
+
+ !$omp parallel do reduction(+ : diffp)
+ do i = 1, n
+ diffp%x = diffp%x + tts(i)%x
+ diffp%y = diffp%y + tts(i)%y
+ end do
+
+ !$omp parallel do reduction(+ : diffp2)
+ do i = 1, n
+ diffp2%x = diffp2%x + tts2(i)%x
+ diffp2%y = diffp2%y + tts2(i)%y
+ end do
+
+end subroutine reduce_1
+!CHECK: END SUBROUTINE reduce_1
diff --git a/flang/test/Semantics/OpenMP/declare-reduction-functions.f90 b/flang/test/Semantics/OpenMP/declare-reduction-functions.f90
new file mode 100644
index 0000000000000..924ef0807ec80
--- /dev/null
+++ b/flang/test/Semantics/OpenMP/declare-reduction-functions.f90
@@ -0,0 +1,126 @@
+! RUN: %flang_fc1 -fdebug-dump-symbols -fopenmp -fopenmp-version=50 %s | FileCheck %s
+
+module mm
+ implicit none
+ type two
+ integer(4) :: a, b
+ end type two
+
+ type three
+ integer(8) :: a, b, c
+ end type three
+
+ type twothree
+ type(two) t2
+ type(three) t3
+ end type twothree
+
+contains
+!CHECK-LABEL: Subprogram scope: inittwo
+ subroutine inittwo(x,n)
+ integer :: n
+ type(two) :: x
+ x%a=n
+ x%b=n
+ end subroutine inittwo
+
+ subroutine initthree(x,n)
+ integer :: n
+ type(three) :: x
+ x%a=n
+ x%b=n
+ end subroutine initthree
+
+ function add_two(x, y)
+ type(two) add_two, x, y, res
+ res%a = x%a + y%a
+ res%b = x%b + y%b
+ add_two = res
+ end function add_two
+
+ function add_three(x, y)
+ type(three) add_three, x, y, res
+ res%a = x%a + y%a
+ res%b = x%b + y%b
+ res%c = x%c + y%c
+ add_three = res
+ end function add_three
+
+!CHECK-LABEL: Subprogram scope: functwo
+ function functwo(x, n)
+ type(two) functwo
+ integer :: n
+ type(two) :: x(n)
+ type(two) :: res
+ integer :: i
+ !$omp declare reduction(adder:two:omp_out=add_two(omp_out,omp_in)) initializer(inittwo(omp_priv,0))
+!CHECK: adder: UserReductionDetails TYPE(two)
+!CHECK OtherConstruct scope
+!CHECK: omp_in size=8 offset=0: ObjectEntity type: TYPE(two)
+!CHECK: omp_orig size=8 offset=8: ObjectEntity type: TYPE(two)
+!CHECK: omp_out size=8 offset=16: ObjectEntity type: TYPE(two)
+!CHECK: omp_priv size=8 offset=24: ObjectEntity type: TYPE(two)
+
+
+ !$omp simd reduction(adder:res)
+ do i=1,n
+ res=add_two(res,x(i))
+ enddo
+ functwo=res
+ end function functwo
+
+ function functhree(x, n)
+ implicit none
+ type(three) :: functhree
+ type(three) :: x(n)
+ type(three) :: res
+ integer :: i
+ integer :: n
+ !$omp declare reduction(adder:three:omp_out=add_three(omp_out,omp_in)) initializer(initthree(omp_priv,1))
+
+ !$omp simd reduction(adder:res)
+ do i=1,n
+ res=add_three(res,x(i))
+ enddo
+ functhree=res
+ end function functhree
+
+ function functtwothree(x, n)
+ type(twothree) :: functtwothree
+ type(twothree) :: x(n)
+ type(twothree) :: res
+ type(two) :: res2
+ type(three) :: res3
+ integer :: n
+ integer :: i
+
+ !$omp declare reduction(adder:two:omp_out=add_two(omp_out,omp_in)) initializer(inittwo(omp_priv,0))
+
+ !$omp declare reduction(adder:three:omp_out=add_three(omp_out,omp_in)) initializer(initthree(omp_priv,1))
+
+!CHECK: adder: UserReductionDetails TYPE(two) TYPE(three)
+!CHECK OtherConstruct scope
+!CHECK: omp_in size=8 offset=0: ObjectEntity type: TYPE(two)
+!CHECK: omp_orig size=8 offset=8: ObjectEntity type: TYPE(two)
+!CHECK: omp_out size=8 offset=16: ObjectEntity type: TYPE(two)
+!CHECK: omp_priv size=8 offset=24: ObjectEntity type: TYPE(two)
+!CHECK OtherConstruct scope
+!CHECK: omp_in size=24 offset=0: ObjectEntity type: TYPE(three)
+!CHECK: omp_orig size=24 offset=24: ObjectEntity type: TYPE(three)
+!CHECK: omp_out size=24 offset=48: ObjectEntity type: TYPE(three)
+!CHECK: omp_priv size=24 offset=72: ObjectEntity type: TYPE(three)
+
+ !$omp simd reduction(adder:res3)
+ do i=1,n
+ res3=add_three(res%t3,x(i)%t3)
+ enddo
+
+ !$omp simd reduction(adder:res2)
+ do i=1,n
+ res2=add_two(res2,x(i)%t2)
+ enddo
+ res%t2 = res2
+ res%t3 = res3
+ end function functtwothree
+
+end module mm
diff --git a/flang/test/Semantics/OpenMP/declare-reduction-mangled.f90 b/flang/test/Semantics/OpenMP/declare-reduction-mangled.f90
new file mode 100644
index 0000000000000..f1675b6f251e0
--- /dev/null
+++ b/flang/test/Semantics/OpenMP/declare-reduction-mangled.f90
@@ -0,0 +1,51 @@
+! RUN: %flang_fc1 -fdebug-dump-symbols -fopenmp -fopenmp-version=50 %s | FileCheck %s
+
+!! Test that the name mangling for min & max (also used for iand, ieor and ior).
+module mymod
+ type :: tt
+ real r
+ end type tt
+contains
+ function mymax(a, b)
+ type(tt) :: a, b, mymax
+ if (a%r > b%r) then
+ mymax = a
+ else
+ mymax = b
+ end if
+ end function mymax
+end module mymod
+
+program omp_examples
+!CHECK-LABEL: MainProgram scope: omp_examples
+ use mymod
+ implicit none
+ integer, parameter :: n = 100
+ integer :: i
+ type(tt) :: values(n), big, small
+
+ !$omp declare reduction(max:tt:omp_out = mymax(omp_out, omp_in)) initializer(omp_priv%r = 0)
+ !$omp declare reduction(min:tt:omp_out%r = min(omp_out%r, omp_in%r)) initializer(omp_priv%r = 1)
+
+!CHECK: min, ELEMENTAL, INTRINSIC, PURE (Function): ProcEntity
+!CHECK: mymax (Function): Use from mymax in mymod
+!CHECK: op.max: UserReductionDetails TYPE(tt)
+!CHECK: op.min: UserReductionDetails TYPE(tt)
+
+ big%r = 0
+ !$omp parallel do reduction(max:big)
+!CHECK: big (OmpReduction): HostAssoc
+!CHECK: max, INTRINSIC: ProcEntity
+ do i = 1, n
+ big = mymax(values(i), big)
+ end do
+
+ small%r = 1
+ !$omp parallel do reduction(min:small)
+!CHECK: small (OmpReduction): HostAssoc
+ do i = 1, n
+ small%r = min(values(i)%r, small%r)
+ end do
+
+ print *, "small=", small%r, " big=", big%r
+end program omp_examples
diff --git a/flang/test/Semantics/OpenMP/declare-reduction-operators.f90 b/flang/test/Semantics/OpenMP/declare-reduction-operators.f90
new file mode 100644
index 0000000000000..e7513ab3f95b1
--- /dev/null
+++ b/flang/test/Semantics/OpenMP/declare-reduction-operators.f90
@@ -0,0 +1,55 @@
+! RUN: %flang_fc1 -fdebug-dump-symbols -fopenmp -fopenmp-version=50 %s | FileCheck %s
+
+module vector_mod
+ implicit none
+ type :: Vector
+ real :: x, y, z
+ contains
+ procedure :: add_vectors
+ generic :: operator(+) => add_vectors
+ end type Vector
+contains
+ ! Function implementing vector addition
+ function add_vectors(a, b) result(res)
+ class(Vector), intent(in) :: a, b
+ type(Vector) :: res
+ res%x = a%x + b%x
+ res%y = a%y + b%y
+ res%z = a%z + b%z
+ end function add_vectors
+end module vector_mod
+
+program test_vector
+!CHECK-LABEL: MainProgram scope: test_vector
+ use vector_mod
+!CHECK: add_vectors (Function): Use from add_vectors in vector_mod
+ implicit none
+ integer :: i
+ type(Vector) :: v1(100), v2(100)
+
+ !$OMP declare reduction(+:vector:omp_out=omp_out+omp_in) initializer(omp_priv=Vector(0,0,0))
+!CHECK: op.+: UserReductionDetails TYPE(vector)
+!CHECK: v1 size=1200 offset=4: ObjectEntity type: TYPE(vector) shape: 1_8:100_8
+!CHECK: v2 size=1200 offset=1204: ObjectEntity type: TYPE(vector) shape: 1_8:100_8
+!CHECK: vector: Use from vector in vector_mod
+
+!CHECK: OtherConstruct scope:
+!CHECK: omp_in size=12 offset=0: ObjectEntity type: TYPE(vector)
+!CHECK: omp_orig size=12 offset=12: ObjectEntity type: TYPE(vector)
+!CHECK: omp_out size=12 offset=24: ObjectEntity type: TYPE(vector)
+!CHECK: omp_priv size=12 offset=36: ObjectEntity type: TYPE(vector)
+
+ v2 = Vector(0.0, 0.0, 0.0)
+ v1 = Vector(1.0, 2.0, 3.0)
+ !$OMP parallel do reduction(+:v2)
+!CHECK: OtherConstruct scope
+!CHECK: i (OmpPrivate, OmpPreDetermined): HostAssoc
+!CHECK: v1: HostAssoc
+!CHECK: v2 (OmpReduction): HostAssoc
+
+ do i = 1, 100
+ v2(i) = v2(i) + v1(i) ! Invokes add_vectors
+ end do
+
+ print *, 'v2 components:', v2%x, v2%y, v2%z
+end program test_vector
diff --git a/flang/test/Semantics/OpenMP/declare-reduction-typeerror.f90 b/flang/test/Semantics/OpenMP/declare-reduction-typeerror.f90
new file mode 100644
index 0000000000000..14695faf844b6
--- /dev/null
+++ b/flang/test/Semantics/OpenMP/declare-reduction-typeerror.f90
@@ -0,0 +1,30 @@
+! RUN: not %flang_fc1 -fdebug-dump-symbols -fopenmp -fopenmp-version=50 %s 2>&1 | FileCheck %s
+
+module mm
+ implicit none
+ type two
+ integer(4) :: a, b
+ end type two
+
+ type three
+ integer(8) :: a, b, c
+ end type three
+contains
+ function add_two(x, y)
+ type(two) add_two, x, y, res
+ add_two = res
+ end function add_two
+
+ function func(n)
+ type(three) :: func
+ type(three) :: res3
+ integer :: n
+ integer :: i
+ !$omp declare reduction(adder:two:omp_out=add_two(omp_out,omp_in))
+ !$omp simd reduction(adder:res3)
+!CHECK: error: The type of 'res3' is incompatible with the reduction operator.
+ do i=1,n
+ enddo
+ func = res3
+ end function func
+end module mm
diff --git a/flang/test/Semantics/OpenMP/declare-reduction.f90 b/flang/test/Semantics/OpenMP/declare-reduction.f90
index 11612f01f0f2d..ddca38fd57812 100644
--- a/flang/test/Semantics/OpenMP/declare-reduction.f90
+++ b/flang/test/Semantics/OpenMP/declare-reduction.f90
@@ -17,7 +17,7 @@ subroutine initme(x,n)
end subroutine initme
end interface
!$omp declare reduction(red_add:integer(4):omp_out=omp_out+omp_in) initializer(initme(omp_priv,0))
-!CHECK: red_add: Misc ConstructName
+!CHECK: red_add: UserReductionDetails
!CHECK: Subprogram scope: initme
!CHECK: omp_in size=4 offset=0: ObjectEntity type: INTEGER(4)
!CHECK: omp_orig size=4 offset=4: ObjectEntity type: INTEGER(4)
@@ -35,7 +35,7 @@ program main
!$omp declare reduction (my_add_red : integer : omp_out = omp_out + omp_in) initializer (omp_priv=0)
-!CHECK: my_add_red: Misc ConstructName
+!CHECK: my_add_red: UserReductionDetails
!CHECK: omp_in size=4 offset=0: ObjectEntity type: INTEGER(4)
!CHECK: omp_orig size=4 offset=4: ObjectEntity type: INTEGER(4)
!CHECK: omp_out size=4 offset=8: ObjectEntity type: INTEGER(4)
>From c79b84a3ba4bc85d635ae2c6d1ad8f8350384bf0 Mon Sep 17 00:00:00 2001
From: Mats Petersson <mats.petersson at arm.com>
Date: Wed, 26 Mar 2025 13:42:43 +0000
Subject: [PATCH 2/4] Fix review comments
* Add two more tests (multiple operator-based declarations and re-using
symbol already declared.
* Add a few comments.
* Fix up logical results.
---
flang/include/flang/Semantics/symbol.h | 10 +--
flang/lib/Semantics/check-omp-structure.cpp | 11 +--
flang/lib/Semantics/resolve-names.cpp | 38 +++++++----
.../OpenMP/declare-reduction-dupsym.f90 | 15 ++++
.../OpenMP/declare-reduction-functions.f90 | 68 ++++++++++++++++++-
.../OpenMP/declare-reduction-logical.f90 | 32 +++++++++
.../OpenMP/declare-reduction-typeerror.f90 | 4 ++
7 files changed, 152 insertions(+), 26 deletions(-)
create mode 100644 flang/test/Semantics/OpenMP/declare-reduction-dupsym.f90
create mode 100644 flang/test/Semantics/OpenMP/declare-reduction-logical.f90
diff --git a/flang/include/flang/Semantics/symbol.h b/flang/include/flang/Semantics/symbol.h
index 12867a5f8ec6f..b944912290cf7 100644
--- a/flang/include/flang/Semantics/symbol.h
+++ b/flang/include/flang/Semantics/symbol.h
@@ -701,7 +701,10 @@ class GenericDetails {
};
llvm::raw_ostream &operator<<(llvm::raw_ostream &, const GenericDetails &);
-class UserReductionDetails : public WithBindName {
+// Used for OpenMP DECLARE REDUCTION, it holds the information
+// needed to resolve which declaration (there could be multiple
+// with the same name) to use for a given type.
+class UserReductionDetails {
public:
using TypeVector = std::vector<const DeclTypeSpec *>;
UserReductionDetails() = default;
@@ -710,10 +713,7 @@ class UserReductionDetails : public WithBindName {
const TypeVector &GetTypeList() const { return typeList_; }
bool SupportsType(const DeclTypeSpec *type) const {
- for (auto t : typeList_)
- if (t == type)
- return true;
- return false;
+ return llvm::is_contained(typeList_, type);
}
private:
diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index fc8b6f1021b02..a447ddd66a878 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -3476,7 +3476,10 @@ static bool IsReductionAllowedForType(
case parser::DefinedOperator::IntrinsicOperator::OR:
case parser::DefinedOperator::IntrinsicOperator::EQV:
case parser::DefinedOperator::IntrinsicOperator::NEQV:
- return isLogical(type);
+ if (isLogical(type)) {
+ return true;
+ }
+ break;
// Reduction identifier is not in OMP5.2 Table 5.2
default:
@@ -3493,7 +3496,7 @@ static bool IsReductionAllowedForType(
}
return false;
}
- assert(0 && "Intrinsic Operator not found - parsing gone wrong?");
+ DIE("Intrinsic Operator not found - parsing gone wrong?");
return false; // Reject everything else.
}};
@@ -3531,7 +3534,7 @@ static bool IsReductionAllowedForType(
// We also need to check for mangled names (max, min, iand, ieor and ior)
// and then check if the type is there.
- parser::CharBlock mangledName = MangleSpecialFunctions(name->source);
+ parser::CharBlock mangledName{MangleSpecialFunctions(name->source)};
if (const auto &symbol{scope.FindSymbol(mangledName)}) {
if (const auto *reductionDetails{
symbol->detailsIf<UserReductionDetails>()}) {
@@ -3541,7 +3544,7 @@ static bool IsReductionAllowedForType(
// Everything else is "not matching type".
return false;
}
- assert(0 && "name and name->symbol should be set here...");
+ DIE("name and name->symbol should be set here...");
return false;
}};
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 825ab36d2e800..3d36e0cf71c0d 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -1768,7 +1768,7 @@ parser::CharBlock MakeNameFromOperator(
return parser::CharBlock{"op.NEQV", 8};
default:
- assert(0 && "Unsupported operator...");
+ DIE("Unsupported operator...");
return parser::CharBlock{"op.?", 4};
}
}
@@ -1797,8 +1797,8 @@ void OmpVisitor::ProcessReductionSpecifier(
const parser::OmpReductionSpecifier &spec,
const std::optional<parser::OmpClauseList> &clauses) {
const parser::Name *name{nullptr};
- parser::Name mangledName{};
- UserReductionDetails reductionDetailsTemp{};
+ parser::Name mangledName;
+ UserReductionDetails reductionDetailsTemp;
const auto &id{std::get<parser::OmpReductionIdentifier>(spec.t)};
if (auto procDes{std::get_if<parser::ProcedureDesignator>(&id.u)}) {
name = std::get_if<parser::Name>(&procDes->u);
@@ -1812,11 +1812,22 @@ void OmpVisitor::ProcessReductionSpecifier(
name = &mangledName;
}
+ // Use reductionDetailsTemp if we can't find the symbol (this is
+ // the first, or only, instance with this name). The detaiols then
+ // gets stored in the symbol when it's created.
UserReductionDetails *reductionDetails{&reductionDetailsTemp};
- Symbol *symbol{name ? name->symbol : nullptr};
- symbol = FindSymbol(mangledName);
+ Symbol *symbol{FindSymbol(mangledName)};
if (symbol) {
+ // If we found a symbol, we append the type info to the
+ // existing reductionDetails.
reductionDetails = symbol->detailsIf<UserReductionDetails>();
+
+ if (!reductionDetails) {
+ context().Say(name->source,
+ "Duplicate defineition of '%s' in !$OMP DECLARE REDUCTION"_err_en_US,
+ name->source);
+ return;
+ }
}
auto &typeList{std::get<parser::OmpTypeNameList>(spec.t)};
@@ -1845,17 +1856,16 @@ void OmpVisitor::ProcessReductionSpecifier(
// We need to walk t.u because Walk(t) does it's own BeginDeclTypeSpec.
Walk(t.u);
- const DeclTypeSpec *typeSpec{GetDeclTypeSpec()};
- assert(typeSpec && "We should have a type here");
-
- if (reductionDetails) {
+ // Only process types we can find. There will be an error later on when
+ // a type isn't found.
+ if (const DeclTypeSpec * typeSpec{GetDeclTypeSpec()}) {
reductionDetails->AddType(typeSpec);
- }
- for (auto &nm : ompVarNames) {
- ObjectEntityDetails details{};
- details.set_type(*typeSpec);
- MakeSymbol(nm, Attrs{}, std::move(details));
+ for (auto &nm : ompVarNames) {
+ ObjectEntityDetails details{};
+ details.set_type(*typeSpec);
+ MakeSymbol(nm, Attrs{}, std::move(details));
+ }
}
EndDeclTypeSpec();
Walk(std::get<std::optional<parser::OmpReductionCombiner>>(spec.t));
diff --git a/flang/test/Semantics/OpenMP/declare-reduction-dupsym.f90 b/flang/test/Semantics/OpenMP/declare-reduction-dupsym.f90
new file mode 100644
index 0000000000000..17f70174e1854
--- /dev/null
+++ b/flang/test/Semantics/OpenMP/declare-reduction-dupsym.f90
@@ -0,0 +1,15 @@
+! RUN: not %flang_fc1 -fopenmp -fopenmp-version=50 %s 2>&1 | FileCheck %s
+
+!! Check for duplicate symbol use.
+subroutine dup_symbol()
+ type :: loc
+ integer :: x
+ integer :: y
+ end type loc
+
+ integer :: my_red
+
+!CHECK: error: Duplicate defineition of 'my_red' in !$OMP DECLARE REDUCTION
+ !$omp declare reduction(my_red : loc : omp_out%x = omp_out%x + omp_in%x) initializer(omp_priv%x = 0)
+
+end subroutine dup_symbol
diff --git a/flang/test/Semantics/OpenMP/declare-reduction-functions.f90 b/flang/test/Semantics/OpenMP/declare-reduction-functions.f90
index 924ef0807ec80..a2435fca415cd 100644
--- a/flang/test/Semantics/OpenMP/declare-reduction-functions.f90
+++ b/flang/test/Semantics/OpenMP/declare-reduction-functions.f90
@@ -85,8 +85,8 @@ function functhree(x, n)
functhree=res
end function functhree
- function functtwothree(x, n)
- type(twothree) :: functtwothree
+ function functwothree(x, n)
+ type(twothree) :: functwothree
type(twothree) :: x(n)
type(twothree) :: res
type(two) :: res2
@@ -121,6 +121,68 @@ function functtwothree(x, n)
enddo
res%t2 = res2
res%t3 = res3
- end function functtwothree
+ functwothree=res
+ end function functwothree
+
+!CHECK-LABEL: Subprogram scope: funcbtwo
+ function funcBtwo(x, n)
+ type(two) funcBtwo
+ integer :: n
+ type(two) :: x(n)
+ type(two) :: res
+ integer :: i
+ !$omp declare reduction(+:two:omp_out=add_two(omp_out,omp_in)) initializer(inittwo(omp_priv,0))
+!CHECK: op.+: UserReductionDetails TYPE(two)
+!CHECK OtherConstruct scope
+!CHECK: omp_in size=8 offset=0: ObjectEntity type: TYPE(two)
+!CHECK: omp_orig size=8 offset=8: ObjectEntity type: TYPE(two)
+!CHECK: omp_out size=8 offset=16: ObjectEntity type: TYPE(two)
+!CHECK: omp_priv size=8 offset=24: ObjectEntity type: TYPE(two)
+
+
+ !$omp simd reduction(+:res)
+ do i=1,n
+ res=add_two(res,x(i))
+ enddo
+ funcBtwo=res
+ end function funcBtwo
+
+ function funcBtwothree(x, n)
+ type(twothree) :: funcBtwothree
+ type(twothree) :: x(n)
+ type(twothree) :: res
+ type(two) :: res2
+ type(three) :: res3
+ integer :: n
+ integer :: i
+
+ !$omp declare reduction(+:two:omp_out=add_two(omp_out,omp_in)) initializer(inittwo(omp_priv,0))
+ !$omp declare reduction(+:three:omp_out=add_three(omp_out,omp_in)) initializer(initthree(omp_priv,1))
+
+!CHECK: op.+: UserReductionDetails TYPE(two) TYPE(three)
+!CHECK OtherConstruct scope
+!CHECK: omp_in size=8 offset=0: ObjectEntity type: TYPE(two)
+!CHECK: omp_orig size=8 offset=8: ObjectEntity type: TYPE(two)
+!CHECK: omp_out size=8 offset=16: ObjectEntity type: TYPE(two)
+!CHECK: omp_priv size=8 offset=24: ObjectEntity type: TYPE(two)
+!CHECK OtherConstruct scope
+!CHECK: omp_in size=24 offset=0: ObjectEntity type: TYPE(three)
+!CHECK: omp_orig size=24 offset=24: ObjectEntity type: TYPE(three)
+!CHECK: omp_out size=24 offset=48: ObjectEntity type: TYPE(three)
+!CHECK: omp_priv size=24 offset=72: ObjectEntity type: TYPE(three)
+
+ !$omp simd reduction(+:res3)
+ do i=1,n
+ res3=add_three(res%t3,x(i)%t3)
+ enddo
+
+ !$omp simd reduction(+:res2)
+ do i=1,n
+ res2=add_two(res2,x(i)%t2)
+ enddo
+ res%t2 = res2
+ res%t3 = res3
+ end function funcBtwothree
+
end module mm
diff --git a/flang/test/Semantics/OpenMP/declare-reduction-logical.f90 b/flang/test/Semantics/OpenMP/declare-reduction-logical.f90
new file mode 100644
index 0000000000000..7ab7cad473ac8
--- /dev/null
+++ b/flang/test/Semantics/OpenMP/declare-reduction-logical.f90
@@ -0,0 +1,32 @@
+! RUN: %flang_fc1 -fdebug-dump-symbols -fopenmp -fopenmp-version=50 %s | FileCheck %s
+
+module mm
+ implicit none
+ type logicalwrapper
+ logical b
+ end type logicalwrapper
+
+contains
+!CHECK-LABEL: Subprogram scope: func
+ function func(x, n)
+ logical func
+ integer :: n
+ type(logicalwrapper) :: x(n)
+ type(logicalwrapper) :: res
+ integer :: i
+ !$omp declare reduction(.AND.:type(logicalwrapper):omp_out%b=omp_out%b .AND. omp_in%b) initializer(omp_priv%b=.true.)
+!CHECK: op.AND: UserReductionDetails TYPE(logicalwrapper)
+!CHECK OtherConstruct scope
+!CHECK: omp_in size=4 offset=0: ObjectEntity type: TYPE(logicalwrapper)
+!CHECK: omp_orig size=4 offset=4: ObjectEntity type: TYPE(logicalwrapper)
+!CHECK: omp_out size=4 offset=8: ObjectEntity type: TYPE(logicalwrapper)
+!CHECK: omp_priv size=4 offset=12: ObjectEntity type: TYPE(logicalwrapper)
+
+ !$omp simd reduction(.AND.:res)
+ do i=1,n
+ res%b=res%b .and. x(i)%b
+ enddo
+
+ func=res%b
+ end function func
+end module mm
diff --git a/flang/test/Semantics/OpenMP/declare-reduction-typeerror.f90 b/flang/test/Semantics/OpenMP/declare-reduction-typeerror.f90
index 14695faf844b6..b8ede55aa0ed7 100644
--- a/flang/test/Semantics/OpenMP/declare-reduction-typeerror.f90
+++ b/flang/test/Semantics/OpenMP/declare-reduction-typeerror.f90
@@ -20,6 +20,10 @@ function func(n)
type(three) :: res3
integer :: n
integer :: i
+
+ !$omp declare reduction(dummy:kerflunk:omp_out=omp_out+omp_in)
+!CHECK: error: Derived type 'kerflunk' not found
+
!$omp declare reduction(adder:two:omp_out=add_two(omp_out,omp_in))
!$omp simd reduction(adder:res3)
!CHECK: error: The type of 'res3' is incompatible with the reduction operator.
>From 1ee8a6985ff0a8e61a542b31f08e66ac9e642d01 Mon Sep 17 00:00:00 2001
From: Mats Petersson <mats.petersson at arm.com>
Date: Wed, 26 Mar 2025 17:51:25 +0000
Subject: [PATCH 3/4] Use stringswitch and spell details correctly
---
flang/lib/Semantics/resolve-names.cpp | 27 +++++++++------------------
1 file changed, 9 insertions(+), 18 deletions(-)
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 3d36e0cf71c0d..bb614bd978f19 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -38,6 +38,7 @@
#include "flang/Semantics/type.h"
#include "flang/Support/Fortran.h"
#include "flang/Support/default-kinds.h"
+#include "llvm/ADT/StringSwitch.h"
#include "llvm/Support/raw_ostream.h"
#include <list>
#include <map>
@@ -1774,23 +1775,13 @@ parser::CharBlock MakeNameFromOperator(
}
parser::CharBlock MangleSpecialFunctions(const parser::CharBlock name) {
- if (name == "max") {
- return parser::CharBlock{"op.max", 6};
- }
- if (name == "min") {
- return parser::CharBlock{"op.min", 6};
- }
- if (name == "iand") {
- return parser::CharBlock{"op.iand", 7};
- }
- if (name == "ior") {
- return parser::CharBlock{"op.ior", 6};
- }
- if (name == "ieor") {
- return parser::CharBlock{"op.ieor", 7};
- }
- // All other names: return as is.
- return name;
+ return llvm::StringSwitch<parser::CharBlock>(name.ToString())
+ .Case("max", {"op.max", 6})
+ .Case("min", {"op.min", 6})
+ .Case("iand", {"op.iand", 7})
+ .Case("ior", {"op.ior", 6})
+ .Case("ieor", {"op.ieor", 7})
+ .Default(name);
}
void OmpVisitor::ProcessReductionSpecifier(
@@ -1813,7 +1804,7 @@ void OmpVisitor::ProcessReductionSpecifier(
}
// Use reductionDetailsTemp if we can't find the symbol (this is
- // the first, or only, instance with this name). The detaiols then
+ // the first, or only, instance with this name). The details then
// gets stored in the symbol when it's created.
UserReductionDetails *reductionDetails{&reductionDetailsTemp};
Symbol *symbol{FindSymbol(mangledName)};
>From 322292e9bf9fd3f744770a659cd0d094d5e7364b Mon Sep 17 00:00:00 2001
From: Mats Petersson <mats.petersson at arm.com>
Date: Fri, 4 Apr 2025 16:27:07 +0100
Subject: [PATCH 4/4] Add support for user defined operators in declare
reduction
Also print the reduction declaration in the module file.
Fix trivial typo.
Add/modify tests to cover all the new things, including fixing
the duplicated typo in the test...
---
flang/include/flang/Semantics/semantics.h | 9 +++
flang/include/flang/Semantics/symbol.h | 10 +++
flang/lib/Parser/unparse.cpp | 7 +++
flang/lib/Semantics/mod-file.cpp | 21 +++++++
flang/lib/Semantics/mod-file.h | 1 +
flang/lib/Semantics/resolve-names.cpp | 40 +++++++++---
flang/lib/Semantics/semantics.cpp | 6 ++
.../OpenMP/declare-reduction-dupsym.f90 | 2 +-
.../OpenMP/declare-reduction-modfile.f90 | 63 +++++++++++++++++++
.../OpenMP/declare-reduction-operators.f90 | 29 +++++++++
10 files changed, 179 insertions(+), 9 deletions(-)
create mode 100644 flang/test/Semantics/OpenMP/declare-reduction-modfile.f90
diff --git a/flang/include/flang/Semantics/semantics.h b/flang/include/flang/Semantics/semantics.h
index 730513dbe3232..460af89daa0cf 100644
--- a/flang/include/flang/Semantics/semantics.h
+++ b/flang/include/flang/Semantics/semantics.h
@@ -290,6 +290,10 @@ class SemanticsContext {
// Top-level ProgramTrees are owned by the SemanticsContext for persistence.
ProgramTree &SaveProgramTree(ProgramTree &&);
+ // Store (and get a reference to the stored string) for mangled names
+ // used for OpenMP DECLARE REDUCTION.
+ std::string &StoreUserReductionName(const std::string &name);
+
private:
struct ScopeIndexComparator {
bool operator()(parser::CharBlock, parser::CharBlock) const;
@@ -343,6 +347,11 @@ class SemanticsContext {
std::map<const Symbol *, SourceName> moduleFileOutputRenamings_;
UnorderedSymbolSet isDefined_;
std::list<ProgramTree> programTrees_;
+
+ // storage for mangled names used in OMP DECLARE REDUCTION.
+ // use std::list to avoid re-allocating the string when adding
+ // more content to the container.
+ std::list<std::string> userReductionNames_;
};
class Semantics {
diff --git a/flang/include/flang/Semantics/symbol.h b/flang/include/flang/Semantics/symbol.h
index b944912290cf7..f28a1d6b929eb 100644
--- a/flang/include/flang/Semantics/symbol.h
+++ b/flang/include/flang/Semantics/symbol.h
@@ -29,6 +29,8 @@ class raw_ostream;
}
namespace Fortran::parser {
struct Expr;
+struct OpenMPDeclareReductionConstruct;
+struct OmpDirectiveSpecification;
}
namespace Fortran::semantics {
@@ -707,6 +709,10 @@ llvm::raw_ostream &operator<<(llvm::raw_ostream &, const GenericDetails &);
class UserReductionDetails {
public:
using TypeVector = std::vector<const DeclTypeSpec *>;
+ using DeclInfo = std::variant<const parser::OpenMPDeclareReductionConstruct *,
+ const parser::OmpDirectiveSpecification *>;
+ using DeclVector = std::vector<DeclInfo>;
+
UserReductionDetails() = default;
void AddType(const DeclTypeSpec *type) { typeList_.push_back(type); }
@@ -716,8 +722,12 @@ class UserReductionDetails {
return llvm::is_contained(typeList_, type);
}
+ void AddDecl(const DeclInfo &decl) { declList_.push_back(decl); }
+ const DeclVector &GetDeclList() const { return declList_; }
+
private:
TypeVector typeList_;
+ DeclVector declList_;
};
class UnknownDetails {};
diff --git a/flang/lib/Parser/unparse.cpp b/flang/lib/Parser/unparse.cpp
index c5de5d1d08dd5..9dcf882007387 100644
--- a/flang/lib/Parser/unparse.cpp
+++ b/flang/lib/Parser/unparse.cpp
@@ -3308,4 +3308,11 @@ template void Unparse<Program>(llvm::raw_ostream &, const Program &, Encoding,
bool, bool, preStatementType *, AnalyzedObjectsAsFortran *);
template void Unparse<Expr>(llvm::raw_ostream &, const Expr &, Encoding, bool,
bool, preStatementType *, AnalyzedObjectsAsFortran *);
+
+template void Unparse<parser::OpenMPDeclareReductionConstruct>(
+ llvm::raw_ostream &, const parser::OpenMPDeclareReductionConstruct &,
+ Encoding, bool, bool, preStatementType *, AnalyzedObjectsAsFortran *);
+template void Unparse<parser::OmpDirectiveSpecification>(llvm::raw_ostream &,
+ const parser::OmpDirectiveSpecification &, Encoding, bool, bool,
+ preStatementType *, AnalyzedObjectsAsFortran *);
} // namespace Fortran::parser
diff --git a/flang/lib/Semantics/mod-file.cpp b/flang/lib/Semantics/mod-file.cpp
index c3b46261228df..b0c8e30659500 100644
--- a/flang/lib/Semantics/mod-file.cpp
+++ b/flang/lib/Semantics/mod-file.cpp
@@ -8,6 +8,7 @@
#include "mod-file.h"
#include "resolve-names.h"
+#include "flang/Common/indirection.h"
#include "flang/Common/restorer.h"
#include "flang/Evaluate/tools.h"
#include "flang/Parser/message.h"
@@ -887,6 +888,7 @@ void ModFileWriter::PutEntity(llvm::raw_ostream &os, const Symbol &symbol) {
[&](const ObjectEntityDetails &) { PutObjectEntity(os, symbol); },
[&](const ProcEntityDetails &) { PutProcEntity(os, symbol); },
[&](const TypeParamDetails &) { PutTypeParam(os, symbol); },
+ [&](const UserReductionDetails &) { PutUserReduction(os, symbol); },
[&](const auto &) {
common::die("PutEntity: unexpected details: %s",
DetailsToString(symbol.details()).c_str());
@@ -1035,6 +1037,25 @@ void ModFileWriter::PutTypeParam(llvm::raw_ostream &os, const Symbol &symbol) {
os << '\n';
}
+void ModFileWriter::PutUserReduction(
+ llvm::raw_ostream &os, const Symbol &symbol) {
+ auto &details{symbol.get<UserReductionDetails>()};
+ // The module content for a OpenMP Declare Reduction is the OpenMP
+ // declaration. There may be multiple declarations.
+ // Decls are pointers, so do not use a referene.
+ for (const auto decl : details.GetDeclList()) {
+ if (auto d = std::get_if<const parser::OpenMPDeclareReductionConstruct *>(
+ &decl)) {
+ Unparse(os, **d);
+ } else if (auto s = std::get_if<const parser::OmpDirectiveSpecification *>(
+ &decl)) {
+ Unparse(os, **s);
+ } else {
+ DIE("Unknown OpenMP DECLARE REDUCTION content");
+ }
+ }
+}
+
void PutInit(llvm::raw_ostream &os, const Symbol &symbol, const MaybeExpr &init,
const parser::Expr *unanalyzed) {
if (IsNamedConstant(symbol) || symbol.owner().IsDerivedType()) {
diff --git a/flang/lib/Semantics/mod-file.h b/flang/lib/Semantics/mod-file.h
index 82538fb510873..9e5724089b3c5 100644
--- a/flang/lib/Semantics/mod-file.h
+++ b/flang/lib/Semantics/mod-file.h
@@ -80,6 +80,7 @@ class ModFileWriter {
void PutDerivedType(const Symbol &, const Scope * = nullptr);
void PutDECStructure(const Symbol &, const Scope * = nullptr);
void PutTypeParam(llvm::raw_ostream &, const Symbol &);
+ void PutUserReduction(llvm::raw_ostream &, const Symbol &);
void PutSubprogram(const Symbol &);
void PutGeneric(const Symbol &);
void PutUse(const Symbol &);
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index bb614bd978f19..189879e36689d 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -1499,7 +1499,7 @@ class OmpVisitor : public virtual DeclarationVisitor {
AddOmpSourceRange(x.source);
ProcessReductionSpecifier(
std::get<Indirection<parser::OmpReductionSpecifier>>(x.t).value(),
- std::get<std::optional<parser::OmpClauseList>>(x.t));
+ std::get<std::optional<parser::OmpClauseList>>(x.t), x);
return false;
}
bool Pre(const parser::OmpMapClause &);
@@ -1655,8 +1655,12 @@ class OmpVisitor : public virtual DeclarationVisitor {
private:
void ProcessMapperSpecifier(const parser::OmpMapperSpecifier &spec,
const parser::OmpClauseList &clauses);
+ template <typename T>
void ProcessReductionSpecifier(const parser::OmpReductionSpecifier &spec,
- const std::optional<parser::OmpClauseList> &clauses);
+ const std::optional<parser::OmpClauseList> &clauses,
+ const T &wholeConstruct);
+
+ parser::CharBlock MangleDefinedOperator(const parser::CharBlock &name);
};
bool OmpVisitor::NeedsScope(const parser::OpenMPBlockConstruct &x) {
@@ -1784,9 +1788,21 @@ parser::CharBlock MangleSpecialFunctions(const parser::CharBlock name) {
.Default(name);
}
+parser::CharBlock OmpVisitor::MangleDefinedOperator(
+ const parser::CharBlock &name) {
+ // This function should only be used with user defined operators, that have
+ // the pattern
+ // .<leters>.
+ CHECK(name[0] == '.' && name[name.size() - 1] == '.');
+ return parser::CharBlock{
+ context().StoreUserReductionName("op" + name.ToString())};
+}
+
+template <typename T>
void OmpVisitor::ProcessReductionSpecifier(
const parser::OmpReductionSpecifier &spec,
- const std::optional<parser::OmpClauseList> &clauses) {
+ const std::optional<parser::OmpClauseList> &clauses,
+ const T &wholeOmpConstruct) {
const parser::Name *name{nullptr};
parser::Name mangledName;
UserReductionDetails reductionDetailsTemp;
@@ -1796,11 +1812,17 @@ void OmpVisitor::ProcessReductionSpecifier(
if (name) {
mangledName.source = MangleSpecialFunctions(name->source);
}
+
} else {
const auto &defOp{std::get<parser::DefinedOperator>(id.u)};
- mangledName.source = MakeNameFromOperator(
- std::get<parser::DefinedOperator::IntrinsicOperator>(defOp.u));
- name = &mangledName;
+ if (const auto definedOp{std::get_if<parser::DefinedOpName>(&defOp.u)}) {
+ name = &definedOp->v;
+ mangledName.source = MangleDefinedOperator(definedOp->v.source);
+ } else {
+ mangledName.source = MakeNameFromOperator(
+ std::get<parser::DefinedOperator::IntrinsicOperator>(defOp.u));
+ name = &mangledName;
+ }
}
// Use reductionDetailsTemp if we can't find the symbol (this is
@@ -1815,7 +1837,7 @@ void OmpVisitor::ProcessReductionSpecifier(
if (!reductionDetails) {
context().Say(name->source,
- "Duplicate defineition of '%s' in !$OMP DECLARE REDUCTION"_err_en_US,
+ "Duplicate definition of '%s' in !$OMP DECLARE REDUCTION"_err_en_US,
name->source);
return;
}
@@ -1864,6 +1886,8 @@ void OmpVisitor::ProcessReductionSpecifier(
PopScope();
}
+ reductionDetails->AddDecl(&wholeOmpConstruct);
+
if (name) {
if (!symbol) {
symbol = &MakeSymbol(mangledName, Attrs{}, std::move(*reductionDetails));
@@ -1895,7 +1919,7 @@ bool OmpVisitor::Pre(const parser::OmpDirectiveSpecification &x) {
if (maybeArgs && maybeClauses) {
const parser::OmpArgument &first{maybeArgs->front()};
if (auto *spec{std::get_if<parser::OmpReductionSpecifier>(&first.u)}) {
- ProcessReductionSpecifier(*spec, maybeClauses);
+ ProcessReductionSpecifier(*spec, maybeClauses, x);
}
}
break;
diff --git a/flang/lib/Semantics/semantics.cpp b/flang/lib/Semantics/semantics.cpp
index 10a01039ea0ae..4a74d9e1dc1bd 100644
--- a/flang/lib/Semantics/semantics.cpp
+++ b/flang/lib/Semantics/semantics.cpp
@@ -771,4 +771,10 @@ bool SemanticsContext::IsSymbolDefined(const Symbol &symbol) const {
return isDefined_.find(symbol) != isDefined_.end();
}
+std::string &SemanticsContext::StoreUserReductionName(const std::string &name) {
+ userReductionNames_.push_back(name);
+ CHECK(userReductionNames_.back() == name);
+ return userReductionNames_.back();
+}
+
} // namespace Fortran::semantics
diff --git a/flang/test/Semantics/OpenMP/declare-reduction-dupsym.f90 b/flang/test/Semantics/OpenMP/declare-reduction-dupsym.f90
index 17f70174e1854..2e82cd1a18332 100644
--- a/flang/test/Semantics/OpenMP/declare-reduction-dupsym.f90
+++ b/flang/test/Semantics/OpenMP/declare-reduction-dupsym.f90
@@ -9,7 +9,7 @@ subroutine dup_symbol()
integer :: my_red
-!CHECK: error: Duplicate defineition of 'my_red' in !$OMP DECLARE REDUCTION
+!CHECK: error: Duplicate definition of 'my_red' in !$OMP DECLARE REDUCTION
!$omp declare reduction(my_red : loc : omp_out%x = omp_out%x + omp_in%x) initializer(omp_priv%x = 0)
end subroutine dup_symbol
diff --git a/flang/test/Semantics/OpenMP/declare-reduction-modfile.f90 b/flang/test/Semantics/OpenMP/declare-reduction-modfile.f90
new file mode 100644
index 0000000000000..caed7fd335376
--- /dev/null
+++ b/flang/test/Semantics/OpenMP/declare-reduction-modfile.f90
@@ -0,0 +1,63 @@
+! RUN: %python %S/../test_modfile.py %s %flang_fc1 -fopenmp
+! Check correct modfile generation for OpenMP DECLARE REDUCTION construct.
+
+!Expect: drm.mod
+!module drm
+!type::t1
+!integer(4)::val
+!endtype
+!!$OMP DECLARE REDUCTION (*:t1:omp_out = omp_out*omp_in) INITIALIZER(omp_priv=t&
+!!$OMP&1(1))
+!!$OMP DECLARE REDUCTION (.fluffy.:t1:omp_out = omp_out.fluffy.omp_in) INITIALI&
+!!$OMP&ZER(omp_priv=t1(0))
+!!$OMP DECLARE REDUCTION (.mul.:t1:omp_out = omp_out.mul.omp_in) INITIALIZER(om&
+!!$OMP&p_priv=t1(1))
+!interface operator(.mul.)
+!procedure::mul
+!end interface
+!interface operator(.fluffy.)
+!procedure::add
+!end interface
+!interface operator(*)
+!procedure::mul
+!end interface
+!contains
+!function mul(v1,v2)
+!type(t1),intent(in)::v1
+!type(t1),intent(in)::v2
+!type(t1)::mul
+!end
+!function add(v1,v2)
+!type(t1),intent(in)::v1
+!type(t1),intent(in)::v2
+!type(t1)::add
+!end
+!end
+
+module drm
+ type t1
+ integer :: val
+ end type t1
+ interface operator(.mul.)
+ procedure mul
+ end interface
+ interface operator(.fluffy.)
+ procedure add
+ end interface
+ interface operator(*)
+ module procedure mul
+ end interface
+!$omp declare reduction(*:t1:omp_out=omp_out*omp_in) initializer(omp_priv=t1(1))
+!$omp declare reduction(.mul.:t1:omp_out=omp_out.mul.omp_in) initializer(omp_priv=t1(1))
+!$omp declare reduction(.fluffy.:t1:omp_out=omp_out.fluffy.omp_in) initializer(omp_priv=t1(0))
+contains
+ type(t1) function mul(v1, v2)
+ type(t1), intent (in):: v1, v2
+ mul%val = v1%val * v2%val
+ end function
+ type(t1) function add(v1, v2)
+ type(t1), intent (in):: v1, v2
+ add%val = v1%val + v2%val
+ end function
+end module drm
+
diff --git a/flang/test/Semantics/OpenMP/declare-reduction-operators.f90 b/flang/test/Semantics/OpenMP/declare-reduction-operators.f90
index e7513ab3f95b1..73fa1a1fea2c5 100644
--- a/flang/test/Semantics/OpenMP/declare-reduction-operators.f90
+++ b/flang/test/Semantics/OpenMP/declare-reduction-operators.f90
@@ -19,6 +19,35 @@ function add_vectors(a, b) result(res)
end function add_vectors
end module vector_mod
+!! Test user-defined operators. Two different varieties, using conventional and
+!! unconventional names.
+module m1
+ interface operator(.mul.)
+ procedure my_mul
+ end interface
+ interface operator(.fluffy.)
+ procedure my_add
+ end interface
+ type t1
+ integer :: val = 1
+ end type
+!$omp declare reduction(.mul.:t1:omp_out=omp_out.mul.omp_in)
+!$omp declare reduction(.fluffy.:t1:omp_out=omp_out.fluffy.omp_in)
+!CHECK: op.fluffy., PUBLIC: UserReductionDetails TYPE(t1)
+!CHECK: op.mul., PUBLIC: UserReductionDetails TYPE(t1)
+contains
+ function my_mul(x, y)
+ type (t1), intent (in) :: x, y
+ type (t1) :: my_mul
+ my_mul%val = x%val * y%val
+ end function
+ function my_add(x, y)
+ type (t1), intent (in) :: x, y
+ type (t1) :: my_add
+ my_add%val = x%val + y%val
+ end function
+end module m1
+
program test_vector
!CHECK-LABEL: MainProgram scope: test_vector
use vector_mod
More information about the flang-commits
mailing list