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

[Peter Klausler via flang-commits]

Author: Peter Klausler
Date: 2022-07-13T16:36:25-07:00
New Revision: 0406c0cda675f3cb7d294a3e65eb4f19c9efe98b

URL: https://github.com/llvm/llvm-project/commit/0406c0cda675f3cb7d294a3e65eb4f19c9efe98b
DIFF: https://github.com/llvm/llvm-project/commit/0406c0cda675f3cb7d294a3e65eb4f19c9efe98b.diff

LOG: [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

Added: 
    

Modified: 
    flang/lib/Semantics/resolve-names.cpp
    flang/test/Semantics/null-init.f90

Removed: 
    


################################################################################
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