diff options
author | Peter Klausler <pklausler@nvidia.com> | 2022-07-08 14:35:42 -0700 |
---|---|---|
committer | Peter Klausler <pklausler@nvidia.com> | 2022-07-13 16:36:25 -0700 |
commit | 0406c0cda675f3cb7d294a3e65eb4f19c9efe98b (patch) | |
tree | 6f319abf0fa8d5953c3d3e0747b18f577d8ab3c5 | |
parent | e690137dde1c9b037e0c987d393da054d86eeeab (diff) | |
download | llvm-0406c0cda675f3cb7d294a3e65eb4f19c9efe98b.zip llvm-0406c0cda675f3cb7d294a3e65eb4f19c9efe98b.tar.gz llvm-0406c0cda675f3cb7d294a3e65eb4f19c9efe98b.tar.bz2 |
[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
-rw-r--r-- | flang/lib/Semantics/resolve-names.cpp | 74 | ||||
-rw-r--r-- | flang/test/Semantics/null-init.f90 | 5 |
2 files changed, 43 insertions, 36 deletions
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp index 7384dd4..a859073 100644 --- a/flang/lib/Semantics/resolve-names.cpp +++ b/flang/lib/Semantics/resolve-names.cpp @@ -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( diff --git a/flang/test/Semantics/null-init.f90 b/flang/test/Semantics/null-init.f90 index 53c1b0f..234dd4b 100644 --- a/flang/test/Semantics/null-init.f90 +++ b/flang/test/Semantics/null-init.f90 @@ -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 |