[flang] Allow DATA initialization of derived types w/ allocatable components

[klausler]

Summary

While one cannot of course statically initialize an allocatable component
of an instance of a derived type, its mere presence should not prevent
DATA initialization of the other nonallocatable components. Semantics
was treating the existence of an allocatable component as a case of
"default initialization", which it is, but not one that should run
afoul of C877. Add another Boolean argument to IsInitialized() to allow
for a more nuanced test.

[klausler]

ping

[mleair]

Sorry, I thought I approved this already. LGTM.

flang/include/flang/Semantics/tools.h

 bool CanBeTypeBoundProc(const Symbol *);
 // 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 IsInitialized(const Symbol &, bool ignoreDATAstatements = false,
+    bool ignoreAllocatable = false);
 // 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 InCommonBlock(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 &);
   RawParameters &rawParameters() { return rawParameters_; }
   const ParameterMapType &parameters() const { return parameters_; }
 
   bool MightBeParameterized() const;
   bool IsForwardReferenced() const;
-  bool HasDefaultInitialization() const;
+  bool HasDefaultInitialization(bool ignoreAllocatable = false) const;
   bool HasDestruction() const;
   bool HasFinalization() 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 std::optional<parser::Keyword> &, ParamValue &&);
   // Checks the raw parameter list against the definition of a derived type.

flang/lib/Evaluate/initial-image.cpp

if constexpr (T::category == TypeCategory::Derived) {
               }
             }
           } else if (IsPointer(component)) {
             for (std::size_t j{0}; j < elements; ++j, at += stride) {
               if (Result value{image_.AsConstantPointer(at)}) {
                 typedValue[j].emplace(component, std::move(*value));
               }
             }
-          } else {
+          } else if (!IsAllocatable(component)) {
             auto componentType{DynamicType::From(component)};
             CHECK(componentType.has_value());
             auto componentExtents{GetConstantExtents(context_, component)};
             CHECK(componentExtents.has_value());
             for (std::size_t j{0}; j < elements; ++j, at += stride) {
               if (Result value{image_.AsConstant(
                       context_, *componentType, *componentExtents, at)}) {
                 typedValue[j].emplace(component, std::move(*value));

flang/lib/Semantics/check-data.cpp

bool operator()(const Symbol &symbol) { // C876
     // default component values
     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)  ? "Default-initialized"
+                : IsInitialized(symbol, true /*ignore DATA*/,
+                      true /*ignore allocatable 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_)
                 ? "Target of pointer"

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) {
-  if (IsAllocatable(symbol) ||
-      (!ignoreDataStatements && symbol.test(Symbol::Flag::InDataStmt)) ||
-      HasDeclarationInitializer(symbol)) {
+bool IsInitialized(
+    const Symbol &symbol, bool ignoreDataStatements, bool ignoreAllocatable) {
+  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)) {
     return false;
   } else if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
     if (!object->isDummy() && object->type()) {
       if (const auto *derived{object->type()->AsDerived()}) {
-        DirectComponentIterator directs{*derived};
-        return bool{std::find_if(
-            directs.begin(), directs.end(), [](const Symbol &component) {
-              return IsAllocatable(component) ||
-                  HasDeclarationInitializer(component);
-            })};
+        return derived->HasDefaultInitialization(ignoreAllocatable);
       }
     }
   }
   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() const {
+bool DerivedTypeSpec::HasDefaultInitialization(bool ignoreAllocatable) const {
   DirectComponentIterator components{*this};
-  return bool{std::find_if(components.begin(), components.end(),
-      [&](const Symbol &component) { return IsInitialized(component); })};
+  return bool{std::find_if(
+      components.begin(), components.end(), [&](const Symbol &component) {
+        return IsInitialized(component, true, ignoreAllocatable);
+      })};
 }
 
 bool DerivedTypeSpec::HasDestruction() const {
   if (!typeSymbol().get<DerivedTypeDetails>().finals().empty()) {
     return true;
   }
   DirectComponentIterator components{*this};
   return bool{std::find_if(

flang/test/Semantics/data04.f90

subroutine CheckObject(i)
         type(specialNumbers), pointer :: headOfTheList
         integer, pointer, dimension(:) :: ptoarray
         character, pointer, dimension(:) :: ptochar
       end type
       type large
         integer, allocatable :: allocVal
         integer, allocatable :: elt(:)
         integer val
-        type(specialNumbers) numsArray(5)
+        type(specialNumbers) numsArray(10)
       end type
       type(large) largeNumber
       type(large), allocatable :: allocatableLarge
       type(large) :: largeNumberArray(i)
       type(large) :: largeArray(5)
       character :: name(i)
       type small
         real :: x
       end type
       type(small), pointer :: sp
-      !C877
-      !ERROR: Default-initialized 'largenumber' must not be initialized in a DATA statement
+      !This case is ok.
       DATA(largeNumber % numsArray(j) % headOfTheList, j = 1, 10) / 10 * NULL() /
       !C877
       !ERROR: Data object must not contain pointer 'headofthelist' as a non-rightmost part
       DATA(largeNumber % numsArray(j) % headOfTheList % one, j = 1, 10) / 10 * 1 /
       !C877
       !ERROR: Rightmost data object pointer 'ptoarray' must not be subscripted
       DATA(largeNumber % numsArray(j) % ptoarray(1), j = 1, 10) / 10 * 1 /
       !C877
       !ERROR: Rightmost data object pointer 'ptochar' must not be subscripted
-      DATA largeNumber % numsArray(0) % ptochar(1:2) / 'ab' /
+      DATA largeNumber % numsArray(1) % ptochar(1:2) / 'ab' /
       !C876
-      !ERROR: Default-initialized 'largenumber' must not be initialized in a DATA statement
+      !ERROR: Allocatable 'elt' must not be initialized in a DATA statement
       DATA(largeNumber % elt(j) , j = 1, 10) / 10 * 1/
       !C876
-      !ERROR: Default-initialized 'largearray' must not be initialized in a DATA statement
+      !ERROR: Allocatable 'allocval' must not be initialized in a DATA statement
       DATA(largeArray(j) % allocVal , j = 1, 10) / 10 * 1/
       !C876
       !ERROR: Allocatable 'allocatablelarge' must not be initialized in a DATA statement
       DATA allocatableLarge % val / 1 /
       !C876
       !ERROR: Automatic variable 'largenumberarray' must not be initialized in a DATA statement
       DATA(largeNumberArray(j) % val, j = 1, 10) / 10 * NULL() /
       !C876

flang/test/Semantics/data06.f90

 ! RUN: %python %S/test_errors.py %s %flang_fc1
 ! DATA statement errors
 subroutine s1
   type :: t1
     integer :: j = 666
   end type t1
   type(t1) :: t1x
   !ERROR: Default-initialized 't1x' must not be initialized in a DATA statement
   data t1x%j / 777 /
+  type :: t2
+    integer, allocatable :: j
+    integer :: k
+  end type t2
+  type(t2) :: t2x
+  data t2x%k / 777 / ! allocatable component is ok
   integer :: ja = 888
   !ERROR: Default-initialized 'ja' must not be initialized in a DATA statement
   data ja / 999 /
   integer :: a1(10)
   !ERROR: DATA statement set has more values than objects
   data a1(1:9:2) / 6 * 1 /
   integer :: a2(10)
   !ERROR: DATA statement set has no value for 'a2(2_8)'