[flang] Include default component initialization in static initializers

The combined initializers constructed from DATA statements and explicit
static initialization in declarations needs to include derived type
component default initializations, overriding those default values
without complaint with values from explicit DATA statement or declaration
initializations when they overlap.  This also has to work for objects
with storage association due to EQUIVALENCE.  When storage association causes
default component initializations to overlap, emit errors if and only
if the values differ (See Fortran 2018 subclause 19.5.3, esp. paragraph
10).

The f18 front-end has a module that analyzes and converts DATA statements
into equivalent static initializers for objects.  For storage-associated
objects, compiler-generated objects are created that overlay the entire
association and fill it with a combined initializer.  This "data-to-inits"
module already exists, and this patch is essentially extension and
clean-up of its machinery to complete the job.

Also: emit EQUIVALENCE to module files; mark compiler-created symbols
and *don't* emit those to module files; check non-static EQUIVALENCE
sets for conflicting default component initializations, so lowering
doesn't have to check them or emit diagnostics.

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

Author: klausler

flang/include/flang/Evaluate/initial-image.h

@@ -30,6 +30,7 @@ class InitialImage {
   };
 
   explicit InitialImage(std::size_t bytes) : data_(bytes) {}
+  InitialImage(InitialImage &&that) = default;
 
   std::size_t size() const { return data_.size(); }
 
