[flang][runtime] Initialize uninitialized pointer components

[klausler]

Summary

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.

[vzakhari]

LGTM! Do we need to highlight the default initialization in the docs?

[klausler]

In D149979#4322992, @vzakhari wrote:

LGTM! Do we need to highlight the default initialization in the docs?

No. We're doing this as an implementation convenience, not as a guaranteed feature upon which users may rely, and we could happily rescind it if a better technique were to be discovered.

[vzakhari]

In D149979#4323014, @klausler wrote:

In D149979#4322992, @vzakhari wrote:

LGTM! Do we need to highlight the default initialization in the docs?

No. We're doing this as an implementation convenience, not as a guaranteed feature upon which users may rely, and we could happily rescind it if a better technique were to be discovered.

OK. Thanks!

flang/include/flang/Semantics/tools.h

 // Does a non-PARAMETER symbol have explicit initialization with =value or
 // =>target in its declaration (but not in a DATA statement)? (Being
 // ALLOCATABLE or having a derived type with default component initialization
 // doesn't count; it must be a variable initialization that implies the SAVE
 // attribute, or a derived type component default value.)
 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 &);
 bool IsSeparateModuleProcedureInterface(const Symbol *);
 bool HasAlternateReturns(const Symbol &);
 bool IsAutomaticallyDestroyed(const Symbol &);
 
 // Return an ultimate component of type that matches predicate, or nullptr.

flang/include/flang/Semantics/type.h

public:
   const Scope *scope() const { return scope_; }
   void set_scope(const Scope &);
   void ReplaceScope(const Scope &);
   const RawParameters &rawParameters() const { return rawParameters_; }
   const ParameterMapType &parameters() const { return parameters_; }
 
   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
   // parameter list in the parse tree, built by calling AddRawParamValue().
   // It can be used with forward-referenced derived types.
   void AddRawParamValue(const parser::Keyword *, ParamValue &&);
   // Checks the raw parameter list against the definition of a derived type.
   // Converts the raw parameter list to a map, naming each actual parameter.

flang/lib/Semantics/check-data.cpp

bool operator()(const Symbol &symbol) { // C876
     const Scope &scope{context_.FindScope(source_)};
     bool isFirstSymbol{isFirstSymbol_};
     isFirstSymbol_ = false;
     if (const char *whyNot{IsAutomatic(symbol) ? "Automatic variable"
                 : IsDummy(symbol)              ? "Dummy argument"
                 : 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
                 : !isFirstSymbol                   ? nullptr
                 : IsHostAssociated(symbol, scope)  ? "Host-associated object"
                 : IsUseAssociated(symbol, scope)   ? "USE-associated object"
                 : symbol.has<AssocEntityDetails>() ? "Construct association"
                 : IsPointer(symbol) && (hasComponent_ || hasSubscript_)

flang/lib/Semantics/expression.cpp

for (const auto &component :
     }
   }
 
   // Ensure that unmentioned component objects have default initializers.
   for (const Symbol &symbol : components) {
     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,
                                 symbol.name()),
               symbol);
         }
       }
     }

flang/lib/Semantics/runtime-type-info.cpp

AddValue(dtValues, derivedTypeSchema_, "specialbitset"s,
         IntExpr<4>(specialBitSet));
     // Note the presence/absence of a parent component
     AddValue(dtValues, derivedTypeSchema_, "hasparent"s,
         IntExpr<1>(dtScope.GetDerivedTypeParent() != nullptr));
     // To avoid wasting run time attempting to initialize derived type
     // 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 ||
             (derivedTypeSpec && !derivedTypeSpec->HasDestruction())));
     // Similarly, a flag to short-circuit finalization when not needed.
     AddValue(dtValues, derivedTypeSchema_, "nofinalizationneeded"s,
         IntExpr<1>(isAbstractType ||
             (derivedTypeSpec && !IsFinalizable(*derivedTypeSpec))));

flang/lib/Semantics/tools.cpp

if (IsNamedConstant(symbol)) {
     return object->init().has_value();
   } else if (const auto *proc{symbol.detailsIf<ProcEntityDetails>()}) {
     return proc->init().has_value();
   } else {
     return false;
   }
 }
 
-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);
       }
     }
   }
   return false;
 }
 
 bool IsDestructible(const Symbol &symbol, const Symbol *derivedTypeSymbol) {
   if (IsAllocatable(symbol) || IsAutomatic(symbol)) {

flang/lib/Semantics/type.cpp

 bool DerivedTypeSpec::MightBeParameterized() const {
   return !cooked_ || !parameters_.empty();
 }
 
 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);
       })};
 }
 
 bool DerivedTypeSpec::HasDestruction() const {
   if (!FinalsForDerivedTypeInstantiation(*this).empty()) {
     return true;
   }
   DirectComponentIterator components{*this};

flang/runtime/derived.cpp

for (std::size_t k{0}; k < myComponents; ++k) {
     } else if (const void *init{comp.initialization()}) {
       // Explicit initialization of data pointers and
       // non-allocatable non-automatic components
       std::size_t bytes{comp.SizeInBytes(instance)};
       for (std::size_t j{0}; j < elements; ++j) {
         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
       // data component.  Handles parent component's elements.  Recursive.
       SubscriptValue extent[maxRank];
       const typeInfo::Value *bounds{comp.bounds()};
       for (int dim{0}; dim < comp.rank(); ++dim) {
         typeInfo::TypeParameterValue lb{

flang/runtime/type-info.cpp

if (const DerivedType * type{derivedType()}) {
       descriptor.Establish(*type, nullptr, rank_, nullptr, attribute);
     } else { // unlimited polymorphic
       descriptor.Establish(TypeCode{TypeCategory::Derived, 0}, 0, nullptr,
           rank_, nullptr, attribute, true);
     }
   } 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())};
     for (int j{0}; j < rank_; ++j) {
       auto lb{boundValues++->GetValue(&container)};
       auto ub{boundValues++->GetValue(&container)};
       RUNTIME_CHECK(terminator, lb.has_value() && ub.has_value());
       Dimension &dim{descriptor.GetDimension(j)};

flang/test/Semantics/canondo01.f90

-
 ! RUN: %flang_fc1 -fdebug-unparse-with-symbols %s 2>&1 | FileCheck %s
 ! CHECK: end do
 
 SUBROUTINE sub00(a,b,n,m)
   INTEGER n,m
   REAL a(n,m), b(n,m)
 
   DO 10 j = 1,m
      DO 10 i = 1,n
         g = a(i,j) - b(i,j)
 10      PRINT *, g
 END SUBROUTINE sub00

flang/test/Semantics/structconst07.f90

+! 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
+

flang/test/Semantics/structconst07.f90#

-! RUN: %python %S/test_errors.py %s %flang_fc1
-! C1594(4)
-module m
-  type t1
-    

flang/test/Semantics/typeinfo03.f90

+!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)