[flang-commits] [flang] 6052025 - [flang] Add IsElementalProcedure() predicate
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Wed Jul 6 18:08:56 PDT 2022
Author: Peter Klausler
Date: 2022-07-06T18:08:45-07:00
New Revision: 6052025b5813231505e0a656f13e6e04973a485e
URL: https://github.com/llvm/llvm-project/commit/6052025b5813231505e0a656f13e6e04973a485e
DIFF: https://github.com/llvm/llvm-project/commit/6052025b5813231505e0a656f13e6e04973a485e.diff
LOG: [flang] Add IsElementalProcedure() predicate
Replace most tests of the explicit Attr::ELEMENTAL symbol flag with
a new predicate IsElementalProcedure() that works correctly for alternate
ENTRY points and does the right thing for procedure interfaces that
reference elemental intrinsic functions like SIN() whose elemental
nature does not propagate.
Differential Revision: https://reviews.llvm.org/D129022
Added:
Modified:
flang/include/flang/Evaluate/tools.h
flang/lib/Evaluate/call.cpp
flang/lib/Evaluate/tools.cpp
flang/lib/Semantics/check-declarations.cpp
flang/lib/Semantics/check-omp-structure.cpp
flang/lib/Semantics/symbol.cpp
Removed:
################################################################################
diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h
index b8908555f8e87..f3aaf59fd136b 100644
--- a/flang/include/flang/Evaluate/tools.h
+++ b/flang/include/flang/Evaluate/tools.h
@@ -1106,6 +1106,7 @@ const Symbol *GetMainEntry(const Symbol *);
bool IsVariableName(const Symbol &);
bool IsPureProcedure(const Symbol &);
bool IsPureProcedure(const Scope &);
+bool IsElementalProcedure(const Symbol &);
bool IsFunction(const Symbol &);
bool IsFunction(const Scope &);
bool IsProcedure(const Symbol &);
diff --git a/flang/lib/Evaluate/call.cpp b/flang/lib/Evaluate/call.cpp
index 39ca949b066f0..6b008cfbd0b1a 100644
--- a/flang/lib/Evaluate/call.cpp
+++ b/flang/lib/Evaluate/call.cpp
@@ -133,9 +133,9 @@ const Symbol *ProcedureDesignator::GetInterfaceSymbol() const {
bool ProcedureDesignator::IsElemental() const {
if (const Symbol * interface{GetInterfaceSymbol()}) {
- return interface->attrs().test(semantics::Attr::ELEMENTAL);
+ return IsElementalProcedure(*interface);
} else if (const Symbol * symbol{GetSymbol()}) {
- return symbol->attrs().test(semantics::Attr::ELEMENTAL);
+ return IsElementalProcedure(*symbol);
} else if (const auto *intrinsic{std::get_if<SpecificIntrinsic>(&u)}) {
return intrinsic->characteristics.value().attrs.test(
characteristics::Procedure::Attr::Elemental);
diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp
index 831c47022e788..b04bf21164ad0 100644
--- a/flang/lib/Evaluate/tools.cpp
+++ b/flang/lib/Evaluate/tools.cpp
@@ -1213,7 +1213,7 @@ bool IsPureProcedure(const Symbol &original) {
const Symbol &symbol{DEREF(GetMainEntry(&original.GetUltimate()))};
if (const auto *procDetails{symbol.detailsIf<ProcEntityDetails>()}) {
if (const Symbol * procInterface{procDetails->interface().symbol()}) {
- // procedure component with a pure interface
+ // procedure with a pure interface
return IsPureProcedure(*procInterface);
}
} else if (const auto *details{symbol.detailsIf<ProcBindingDetails>()}) {
@@ -1246,6 +1246,24 @@ bool IsPureProcedure(const Scope &scope) {
return symbol && IsPureProcedure(*symbol);
}
+bool IsElementalProcedure(const Symbol &original) {
+ // An ENTRY is elemental if its containing subprogram is
+ const Symbol &symbol{DEREF(GetMainEntry(&original.GetUltimate()))};
+ if (const auto *procDetails{symbol.detailsIf<ProcEntityDetails>()}) {
+ if (const Symbol * procInterface{procDetails->interface().symbol()}) {
+ // procedure with an elemental interface, ignoring the elemental
+ // aspect of intrinsic functions
+ return !procInterface->attrs().test(Attr::INTRINSIC) &&
+ IsElementalProcedure(*procInterface);
+ }
+ } else if (const auto *details{symbol.detailsIf<ProcBindingDetails>()}) {
+ return IsElementalProcedure(details->symbol());
+ } else if (!IsProcedure(symbol)) {
+ return false;
+ }
+ return symbol.attrs().test(Attr::ELEMENTAL);
+}
+
bool IsFunction(const Symbol &symbol) {
const Symbol &ultimate{symbol.GetUltimate()};
return ultimate.test(Symbol::Flag::Function) ||
diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index 582892f8497b0..1e2e846a14b74 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -91,7 +91,7 @@ class CheckHelper {
return innermostSymbol_ && IsPureProcedure(*innermostSymbol_);
}
bool InElemental() const {
- return innermostSymbol_ && innermostSymbol_->attrs().test(Attr::ELEMENTAL);
+ return innermostSymbol_ && IsElementalProcedure(*innermostSymbol_);
}
bool InFunction() const {
return innermostSymbol_ && IsFunction(*innermostSymbol_);
@@ -319,13 +319,12 @@ void CheckHelper::Check(const Symbol &symbol) {
messages_.Say(
"An assumed-length CHARACTER(*) function cannot return an array"_err_en_US);
}
- if (symbol.attrs().test(Attr::PURE)) {
- messages_.Say(
- "An assumed-length CHARACTER(*) function cannot be PURE"_err_en_US);
- }
- if (symbol.attrs().test(Attr::ELEMENTAL)) {
+ if (IsElementalProcedure(symbol)) {
messages_.Say(
"An assumed-length CHARACTER(*) function cannot be ELEMENTAL"_err_en_US);
+ } else if (IsPureProcedure(symbol)) {
+ messages_.Say(
+ "An assumed-length CHARACTER(*) function cannot be PURE"_err_en_US);
}
if (const Symbol * result{FindFunctionResult(symbol)}) {
if (IsPointer(*result)) {
@@ -670,7 +669,7 @@ void CheckHelper::CheckPointerInitialization(const Symbol &symbol) {
context_.Say("Procedure pointer '%s' initializer '%s' is neither "
"an external nor a module procedure"_err_en_US,
symbol.name(), ultimate.name());
- } else if (ultimate.attrs().test(Attr::ELEMENTAL)) {
+ } else if (IsElementalProcedure(ultimate)) {
context_.Say("Procedure pointer '%s' cannot be initialized with the "
"elemental procedure '%s"_err_en_US,
symbol.name(), ultimate.name());
@@ -779,9 +778,9 @@ void CheckHelper::CheckProcEntity(
}
const Symbol *interface { details.interface().symbol() };
if (!symbol.attrs().test(Attr::INTRINSIC) &&
- (symbol.attrs().test(Attr::ELEMENTAL) ||
+ (IsElementalProcedure(symbol) ||
(interface && !interface->attrs().test(Attr::INTRINSIC) &&
- interface->attrs().test(Attr::ELEMENTAL)))) {
+ IsElementalProcedure(*interface)))) {
// There's no explicit constraint or "shall" that we can find in the
// standard for this check, but it seems to be implied in multiple
// sites, and ELEMENTAL non-intrinsic actual arguments *are*
@@ -821,7 +820,7 @@ void CheckHelper::CheckProcEntity(
"to procedure pointer '%s'"_err_en_US,
interface->name(), symbol.name());
}
- } else if (interface->attrs().test(Attr::ELEMENTAL)) {
+ } else if (IsElementalProcedure(*interface)) {
messages_.Say("Procedure pointer '%s' may not be ELEMENTAL"_err_en_US,
symbol.name()); // C1517
}
@@ -931,7 +930,7 @@ void CheckHelper::CheckSubprogram(
}
}
}
- if (symbol.attrs().test(Attr::ELEMENTAL)) {
+ if (IsElementalProcedure(symbol)) {
// See comment on the similar check in CheckProcEntity()
if (details.isDummy()) {
messages_.Say("A dummy procedure may not be ELEMENTAL"_err_en_US);
@@ -1661,8 +1660,8 @@ void CheckHelper::CheckProcBinding(
"An overridden pure type-bound procedure binding must also be pure"_err_en_US);
return;
}
- if (!binding.symbol().attrs().test(Attr::ELEMENTAL) &&
- overriddenBinding->symbol().attrs().test(Attr::ELEMENTAL)) {
+ if (!IsElementalProcedure(binding.symbol()) &&
+ IsElementalProcedure(overriddenBinding->symbol())) {
SayWithDeclaration(*overridden,
"A type-bound procedure and its override must both, or neither, be ELEMENTAL"_err_en_US);
return;
diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index ef68f77059b3c..6dc97eaddb952 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -68,9 +68,7 @@ class OmpWorkshareBlockChecker {
if (const auto *e{GetExpr(context_, expr)}) {
for (const Symbol &symbol : evaluate::CollectSymbols(*e)) {
const Symbol &root{GetAssociationRoot(symbol)};
- if (IsFunction(root) &&
- !(root.attrs().test(Attr::ELEMENTAL) ||
- root.attrs().test(Attr::INTRINSIC))) {
+ if (IsFunction(root) && !IsElementalProcedure(root)) {
context_.Say(expr.source,
"User defined non-ELEMENTAL function "
"'%s' is not allowed in a WORKSHARE construct"_err_en_US,
diff --git a/flang/lib/Semantics/symbol.cpp b/flang/lib/Semantics/symbol.cpp
index d3b1197420128..904057e8a9c44 100644
--- a/flang/lib/Semantics/symbol.cpp
+++ b/flang/lib/Semantics/symbol.cpp
@@ -641,7 +641,7 @@ const Symbol *DerivedTypeDetails::GetFinalForRank(int rank) const {
if (const Symbol * arg{details->dummyArgs().at(0)}) {
if (const auto *object{arg->detailsIf<ObjectEntityDetails>()}) {
if (rank == object->shape().Rank() || object->IsAssumedRank() ||
- symbol.attrs().test(Attr::ELEMENTAL)) {
+ IsElementalProcedure(symbol)) {
return &symbol;
}
}
More information about the flang-commits
mailing list