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

[flang] Catch procedure pointer interface error 

A procedure pointer is allowed to name a specific intrinsic function
from F'2018 table 16.2 as its interface, but not other intrinsic
procedures.  Catch this error, and thereby also fix a crash resulting
from a failure later in compilation from failed characteristics;
while here, also catch the similar error with initializers.

Differential Revision: https://reviews.llvm.org/D103570
This commit is contained in:
peter klausler 2021-06-02 17:09:42 -07:00
parent da3ed58b97
commit f8f7002828
2 changed files with 21 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
flang/lib/Evaluate/characteristics.cpp
View File

@ -367,7 +367,7 @@ static std::optional<Procedure> CharacterizeProcedure(
const semantics::Symbol &original, FoldingContext &context,
semantics::UnorderedSymbolSet &seenProcs) {
Procedure result;
const auto &symbol{original.GetUltimate()};
const auto &symbol{ResolveAssociations(original)};
if (seenProcs.find(symbol) != seenProcs.end()) {
std::string procsList{GetSeenProcs(seenProcs)};
context.messages().Say(symbol.name(),
@ -417,6 +417,11 @@ static std::optional<Procedure> CharacterizeProcedure(
[&](const semantics::ProcEntityDetails &proc)
-> std::optional<Procedure> {
if (symbol.attrs().test(semantics::Attr::INTRINSIC)) {
// Fails when the intrinsic is not a specific intrinsic function
// from F'2018 table 16.2. In order to handle forward references,
// attempts to use impermissible intrinsic procedures as the
// interfaces of procedure pointers are caught and flagged in
// declaration checking in Semantics.
return context.intrinsics().IsSpecificIntrinsicFunction(
symbol.name().ToString());
}
@ -786,7 +791,7 @@ std::optional<Procedure> Procedure::Characterize(
const ProcedureDesignator &proc, FoldingContext &context) {
if (const auto *symbol{proc.GetSymbol()}) {
if (auto result{characteristics::Procedure::Characterize(
symbol->GetUltimate(), context)}) {
ResolveAssociations(*symbol), context)}) {
return result;
}
} else if (const auto *intrinsic{proc.GetSpecificIntrinsic()}) {

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

@ -575,6 +575,12 @@ void CheckHelper::CheckPointerInitialization(const Symbol &symbol) {
// or an unrestricted specific intrinsic function.
const Symbol &ultimate{(*proc->init())->GetUltimate()};
if (ultimate.attrs().test(Attr::INTRINSIC)) {
if (!context_.intrinsics().IsSpecificIntrinsicFunction(
ultimate.name().ToString())) { // C1030
context_.Say(
"Intrinsic procedure '%s' is not a specific intrinsic permitted for use as the initializer for procedure pointer '%s'"_err_en_US,
ultimate.name(), symbol.name());
}
} else if (!ultimate.attrs().test(Attr::EXTERNAL) &&
ultimate.owner().kind() != Scope::Kind::Module) {
context_.Say("Procedure pointer '%s' initializer '%s' is neither "
@ -715,8 +721,14 @@ void CheckHelper::CheckProcEntity(
if (symbol.attrs().test(Attr::POINTER)) {
CheckPointerInitialization(symbol);
if (const Symbol * interface{details.interface().symbol()}) {
if (interface->attrs().test(Attr::ELEMENTAL) &&
!interface->attrs().test(Attr::INTRINSIC)) {
if (interface->attrs().test(Attr::INTRINSIC)) {
if (!context_.intrinsics().IsSpecificIntrinsicFunction(
interface->name().ToString())) { // C1515
messages_.Say(
"Intrinsic procedure '%s' is not a specific intrinsic permitted for use as the definition of the interface to procedure pointer '%s'"_err_en_US,
interface->name(), symbol.name());
}
} else if (interface->attrs().test(Attr::ELEMENTAL)) {
messages_.Say("Procedure pointer '%s' may not be ELEMENTAL"_err_en_US,
symbol.name()); // C1517
}