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

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.

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

Author: klausler

flang/include/flang/Semantics/tools.h

@@ -107,7 +107,8 @@ bool CanBeTypeBoundProc(const Symbol *);
 // 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 &);

flang/include/flang/Semantics/type.h

@@ -265,7 +265,7 @@ class DerivedTypeSpec {
 
   bool MightBeParameterized() const;
   bool IsForwardReferenced() const;
-  bool HasDefaultInitialization() const;
+  bool HasDefaultInitialization(bool ignoreAllocatable = false) const;
   bool HasDestruction() const;
   bool HasFinalization() const;
 

flang/lib/Evaluate/initial-image.cpp

@@ -115,7 +115,7 @@ class AsConstantHelper {
                 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)};

flang/lib/Semantics/check-data.cpp

@@ -62,7 +62,9 @@ class DataVarChecker : public evaluate::AllTraverse<DataVarChecker, true> {
                 : 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

flang/lib/Semantics/tools.cpp

@@ -558,23 +558,21 @@ bool HasDeclarationInitializer(const Symbol &symbol) {
   }
 }
 
-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);
       }
     }
   }

flang/lib/Semantics/type.cpp

@@ -177,10 +177,12 @@ 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 {

flang/test/Semantics/data04.f90

@@ -58,7 +58,7 @@ subroutine CheckObject(i)
         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
@@ -69,8 +69,7 @@ subroutine CheckObject(i)
         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
@@ -80,12 +79,12 @@ subroutine CheckObject(i)
       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

flang/test/Semantics/data06.f90

@@ -7,6 +7,12 @@ subroutine s1
   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 /