[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
Thu Apr 10 11:21:30 PDT 2025
https://github.com/Leporacanthicus updated https://github.com/llvm/llvm-project/pull/131628
>From a75db6e7529fa9c3f1770e1325e6cd1696a77052 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/9] [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 717982f66027c..aa8c830e8f2d2 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"
@@ -3403,8 +3404,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) {
@@ -3486,7 +3487,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;
}};
@@ -3506,9 +3508,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:
@@ -3521,8 +3525,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) {
@@ -3535,18 +3549,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(
@@ -3561,7 +3599,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 74367b5229548..f048b374588ca 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -1752,15 +1752,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)};
@@ -1792,6 +1852,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);
@@ -1802,6 +1866,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 ee4f70556e81a47c3c42b3bf781425deac5d44a0 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/9] 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 aa8c830e8f2d2..1eac0bdfc05bd 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -3518,7 +3518,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:
@@ -3535,7 +3538,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.
}};
@@ -3573,7 +3576,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>()}) {
@@ -3583,7 +3586,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 f048b374588ca..fe63ff31afd3d 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -1772,7 +1772,7 @@ parser::CharBlock MakeNameFromOperator(
return parser::CharBlock{"op.NEQV", 8};
default:
- assert(0 && "Unsupported operator...");
+ DIE("Unsupported operator...");
return parser::CharBlock{"op.?", 4};
}
}
@@ -1801,8 +1801,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);
@@ -1816,11 +1816,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)};
@@ -1849,17 +1860,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 3f926bda65b22b18e2524f95cd5041792054c9d2 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/9] 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 fe63ff31afd3d..4f5dde00223bc 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>
@@ -1778,23 +1779,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(
@@ -1817,7 +1808,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 d0b5e5cb04a86a7980c7238787a927f881e03205 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/9] 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 | 41 +++++++++---
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, 180 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 47dae0ae753d2..3f6815968b76f 100644
--- a/flang/lib/Parser/unparse.cpp
+++ b/flang/lib/Parser/unparse.cpp
@@ -3325,4 +3325,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 ee356e56e4458..93226beb8b5ed 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 4f5dde00223bc..3943bdaf0c2c7 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -1502,7 +1502,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 &);
@@ -1658,8 +1658,13 @@ 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);
+
int metaLevel_{0};
};
@@ -1788,9 +1793,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;
@@ -1800,11 +1817,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
@@ -1819,7 +1842,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;
}
@@ -1868,6 +1891,8 @@ void OmpVisitor::ProcessReductionSpecifier(
PopScope();
}
+ reductionDetails->AddDecl(&wholeOmpConstruct);
+
if (name) {
if (!symbol) {
symbol = &MakeSymbol(mangledName, Attrs{}, std::move(*reductionDetails));
@@ -1903,7 +1928,7 @@ bool OmpVisitor::Pre(const parser::OmpDirectiveSpecification &x) {
if (maybeArgs && maybeClauses) {
const parser::OmpArgument &first{maybeArgs->v.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
>From 38bdc0f7b498150eaa6d7a291456477fc94aff73 Mon Sep 17 00:00:00 2001
From: Mats Petersson <mats.petersson at arm.com>
Date: Fri, 4 Apr 2025 18:56:14 +0100
Subject: [PATCH 5/9] Fix nit comments and add simple bad operator test
---
flang/lib/Semantics/check-omp-structure.cpp | 12 +++++-------
flang/lib/Semantics/resolve-names-utils.h | 3 ++-
flang/lib/Semantics/resolve-names.cpp | 8 +++++---
flang/lib/Semantics/symbol.cpp | 3 +--
.../OpenMP/declare-reduction-bad-operator.f90 | 6 ++++++
5 files changed, 19 insertions(+), 13 deletions(-)
create mode 100644 flang/test/Semantics/OpenMP/declare-reduction-bad-operator.f90
diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index 1eac0bdfc05bd..099a58124638d 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -3488,7 +3488,7 @@ void OmpStructureChecker::CheckReductionObjects(
static bool IsReductionAllowedForType(
const parser::OmpReductionIdentifier &ident, const DeclTypeSpec &type,
- const Scope &scope) {
+ const Scope &scope, SemanticsContext &context) {
auto isLogical{[](const DeclTypeSpec &type) -> bool {
return type.category() == DeclTypeSpec::Logical;
}};
@@ -3528,7 +3528,7 @@ static bool IsReductionAllowedForType(
DIE("This should have been caught in CheckIntrinsicOperator");
return false;
}
- parser::CharBlock name{MakeNameFromOperator(*intrinsicOp)};
+ parser::CharBlock name{MakeNameFromOperator(*intrinsicOp, context)};
Symbol *symbol{scope.FindSymbol(name)};
if (symbol) {
const auto *reductionDetails{symbol->detailsIf<UserReductionDetails>()};
@@ -3539,11 +3539,11 @@ static bool IsReductionAllowedForType(
return false;
}
DIE("Intrinsic Operator not found - parsing gone wrong?");
- return false; // Reject everything else.
}};
auto checkDesignator{[&](const parser::ProcedureDesignator &procD) {
const parser::Name *name{std::get_if<parser::Name>(&procD.u)};
+ CHECK(name && name->symbol);
if (name && name->symbol) {
const SourceName &realName{name->symbol->GetUltimate().name()};
// OMP5.2: The type [...] of a list item that appears in a
@@ -3583,10 +3583,8 @@ static bool IsReductionAllowedForType(
return reductionDetails->SupportsType(&type);
}
}
- // Everything else is "not matching type".
- return false;
}
- DIE("name and name->symbol should be set here...");
+ // Everything else is "not matching type".
return false;
}};
@@ -3603,7 +3601,7 @@ void OmpStructureChecker::CheckReductionObjectTypes(
for (auto &[symbol, source] : symbols) {
if (auto *type{symbol->GetType()}) {
const auto &scope{context_.FindScope(symbol->name())};
- if (!IsReductionAllowedForType(ident, *type, scope)) {
+ if (!IsReductionAllowedForType(ident, *type, scope, context_)) {
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 de0991d69b61b..ed74c8203e29a 100644
--- a/flang/lib/Semantics/resolve-names-utils.h
+++ b/flang/lib/Semantics/resolve-names-utils.h
@@ -147,7 +147,8 @@ void MapSubprogramToNewSymbols(const Symbol &oldSymbol, Symbol &newSymbol,
Scope &newScope, SymbolAndTypeMappings * = nullptr);
parser::CharBlock MakeNameFromOperator(
- const parser::DefinedOperator::IntrinsicOperator &op);
+ const parser::DefinedOperator::IntrinsicOperator &op,
+ SemanticsContext &context);
parser::CharBlock MangleSpecialFunctions(const parser::CharBlock name);
} // namespace Fortran::semantics
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 3943bdaf0c2c7..552a0efc6aaa5 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -1759,7 +1759,8 @@ void OmpVisitor::ProcessMapperSpecifier(const parser::OmpMapperSpecifier &spec,
}
parser::CharBlock MakeNameFromOperator(
- const parser::DefinedOperator::IntrinsicOperator &op) {
+ const parser::DefinedOperator::IntrinsicOperator &op,
+ SemanticsContext &context) {
switch (op) {
case parser::DefinedOperator::IntrinsicOperator::Multiply:
return parser::CharBlock{"op.*", 4};
@@ -1778,7 +1779,7 @@ parser::CharBlock MakeNameFromOperator(
return parser::CharBlock{"op.NEQV", 8};
default:
- DIE("Unsupported operator...");
+ context.Say("Unsupported operator in OMP DECLARE REDUCTION"_err_en_US);
return parser::CharBlock{"op.?", 4};
}
}
@@ -1825,7 +1826,8 @@ void OmpVisitor::ProcessReductionSpecifier(
mangledName.source = MangleDefinedOperator(definedOp->v.source);
} else {
mangledName.source = MakeNameFromOperator(
- std::get<parser::DefinedOperator::IntrinsicOperator>(defOp.u));
+ std::get<parser::DefinedOperator::IntrinsicOperator>(defOp.u),
+ context());
name = &mangledName;
}
}
diff --git a/flang/lib/Semantics/symbol.cpp b/flang/lib/Semantics/symbol.cpp
index e627dd293ba7c..e1e9f1705e452 100644
--- a/flang/lib/Semantics/symbol.cpp
+++ b/flang/lib/Semantics/symbol.cpp
@@ -246,8 +246,7 @@ void GenericDetails::CopyFrom(const GenericDetails &from) {
// This is primarily for debugging.
std::string DetailsToString(const Details &details) {
return common::visit(
- common::visitors{//
- [](const UnknownDetails &) { return "Unknown"; },
+ common::visitors{[](const UnknownDetails &) { return "Unknown"; },
[](const MainProgramDetails &) { return "MainProgram"; },
[](const ModuleDetails &) { return "Module"; },
[](const SubprogramDetails &) { return "Subprogram"; },
diff --git a/flang/test/Semantics/OpenMP/declare-reduction-bad-operator.f90 b/flang/test/Semantics/OpenMP/declare-reduction-bad-operator.f90
new file mode 100644
index 0000000000000..3b27c6aa20f13
--- /dev/null
+++ b/flang/test/Semantics/OpenMP/declare-reduction-bad-operator.f90
@@ -0,0 +1,6 @@
+! RUN: not %flang_fc1 -fdebug-dump-symbols -fopenmp -fopenmp-version=50 %s 2>&1 | FileCheck %s
+
+function func(n)
+ !$omp declare reduction(/:integer:omp_out=omp_out+omp_in)
+!CHECK: error: Unsupported operator in OMP DECLARE REDUCTION
+end function func
>From 0afc3591885e72d59912811e0e01b158f895b928 Mon Sep 17 00:00:00 2001
From: Mats Petersson <mats.petersson at arm.com>
Date: Fri, 4 Apr 2025 19:47:42 +0100
Subject: [PATCH 6/9] Fix error messages to be more consistent
---
flang/lib/Semantics/resolve-names.cpp | 6 +++---
.../Semantics/OpenMP/declare-reduction-bad-operator.f90 | 2 +-
flang/test/Semantics/OpenMP/declare-reduction-error.f90 | 2 +-
3 files changed, 5 insertions(+), 5 deletions(-)
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 552a0efc6aaa5..f1c2a0759e2ed 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -1492,7 +1492,7 @@ class OmpVisitor : public virtual DeclarationVisitor {
auto *symbol{FindSymbol(NonDerivedTypeScope(), name)};
if (!symbol) {
context().Say(name.source,
- "Implicit subroutine declaration '%s' in !$OMP DECLARE REDUCTION"_err_en_US,
+ "Implicit subroutine declaration '%s' in DECLARE REDUCTION"_err_en_US,
name.source);
}
return true;
@@ -1779,7 +1779,7 @@ parser::CharBlock MakeNameFromOperator(
return parser::CharBlock{"op.NEQV", 8};
default:
- context.Say("Unsupported operator in OMP DECLARE REDUCTION"_err_en_US);
+ context.Say("Unsupported operator in DECLARE REDUCTION"_err_en_US);
return parser::CharBlock{"op.?", 4};
}
}
@@ -1844,7 +1844,7 @@ void OmpVisitor::ProcessReductionSpecifier(
if (!reductionDetails) {
context().Say(name->source,
- "Duplicate definition of '%s' in !$OMP DECLARE REDUCTION"_err_en_US,
+ "Duplicate definition of '%s' in DECLARE REDUCTION"_err_en_US,
name->source);
return;
}
diff --git a/flang/test/Semantics/OpenMP/declare-reduction-bad-operator.f90 b/flang/test/Semantics/OpenMP/declare-reduction-bad-operator.f90
index 3b27c6aa20f13..1d1d2903a2780 100644
--- a/flang/test/Semantics/OpenMP/declare-reduction-bad-operator.f90
+++ b/flang/test/Semantics/OpenMP/declare-reduction-bad-operator.f90
@@ -2,5 +2,5 @@
function func(n)
!$omp declare reduction(/:integer:omp_out=omp_out+omp_in)
-!CHECK: error: Unsupported operator in OMP DECLARE REDUCTION
+!CHECK: error: Unsupported operator in DECLARE REDUCTION
end function func
diff --git a/flang/test/Semantics/OpenMP/declare-reduction-error.f90 b/flang/test/Semantics/OpenMP/declare-reduction-error.f90
index c22cf106ea507..21f5cc186e037 100644
--- a/flang/test/Semantics/OpenMP/declare-reduction-error.f90
+++ b/flang/test/Semantics/OpenMP/declare-reduction-error.f90
@@ -7,5 +7,5 @@ end subroutine initme
subroutine subr
!$omp declare reduction(red_add:integer(4):omp_out=omp_out+omp_in) initializer(initme(omp_priv,0))
- !CHECK: error: Implicit subroutine declaration 'initme' in !$OMP DECLARE REDUCTION
+ !CHECK: error: Implicit subroutine declaration 'initme' in DECLARE REDUCTION
end subroutine subr
>From 1b08d9cdb6b57640e0f85361c8b60f8b77084d57 Mon Sep 17 00:00:00 2001
From: Mats Petersson <mats.petersson at arm.com>
Date: Mon, 7 Apr 2025 10:47:44 +0100
Subject: [PATCH 7/9] add missed test change
---
flang/test/Semantics/OpenMP/declare-reduction-dupsym.f90 | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/flang/test/Semantics/OpenMP/declare-reduction-dupsym.f90 b/flang/test/Semantics/OpenMP/declare-reduction-dupsym.f90
index 2e82cd1a18332..83f8f85299dca 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 definition of 'my_red' in !$OMP DECLARE REDUCTION
+!CHECK: error: Duplicate definition of 'my_red' in 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
>From 17a400b89ce08f84c76ebbb4f1b2b7c92f3ae5ae Mon Sep 17 00:00:00 2001
From: Mats Petersson <mats.petersson at arm.com>
Date: Tue, 8 Apr 2025 14:41:37 +0100
Subject: [PATCH 8/9] Improve support for metadirective + declare reduction
---
flang/include/flang/Semantics/symbol.h | 4 ++--
flang/lib/Parser/unparse.cpp | 4 ++--
flang/lib/Semantics/mod-file.cpp | 2 +-
flang/lib/Semantics/resolve-names.cpp | 12 +++++++++++-
.../Semantics/OpenMP/declare-reduction-modfile.f90 | 4 +++-
5 files changed, 19 insertions(+), 7 deletions(-)
diff --git a/flang/include/flang/Semantics/symbol.h b/flang/include/flang/Semantics/symbol.h
index f28a1d6b929eb..5cc47b36c234f 100644
--- a/flang/include/flang/Semantics/symbol.h
+++ b/flang/include/flang/Semantics/symbol.h
@@ -30,7 +30,7 @@ class raw_ostream;
namespace Fortran::parser {
struct Expr;
struct OpenMPDeclareReductionConstruct;
-struct OmpDirectiveSpecification;
+struct OmpMetadirectiveDirective;
}
namespace Fortran::semantics {
@@ -710,7 +710,7 @@ class UserReductionDetails {
public:
using TypeVector = std::vector<const DeclTypeSpec *>;
using DeclInfo = std::variant<const parser::OpenMPDeclareReductionConstruct *,
- const parser::OmpDirectiveSpecification *>;
+ const parser::OmpMetadirectiveDirective *>;
using DeclVector = std::vector<DeclInfo>;
UserReductionDetails() = default;
diff --git a/flang/lib/Parser/unparse.cpp b/flang/lib/Parser/unparse.cpp
index 3f6815968b76f..bcc50a72a84b4 100644
--- a/flang/lib/Parser/unparse.cpp
+++ b/flang/lib/Parser/unparse.cpp
@@ -3329,7 +3329,7 @@ template void Unparse<Expr>(llvm::raw_ostream &, const Expr &, Encoding, bool,
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,
+template void Unparse<parser::OmpMetadirectiveDirective>(llvm::raw_ostream &,
+ const parser::OmpMetadirectiveDirective &, 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 93226beb8b5ed..c24b4a63a2aeb 100644
--- a/flang/lib/Semantics/mod-file.cpp
+++ b/flang/lib/Semantics/mod-file.cpp
@@ -1047,7 +1047,7 @@ void ModFileWriter::PutUserReduction(
if (auto d = std::get_if<const parser::OpenMPDeclareReductionConstruct *>(
&decl)) {
Unparse(os, **d);
- } else if (auto s = std::get_if<const parser::OmpDirectiveSpecification *>(
+ } else if (auto s = std::get_if<const parser::OmpMetadirectiveDirective *>(
&decl)) {
Unparse(os, **s);
} else {
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index f1c2a0759e2ed..9c3bd00627ff7 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -1655,6 +1655,14 @@ class OmpVisitor : public virtual DeclarationVisitor {
EndDeclTypeSpec();
}
+ bool Pre(const parser::OmpMetadirectiveDirective &x) { //
+ metaDirective_ = &x;
+ return true;
+ }
+ void Post(const parser::OmpMetadirectiveDirective &) { //
+ metaDirective_ = nullptr;
+ }
+
private:
void ProcessMapperSpecifier(const parser::OmpMapperSpecifier &spec,
const parser::OmpClauseList &clauses);
@@ -1666,6 +1674,7 @@ class OmpVisitor : public virtual DeclarationVisitor {
parser::CharBlock MangleDefinedOperator(const parser::CharBlock &name);
int metaLevel_{0};
+ const parser::OmpMetadirectiveDirective *metaDirective_{nullptr};
};
bool OmpVisitor::NeedsScope(const parser::OpenMPBlockConstruct &x) {
@@ -1930,7 +1939,8 @@ bool OmpVisitor::Pre(const parser::OmpDirectiveSpecification &x) {
if (maybeArgs && maybeClauses) {
const parser::OmpArgument &first{maybeArgs->v.front()};
if (auto *spec{std::get_if<parser::OmpReductionSpecifier>(&first.u)}) {
- ProcessReductionSpecifier(*spec, maybeClauses, x);
+ CHECK(metaDirective_);
+ ProcessReductionSpecifier(*spec, maybeClauses, *metaDirective_);
}
}
break;
diff --git a/flang/test/Semantics/OpenMP/declare-reduction-modfile.f90 b/flang/test/Semantics/OpenMP/declare-reduction-modfile.f90
index caed7fd335376..f80eb1097e18a 100644
--- a/flang/test/Semantics/OpenMP/declare-reduction-modfile.f90
+++ b/flang/test/Semantics/OpenMP/declare-reduction-modfile.f90
@@ -1,4 +1,4 @@
-! RUN: %python %S/../test_modfile.py %s %flang_fc1 -fopenmp
+! RUN: %python %S/../test_modfile.py %s %flang_fc1 -fopenmp -fopenmp-version=52
! Check correct modfile generation for OpenMP DECLARE REDUCTION construct.
!Expect: drm.mod
@@ -8,6 +8,7 @@
!endtype
!!$OMP DECLARE REDUCTION (*:t1:omp_out = omp_out*omp_in) INITIALIZER(omp_priv=t&
!!$OMP&1(1))
+!!$OMP METADIRECTIVE OTHERWISE(DECLARE REDUCTION(+:INTEGER))
!!$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&
@@ -50,6 +51,7 @@ module drm
!$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))
+!$omp metadirective otherwise(declare reduction(+: integer))
contains
type(t1) function mul(v1, v2)
type(t1), intent (in):: v1, v2
>From 93f817902ed042f48c5171b23d95578e87eb5b0e Mon Sep 17 00:00:00 2001
From: Mats Petersson <mats.petersson at arm.com>
Date: Thu, 10 Apr 2025 19:11:10 +0100
Subject: [PATCH 9/9] Fix Klausler reported review comments
Also rebase, as the branch was quite a way behind. Small conflict
was resolved.
---
flang/include/flang/Semantics/symbol.h | 6 +++---
flang/lib/Semantics/check-omp-structure.cpp | 9 ++++----
flang/lib/Semantics/mod-file.cpp | 23 ++++++++++++---------
flang/lib/Semantics/resolve-names-utils.h | 2 +-
flang/lib/Semantics/resolve-names.cpp | 20 +++++++-----------
5 files changed, 29 insertions(+), 31 deletions(-)
diff --git a/flang/include/flang/Semantics/symbol.h b/flang/include/flang/Semantics/symbol.h
index 5cc47b36c234f..b7b29afe1ceea 100644
--- a/flang/include/flang/Semantics/symbol.h
+++ b/flang/include/flang/Semantics/symbol.h
@@ -715,11 +715,11 @@ class UserReductionDetails {
UserReductionDetails() = default;
- void AddType(const DeclTypeSpec *type) { typeList_.push_back(type); }
+ void AddType(const DeclTypeSpec &type) { typeList_.push_back(&type); }
const TypeVector &GetTypeList() const { return typeList_; }
- bool SupportsType(const DeclTypeSpec *type) const {
- return llvm::is_contained(typeList_, type);
+ bool SupportsType(const DeclTypeSpec &type) const {
+ return llvm::is_contained(typeList_, &type);
}
void AddDecl(const DeclInfo &decl) { declList_.push_back(decl); }
diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index 099a58124638d..91b8a8dd57d3b 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -3404,8 +3404,7 @@ bool OmpStructureChecker::CheckReductionOperator(
valid =
llvm::is_contained({"max", "min", "iand", "ior", "ieor"}, realName);
if (!valid) {
- auto *reductionDetails{name->symbol->detailsIf<UserReductionDetails>()};
- valid = reductionDetails != nullptr;
+ valid = name->symbol->detailsIf<UserReductionDetails>();
}
}
if (!valid) {
@@ -3534,7 +3533,7 @@ static bool IsReductionAllowedForType(
const auto *reductionDetails{symbol->detailsIf<UserReductionDetails>()};
assert(reductionDetails && "Expected to find reductiondetails");
- return reductionDetails->SupportsType(&type);
+ return reductionDetails->SupportsType(type);
}
return false;
}
@@ -3571,7 +3570,7 @@ static bool IsReductionAllowedForType(
// supported.
if (const auto *reductionDetails{
name->symbol->detailsIf<UserReductionDetails>()}) {
- return reductionDetails->SupportsType(&type);
+ return reductionDetails->SupportsType(type);
}
// We also need to check for mangled names (max, min, iand, ieor and ior)
@@ -3580,7 +3579,7 @@ static bool IsReductionAllowedForType(
if (const auto &symbol{scope.FindSymbol(mangledName)}) {
if (const auto *reductionDetails{
symbol->detailsIf<UserReductionDetails>()}) {
- return reductionDetails->SupportsType(&type);
+ return reductionDetails->SupportsType(type);
}
}
}
diff --git a/flang/lib/Semantics/mod-file.cpp b/flang/lib/Semantics/mod-file.cpp
index c24b4a63a2aeb..10abb4db159c1 100644
--- a/flang/lib/Semantics/mod-file.cpp
+++ b/flang/lib/Semantics/mod-file.cpp
@@ -1039,20 +1039,23 @@ void ModFileWriter::PutTypeParam(llvm::raw_ostream &os, const Symbol &symbol) {
void ModFileWriter::PutUserReduction(
llvm::raw_ostream &os, const Symbol &symbol) {
- auto &details{symbol.get<UserReductionDetails>()};
+ const 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::OmpMetadirectiveDirective *>(
- &decl)) {
- Unparse(os, **s);
- } else {
- DIE("Unknown OpenMP DECLARE REDUCTION content");
- }
+ common::visit( //
+ common::visitors{//
+ [&](const parser::OpenMPDeclareReductionConstruct *d) {
+ Unparse(os, *d);
+ },
+ [&](const parser::OmpMetadirectiveDirective *m) {
+ Unparse(os, *m);
+ },
+ [&](const auto &) {
+ DIE("Unknown OpenMP DECLARE REDUCTION content");
+ }},
+ decl);
}
}
diff --git a/flang/lib/Semantics/resolve-names-utils.h b/flang/lib/Semantics/resolve-names-utils.h
index ed74c8203e29a..809074031e2cc 100644
--- a/flang/lib/Semantics/resolve-names-utils.h
+++ b/flang/lib/Semantics/resolve-names-utils.h
@@ -149,7 +149,7 @@ void MapSubprogramToNewSymbols(const Symbol &oldSymbol, Symbol &newSymbol,
parser::CharBlock MakeNameFromOperator(
const parser::DefinedOperator::IntrinsicOperator &op,
SemanticsContext &context);
-parser::CharBlock MangleSpecialFunctions(const parser::CharBlock name);
+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 9c3bd00627ff7..0416b5d410fec 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -1442,11 +1442,15 @@ class OmpVisitor : public virtual DeclarationVisitor {
static bool NeedsScope(const parser::OpenMPBlockConstruct &);
static bool NeedsScope(const parser::OmpClause &);
- bool Pre(const parser::OmpMetadirectiveDirective &) {
+ bool Pre(const parser::OmpMetadirectiveDirective &x) { //
+ metaDirective_ = &x;
++metaLevel_;
return true;
}
- void Post(const parser::OmpMetadirectiveDirective &) { --metaLevel_; }
+ void Post(const parser::OmpMetadirectiveDirective &) { //
+ metaDirective_ = nullptr;
+ --metaLevel_;
+ }
bool Pre(const parser::OpenMPRequiresConstruct &x) {
AddOmpSourceRange(x.source);
@@ -1655,14 +1659,6 @@ class OmpVisitor : public virtual DeclarationVisitor {
EndDeclTypeSpec();
}
- bool Pre(const parser::OmpMetadirectiveDirective &x) { //
- metaDirective_ = &x;
- return true;
- }
- void Post(const parser::OmpMetadirectiveDirective &) { //
- metaDirective_ = nullptr;
- }
-
private:
void ProcessMapperSpecifier(const parser::OmpMapperSpecifier &spec,
const parser::OmpClauseList &clauses);
@@ -1793,7 +1789,7 @@ parser::CharBlock MakeNameFromOperator(
}
}
-parser::CharBlock MangleSpecialFunctions(const parser::CharBlock name) {
+parser::CharBlock MangleSpecialFunctions(const parser::CharBlock &name) {
return llvm::StringSwitch<parser::CharBlock>(name.ToString())
.Case("max", {"op.max", 6})
.Case("min", {"op.min", 6})
@@ -1888,7 +1884,7 @@ void OmpVisitor::ProcessReductionSpecifier(
// 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);
+ reductionDetails->AddType(*typeSpec);
for (auto &nm : ompVarNames) {
ObjectEntityDetails details{};
More information about the flang-commits
mailing list