[flang] Ensure name resolution visits "=>NULL()" in entity-decl

Most modern Fortran programs declare procedure pointers with a
procedure-declaration-stmt, but it's also possible to declare one
with a type-declaration-stmt with a POINTER attribute.  In this
case, e.g. "real, external, pointer :: p => null()" the initializer
is required to be a null-init.  The parse tree traversal in name
resolution would visit the null-init if the symbol were an object
pointer only, leading to a crash in the case of a procedure pointer.

That explanation of the bug is longer than the fix.  In short,
ensure that a null-init in an entity-decl is visited for both
species of pointers.

Differential Revision: https://reviews.llvm.org/D129676
This commit is contained in:
Peter Klausler 2022-07-08 14:35:42 -07:00
parent e690137dde
commit 0406c0cda6
2 changed files with 43 additions and 36 deletions

View File

@ -3885,9 +3885,8 @@ void DeclarationVisitor::Post(const parser::EntityDecl &x) {
Symbol &symbol{DeclareUnknownEntity(name, attrs)};
symbol.ReplaceName(name.source);
if (const auto &init{std::get<std::optional<parser::Initialization>>(x.t)}) {
if (ConvertToObjectEntity(symbol)) {
Initialization(name, *init, false);
}
ConvertToObjectEntity(symbol) || ConvertToProcEntity(symbol);
Initialization(name, *init, false);
} else if (attrs.test(Attr::PARAMETER)) { // C882, C883
Say(name, "Missing initialization for parameter '%s'"_err_en_US);
}
@ -6684,42 +6683,45 @@ void DeclarationVisitor::Initialization(const parser::Name &name,
Say(name, "Allocatable object '%s' cannot be initialized"_err_en_US);
return;
}
if (auto *object{ultimate.detailsIf<ObjectEntityDetails>()}) {
// TODO: check C762 - all bounds and type parameters of component
// are colons or constant expressions if component is initialized
common::visit(
common::visitors{
[&](const parser::ConstantExpr &expr) {
NonPointerInitialization(name, expr);
},
[&](const parser::NullInit &null) {
Walk(null);
if (auto nullInit{EvaluateExpr(null)}) {
if (!evaluate::IsNullPointer(*nullInit)) {
Say(name,
"Pointer initializer must be intrinsic NULL()"_err_en_US); // C813
} else if (IsPointer(ultimate)) {
// TODO: check C762 - all bounds and type parameters of component
// are colons or constant expressions if component is initialized
common::visit(
common::visitors{
[&](const parser::ConstantExpr &expr) {
NonPointerInitialization(name, expr);
},
[&](const parser::NullInit &null) { // => NULL()
Walk(null);
if (auto nullInit{EvaluateExpr(null)}) {
if (!evaluate::IsNullPointer(*nullInit)) {
Say(name,
"Pointer initializer must be intrinsic NULL()"_err_en_US); // C813
} else if (IsPointer(ultimate)) {
if (auto *object{ultimate.detailsIf<ObjectEntityDetails>()}) {
object->set_init(std::move(*nullInit));
} else {
Say(name,
"Non-pointer component '%s' initialized with null pointer"_err_en_US);
} else if (auto *procPtr{
ultimate.detailsIf<ProcEntityDetails>()}) {
procPtr->set_init(nullptr);
}
} else {
Say(name,
"Non-pointer component '%s' initialized with null pointer"_err_en_US);
}
},
[&](const parser::InitialDataTarget &) {
// Defer analysis to the end of the specification part
// so that forward references and attribute checks like SAVE
// work better.
ultimate.set(Symbol::Flag::InDataStmt);
},
[&](const std::list<Indirection<parser::DataStmtValue>> &values) {
// Handled later in data-to-inits conversion
ultimate.set(Symbol::Flag::InDataStmt);
Walk(values);
},
},
init.u);
}
}
},
[&](const parser::InitialDataTarget &) {
// Defer analysis to the end of the specification part
// so that forward references and attribute checks like SAVE
// work better.
ultimate.set(Symbol::Flag::InDataStmt);
},
[&](const std::list<Indirection<parser::DataStmtValue>> &values) {
// Handled later in data-to-inits conversion
ultimate.set(Symbol::Flag::InDataStmt);
Walk(values);
},
},
init.u);
}
void DeclarationVisitor::PointerInitialization(

View File

@ -95,3 +95,8 @@ subroutine m12
integer, pointer :: p
data p/null(j)/ ! ok
end subroutine
subroutine s13
integer, external, pointer :: p1 => null()
procedure(), pointer :: p2 => null()
end subroutine