Welcome to mirror list, hosted at ThFree Co, Russian Federation.

github.com/llvm/llvm-project.git - Unnamed repository; edit this file 'description' to name the repository.
summaryrefslogtreecommitdiff
path: root/flang
diff options
context:
space:
mode:
authorPeter Klausler <pklausler@nvidia.com>2022-07-09 00:35:42 +0300
committerPeter Klausler <pklausler@nvidia.com>2022-07-14 02:36:25 +0300
commit0406c0cda675f3cb7d294a3e65eb4f19c9efe98b (patch)
tree6f319abf0fa8d5953c3d3e0747b18f577d8ab3c5 /flang
parente690137dde1c9b037e0c987d393da054d86eeeab (diff)
[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
Diffstat (limited to 'flang')
-rw-r--r--flang/lib/Semantics/resolve-names.cpp74
-rw-r--r--flang/test/Semantics/null-init.f905
2 files changed, 43 insertions, 36 deletions
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 7384dd476b99..a859073b4515 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 53c1b0f95f54..234dd4bdcbe4 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