Skip to content

Commit

Permalink
[flang] Add IsElementalProcedure() predicate
Browse files Browse the repository at this point in the history 
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
  • Loading branch information
@klausler
klausler committed Jul 7, 2022
1 parent c0db2b7 commit 6052025
Show file tree
Hide file tree
Showing 6 changed files with 36 additions and 20 deletions.
1 change: 1 addition & 0 deletions flang/include/flang/Evaluate/tools.h
View file
Expand Up @@ -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 &);
Expand Down
4 changes: 2 additions & 2 deletions flang/lib/Evaluate/call.cpp
View file
Expand Up @@ -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);
Expand Down
20 changes: 19 additions & 1 deletion flang/lib/Evaluate/tools.cpp
View file
Expand Up @@ -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>()}) {
Expand Down Expand Up @@ -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) ||
Expand Down
25 changes: 12 additions & 13 deletions flang/lib/Semantics/check-declarations.cpp
View file
Expand Up @@ -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_);
Expand Down Expand Up @@ -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)) {
Expand Down Expand Up @@ -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());
Expand Down Expand Up @@ -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*
Expand Down Expand Up @@ -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
}
Expand Down Expand Up @@ -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);
Expand Down Expand Up @@ -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;
Expand Down
4 changes: 1 addition & 3 deletions flang/lib/Semantics/check-omp-structure.cpp
View file
Expand Up @@ -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,
Expand Down
2 changes: 1 addition & 1 deletion flang/lib/Semantics/symbol.cpp
View file
Expand Up @@ -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;
}
}
Expand Down

0 comments on commit 6052025

Please sign in to comment.