[flang] Process pointer component default initializers sooner (llvm#145601)

Name resolution defers the analysis of all object pointer initializers
to the end of a specification part, including the default initializers
of derived type data pointer components. This deferment allows object
pointer initializers to contain forward references to objects whose
declarations appear later.

However, this deferment has the unfortunate effect of causing NULL
default initialization of such object pointer components when they do
not appear in structure constructors that are used as default
initializers, and their default initializers are required. So handle
object pointer default initializers of components as they appear, as
before.

Author: klausler

flang/docs/Extensions.md

@@ -875,6 +875,13 @@ print *, [(j,j=1,10)]
   compilers) and don't use any defined unformatted WRITE that might have been
   defined.
 
+* Forward references to target objects are allowed to appear
+  in the initializers of data pointer declarationss.
+  Forward references to target objects are not accepted in the default
+  initializers of derived type component declarations, however,
+  since these default values need to be available to process incomplete
+  structure constructors.
+
 ## De Facto Standard Features
 
 * `EXTENDS_TYPE_OF()` returns `.TRUE.` if both of its arguments have the

flang/lib/Semantics/resolve-names.cpp

@@ -5383,7 +5383,7 @@ void DeclarationVisitor::Post(const parser::EntityDecl &x) {
     ConvertToObjectEntity(symbol) || ConvertToProcEntity(symbol);
     symbol.set(
         Symbol::Flag::EntryDummyArgument, false); // forestall excessive errors
-    Initialization(name, *init, false);
+    Initialization(name, *init, /*inComponentDecl=*/false);
   } else if (attrs.test(Attr::PARAMETER)) { // C882, C883
     Say(name, "Missing initialization for parameter '%s'"_err_en_US);
   }
@@ -6398,7 +6398,7 @@ void DeclarationVisitor::Post(const parser::ComponentDecl &x) {
     SetCUDADataAttr(name.source, symbol, cudaDataAttr());
     if (symbol.has<ObjectEntityDetails>()) {
       if (auto &init{std::get<std::optional<parser::Initialization>>(x.t)}) {
-        Initialization(name, *init, true);
+        Initialization(name, *init, /*inComponentDecl=*/true);
       }
     }
     currScope().symbol()->get<DerivedTypeDetails>().add_component(symbol);
@@ -8933,9 +8933,13 @@ void DeclarationVisitor::Initialization(const parser::Name &name,
             // 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);
+            if (inComponentDecl) {
+              PointerInitialization(name, target);
+            } else {
+              auto restorer{common::ScopedSet(deferImplicitTyping_, true)};
+              Walk(target);
+              ultimate.set(Symbol::Flag::InDataStmt);
+            }
           },
           [&](const std::list<Indirection<parser::DataStmtValue>> &values) {
             // Handled later in data-to-inits conversion
@@ -10355,11 +10359,6 @@ class DeferredCheckVisitor {
         std::get<std::optional<parser::Initialization>>(decl.t));
     return false;
   }
-  bool Pre(const parser::ComponentDecl &decl) {
-    Init(std::get<parser::Name>(decl.t),
-        std::get<std::optional<parser::Initialization>>(decl.t));
-    return false;
-  }
   bool Pre(const parser::ProcDecl &decl) {
     if (const auto &init{
             std::get<std::optional<parser::ProcPointerInit>>(decl.t)}) {

flang/test/Semantics/bug1056.f90

@@ -0,0 +1,13 @@
+! RUN: %flang_fc1 -fdebug-unparse %s | FileCheck %s
+program bug
+  integer, target :: ita(2) = [1,2], itb(2) = [3,4], itc(2) = [5,6]
+  type t1
+    integer, pointer :: p1(:) => ita, p2(:) => itb
+  end type
+  type t2
+    !CHECK: TYPE(t1) :: comp = t1(p1=itc,p2=itb)
+    type(t1) :: comp = t1(itc)
+  end type
+  integer, pointer :: p3(:) => itd
+  integer, target :: itd(2) = [7,8]
+end

flang/test/Semantics/symbol15.f90

@@ -43,6 +43,9 @@ subroutine iface
  !DEF: /m/pp6 EXTERNAL, POINTER, PUBLIC (Subroutine) ProcEntity
  !DEF: /m/modproc1 PUBLIC (Subroutine) Subprogram
  procedure(iface), pointer :: pp6 => modproc1
+ !DEF: /m/xx PUBLIC, TARGET ObjectEntity REAL(4)
+ !DEF: /m/yy PUBLIC, TARGET ObjectEntity REAL(4)
+ real, target :: xx, yy(2)
  !DEF: /m/t1 PUBLIC DerivedType
  type :: t1
   !DEF: /m/t1/opc1 POINTER ObjectEntity REAL(4)
@@ -51,11 +54,11 @@ subroutine iface
   !REF: /m/null
   real, pointer :: opc2 => null()
   !DEF: /m/t1/opc3 POINTER ObjectEntity REAL(4)
-  !REF: /m/x
-  real, pointer :: opc3 => x
+  !REF: /m/xx
+  real, pointer :: opc3 => xx
   !DEF: /m/t1/opc4 POINTER ObjectEntity REAL(4)
-  !REF: /m/y
-  real, pointer :: opc4 => y(1)
+  !REF: /m/yy
+  real, pointer :: opc4 => yy(1)
   !REF: /m/iface
   !DEF: /m/t1/ppc1 NOPASS, POINTER (Subroutine) ProcEntity
   procedure(iface), nopass, pointer :: ppc1
@@ -101,12 +104,12 @@ subroutine iface
   !REF: /m/null
   real, pointer :: opc2 => null()
   !DEF: /m/pdt1/opc3 POINTER ObjectEntity REAL(4)
-  !REF: /m/x
-  real, pointer :: opc3 => x
+  !REF: /m/xx
+  real, pointer :: opc3 => xx
   !DEF: /m/pdt1/opc4 POINTER ObjectEntity REAL(4)
-  !REF: /m/y
+  !REF: /m/yy
   !REF: /m/pdt1/k
-  real, pointer :: opc4 => y(k)
+  real, pointer :: opc4 => yy(k)
   !REF: /m/iface
   !DEF: /m/pdt1/ppc1 NOPASS, POINTER (Subroutine) ProcEntity
   procedure(iface), nopass, pointer :: ppc1

t.f90

@@ -0,0 +1,11 @@
+integer, target :: ita(2) = [1,2], itb(2) = [3,4], itc(2) = [5,6]
+type t1
+  integer, pointer :: p1(:) => ita, p2(:) => itb
+end type
+type t2
+  type(t1) :: comp = t1(itc)
+end type
+type(t2) :: var
+print *, var%comp%p2
+var%comp = t1(itc)
+end