[flang][runtime] Initialize uninitialized pointer components

Pointer components without default initialization pose some
difficult (or impossible) problems when they appear as right-hand
side targets in pointer assignment statements; they may contain
garbage or stale data that looks enough like a valid descriptor
to cause a crash.  Solve the problem by avoiding it -- ensure
that pointers' descriptors are at least minimally established.

Differential Revision: https://reviews.llvm.org/D149979

13 files changed, 55 insertions, 25 deletions

diff --git a/flang/include/flang/Semantics/tools.h b/flang/include/flang/Semantics/tools.h
index 4a78b31c5a79..ee62b66d54b0 100644
--- a/flang/include/flang/Semantics/tools.h
+++ b/flang/include/flang/Semantics/tools.h
@@ -117,7 +117,7 @@ bool CanBeTypeBoundProc(const Symbol &);
 bool HasDeclarationInitializer(const Symbol &);
 // Is the symbol explicitly or implicitly initialized in any way?
 bool IsInitialized(const Symbol &, bool ignoreDATAstatements = false,
-    bool ignoreAllocatable = false);
+    bool ignoreAllocatable = false, bool ignorePointer = true);
 // Is the symbol a component subject to deallocation or finalization?
 bool IsDestructible(const Symbol &, const Symbol *derivedType = nullptr);
 bool HasIntrinsicTypeName(const Symbol &);
diff --git a/flang/include/flang/Semantics/type.h b/flang/include/flang/Semantics/type.h
index 76866c8e994b..3fcd438eaf13 100644
--- a/flang/include/flang/Semantics/type.h
+++ b/flang/include/flang/Semantics/type.h
@@ -266,7 +266,8 @@ public:
 
   bool MightBeParameterized() const;
   bool IsForwardReferenced() const;
-  bool HasDefaultInitialization(bool ignoreAllocatable = false) const;
+  bool HasDefaultInitialization(
+      bool ignoreAllocatable = false, bool ignorePointer = true) const;
   bool HasDestruction() const;
 
   // The "raw" type parameter list is a simple transcription from the
