[flang] Defer processing of non-pointer variable initializers (#76475)

Initializers in entity-decls don't need to have their expressions
analyzed immediately in name resolution unless of course they are
defining the values of named constants. By deferring the expression
analysis, the compiler can better handle references to module and
internal procedures that might appear in structure constructors; at
present, these are typically rejected as being forward references (which
they can be) to subprogram names that can't yet be checked for
compatibility with the characteristics of the corresponding procedure
component.

Author: klausler

flang/lib/Semantics/resolve-names.cpp

@@ -698,7 +698,7 @@ class ScopeHandler : public ImplicitRulesVisitor {
   bool CheckPossibleBadForwardRef(const Symbol &);
 
   bool inSpecificationPart_{false};
-  bool inDataStmtObject_{false};
+  bool deferImplicitTyping_{false};
   bool inEquivalenceStmt_{false};
 
   // Some information is collected from a specification part for deferred
@@ -1629,6 +1629,7 @@ class ResolveNamesVisitor : public virtual ScopeHandler,
   bool BeginScopeForNode(const ProgramTree &);
   void EndScopeForNode(const ProgramTree &);
   void FinishSpecificationParts(const ProgramTree &);
+  void FinishExecutionParts(const ProgramTree &);
   void FinishDerivedTypeInstantiation(Scope &);
   void ResolveExecutionParts(const ProgramTree &);
   void UseCUDABuiltinNames();
@@ -2533,7 +2534,7 @@ void ScopeHandler::ApplyImplicitRules(
     // or object, it'll be caught later.
     return;
   }
-  if (inDataStmtObject_) {
+  if (deferImplicitTyping_) {
     return;
   }
   if (!context().HasError(symbol)) {
@@ -2709,7 +2710,7 @@ const DeclTypeSpec &ScopeHandler::MakeLogicalType(int kind) {
 }
 
 void ScopeHandler::NotePossibleBadForwardRef(const parser::Name &name) {
-  if (inSpecificationPart_ && !inDataStmtObject_ && name.symbol) {
+  if (inSpecificationPart_ && !deferImplicitTyping_ && name.symbol) {
     auto kind{currScope().kind()};
     if ((kind == Scope::Kind::Subprogram && !currScope().IsStmtFunction()) ||
         kind == Scope::Kind::BlockConstruct) {
@@ -6802,7 +6803,8 @@ bool ConstructVisitor::Pre(const parser::DataStmtObject &x) {
   auto flagRestorer{common::ScopedSet(inSpecificationPart_, false)};
   common::visit(common::visitors{
                     [&](const Indirection<parser::Variable> &y) {
-                      auto restorer{common::ScopedSet(inDataStmtObject_, true)};
+                      auto restorer{
+                          common::ScopedSet(deferImplicitTyping_, true)};
                       Walk(y.value());
                       const parser::Name &first{
                           parser::GetFirstName(y.value())};
@@ -7386,7 +7388,7 @@ const parser::Name *DeclarationVisitor::ResolveName(const parser::Name &name) {
     }
     return &name;
   }
-  if (isImplicitNoneType() && !inDataStmtObject_) {
+  if (isImplicitNoneType() && !deferImplicitTyping_) {
     Say(name, "No explicit type declared for '%s'"_err_en_US);
     return nullptr;
   }
@@ -7548,7 +7550,15 @@ void DeclarationVisitor::Initialization(const parser::Name &name,
   common::visit(
       common::visitors{
           [&](const parser::ConstantExpr &expr) {
-            NonPointerInitialization(name, expr);
+            Walk(expr);
+            if (IsNamedConstant(ultimate) || inComponentDecl) {
+              NonPointerInitialization(name, expr);
+            } else {
+              // Defer analysis so forward references to nested subprograms
+              // can be properly resolved when they appear in structure
+              // constructors.
+              ultimate.set(Symbol::Flag::InDataStmt);
+            }
           },
           [&](const parser::NullInit &null) { // => NULL()
             Walk(null);
@@ -7569,10 +7579,12 @@ void DeclarationVisitor::Initialization(const parser::Name &name,
               }
             }
           },
-          [&](const parser::InitialDataTarget &) {
+          [&](const parser::InitialDataTarget &target) {
             // Defer analysis to the end of the specification part
             // so that forward references and attribute checks like SAVE
             // work better.
+            auto restorer{common::ScopedSet(deferImplicitTyping_, true)};
+            Walk(target);
             ultimate.set(Symbol::Flag::InDataStmt);
           },
           [&](const std::list<Indirection<parser::DataStmtValue>> &values) {
@@ -7590,12 +7602,27 @@ void DeclarationVisitor::PointerInitialization(
     Symbol &ultimate{name.symbol->GetUltimate()};
     if (!context().HasError(ultimate)) {
       if (IsPointer(ultimate)) {
-        if (auto *details{ultimate.detailsIf<ObjectEntityDetails>()}) {
-          CHECK(!details->init());
-          Walk(target);
-          if (MaybeExpr expr{EvaluateExpr(target)}) {
-            // Validation is done in declaration checking.
+        Walk(target);
+        if (MaybeExpr expr{EvaluateExpr(target)}) {
+          // Validation is done in declaration checking.
+          if (auto *details{ultimate.detailsIf<ObjectEntityDetails>()}) {
+            CHECK(!details->init());
             details->set_init(std::move(*expr));
+            ultimate.set(Symbol::Flag::InDataStmt, false);
+          } else if (auto *details{ultimate.detailsIf<ProcEntityDetails>()}) {
+            // something like "REAL, EXTERNAL, POINTER :: p => t"
+            if (evaluate::IsNullProcedurePointer(*expr)) {
+              CHECK(!details->init());
+              details->set_init(nullptr);
+            } else if (const Symbol *
+                targetSymbol{evaluate::UnwrapWholeSymbolDataRef(*expr)}) {
+              CHECK(!details->init());
+              details->set_init(*targetSymbol);
+            } else {
+              Say(name,
+                  "Procedure pointer '%s' must be initialized with a procedure name or NULL()"_err_en_US);
+              context().SetError(ultimate);
+            }
           }
         }
       } else {
@@ -7635,27 +7662,23 @@ void DeclarationVisitor::PointerInitialization(
 
 void DeclarationVisitor::NonPointerInitialization(
     const parser::Name &name, const parser::ConstantExpr &expr) {
-  if (name.symbol) {
+  if (!context().HasError(name.symbol)) {
     Symbol &ultimate{name.symbol->GetUltimate()};
-    if (!context().HasError(ultimate) && !context().HasError(name.symbol)) {
+    if (!context().HasError(ultimate)) {
       if (IsPointer(ultimate)) {
         Say(name,
             "'%s' is a pointer but is not initialized like one"_err_en_US);
       } else if (auto *details{ultimate.detailsIf<ObjectEntityDetails>()}) {
-        CHECK(!details->init());
-        if (IsAllocatable(ultimate)) {
+        if (details->init()) {
+        } else if (IsAllocatable(ultimate)) {
           Say(name, "Allocatable object '%s' cannot be initialized"_err_en_US);
-          return;
-        }
-        Walk(expr);
-        if (ultimate.owner().IsParameterizedDerivedType()) {
+        } else if (ultimate.owner().IsParameterizedDerivedType()) {
           // Save the expression for per-instantiation analysis.
           details->set_unanalyzedPDTComponentInit(&expr.thing.value());
-        } else {
-          if (MaybeExpr folded{EvaluateNonPointerInitializer(
-                  ultimate, expr, expr.thing.value().source)}) {
-            details->set_init(std::move(*folded));
-          }
+        } else if (MaybeExpr folded{EvaluateNonPointerInitializer(
+                       ultimate, expr, expr.thing.value().source)}) {
+          details->set_init(std::move(*folded));
+          ultimate.set(Symbol::Flag::InDataStmt, false);
         }
       } else {
         Say(name, "'%s' is not an object that can be initialized"_err_en_US);
@@ -8424,6 +8447,7 @@ bool ResolveNamesVisitor::Pre(const parser::ProgramUnit &x) {
   ResolveSpecificationParts(root);
   FinishSpecificationParts(root);
   ResolveExecutionParts(root);
+  FinishExecutionParts(root);
   ResolveAccParts(context(), x);
   ResolveOmpParts(context(), x);
   return false;
@@ -8841,6 +8865,8 @@ class DeferredCheckVisitor {
     }
   }
 
+  bool Pre(const parser::BlockConstruct &x) { return true; }
+
   void Post(const parser::ProcInterface &pi) {
     if (const auto *name{std::get_if<parser::Name>(&pi.u)}) {
       resolver_.CheckExplicitInterface(*name);
@@ -8871,7 +8897,6 @@ class DeferredCheckVisitor {
       resolver_.CheckBindings(tbps);
     }
   }
-  bool Pre(const parser::StmtFunctionStmt &stmtFunc) { return false; }
 
 private:
   void Init(const parser::Name &name,
@@ -8880,6 +8905,9 @@ class DeferredCheckVisitor {
       if (const auto *target{
               std::get_if<parser::InitialDataTarget>(&init->u)}) {
         resolver_.PointerInitialization(name, *target);
+      } else if (const auto *expr{
+                     std::get_if<parser::ConstantExpr>(&init->u)}) {
+        resolver_.NonPointerInitialization(name, *expr);
       }
     }
   }
@@ -8894,15 +8922,16 @@ void ResolveNamesVisitor::FinishSpecificationParts(const ProgramTree &node) {
   if (!node.scope()) {
     return; // error occurred creating scope
   }
+  auto flagRestorer{common::ScopedSet(inSpecificationPart_, true)};
   SetScope(*node.scope());
-  // The initializers of pointers, the default initializers of pointer
-  // components, non-deferred type-bound procedure bindings have not
-  // yet been traversed.
-  // We do that now, when any (formerly) forward references that appear
+  // The initializers of pointers and non-PARAMETER objects, the default
+  // initializers of components, and non-deferred type-bound procedure
+  // bindings have not yet been traversed.
+  // We do that now, when any forward references that appeared
   // in those initializers will resolve to the right symbols without
-  // incurring spurious errors with IMPLICIT NONE.
+  // incurring spurious errors with IMPLICIT NONE or forward references
+  // to nested subprograms.
   DeferredCheckVisitor{*this}.Walk(node.spec());
-  DeferredCheckVisitor{*this}.Walk(node.exec()); // for BLOCK
   for (Scope &childScope : currScope().children()) {
     if (childScope.IsParameterizedDerivedTypeInstantiation()) {
       FinishDerivedTypeInstantiation(childScope);
@@ -8913,6 +8942,18 @@ void ResolveNamesVisitor::FinishSpecificationParts(const ProgramTree &node) {
   }
 }
 
+void ResolveNamesVisitor::FinishExecutionParts(const ProgramTree &node) {
+  if (node.scope()) {
+    SetScope(*node.scope());
+    if (node.exec()) {
+      DeferredCheckVisitor{*this}.Walk(*node.exec());
+    }
+    for (const auto &child : node.children()) {
+      FinishExecutionParts(child);
+    }
+  }
+}
+
 // Duplicate and fold component object pointer default initializer designators
 // using the actual type parameter values of each particular instantiation.
 // Validation is done later in declaration checking.

flang/test/Semantics/bad-forward-type.f90

@@ -84,7 +84,6 @@ subroutine s9
   type con
     Type(t(3)), pointer :: y
   end type
-  !ERROR: Cannot construct value for derived type 't' before it is defined
   Integer :: nn = Size(Transfer(t(3)(666),[0]))
   type :: t(n)
     integer, kind :: n = 3

flang/test/Semantics/init01.f90

@@ -90,7 +90,7 @@ subroutine components(n)
   real, pointer :: p10 => o3%x
   associate (a1 => o3, a2 => o3%x)
     block
-      real, pointer :: p11 => a1
+      type(t3), pointer :: p11 => a1
       real, pointer :: p12 => a2
     end block
   end associate

flang/test/Semantics/pointer01.f90

@@ -16,6 +16,7 @@ program main
   !ERROR: 'inner' cannot have the POINTER attribute
   pointer inner
   real obj
+  !ERROR: 'ip' is a pointer but is not initialized like one
   !ERROR: 'ip' may not have both the POINTER and PARAMETER attributes
   integer, parameter :: ip = 123
   pointer ip

flang/test/Semantics/symbol15.f90

@@ -14,10 +14,10 @@ subroutine iface
  !DEF: /m/op2 POINTER, PUBLIC ObjectEntity REAL(4)
  !DEF: /m/null INTRINSIC, PUBLIC, PURE (Function) ProcEntity
  real, pointer :: op2 => null()
- !DEF: /m/op3 POINTER, PUBLIC (InDataStmt) ObjectEntity REAL(4)
+ !DEF: /m/op3 POINTER, PUBLIC ObjectEntity REAL(4)
  !DEF: /m/x PUBLIC, TARGET ObjectEntity REAL(4)
  real, pointer :: op3 => x
- !DEF: /m/op4 POINTER, PUBLIC (InDataStmt) ObjectEntity REAL(4)
+ !DEF: /m/op4 POINTER, PUBLIC ObjectEntity REAL(4)
  !DEF: /m/y PUBLIC, TARGET ObjectEntity REAL(4)
  real, pointer :: op4 => y(1)
  !REF: /m/iface
@@ -50,10 +50,10 @@ subroutine iface
   !DEF: /m/t1/opc2 POINTER ObjectEntity REAL(4)
   !REF: /m/null
   real, pointer :: opc2 => null()
-  !DEF: /m/t1/opc3 POINTER (InDataStmt) ObjectEntity REAL(4)
+  !DEF: /m/t1/opc3 POINTER ObjectEntity REAL(4)
   !REF: /m/x
   real, pointer :: opc3 => x
-  !DEF: /m/t1/opc4 POINTER (InDataStmt) ObjectEntity REAL(4)
+  !DEF: /m/t1/opc4 POINTER ObjectEntity REAL(4)
   !REF: /m/y
   real, pointer :: opc4 => y(1)
   !REF: /m/iface
@@ -100,10 +100,10 @@ subroutine iface
   !DEF: /m/pdt1/opc2 POINTER ObjectEntity REAL(4)
   !REF: /m/null
   real, pointer :: opc2 => null()
-  !DEF: /m/pdt1/opc3 POINTER (InDataStmt) ObjectEntity REAL(4)
+  !DEF: /m/pdt1/opc3 POINTER ObjectEntity REAL(4)
   !REF: /m/x
   real, pointer :: opc3 => x
-  !DEF: /m/pdt1/opc4 POINTER (InDataStmt) ObjectEntity REAL(4)
+  !DEF: /m/pdt1/opc4 POINTER ObjectEntity REAL(4)
   !REF: /m/y
   !REF: /m/pdt1/k
   real, pointer :: opc4 => y(k)
@@ -160,10 +160,10 @@ subroutine iface
   subroutine ext2
   end subroutine
  end interface
- !DEF: /m/op10 POINTER, PUBLIC(InDataStmt) ObjectEntity REAL(4)
+ !DEF: /m/op10 POINTER, PUBLIC ObjectEntity REAL(4)
  !REF: /m/x
  real, pointer :: op10 => x
- !DEF: /m/op11 POINTER, PUBLIC(InDataStmt) ObjectEntity REAL(4)
+ !DEF: /m/op11 POINTER, PUBLIC ObjectEntity REAL(4)
  !REF: /m/y
  real, pointer :: op11 => y(1)
  !REF: /m/iface
@@ -176,10 +176,10 @@ subroutine ext2
  procedure(iface), pointer :: pp11 => ext2
  !DEF: /m/t2 PUBLIC DerivedType
  type :: t2
-  !DEF: /m/t2/opc10 POINTER (InDataStmt) ObjectEntity REAL(4)
+  !DEF: /m/t2/opc10 POINTER ObjectEntity REAL(4)
   !REF: /m/x
   real, pointer :: opc10 => x
-  !DEF: /m/t2/opc11 POINTER (InDataStmt) ObjectEntity REAL(4)
+  !DEF: /m/t2/opc11 POINTER ObjectEntity REAL(4)
   !REF: /m/y
   real, pointer :: opc11 => y(1)
   !REF: /m/iface
@@ -203,10 +203,10 @@ subroutine ext2
  type :: pdt2(k)
   !REF: /m/pdt2/k
   integer, kind :: k
-  !DEF: /m/pdt2/opc10 POINTER (InDataStmt) ObjectEntity REAL(4)
+  !DEF: /m/pdt2/opc10 POINTER ObjectEntity REAL(4)
   !REF: /m/x
   real, pointer :: opc10 => x
-  !DEF: /m/pdt2/opc11 POINTER (InDataStmt) ObjectEntity REAL(4)
+  !DEF: /m/pdt2/opc11 POINTER ObjectEntity REAL(4)
   !REF: /m/y
   !REF: /m/pdt2/k
   real, pointer :: opc11 => y(k)