[flang-commits] [flang] [flang][openmp]Add UserReductionDetails and use in DECLARE REDUCTION (PR #140066)
Tom Eccles via flang-commits
flang-commits at lists.llvm.org
Thu Jun 5 04:22:15 PDT 2025
https://github.com/tblah updated https://github.com/llvm/llvm-project/pull/140066
>From 2b1ea348ae3cdb119379617f3293fe2b31e59911 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 01/21] [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 cec212f0eae37..a134a95109296 100644
--- a/flang/include/flang/Semantics/symbol.h
+++ b/flang/include/flang/Semantics/symbol.h
@@ -728,6 +728,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,
@@ -735,7 +754,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 f9d645dc2e78a..3b83fbd51f1a2 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"
@@ -3533,8 +3534,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) {
@@ -3615,7 +3616,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;
}};
@@ -3635,9 +3637,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:
@@ -3650,8 +3654,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) {
@@ -3664,18 +3678,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(
@@ -3690,7 +3728,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 297007bcbde67..e43b76316cf93 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -1801,15 +1801,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)};
@@ -1841,6 +1901,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);
@@ -1851,6 +1915,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 52f74035bd6a8..305ff205be0ec 100644
--- a/flang/lib/Semantics/symbol.cpp
+++ b/flang/lib/Semantics/symbol.cpp
@@ -292,7 +292,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"; },
@@ -312,7 +312,7 @@ std::string DetailsToString(const Details &details) {
[](const TypeParamDetails &) { return "TypeParam"; },
[](const MiscDetails &) { return "Misc"; },
[](const AssocEntityDetails &) { return "AssocEntity"; },
- },
+ [](const UserReductionDetails &) { return "UserReductionDetails"; }},
details);
}
@@ -346,6 +346,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);
@@ -644,6 +647,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 4809f3e0f92c9d42a98cdf28dd76398c5fbaf73d 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 02/21] 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 a134a95109296..8e40b429e54b3 100644
--- a/flang/include/flang/Semantics/symbol.h
+++ b/flang/include/flang/Semantics/symbol.h
@@ -728,7 +728,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;
@@ -737,10 +740,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 3b83fbd51f1a2..a51bc3f025bfa 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -3647,7 +3647,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:
@@ -3664,7 +3667,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.
}};
@@ -3702,7 +3705,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>()}) {
@@ -3712,7 +3715,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 e43b76316cf93..18a9ba9a7c588 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -1821,7 +1821,7 @@ parser::CharBlock MakeNameFromOperator(
return parser::CharBlock{"op.NEQV", 8};
default:
- assert(0 && "Unsupported operator...");
+ DIE("Unsupported operator...");
return parser::CharBlock{"op.?", 4};
}
}
@@ -1850,8 +1850,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);
@@ -1865,11 +1865,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)};
@@ -1898,17 +1909,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 dea0887f09de699c168a16e166493d3fc3342586 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 03/21] 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 18a9ba9a7c588..48cdd4c0d3604 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>
@@ -1827,23 +1828,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(
@@ -1866,7 +1857,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 304575dd1f499242e9ab0974e625119f9671dafe 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 04/21] 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 | 8 +++
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, 181 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 8e40b429e54b3..fe5da5ed86e93 100644
--- a/flang/include/flang/Semantics/symbol.h
+++ b/flang/include/flang/Semantics/symbol.h
@@ -30,6 +30,8 @@ class raw_ostream;
}
namespace Fortran::parser {
struct Expr;
+struct OpenMPDeclareReductionConstruct;
+struct OmpDirectiveSpecification;
}
namespace Fortran::semantics {
@@ -734,6 +736,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); }
@@ -743,8 +749,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 0784a6703bbde..95243aaf16563 100644
--- a/flang/lib/Parser/unparse.cpp
+++ b/flang/lib/Parser/unparse.cpp
@@ -3368,4 +3368,12 @@ template void Unparse<Program>(llvm::raw_ostream &, const Program &,
template void Unparse<Expr>(llvm::raw_ostream &, const Expr &,
const common::LangOptions &, Encoding, bool, bool, preStatementType *,
AnalyzedObjectsAsFortran *);
+
+template void Unparse<parser::OpenMPDeclareReductionConstruct>(
+ llvm::raw_ostream &, const parser::OpenMPDeclareReductionConstruct &,
+ const common::LangOptions &, Encoding, bool, bool, preStatementType *,
+ AnalyzedObjectsAsFortran *);
+template void Unparse<parser::OmpDirectiveSpecification>(llvm::raw_ostream &,
+ const parser::OmpDirectiveSpecification &, const common::LangOptions &,
+ 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 a1ec956562204..a17884c3016e3 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"
@@ -894,6 +895,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());
@@ -1043,6 +1045,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, context_.langOptions());
+ } else if (auto s = std::get_if<const parser::OmpDirectiveSpecification *>(
+ &decl)) {
+ Unparse(os, **s, context_.langOptions());
+ } else {
+ DIE("Unknown OpenMP DECLARE REDUCTION content");
+ }
+ }
+}
+
void PutInit(llvm::raw_ostream &os, const Symbol &symbol, const MaybeExpr &init,
const parser::Expr *unanalyzed, SemanticsContext &context) {
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 48cdd4c0d3604..b79e33e7a639d 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -1552,7 +1552,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 &);
@@ -1713,8 +1713,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};
};
@@ -1837,9 +1842,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;
@@ -1849,11 +1866,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
@@ -1868,7 +1891,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;
}
@@ -1917,6 +1940,8 @@ void OmpVisitor::ProcessReductionSpecifier(
PopScope();
}
+ reductionDetails->AddDecl(&wholeOmpConstruct);
+
if (name) {
if (!symbol) {
symbol = &MakeSymbol(mangledName, Attrs{}, std::move(*reductionDetails));
@@ -1952,7 +1977,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 e07054f8ec564..bccccba86346d 100644
--- a/flang/lib/Semantics/semantics.cpp
+++ b/flang/lib/Semantics/semantics.cpp
@@ -772,4 +772,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 ebe6df81780f0c5530972b45e966d9ce83d0302b 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 05/21] 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 a51bc3f025bfa..479a1df1d9f22 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -3617,7 +3617,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;
}};
@@ -3657,7 +3657,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>()};
@@ -3668,11 +3668,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
@@ -3712,10 +3712,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;
}};
@@ -3732,7 +3730,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 b79e33e7a639d..c0d569fac8cdf 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -1808,7 +1808,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};
@@ -1827,7 +1828,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};
}
}
@@ -1874,7 +1875,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 305ff205be0ec..0380207927ad3 100644
--- a/flang/lib/Semantics/symbol.cpp
+++ b/flang/lib/Semantics/symbol.cpp
@@ -292,8 +292,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 1cdc4e4a55eaadf1646c462623bdf53d6abf45c3 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 06/21] 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 c0d569fac8cdf..25f9462a67d6b 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -1523,7 +1523,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;
@@ -1828,7 +1828,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};
}
}
@@ -1893,7 +1893,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 647d6077dba3cd80752f14b8cd9aefddbb87e7d8 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 07/21] 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 eebd884d8caa2041f40cfc8df7a4726b748bae0b 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 08/21] 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, 17 insertions(+), 9 deletions(-)
diff --git a/flang/include/flang/Semantics/symbol.h b/flang/include/flang/Semantics/symbol.h
index fe5da5ed86e93..af88f225d2ebf 100644
--- a/flang/include/flang/Semantics/symbol.h
+++ b/flang/include/flang/Semantics/symbol.h
@@ -31,7 +31,7 @@ class raw_ostream;
namespace Fortran::parser {
struct Expr;
struct OpenMPDeclareReductionConstruct;
-struct OmpDirectiveSpecification;
+struct OmpMetadirectiveDirective;
}
namespace Fortran::semantics {
@@ -737,7 +737,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 95243aaf16563..e0abe95d07c86 100644
--- a/flang/lib/Parser/unparse.cpp
+++ b/flang/lib/Parser/unparse.cpp
@@ -3373,7 +3373,7 @@ template void Unparse<parser::OpenMPDeclareReductionConstruct>(
llvm::raw_ostream &, const parser::OpenMPDeclareReductionConstruct &,
const common::LangOptions &, Encoding, bool, bool, preStatementType *,
AnalyzedObjectsAsFortran *);
-template void Unparse<parser::OmpDirectiveSpecification>(llvm::raw_ostream &,
- const parser::OmpDirectiveSpecification &, const common::LangOptions &,
+template void Unparse<parser::OmpMetadirectiveDirective>(llvm::raw_ostream &,
+ const parser::OmpMetadirectiveDirective &, const common::LangOptions &,
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 a17884c3016e3..d15b71a4b75be 100644
--- a/flang/lib/Semantics/mod-file.cpp
+++ b/flang/lib/Semantics/mod-file.cpp
@@ -1055,7 +1055,7 @@ void ModFileWriter::PutUserReduction(
if (auto d = std::get_if<const parser::OpenMPDeclareReductionConstruct *>(
&decl)) {
Unparse(os, **d, context_.langOptions());
- } else if (auto s = std::get_if<const parser::OmpDirectiveSpecification *>(
+ } else if (auto s = std::get_if<const parser::OmpMetadirectiveDirective *>(
&decl)) {
Unparse(os, **s, context_.langOptions());
} else {
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 25f9462a67d6b..545ca53651fad 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -1468,11 +1468,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);
@@ -1721,6 +1725,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) {
@@ -1979,7 +1984,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 7422a1688962ff090eb40974ef95b6ada52886ed 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 09/21] 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 | 8 +++----
5 files changed, 25 insertions(+), 23 deletions(-)
diff --git a/flang/include/flang/Semantics/symbol.h b/flang/include/flang/Semantics/symbol.h
index af88f225d2ebf..7db856ceaa76d 100644
--- a/flang/include/flang/Semantics/symbol.h
+++ b/flang/include/flang/Semantics/symbol.h
@@ -742,11 +742,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 479a1df1d9f22..f4e41a9f7c278 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -3534,8 +3534,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) {
@@ -3663,7 +3662,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;
}
@@ -3700,7 +3699,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)
@@ -3709,7 +3708,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 d15b71a4b75be..dbd55a61f510f 100644
--- a/flang/lib/Semantics/mod-file.cpp
+++ b/flang/lib/Semantics/mod-file.cpp
@@ -1047,20 +1047,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, context_.langOptions());
- } else if (auto s = std::get_if<const parser::OmpMetadirectiveDirective *>(
- &decl)) {
- Unparse(os, **s, context_.langOptions());
- } else {
- DIE("Unknown OpenMP DECLARE REDUCTION content");
- }
+ common::visit( //
+ common::visitors{//
+ [&](const parser::OpenMPDeclareReductionConstruct *d) {
+ Unparse(os, *d, context_.langOptions());
+ },
+ [&](const parser::OmpMetadirectiveDirective *m) {
+ Unparse(os, *m, context_.langOptions());
+ },
+ [&](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 545ca53651fad..6750890dda739 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -1468,12 +1468,12 @@ class OmpVisitor : public virtual DeclarationVisitor {
static bool NeedsScope(const parser::OpenMPBlockConstruct &);
static bool NeedsScope(const parser::OmpClause &);
- bool Pre(const parser::OmpMetadirectiveDirective &x) {
+ bool Pre(const parser::OmpMetadirectiveDirective &x) { //
metaDirective_ = &x;
++metaLevel_;
return true;
}
- void Post(const parser::OmpMetadirectiveDirective &) {
+ void Post(const parser::OmpMetadirectiveDirective &) { //
metaDirective_ = nullptr;
--metaLevel_;
}
@@ -1838,7 +1838,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})
@@ -1933,7 +1933,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{};
>From 136b45be5fb4f66ac1dde47f7078816d72490172 Mon Sep 17 00:00:00 2001
From: Mats Petersson <mats.petersson at arm.com>
Date: Tue, 29 Apr 2025 13:25:19 +0100
Subject: [PATCH 10/21] Fix some semantics issues
---
flang/lib/Semantics/assignment.cpp | 10 ++++++
flang/lib/Semantics/assignment.h | 3 ++
flang/lib/Semantics/check-omp-structure.cpp | 39 +++++++++++++--------
flang/lib/Semantics/resolve-names-utils.h | 1 +
flang/lib/Semantics/resolve-names.cpp | 14 +++-----
5 files changed, 43 insertions(+), 24 deletions(-)
diff --git a/flang/lib/Semantics/assignment.cpp b/flang/lib/Semantics/assignment.cpp
index 6e55d0210ee0e..43e23a9d8f60b 100644
--- a/flang/lib/Semantics/assignment.cpp
+++ b/flang/lib/Semantics/assignment.cpp
@@ -43,6 +43,7 @@ class AssignmentContext {
void Analyze(const parser::PointerAssignmentStmt &);
void Analyze(const parser::ConcurrentControl &);
int deviceConstructDepth_{0};
+ SemanticsContext &context() { return context_; }
private:
bool CheckForPureContext(const SomeExpr &rhs, parser::CharBlock rhsSource);
@@ -218,8 +219,17 @@ void AssignmentContext::PopWhereContext() {
AssignmentChecker::~AssignmentChecker() {}
+SemanticsContext &AssignmentChecker::context() {
+ return context_.value().context();
+}
+
AssignmentChecker::AssignmentChecker(SemanticsContext &context)
: context_{new AssignmentContext{context}} {}
+
+void AssignmentChecker::Enter(
+ const parser::OpenMPDeclareReductionConstruct &x) {
+ context().set_location(x.source);
+}
void AssignmentChecker::Enter(const parser::AssignmentStmt &x) {
context_.value().Analyze(x);
}
diff --git a/flang/lib/Semantics/assignment.h b/flang/lib/Semantics/assignment.h
index a67bee4a03dfc..4a1bb92037119 100644
--- a/flang/lib/Semantics/assignment.h
+++ b/flang/lib/Semantics/assignment.h
@@ -37,6 +37,7 @@ class AssignmentChecker : public virtual BaseChecker {
public:
explicit AssignmentChecker(SemanticsContext &);
~AssignmentChecker();
+ void Enter(const parser::OpenMPDeclareReductionConstruct &x);
void Enter(const parser::AssignmentStmt &);
void Enter(const parser::PointerAssignmentStmt &);
void Enter(const parser::WhereStmt &);
@@ -54,6 +55,8 @@ class AssignmentChecker : public virtual BaseChecker {
void Enter(const parser::OpenACCLoopConstruct &);
void Leave(const parser::OpenACCLoopConstruct &);
+ SemanticsContext &context();
+
private:
common::Indirection<AssignmentContext> context_;
};
diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index f4e41a9f7c278..bee4a2244bf6a 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -3521,6 +3521,14 @@ bool OmpStructureChecker::CheckReductionOperator(
break;
}
}
+ // User-defined operators are OK if there has been a declared reduction
+ // for that. So check if it's a defined operator, and it has
+ // UserReductionDetails - then it's good.
+ if (const auto *definedOp{std::get_if<parser::DefinedOpName>(&dOpr.u)}) {
+ if (definedOp->v.symbol->detailsIf<UserReductionDetails>()) {
+ return true;
+ }
+ }
context_.Say(source, "Invalid reduction operator in %s clause."_err_en_US,
parser::ToUpperCaseLetters(getClauseName(clauseId).str()));
return false;
@@ -3614,6 +3622,17 @@ void OmpStructureChecker::CheckReductionObjects(
}
}
+static bool CheckSymbolSupportsType(const Scope &scope,
+ const parser::CharBlock &name, const DeclTypeSpec &type) {
+ if (const auto &symbol{scope.FindSymbol(name)}) {
+ if (const auto *reductionDetails{
+ symbol->detailsIf<UserReductionDetails>()}) {
+ return reductionDetails->SupportsType(&type);
+ }
+ }
+ return false;
+}
+
static bool IsReductionAllowedForType(
const parser::OmpReductionIdentifier &ident, const DeclTypeSpec &type,
const Scope &scope, SemanticsContext &context) {
@@ -3657,14 +3676,11 @@ static bool IsReductionAllowedForType(
return false;
}
parser::CharBlock name{MakeNameFromOperator(*intrinsicOp, context)};
- 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 CheckSymbolSupportsType(scope, name, type);
+ } else if (const auto *definedOp{
+ std::get_if<parser::DefinedOpName>(&dOpr.u)}) {
+ // TODO: Figure out if it's valid.
+ return true;
}
DIE("Intrinsic Operator not found - parsing gone wrong?");
}};
@@ -3705,12 +3721,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)};
- if (const auto &symbol{scope.FindSymbol(mangledName)}) {
- if (const auto *reductionDetails{
- symbol->detailsIf<UserReductionDetails>()}) {
- return reductionDetails->SupportsType(type);
- }
- }
+ return CheckSymbolSupportsType(scope, mangledName, type);
}
// Everything else is "not matching type".
return false;
diff --git a/flang/lib/Semantics/resolve-names-utils.h b/flang/lib/Semantics/resolve-names-utils.h
index 809074031e2cc..ee8113a3fda5e 100644
--- a/flang/lib/Semantics/resolve-names-utils.h
+++ b/flang/lib/Semantics/resolve-names-utils.h
@@ -150,6 +150,7 @@ parser::CharBlock MakeNameFromOperator(
const parser::DefinedOperator::IntrinsicOperator &op,
SemanticsContext &context);
parser::CharBlock MangleSpecialFunctions(const parser::CharBlock &name);
+std::string MangleDefinedOperator(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 6750890dda739..06e2b54818c51 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -1722,8 +1722,6 @@ class OmpVisitor : public virtual DeclarationVisitor {
const std::optional<parser::OmpClauseList> &clauses,
const T &wholeConstruct);
- parser::CharBlock MangleDefinedOperator(const parser::CharBlock &name);
-
int metaLevel_{0};
const parser::OmpMetadirectiveDirective *metaDirective_{nullptr};
};
@@ -1848,14 +1846,9 @@ 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>.
+std::string MangleDefinedOperator(const parser::CharBlock &name) {
CHECK(name[0] == '.' && name[name.size() - 1] == '.');
- return parser::CharBlock{
- context().StoreUserReductionName("op" + name.ToString())};
+ return "op" + name.ToString();
}
template <typename T>
@@ -1877,7 +1870,8 @@ void OmpVisitor::ProcessReductionSpecifier(
const auto &defOp{std::get<parser::DefinedOperator>(id.u)};
if (const auto definedOp{std::get_if<parser::DefinedOpName>(&defOp.u)}) {
name = &definedOp->v;
- mangledName.source = MangleDefinedOperator(definedOp->v.source);
+ mangledName.source = parser::CharBlock{context().StoreUserReductionName(
+ MangleDefinedOperator(definedOp->v.source))};
} else {
mangledName.source = MakeNameFromOperator(
std::get<parser::DefinedOperator::IntrinsicOperator>(defOp.u),
>From e3803611f675c6a0d0a9c9003b38ee9967525c66 Mon Sep 17 00:00:00 2001
From: Mats Petersson <mats.petersson at arm.com>
Date: Thu, 1 May 2025 13:39:58 +0100
Subject: [PATCH 11/21] [Flang][OpenMP] Fix review comment failed examples
Add code to better handle operators in parsing and semantics.
Add a function to set the the scope when processign assignments,
which caused a crash in "check for pure functions".
Add three new tests and amend existing tests to cover a pure function.
---
flang/include/flang/Semantics/symbol.h | 9 +++-
flang/lib/Semantics/check-omp-structure.cpp | 17 ++++---
.../declare-reduction-bad-operator2.f90 | 28 +++++++++++
.../OpenMP/declare-reduction-functions.f90 | 17 ++++++-
.../OpenMP/declare-reduction-operator.f90 | 36 ++++++++++++++
.../OpenMP/declare-reduction-renamedop.f90 | 47 +++++++++++++++++++
6 files changed, 145 insertions(+), 9 deletions(-)
create mode 100644 flang/test/Semantics/OpenMP/declare-reduction-bad-operator2.f90
create mode 100644 flang/test/Semantics/OpenMP/declare-reduction-operator.f90
create mode 100644 flang/test/Semantics/OpenMP/declare-reduction-renamedop.f90
diff --git a/flang/include/flang/Semantics/symbol.h b/flang/include/flang/Semantics/symbol.h
index 7db856ceaa76d..0b73cc504023e 100644
--- a/flang/include/flang/Semantics/symbol.h
+++ b/flang/include/flang/Semantics/symbol.h
@@ -746,7 +746,14 @@ class UserReductionDetails {
const TypeVector &GetTypeList() const { return typeList_; }
bool SupportsType(const DeclTypeSpec &type) const {
- return llvm::is_contained(typeList_, &type);
+ // We have to compare the actual type, not the pointer, as some
+ // types are not guaranteed to be the same object.
+ for (auto t : typeList_) {
+ if (*t == type) {
+ return true;
+ }
+ }
+ return false;
}
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 bee4a2244bf6a..bd1cd36c6f721 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -3522,11 +3522,14 @@ bool OmpStructureChecker::CheckReductionOperator(
}
}
// User-defined operators are OK if there has been a declared reduction
- // for that. So check if it's a defined operator, and it has
- // UserReductionDetails - then it's good.
+ // for that. We mangle those names to store the user details.
if (const auto *definedOp{std::get_if<parser::DefinedOpName>(&dOpr.u)}) {
- if (definedOp->v.symbol->detailsIf<UserReductionDetails>()) {
- return true;
+ std::string mangled = MangleDefinedOperator(definedOp->v.symbol->name());
+ const Scope &scope = definedOp->v.symbol->owner();
+ if (const Symbol *symbol = scope.FindSymbol(mangled)) {
+ if (symbol->detailsIf<UserReductionDetails>()) {
+ return true;
+ }
}
}
context_.Say(source, "Invalid reduction operator in %s clause."_err_en_US,
@@ -3627,7 +3630,7 @@ static bool CheckSymbolSupportsType(const Scope &scope,
if (const auto &symbol{scope.FindSymbol(name)}) {
if (const auto *reductionDetails{
symbol->detailsIf<UserReductionDetails>()}) {
- return reductionDetails->SupportsType(&type);
+ return reductionDetails->SupportsType(type);
}
}
return false;
@@ -3679,8 +3682,8 @@ static bool IsReductionAllowedForType(
return CheckSymbolSupportsType(scope, name, type);
} else if (const auto *definedOp{
std::get_if<parser::DefinedOpName>(&dOpr.u)}) {
- // TODO: Figure out if it's valid.
- return true;
+ return CheckSymbolSupportsType(
+ scope, MangleDefinedOperator(definedOp->v.symbol->name()), type);
}
DIE("Intrinsic Operator not found - parsing gone wrong?");
}};
diff --git a/flang/test/Semantics/OpenMP/declare-reduction-bad-operator2.f90 b/flang/test/Semantics/OpenMP/declare-reduction-bad-operator2.f90
new file mode 100644
index 0000000000000..9ee223c1c71fe
--- /dev/null
+++ b/flang/test/Semantics/OpenMP/declare-reduction-bad-operator2.f90
@@ -0,0 +1,28 @@
+! RUN: not %flang_fc1 -fdebug-dump-symbols -fopenmp -fopenmp-version=50 %s 2>&1 | FileCheck %s
+
+module m1
+ interface operator(.fluffy.)
+ procedure my_mul
+ end interface
+ type t1
+ integer :: val = 1
+ end type
+!$omp declare reduction(.fluffy.:t1:omp_out=omp_out.fluffy.omp_in)
+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 my_mul
+
+ subroutine subr(a, r)
+ implicit none
+ integer, intent(in), dimension(10) :: a
+ integer, intent(out) :: r
+ integer :: i
+ !$omp do parallel reduction(.fluffy.:r)
+!CHECK: error: The type of 'r' is incompatible with the reduction operator.
+ do i=1,10
+ end do
+ end subroutine subr
+end module m1
diff --git a/flang/test/Semantics/OpenMP/declare-reduction-functions.f90 b/flang/test/Semantics/OpenMP/declare-reduction-functions.f90
index a2435fca415cd..000d323f522cf 100644
--- a/flang/test/Semantics/OpenMP/declare-reduction-functions.f90
+++ b/flang/test/Semantics/OpenMP/declare-reduction-functions.f90
@@ -166,7 +166,7 @@ function funcBtwothree(x, n)
!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: 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)
@@ -184,5 +184,20 @@ function funcBtwothree(x, n)
res%t2 = res2
res%t3 = res3
end function funcBtwothree
+
+ !! This is checking a special case, where a reduction is declared inside a
+ !! pure function
+
+ pure logical function reduction()
+!CHECK: reduction size=4 offset=0: ObjectEntity funcResult type: LOGICAL(4)
+!CHECK: rr: UserReductionDetails INTEGER(4)
+!CHECK: OtherConstruct scope: size=16 alignment=4 sourceRange=0 bytes
+!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)
+!CHECK: omp_priv size=4 offset=12: ObjectEntity type: INTEGER(4)
+ !$omp declare reduction (rr : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0)
+ reduction = .false.
+ end function reduction
end module mm
diff --git a/flang/test/Semantics/OpenMP/declare-reduction-operator.f90 b/flang/test/Semantics/OpenMP/declare-reduction-operator.f90
new file mode 100644
index 0000000000000..e4ac7023f4629
--- /dev/null
+++ b/flang/test/Semantics/OpenMP/declare-reduction-operator.f90
@@ -0,0 +1,36 @@
+! RUN: %flang_fc1 -fdebug-dump-symbols -fopenmp -fopenmp-version=50 %s | FileCheck %s
+
+module m1
+ interface operator(.fluffy.)
+!CHECK: .fluffy., PUBLIC (Function): Generic DefinedOp procs: my_mul
+ procedure my_mul
+ end interface
+ type t1
+ integer :: val = 1
+ end type
+!$omp declare reduction(.fluffy.:t1:omp_out=omp_out.fluffy.omp_in)
+!CHECK: op.fluffy., PUBLIC: UserReductionDetails TYPE(t1)
+!CHECK: t1, PUBLIC: DerivedType components: val
+!CHECK: OtherConstruct scope: size=16 alignment=4 sourceRange=0 bytes
+!CHECK: omp_in size=4 offset=0: ObjectEntity type: TYPE(t1)
+!CHECK: omp_orig size=4 offset=4: ObjectEntity type: TYPE(t1)
+!CHECK: omp_out size=4 offset=8: ObjectEntity type: TYPE(t1)
+!CHECK: omp_priv size=4 offset=12: ObjectEntity type: 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 my_mul
+
+ subroutine subr(a, r)
+ implicit none
+ type(t1), intent(in), dimension(10) :: a
+ type(t1), intent(out) :: r
+ integer :: i
+ !$omp do parallel reduction(.fluffy.:r)
+ do i=1,10
+ r = r .fluffy. a(i)
+ end do
+ end subroutine subr
+end module m1
diff --git a/flang/test/Semantics/OpenMP/declare-reduction-renamedop.f90 b/flang/test/Semantics/OpenMP/declare-reduction-renamedop.f90
new file mode 100644
index 0000000000000..12e80cbf7b327
--- /dev/null
+++ b/flang/test/Semantics/OpenMP/declare-reduction-renamedop.f90
@@ -0,0 +1,47 @@
+! RUN: %flang_fc1 -fdebug-dump-symbols -fopenmp -fopenmp-version=50 %s | FileCheck %s
+
+!! Test that we can "rename" an operator when using a module's operator.
+module module1
+!CHECK: Module scope: module1 size=0
+ implicit none
+ type :: t1
+ real :: value
+ end type t1
+ interface operator(.mul.)
+ module procedure my_mul
+ end interface operator(.mul.)
+!CHECK: .mul., PUBLIC (Function): Generic DefinedOp procs: my_mul
+!CHECK: my_mul, PUBLIC (Function): Subprogram result:TYPE(t1) r (TYPE(t1) x,TYPE(t1)
+!CHECK: t1, PUBLIC: DerivedType components: value
+contains
+ function my_mul(x, y) result(r)
+ type(t1), intent(in) :: x, y
+ type(t1) :: r
+ r%value = x%value * y%value
+ end function my_mul
+end module module1
+
+program test_omp_reduction
+!CHECK: MainProgram scope: test_omp_reduction
+ use module1, only: t1, operator(.modmul.) => operator(.mul.)
+
+!CHECK: .modmul. (Function): Use from .mul. in module1
+ implicit none
+
+ type(t1) :: result
+ integer :: i
+ !$omp declare reduction (.modmul. : t1 : omp_out = omp_out .modmul. omp_in) initializer(omp_priv = t1(1.0))
+!CHECK: op.modmul.: UserReductionDetails TYPE(t1)
+!CHECK: t1: Use from t1 in module1
+!CHECK: OtherConstruct scope: size=16 alignment=4 sourceRange=0 bytes
+!CHECK: omp_in size=4 offset=0: ObjectEntity type: TYPE(t1)
+!CHECK: omp_orig size=4 offset=4: ObjectEntity type: TYPE(t1)
+!CHECK: omp_out size=4 offset=8: ObjectEntity type: TYPE(t1)
+!CHECK: omp_priv size=4 offset=12: ObjectEntity type: TYPE(t1)
+ result = t1(1.0)
+ !$omp parallel do reduction(.modmul.:result)
+ do i = 1, 10
+ result = result .modmul. t1(real(i))
+ end do
+ !$omp end parallel do
+end program test_omp_reduction
>From 367dee6067e08984d742fa0a2313c75b03eb00e6 Mon Sep 17 00:00:00 2001
From: Mats Petersson <mats.petersson at arm.com>
Date: Fri, 9 May 2025 17:15:08 +0100
Subject: [PATCH 12/21] Fix review comments
---
flang/include/flang/Semantics/semantics.h | 2 +-
flang/lib/Semantics/check-omp-structure.cpp | 2 +-
flang/lib/Semantics/mod-file.cpp | 1 -
flang/lib/Semantics/resolve-names.cpp | 2 +-
4 files changed, 3 insertions(+), 4 deletions(-)
diff --git a/flang/include/flang/Semantics/semantics.h b/flang/include/flang/Semantics/semantics.h
index 460af89daa0cf..3924e6db81eb8 100644
--- a/flang/include/flang/Semantics/semantics.h
+++ b/flang/include/flang/Semantics/semantics.h
@@ -348,7 +348,7 @@ class SemanticsContext {
UnorderedSymbolSet isDefined_;
std::list<ProgramTree> programTrees_;
- // storage for mangled names used in OMP DECLARE REDUCTION.
+ // 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_;
diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index bd1cd36c6f721..a5132ba1f5de7 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -3627,7 +3627,7 @@ void OmpStructureChecker::CheckReductionObjects(
static bool CheckSymbolSupportsType(const Scope &scope,
const parser::CharBlock &name, const DeclTypeSpec &type) {
- if (const auto &symbol{scope.FindSymbol(name)}) {
+ if (const auto *symbol{scope.FindSymbol(name)}) {
if (const auto *reductionDetails{
symbol->detailsIf<UserReductionDetails>()}) {
return reductionDetails->SupportsType(type);
diff --git a/flang/lib/Semantics/mod-file.cpp b/flang/lib/Semantics/mod-file.cpp
index dbd55a61f510f..2e27716db5c62 100644
--- a/flang/lib/Semantics/mod-file.cpp
+++ b/flang/lib/Semantics/mod-file.cpp
@@ -8,7 +8,6 @@
#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"
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 06e2b54818c51..38cc9ae096835 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -1891,7 +1891,7 @@ void OmpVisitor::ProcessReductionSpecifier(
reductionDetails = symbol->detailsIf<UserReductionDetails>();
if (!reductionDetails) {
- context().Say(name->source,
+ context().Say(
"Duplicate definition of '%s' in DECLARE REDUCTION"_err_en_US,
name->source);
return;
>From e973f03561c84b89e1309db3f4ab6981e584adeb Mon Sep 17 00:00:00 2001
From: Tom Eccles <tom.eccles at arm.com>
Date: Mon, 19 May 2025 17:11:05 +0000
Subject: [PATCH 13/21] Fix typo in test
---
flang/test/Semantics/OpenMP/declare-reduction-operator.f90 | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/flang/test/Semantics/OpenMP/declare-reduction-operator.f90 b/flang/test/Semantics/OpenMP/declare-reduction-operator.f90
index e4ac7023f4629..dc12332b80baf 100644
--- a/flang/test/Semantics/OpenMP/declare-reduction-operator.f90
+++ b/flang/test/Semantics/OpenMP/declare-reduction-operator.f90
@@ -28,7 +28,7 @@ subroutine subr(a, r)
type(t1), intent(in), dimension(10) :: a
type(t1), intent(out) :: r
integer :: i
- !$omp do parallel reduction(.fluffy.:r)
+ !$omp parallel do reduction(.fluffy.:r)
do i=1,10
r = r .fluffy. a(i)
end do
>From 3e947ea291807fd6b936403077d16c2c622fa33c Mon Sep 17 00:00:00 2001
From: Tom Eccles <tom.eccles at arm.com>
Date: Mon, 2 Jun 2025 13:19:52 +0000
Subject: [PATCH 14/21] Use braced initialization
---
flang/lib/Semantics/check-omp-structure.cpp | 6 +++---
1 file changed, 3 insertions(+), 3 deletions(-)
diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index a5132ba1f5de7..0c283ea0e0cc2 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -3524,9 +3524,9 @@ bool OmpStructureChecker::CheckReductionOperator(
// User-defined operators are OK if there has been a declared reduction
// for that. We mangle those names to store the user details.
if (const auto *definedOp{std::get_if<parser::DefinedOpName>(&dOpr.u)}) {
- std::string mangled = MangleDefinedOperator(definedOp->v.symbol->name());
- const Scope &scope = definedOp->v.symbol->owner();
- if (const Symbol *symbol = scope.FindSymbol(mangled)) {
+ std::string mangled{MangleDefinedOperator(definedOp->v.symbol->name())};
+ const Scope &scope{definedOp->v.symbol->owner()};
+ if (const Symbol *symbol{scope.FindSymbol(mangled)}) {
if (symbol->detailsIf<UserReductionDetails>()) {
return true;
}
>From f38de57b118b45d8074eaef2daae35990c910941 Mon Sep 17 00:00:00 2001
From: Tom Eccles <tom.eccles at arm.com>
Date: Wed, 4 Jun 2025 14:39:46 +0000
Subject: [PATCH 15/21] Don't create a new parser::Name on the stack
---
flang/lib/Semantics/resolve-names.cpp | 35 +++++++++++++++------------
1 file changed, 19 insertions(+), 16 deletions(-)
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 38cc9ae096835..f0280078a2538 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -1857,26 +1857,29 @@ void OmpVisitor::ProcessReductionSpecifier(
const std::optional<parser::OmpClauseList> &clauses,
const T &wholeOmpConstruct) {
const parser::Name *name{nullptr};
- parser::Name mangledName;
+ parser::CharBlock mangledName;
UserReductionDetails reductionDetailsTemp;
const auto &id{std::get<parser::OmpReductionIdentifier>(spec.t)};
- if (auto procDes{std::get_if<parser::ProcedureDesignator>(&id.u)}) {
+ if (auto *procDes{std::get_if<parser::ProcedureDesignator>(&id.u)}) {
name = std::get_if<parser::Name>(&procDes->u);
- if (name) {
- mangledName.source = MangleSpecialFunctions(name->source);
- }
-
+ // This shouldn't be a procedure component: this is the name of the
+ // reduction being declared.
+ assert(name && "ProcedureDesignator contained ProcComponentRef");
+ // Prevent the symbol from conflicting with the builtin function name
+ mangledName = MangleSpecialFunctions(name->source);
+ // Note: the Name inside the parse tree is not updated because it is const.
+ // All lookups must use MangleSpecialFunctions.
} else {
const auto &defOp{std::get<parser::DefinedOperator>(id.u)};
- if (const auto definedOp{std::get_if<parser::DefinedOpName>(&defOp.u)}) {
+ if (const auto *definedOp{std::get_if<parser::DefinedOpName>(&defOp.u)}) {
name = &definedOp->v;
- mangledName.source = parser::CharBlock{context().StoreUserReductionName(
- MangleDefinedOperator(definedOp->v.source))};
+ // TODO: StoreReductionName
+ mangledName = parser::CharBlock{context().StoreUserReductionName(
+ MangleDefinedOperator(name->source))};
} else {
- mangledName.source = MakeNameFromOperator(
+ mangledName = MakeNameFromOperator(
std::get<parser::DefinedOperator::IntrinsicOperator>(defOp.u),
context());
- name = &mangledName;
}
}
@@ -1884,7 +1887,7 @@ void OmpVisitor::ProcessReductionSpecifier(
// 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)};
+ Symbol *symbol{currScope().FindSymbol(mangledName)};
if (symbol) {
// If we found a symbol, we append the type info to the
// existing reductionDetails.
@@ -1893,7 +1896,7 @@ void OmpVisitor::ProcessReductionSpecifier(
if (!reductionDetails) {
context().Say(
"Duplicate definition of '%s' in DECLARE REDUCTION"_err_en_US,
- name->source);
+ mangledName);
return;
}
}
@@ -1943,10 +1946,10 @@ void OmpVisitor::ProcessReductionSpecifier(
reductionDetails->AddDecl(&wholeOmpConstruct);
+ if (!symbol) {
+ symbol = &MakeSymbol(mangledName, Attrs{}, std::move(*reductionDetails));
+ }
if (name) {
- if (!symbol) {
- symbol = &MakeSymbol(mangledName, Attrs{}, std::move(*reductionDetails));
- }
name->symbol = symbol;
}
}
>From 70462ee01cdf4f50c60bc6f753fdacc1ecf31478 Mon Sep 17 00:00:00 2001
From: Tom Eccles <tom.eccles at arm.com>
Date: Wed, 4 Jun 2025 14:50:48 +0000
Subject: [PATCH 16/21] Remove StoreUserReductionName
---
flang/include/flang/Semantics/semantics.h | 9 ---------
flang/lib/Semantics/resolve-names.cpp | 4 +---
flang/lib/Semantics/semantics.cpp | 6 ------
3 files changed, 1 insertion(+), 18 deletions(-)
diff --git a/flang/include/flang/Semantics/semantics.h b/flang/include/flang/Semantics/semantics.h
index 3924e6db81eb8..730513dbe3232 100644
--- a/flang/include/flang/Semantics/semantics.h
+++ b/flang/include/flang/Semantics/semantics.h
@@ -290,10 +290,6 @@ 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;
@@ -347,11 +343,6 @@ 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/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index f0280078a2538..20d0ef0c0e9df 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -1873,9 +1873,7 @@ void OmpVisitor::ProcessReductionSpecifier(
const auto &defOp{std::get<parser::DefinedOperator>(id.u)};
if (const auto *definedOp{std::get_if<parser::DefinedOpName>(&defOp.u)}) {
name = &definedOp->v;
- // TODO: StoreReductionName
- mangledName = parser::CharBlock{context().StoreUserReductionName(
- MangleDefinedOperator(name->source))};
+ mangledName = context().SaveTempName(MangleDefinedOperator(name->source));
} else {
mangledName = MakeNameFromOperator(
std::get<parser::DefinedOperator::IntrinsicOperator>(defOp.u),
diff --git a/flang/lib/Semantics/semantics.cpp b/flang/lib/Semantics/semantics.cpp
index bccccba86346d..e07054f8ec564 100644
--- a/flang/lib/Semantics/semantics.cpp
+++ b/flang/lib/Semantics/semantics.cpp
@@ -772,10 +772,4 @@ 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
>From d147b154f82d6a39b2df72b9b1efebef5bf2fb0e Mon Sep 17 00:00:00 2001
From: Tom Eccles <tom.eccles at arm.com>
Date: Wed, 4 Jun 2025 15:49:52 +0000
Subject: [PATCH 17/21] Clang format
---
flang/lib/Semantics/check-omp-structure.cpp | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index 0c283ea0e0cc2..47c70788d097c 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -3526,7 +3526,7 @@ bool OmpStructureChecker::CheckReductionOperator(
if (const auto *definedOp{std::get_if<parser::DefinedOpName>(&dOpr.u)}) {
std::string mangled{MangleDefinedOperator(definedOp->v.symbol->name())};
const Scope &scope{definedOp->v.symbol->owner()};
- if (const Symbol *symbol{scope.FindSymbol(mangled)}) {
+ if (const Symbol * symbol{scope.FindSymbol(mangled)}) {
if (symbol->detailsIf<UserReductionDetails>()) {
return true;
}
>From 672edfa99c155aa8068320794cc24bbbfb0ef328 Mon Sep 17 00:00:00 2001
From: Tom Eccles <tom.eccles at arm.com>
Date: Wed, 4 Jun 2025 15:51:18 +0000
Subject: [PATCH 18/21] Use emplace_back for non-trivial vector element type
---
flang/include/flang/Semantics/symbol.h | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/flang/include/flang/Semantics/symbol.h b/flang/include/flang/Semantics/symbol.h
index 0b73cc504023e..4f58bdecc37cc 100644
--- a/flang/include/flang/Semantics/symbol.h
+++ b/flang/include/flang/Semantics/symbol.h
@@ -756,7 +756,7 @@ class UserReductionDetails {
return false;
}
- void AddDecl(const DeclInfo &decl) { declList_.push_back(decl); }
+ void AddDecl(const DeclInfo &decl) { declList_.emplace_back(decl); }
const DeclVector &GetDeclList() const { return declList_; }
private:
>From 546add02775ff453543cc2fc6eccc5a3b75e5a4a Mon Sep 17 00:00:00 2001
From: Tom Eccles <tom.eccles at arm.com>
Date: Wed, 4 Jun 2025 15:58:08 +0000
Subject: [PATCH 19/21] Change error to unreachable
---
flang/lib/Semantics/check-omp-structure.cpp | 3 ++-
1 file changed, 2 insertions(+), 1 deletion(-)
diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index 47c70788d097c..3af5195743b69 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -3685,7 +3685,8 @@ static bool IsReductionAllowedForType(
return CheckSymbolSupportsType(
scope, MangleDefinedOperator(definedOp->v.symbol->name()), type);
}
- DIE("Intrinsic Operator not found - parsing gone wrong?");
+ llvm_unreachable(
+ "A DefinedOperator is either a DefinedOpName or an IntrinsicOperator");
}};
auto checkDesignator{[&](const parser::ProcedureDesignator &procD) {
>From d364848f5874f5c2db37f6849f8f859c38d5f053 Mon Sep 17 00:00:00 2001
From: Tom Eccles <tom.eccles at arm.com>
Date: Wed, 4 Jun 2025 16:49:02 +0000
Subject: [PATCH 20/21] Manual clang-format
---
flang/lib/Semantics/check-omp-structure.cpp | 2 +-
flang/lib/Semantics/resolve-names.cpp | 2 +-
2 files changed, 2 insertions(+), 2 deletions(-)
diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index 3af5195743b69..bdd078c33da92 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -3526,7 +3526,7 @@ bool OmpStructureChecker::CheckReductionOperator(
if (const auto *definedOp{std::get_if<parser::DefinedOpName>(&dOpr.u)}) {
std::string mangled{MangleDefinedOperator(definedOp->v.symbol->name())};
const Scope &scope{definedOp->v.symbol->owner()};
- if (const Symbol * symbol{scope.FindSymbol(mangled)}) {
+ if (const Symbol *symbol{scope.FindSymbol(mangled)}) {
if (symbol->detailsIf<UserReductionDetails>()) {
return true;
}
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 20d0ef0c0e9df..ec45561e1c238 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -1927,7 +1927,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()}) {
+ if (const DeclTypeSpec *typeSpec{GetDeclTypeSpec()}) {
reductionDetails->AddType(*typeSpec);
for (auto &nm : ompVarNames) {
>From d12203c6502f988be21d77f28c70a044781dacdf Mon Sep 17 00:00:00 2001
From: Tom Eccles <tom.eccles at arm.com>
Date: Thu, 5 Jun 2025 11:21:03 +0000
Subject: [PATCH 21/21] Fix tests
I had to rebase to reproduce the test failure
---
flang/test/Semantics/OpenMP/declare-reduction-mangled.f90 | 4 ++--
flang/test/Semantics/OpenMP/declare-reduction-operators.f90 | 4 ++--
2 files changed, 4 insertions(+), 4 deletions(-)
diff --git a/flang/test/Semantics/OpenMP/declare-reduction-mangled.f90 b/flang/test/Semantics/OpenMP/declare-reduction-mangled.f90
index f1675b6f251e0..9d0a097fb1991 100644
--- a/flang/test/Semantics/OpenMP/declare-reduction-mangled.f90
+++ b/flang/test/Semantics/OpenMP/declare-reduction-mangled.f90
@@ -34,7 +34,7 @@ program omp_examples
big%r = 0
!$omp parallel do reduction(max:big)
-!CHECK: big (OmpReduction): HostAssoc
+!CHECK: big (OmpReduction, OmpExplicit): HostAssoc
!CHECK: max, INTRINSIC: ProcEntity
do i = 1, n
big = mymax(values(i), big)
@@ -42,7 +42,7 @@ program omp_examples
small%r = 1
!$omp parallel do reduction(min:small)
-!CHECK: small (OmpReduction): HostAssoc
+!CHECK: small (OmpReduction, OmpExplicit): HostAssoc
do i = 1, n
small%r = min(values(i)%r, small%r)
end do
diff --git a/flang/test/Semantics/OpenMP/declare-reduction-operators.f90 b/flang/test/Semantics/OpenMP/declare-reduction-operators.f90
index 73fa1a1fea2c5..d7a9f2fc0a36b 100644
--- a/flang/test/Semantics/OpenMP/declare-reduction-operators.f90
+++ b/flang/test/Semantics/OpenMP/declare-reduction-operators.f90
@@ -73,8 +73,8 @@ program test_vector
!$OMP parallel do reduction(+:v2)
!CHECK: OtherConstruct scope
!CHECK: i (OmpPrivate, OmpPreDetermined): HostAssoc
-!CHECK: v1: HostAssoc
-!CHECK: v2 (OmpReduction): HostAssoc
+!CHECK: v1 (OmpShared): HostAssoc
+!CHECK: v2 (OmpReduction, OmpExplicit): HostAssoc
do i = 1, 100
v2(i) = v2(i) + v1(i) ! Invokes add_vectors
More information about the flang-commits
mailing list