[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
Mon Mar 17 08:19:47 PDT 2025
https://github.com/Leporacanthicus created https://github.com/llvm/llvm-project/pull/131628
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.
>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] [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)
More information about the flang-commits
mailing list