maxjhandsome
/
llvm-project
forked from OSchip/llvm-project
1
0
Fork 0
Code Issues Pull Requests Packages Releases Wiki Activity

[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
This commit is contained in:
Peter Klausler 2022-06-30 15:27:28 -07:00
parent c0db2b75ac
commit 6052025b58
6 changed files with 36 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
flang/include/flang/Evaluate/tools.h
View File

@ -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 &);

4
flang/lib/Evaluate/call.cpp
View File

@ -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);

20
flang/lib/Evaluate/tools.cpp
View File

@ -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) ||

25
flang/lib/Semantics/check-declarations.cpp
View File

@ -91,7 +91,7 @@ private:
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;

4
flang/lib/Semantics/check-omp-structure.cpp
View File

@ -68,9 +68,7 @@ public:
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,

2
flang/lib/Semantics/symbol.cpp
View File

@ -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;
}
}