diff --git a/flang/lib/Semantics/check-data.cpp b/flang/lib/Semantics/check-data.cpp
index f33258ea7c19..6916870907a6 100644
--- a/flang/lib/Semantics/check-data.cpp
+++ b/flang/lib/Semantics/check-data.cpp
@@ -63,7 +63,8 @@ public:
                 : IsFunctionResult(symbol)     ? "Function result"
                 : IsAllocatable(symbol)        ? "Allocatable"
                 : IsInitialized(symbol, true /*ignore DATA*/,
-                      true /*ignore allocatable components*/)
+                      true /*ignore allocatable components*/,
+                      true /*ignore uninitialized pointer components*/)
                 ? "Default-initialized"
                 : IsProcedure(symbol) && !IsPointer(symbol) ? "Procedure"
                 // remaining checks don't apply to components
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index cec936c8f5e4..5ec83344d03d 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -2066,13 +2066,15 @@ MaybeExpr ExpressionAnalyzer::Analyze(
     if (!symbol.test(Symbol::Flag::ParentComp) &&
         unavailable.find(symbol.name()) == unavailable.cend()) {
       if (IsAllocatable(symbol)) {
-        // Set all remaining allocatables to explicit NULL()
+        // Set all remaining allocatables to explicit NULL().
         result.Add(symbol, Expr<SomeType>{NullPointer{}});
-      } else if (const auto *details{
-                     symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
-        if (details->init()) {
-          result.Add(symbol, common::Clone(*details->init()));
-        } else { // C799
+      } else {
+        const auto *object{symbol.detailsIf<semantics::ObjectEntityDetails>()};
+        if (object && object->init()) {
+          result.Add(symbol, common::Clone(*object->init()));
+        } else if (IsPointer(symbol)) {
+          result.Add(symbol, Expr<SomeType>{NullPointer{}});
+        } else if (object) { // C799
           AttachDeclaration(Say(typeName,
                                 "Structure constructor lacks a value for "
                                 "component '%s'"_err_en_US,
diff --git a/flang/lib/Semantics/runtime-type-info.cpp b/flang/lib/Semantics/runtime-type-info.cpp
index 15a2a6710323..acd3c49b3909 100644
--- a/flang/lib/Semantics/runtime-type-info.cpp
+++ b/flang/lib/Semantics/runtime-type-info.cpp
@@ -626,8 +626,8 @@ const Symbol *RuntimeTableBuilder::DescribeType(Scope &dtScope) {
     // instances without any initialized components, analyze the type
     // and set a flag if there's nothing to do for it at run time.
     AddValue(dtValues, derivedTypeSchema_, "noinitializationneeded"s,
-        IntExpr<1>(
-            derivedTypeSpec && !derivedTypeSpec->HasDefaultInitialization()));
+        IntExpr<1>(derivedTypeSpec &&
+            !derivedTypeSpec->HasDefaultInitialization(false, false)));
     // Similarly, a flag to short-circuit destruction when not needed.
     AddValue(dtValues, derivedTypeSchema_, "nodestructionneeded"s,
         IntExpr<1>(isAbstractType ||
diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp
index fb2710b54284..711537ec4947 100644
--- a/flang/lib/Semantics/tools.cpp
+++ b/flang/lib/Semantics/tools.cpp
@@ -642,21 +642,23 @@ bool HasDeclarationInitializer(const Symbol &symbol) {
   }
 }
 
-bool IsInitialized(
-    const Symbol &symbol, bool ignoreDataStatements, bool ignoreAllocatable) {
+bool IsInitialized(const Symbol &symbol, bool ignoreDataStatements,
+    bool ignoreAllocatable, bool ignorePointer) {
   if (!ignoreAllocatable && IsAllocatable(symbol)) {
     return true;
   } else if (!ignoreDataStatements && symbol.test(Symbol::Flag::InDataStmt)) {
     return true;
   } else if (HasDeclarationInitializer(symbol)) {
     return true;
-  } else if (IsNamedConstant(symbol) || IsFunctionResult(symbol) ||
-      IsPointer(symbol)) {
+  } else if (IsPointer(symbol)) {
+    return !ignorePointer;
+  } else if (IsNamedConstant(symbol) || IsFunctionResult(symbol)) {
     return false;
   } else if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
     if (!object->isDummy() && object->type()) {
       if (const auto *derived{object->type()->AsDerived()}) {
-        return derived->HasDefaultInitialization(ignoreAllocatable);
+        return derived->HasDefaultInitialization(
+            ignoreAllocatable, ignorePointer);
       }
     }
   }
diff --git a/flang/lib/Semantics/type.cpp b/flang/lib/Semantics/type.cpp
index d895f01dba2e..667fdc453687 100644
--- a/flang/lib/Semantics/type.cpp
+++ b/flang/lib/Semantics/type.cpp
@@ -179,11 +179,13 @@ bool DerivedTypeSpec::IsForwardReferenced() const {
   return typeSymbol_.get<DerivedTypeDetails>().isForwardReferenced();
 }
 
-bool DerivedTypeSpec::HasDefaultInitialization(bool ignoreAllocatable) const {
+bool DerivedTypeSpec::HasDefaultInitialization(
+    bool ignoreAllocatable, bool ignorePointer) const {
   DirectComponentIterator components{*this};
   return bool{std::find_if(
       components.begin(), components.end(), [&](const Symbol &component) {
-        return IsInitialized(component, true, ignoreAllocatable);
+        return IsInitialized(component, /*ignoreDataStatements=*/true,
+            ignoreAllocatable, ignorePointer);
       })};
 }
 
diff --git a/flang/runtime/derived.cpp b/flang/runtime/derived.cpp
index 981ddb2a6e9d..814fcfa1e1e7 100644
--- a/flang/runtime/derived.cpp
+++ b/flang/runtime/derived.cpp
@@ -58,6 +58,16 @@ int Initialize(const Descriptor &instance, const typeInfo::DerivedType &derived,
         char *ptr{instance.ZeroBasedIndexedElement<char>(j) + comp.offset()};
         std::memcpy(ptr, init, bytes);
       }
+    } else if (comp.genre() == typeInfo::Component::Genre::Pointer) {
+      // Data pointers without explicit initialization are established
+      // so that they are valid right-hand side targets of pointer
+      // assignment statements.
+      for (std::size_t j{0}; j < elements; ++j) {
+        Descriptor &ptrDesc{*instance.OffsetElement<Descriptor>(
+            j * byteStride + comp.offset())};
+        comp.EstablishDescriptor(ptrDesc, instance, terminator);
+        ptrDesc.raw().attribute = CFI_attribute_pointer;
+      }
     } else if (comp.genre() == typeInfo::Component::Genre::Data &&
         comp.derivedType() && !comp.derivedType()->noInitializationNeeded()) {
       // Default initialization of non-pointer non-allocatable/automatic
diff --git a/flang/runtime/type-info.cpp b/flang/runtime/type-info.cpp
index 84ec05d02705..9b624a664a2f 100644
--- a/flang/runtime/type-info.cpp
+++ b/flang/runtime/type-info.cpp
@@ -112,7 +112,7 @@ void Component::EstablishDescriptor(Descriptor &descriptor,
   } else {
     descriptor.Establish(cat, kind_, nullptr, rank_, nullptr, attribute);
   }
-  if (rank_ && genre_ != Genre::Allocatable) {
+  if (rank_ && genre_ != Genre::Allocatable && genre_ != Genre::Pointer) {
     const typeInfo::Value *boundValues{bounds()};
     RUNTIME_CHECK(terminator, boundValues != nullptr);
     auto byteStride{static_cast<SubscriptValue>(descriptor.ElementBytes())};
diff --git a/flang/test/Semantics/canondo01.f90 b/flang/test/Semantics/canondo01.f90
index 50ffa489019e..7a48db346e9a 100644
--- a/flang/test/Semantics/canondo01.f90
+++ b/flang/test/Semantics/canondo01.f90
@@ -1,4 +1,3 @@
-
 ! RUN: %flang_fc1 -fdebug-unparse-with-symbols %s 2>&1 | FileCheck %s
 ! CHECK: end do
 
diff --git a/flang/test/Semantics/structconst07.f90 b/flang/test/Semantics/structconst07.f90
new file mode 100644
index 000000000000..a34289a817af
--- /dev/null
+++ b/flang/test/Semantics/structconst07.f90
@@ -0,0 +1,9 @@
+! RUN: %flang_fc1 -fdebug-unparse %s 2>&1 | FileCheck %s
+type :: hasPointer
+  class(*), pointer :: sp
+end type
+type(hasPointer) hp
+!CHECK: hp=haspointer(sp=NULL())
+hp = hasPointer()
+end
+
diff --git a/flang/test/Semantics/structconst07.f90# b/flang/test/Semantics/structconst07.f90#
deleted file mode 100644
index af75b43658d3..000000000000
--- a/flang/test/Semantics/structconst07.f90#
+++ /dev/null
@@ -1,5 +0,0 @@
-! RUN: %python %S/test_errors.py %s %flang_fc1
-! C1594(4)
-module m
-  type t1
-    
diff --git a/flang/test/Semantics/typeinfo03.f90 b/flang/test/Semantics/typeinfo03.f90
new file mode 100644
index 000000000000..f0c0a817da4a
--- /dev/null
+++ b/flang/test/Semantics/typeinfo03.f90
@@ -0,0 +1,9 @@
+!RUN: bbc --dump-symbols %s | FileCheck %s
+!RUN: %flang_fc1 -fdebug-dump-symbols %s | FileCheck %s
+!Ensure that type with pointer component(s) has "noinitializationneeded=0"
+module m
+  type hasPointer
+    class(*), pointer :: sp, ap(:)
+  end type
+end module
+!CHECK: .dt.haspointer, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.haspointer,sizeinbytes=104_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.haspointer,procptr=NULL(),special=NULL(),specialbitset=0_4,hasparent=0_1,noinitializationneeded=0_1,nodestructionneeded=1_1,nofinalizationneeded=1_1)