@@ -93,19 +94,17 @@ class InitialImage {
 
   void AddPointer(ConstantSubscript, const Expr<SomeType> &);
 
-  void Incorporate(ConstantSubscript, const InitialImage &);
+  void Incorporate(ConstantSubscript toOffset, const InitialImage &from,
+      ConstantSubscript fromOffset, ConstantSubscript bytes);
 
   // Conversions to constant initializers
   std::optional<Expr<SomeType>> AsConstant(FoldingContext &,
       const DynamicType &, const ConstantSubscripts &,
       ConstantSubscript offset = 0) const;
-  std::optional<Expr<SomeType>> AsConstantDataPointer(
-      const DynamicType &, ConstantSubscript offset = 0) const;
-  const ProcedureDesignator &AsConstantProcPointer(
+  std::optional<Expr<SomeType>> AsConstantPointer(
       ConstantSubscript offset = 0) const;
 
   friend class AsConstantHelper;
-  friend class AsConstantDataPointerHelper;
 
 private:
   std::vector<char> data_;

flang/include/flang/Semantics/scope.h

@@ -41,6 +41,8 @@ struct EquivalenceObject {
       std::optional<ConstantSubscript> substringStart, parser::CharBlock source)
       : symbol{symbol}, subscripts{subscripts},
         substringStart{substringStart}, source{source} {}
+  explicit EquivalenceObject(Symbol &symbol)
+      : symbol{symbol}, source{symbol.name()} {}
 
   bool operator==(const EquivalenceObject &) const;
   bool operator<(const EquivalenceObject &) const;

flang/include/flang/Semantics/symbol.h

@@ -497,6 +497,7 @@ class Symbol {
       LocalityShared, // named in SHARED locality-spec
       InDataStmt, // initialized in a DATA statement
       InNamelist, // flag is set if the symbol is in Namelist statement
+      CompilerCreated,
       // OpenACC data-sharing attribute
       AccPrivate, AccFirstPrivate, AccShared,
       // OpenACC data-mapping attribute
@@ -782,7 +783,7 @@ struct SymbolAddressCompare {
   }
 };
 
-// Symbol comparison is based on the order of cooked source
+// Symbol comparison is usually based on the order of cooked source
 // stream creation and, when both are from the same cooked source,
 // their positions in that cooked source stream.
 // Don't use this comparator or OrderedSymbolSet to hold
@@ -794,12 +795,17 @@ struct SymbolSourcePositionCompare {
   bool operator()(const MutableSymbolRef &, const MutableSymbolRef &) const;
 };
 
+struct SymbolOffsetCompare {
+  bool operator()(const SymbolRef &, const SymbolRef &) const;
+  bool operator()(const MutableSymbolRef &, const MutableSymbolRef &) const;
+};
+
 using UnorderedSymbolSet = std::set<SymbolRef, SymbolAddressCompare>;
-using OrderedSymbolSet = std::set<SymbolRef, SymbolSourcePositionCompare>;
+using SourceOrderedSymbolSet = std::set<SymbolRef, SymbolSourcePositionCompare>;
 
 template <typename A>
-OrderedSymbolSet OrderBySourcePosition(const A &container) {
-  OrderedSymbolSet result;
+SourceOrderedSymbolSet OrderBySourcePosition(const A &container) {
+  SourceOrderedSymbolSet result;
   for (SymbolRef x : container) {
     result.emplace(x);
   }

flang/include/flang/Semantics/tools.h

@@ -56,6 +56,8 @@ const DeclTypeSpec *FindParentTypeSpec(const DeclTypeSpec &);
 const DeclTypeSpec *FindParentTypeSpec(const Scope &);
 const DeclTypeSpec *FindParentTypeSpec(const Symbol &);
 
+const EquivalenceSet *FindEquivalenceSet(const Symbol &);
+
 enum class Tristate { No, Yes, Maybe };
 inline Tristate ToTristate(bool x) { return x ? Tristate::Yes : Tristate::No; }
 
@@ -105,14 +107,13 @@ bool IsEventTypeOrLockType(const DerivedTypeSpec *);
 bool IsOrContainsEventOrLockComponent(const Symbol &);
 bool CanBeTypeBoundProc(const Symbol *);
 // Does a non-PARAMETER symbol have explicit initialization with =value or
-// =>target in its declaration, or optionally in a DATA statement? (Being
+// =>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 IsStaticallyInitialized(const Symbol &, bool ignoreDATAstatements = false);
+bool HasDeclarationInitializer(const Symbol &);
 // Is the symbol explicitly or implicitly initialized in any way?
-bool IsInitialized(const Symbol &, bool ignoreDATAstatements = false,
-    const Symbol *derivedType = nullptr);
+bool IsInitialized(const Symbol &, bool ignoreDATAstatements = false);
 // Is the symbol a component subject to deallocation or finalization?
 bool IsDestructible(const Symbol &, const Symbol *derivedType = nullptr);
 bool HasIntrinsicTypeName(const Symbol &);
@@ -330,6 +331,13 @@ enum class ProcedureDefinitionClass {
 
 ProcedureDefinitionClass ClassifyProcedure(const Symbol &);
 
+// Returns a list of storage associations due to EQUIVALENCE in a
+// scope; each storage association is a list of symbol references
+// in ascending order of scope offset.  Note that the scope may have
+// more EquivalenceSets than this function's result has storage
+// associations; these are closures over equivalences.
+std::list<std::list<SymbolRef>> GetStorageAssociations(const Scope &);
+
 // Derived type component iterator that provides a C++ LegacyForwardIterator
 // iterator over the Ordered, Direct, Ultimate or Potential components of a
 // DerivedTypeSpec. These iterators can be used with STL algorithms

flang/lib/Evaluate/initial-image.cpp

@@ -54,11 +54,14 @@ void InitialImage::AddPointer(
   pointers_.emplace(offset, pointer);
 }
 
-void InitialImage::Incorporate(
-    ConstantSubscript offset, const InitialImage &that) {
-  CHECK(that.pointers_.empty()); // pointers are not allowed in EQUIVALENCE
-  CHECK(offset + that.size() <= size());
-  std::memcpy(&data_[offset], &that.data_[0], that.size());
+void InitialImage::Incorporate(ConstantSubscript toOffset,
+    const InitialImage &from, ConstantSubscript fromOffset,
+    ConstantSubscript bytes) {
+  CHECK(from.pointers_.empty()); // pointers are not allowed in EQUIVALENCE
+  CHECK(fromOffset >= 0 && bytes >= 0 &&
+      static_cast<std::size_t>(fromOffset + bytes) <= from.size());
+  CHECK(static_cast<std::size_t>(toOffset + bytes) <= size());
+  std::memcpy(&data_[toOffset], &from.data_[fromOffset], bytes);
 }
 
 // Classes used with common::SearchTypes() to (re)construct Constant<> values
@@ -97,26 +100,31 @@ class AsConstantHelper {
       const semantics::DerivedTypeSpec &derived{type_.GetDerivedTypeSpec()};
       for (auto iter : DEREF(derived.scope())) {
         const Symbol &component{*iter.second};
-        bool isPointer{IsPointer(component)};
-        if (component.has<semantics::ObjectEntityDetails>() ||
-            component.has<semantics::ProcEntityDetails>()) {
-          auto componentType{DynamicType::From(component)};
-          CHECK(componentType);
+        bool isProcPtr{IsProcedurePointer(component)};
+        if (isProcPtr || component.has<semantics::ObjectEntityDetails>()) {
           auto at{offset_ + component.offset()};
-          if (isPointer) {
+          if (isProcPtr) {
             for (std::size_t j{0}; j < elements; ++j, at += stride) {
-              Result value{image_.AsConstantDataPointer(*componentType, at)};
-              CHECK(value);
-              typedValue[j].emplace(component, std::move(*value));
+              if (Result value{image_.AsConstantPointer(at)}) {
+                typedValue[j].emplace(component, std::move(*value));
+              }
+            }
+          } 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 {
+            auto componentType{DynamicType::From(component)};
+            CHECK(componentType.has_value());
             auto componentExtents{GetConstantExtents(context_, component)};
-            CHECK(componentExtents);
+            CHECK(componentExtents.has_value());
             for (std::size_t j{0}; j < elements; ++j, at += stride) {
-              Result value{image_.AsConstant(
-                  context_, *componentType, *componentExtents, at)};
-              CHECK(value);
-              typedValue[j].emplace(component, std::move(*value));
+              if (Result value{image_.AsConstant(
+                      context_, *componentType, *componentExtents, at)}) {
+                typedValue[j].emplace(component, std::move(*value));
+              }
             }
           }
         }
@@ -159,45 +167,11 @@ std::optional<Expr<SomeType>> InitialImage::AsConstant(FoldingContext &context,
       AsConstantHelper{context, type, extents, *this, offset});
 }
 
-class AsConstantDataPointerHelper {
-public:
-  using Result = std::optional<Expr<SomeType>>;
-  using Types = AllTypes;
-  AsConstantDataPointerHelper(const DynamicType &type,
-      const InitialImage &image, ConstantSubscript offset = 0)
-      : type_{type}, image_{image}, offset_{offset} {}
-  template <typename T> Result Test() {
-    if (T::category != type_.category()) {
-      return std::nullopt;
-    }
-    if constexpr (T::category != TypeCategory::Derived) {
-      if (T::kind != type_.kind()) {
-        return std::nullopt;
-      }
-    }
-    auto iter{image_.pointers_.find(offset_)};
-    if (iter == image_.pointers_.end()) {
-      return AsGenericExpr(NullPointer{});
-    }
-    return iter->second;
-  }
-
-private:
-  const DynamicType &type_;
-  const InitialImage &image_;
-  ConstantSubscript offset_;
-};
-
-std::optional<Expr<SomeType>> InitialImage::AsConstantDataPointer(
-    const DynamicType &type, ConstantSubscript offset) const {
-  return common::SearchTypes(AsConstantDataPointerHelper{type, *this, offset});
-}
-
-const ProcedureDesignator &InitialImage::AsConstantProcPointer(
+std::optional<Expr<SomeType>> InitialImage::AsConstantPointer(
     ConstantSubscript offset) const {
-  auto iter{pointers_.find(0)};
-  CHECK(iter != pointers_.end());
-  return DEREF(std::get_if<ProcedureDesignator>(&iter->second.u));
+  auto iter{pointers_.find(offset)};
+  return iter == pointers_.end() ? std::optional<Expr<SomeType>>{}
+                                 : iter->second;
 }
 
 } // namespace Fortran::evaluate

flang/lib/Semantics/check-declarations.cpp

@@ -526,7 +526,7 @@ void CheckHelper::CheckObjectEntity(
     messages_.Say("OPTIONAL attribute may apply only to a dummy "
                   "argument"_err_en_US); // C849
   }
-  if (IsStaticallyInitialized(symbol, true /* ignore DATA inits */)) { // C808
+  if (HasDeclarationInitializer(symbol)) { // C808; ignore DATA initialization
     CheckPointerInitialization(symbol);
     if (IsAutomatic(symbol)) {
       messages_.Say(

flang/lib/Semantics/compute-offsets.cpp

@@ -38,9 +38,9 @@ class ComputeOffsetsHelper {
   };
   struct SymbolAndOffset {
     SymbolAndOffset(Symbol &s, std::size_t off, const EquivalenceObject &obj)
-        : symbol{&s}, offset{off}, object{&obj} {}
+        : symbol{s}, offset{off}, object{&obj} {}
     SymbolAndOffset(const SymbolAndOffset &) = default;
-    Symbol *symbol;
+    MutableSymbolRef symbol;
     std::size_t offset;
     const EquivalenceObject *object;
   };