[flang] Handle DATA initialization of EQUIVALENCE'd objects

[klausler]

Summary

Objects that are storage associated by EQUIVALENCE and
initialized with DATA are initialized by creating a
compiler temporary data object in the same scope,
assigning it an offset, type, and size that covers the
transitive closure of the associated initialized original
symbols, and combining their initializers into one common
initializer for the temporary.

Some problems with offset assignment of EQUIVALENCE'd objects
in COMMON were exposed and corrected, and some more error
cases are checked.

[tskeith]

flang/lib/Semantics/data-to-inits.h

19

[klausler]

Fixed warning (class vs struct).

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

 
   void AddPointer(ConstantSubscript, const Expr<SomeType> &);
 
+  void Incorporate(ConstantSubscript, const InitialImage &);
+
   // Conversions to constant initializers
   std::optional<Expr<SomeType>> AsConstant(FoldingContext &,
       const DynamicType &, const ConstantSubscripts &,

flang/include/flang/Parser/parsing.h

         o, cooked_.GetProvenanceRange(CharBlock(at)), message, echoSourceLine);
   }
 
-  bool ForTesting(std::string path, llvm::raw_ostream &);
-
 private:
   Options options_;
   CookedSource cooked_;

flang/include/flang/Semantics/semantics.h

   void ActivateIndexVar(const parser::Name &, IndexVarKind);
   void DeactivateIndexVar(const parser::Name &);
   SymbolVector GetIndexVars(IndexVarKind);
+  SourceName GetTempName(const Scope &);
 
 private:
   void CheckIndexVarRedefine(

     IndexVarKind kind;
   };
   std::map<SymbolRef, const IndexVarInfo> activeIndexVars_;
+  std::vector<std::string> tempNames_;
 };
 
 class Semantics {

flang/include/flang/Semantics/type.h

   static Bound Assumed() { return Bound(Category::Assumed); }
   static Bound Deferred() { return Bound(Category::Deferred); }
   explicit Bound(MaybeSubscriptIntExpr &&expr) : expr_{std::move(expr)} {}
-  explicit Bound(int bound);
+  explicit Bound(common::ConstantSubscript bound);
   Bound(const Bound &) = default;
   Bound(Bound &&) = default;
   Bound &operator=(const Bound &) = default;

flang/lib/Evaluate/initial-image.cpp

 #include "flang/Evaluate/initial-image.h"
 #include "flang/Semantics/scope.h"
 #include "flang/Semantics/tools.h"
+#include <cstring>
 
 namespace Fortran::evaluate {
 

   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());
+}
+
 // Classes used with common::SearchTypes() to (re)construct Constant<> values
 // of the right type to initialize each symbol from the values that have
 // been placed into its initialization image by DATA statements.

flang/lib/Parser/parsing.cpp

 
 void Parsing::ClearLog() { log_.clear(); }
 
-bool Parsing::ForTesting(std::string path, llvm::raw_ostream &err) {
-  llvm::raw_null_ostream NullStream;
-  Prescan(path, Options{});
-  if (messages_.AnyFatalError()) {
-    messages_.Emit(err, cooked_);
-    err << "could not scan " << path << '\n';
-    return false;
-  }
-  Parse(NullStream);
-  messages_.Emit(err, cooked_);
-  if (!consumedWholeFile_) {
-    EmitMessage(err, finalRestingPlace_, "parser FAIL; final position");
-    return false;
-  }
-  if (messages_.AnyFatalError() || !parseTree_.has_value()) {
-    err << "could not parse " << path << '\n';
-    return false;
-  }
-  return true;
-}
 } // namespace Fortran::parser

flang/lib/Semantics/CMakeLists.txt

   check-select-type.cpp
   check-stop.cpp
   compute-offsets.cpp
+  data-to-inits.cpp
   expression.cpp
   mod-file.cpp
   pointer-assignment.cpp

flang/lib/Semantics/check-data.h

 #ifndef FORTRAN_SEMANTICS_CHECK_DATA_H_
 #define FORTRAN_SEMANTICS_CHECK_DATA_H_
 
+#include "data-to-inits.h"
 #include "flang/Common/interval.h"
 #include "flang/Evaluate/fold-designator.h"
 #include "flang/Evaluate/initial-image.h"

 
 namespace Fortran::semantics {
 
-struct SymbolDataInitialization {
-  using Range = common::Interval<ConstantSubscript>;
-  explicit SymbolDataInitialization(std::size_t bytes) : image{bytes} {}
-  evaluate::InitialImage image;
-  std::list<Range> inits;
-};
-
-using DataInitializations = std::map<SymbolRef, SymbolDataInitialization>;
-
 class DataChecker : public virtual BaseChecker {
 public:
   explicit DataChecker(SemanticsContext &context) : exprAnalyzer_{context} {}

   template <typename T> void CheckIfConstantSubscript(const T &);
   void CheckSubscript(const parser::SectionSubscript &);
   bool CheckAllSubscriptsInDataRef(const parser::DataRef &, parser::CharBlock);
-  void ConstructInitializer(const Symbol &, SymbolDataInitialization &);
 
   DataInitializations inits_;
   evaluate::ExpressionAnalyzer exprAnalyzer_;

flang/lib/Semantics/check-data.cpp

 // DATA statement semantic analysis.
 // - Applies static semantic checks to the variables in each data-stmt-set with
 //   class DataVarChecker;
-// - Applies specific checks to each scalar element initialization with a
-//   constant value or pointer tareg with class DataInitializationCompiler;
-// - Collects the elemental initializations for each symbol and converts them
-//   into a single init() expression with member function
-//   DataChecker::ConstructInitializer().
+// - Invokes conversion of DATA statement values to static initializers
 
 #include "check-data.h"
-#include "pointer-assignment.h"
-#include "flang/Evaluate/fold-designator.h"
+#include "data-to-inits.h"
 #include "flang/Evaluate/traverse.h"
 #include "flang/Parser/parse-tree.h"
 #include "flang/Parser/tools.h"
 #include "flang/Semantics/tools.h"
+#include <algorithm>
+#include <vector>
 
 namespace Fortran::semantics {
 

         }
       }
     }
+    currentSetHasFatalErrors_ = true;
   }
-  currentSetHasFatalErrors_ = true;
 }
 
 void DataChecker::Leave(const parser::DataStmtObject &dataObject) {

       dataObject.u);
 }
 
-// Steps through a list of values in a DATA statement set; implements
-// repetition.
-class ValueListIterator {
-public:
-  explicit ValueListIterator(const parser::DataStmtSet &set)
-      : end_{std::get<std::list<parser::DataStmtValue>>(set.t).end()},
-        at_{std::get<std::list<parser::DataStmtValue>>(set.t).begin()} {
-    SetRepetitionCount();
-  }
-  bool hasFatalError() const { return hasFatalError_; }
-  bool IsAtEnd() const { return at_ == end_; }
-  const SomeExpr *operator*() const { return GetExpr(GetConstant()); }
-  parser::CharBlock LocateSource() const { return GetConstant().source; }
-  ValueListIterator &operator++() {
-    if (repetitionsRemaining_ > 0) {
-      --repetitionsRemaining_;
-    } else if (at_ != end_) {
-      ++at_;
-      SetRepetitionCount();
-    }
-    return *this;
-  }
-
-private:
-  using listIterator = std::list<parser::DataStmtValue>::const_iterator;
-  void SetRepetitionCount();
-  const parser::DataStmtConstant &GetConstant() const {
-    return std::get<parser::DataStmtConstant>(at_->t);
-  }
-
-  listIterator end_;
-  listIterator at_;
-  ConstantSubscript repetitionsRemaining_{0};
-  bool hasFatalError_{false};
-};
-
-void ValueListIterator::SetRepetitionCount() {
-  for (repetitionsRemaining_ = 1; at_ != end_; ++at_) {
-    if (at_->repetitions < 0) {
-      hasFatalError_ = true;
-    }
-    if (at_->repetitions > 0) {
-      repetitionsRemaining_ = at_->repetitions - 1;
-      return;
-    }
-  }
-  repetitionsRemaining_ = 0;
-}
-
-// Collects all of the elemental initializations from DATA statements
-// into a single image for each symbol that appears in any DATA.
-// Expands the implied DO loops and array references.
-// Applies checks that validate each distinct elemental initialization
-// of the variables in a data-stmt-set, as well as those that apply
-// to the corresponding values being use to initialize each element.
-class DataInitializationCompiler {
-public:
-  DataInitializationCompiler(DataInitializations &inits,
-      evaluate::ExpressionAnalyzer &a, const parser::DataStmtSet &set)
-      : inits_{inits}, exprAnalyzer_{a}, values_{set} {}
-  const DataInitializations &inits() const { return inits_; }
-  bool HasSurplusValues() const { return !values_.IsAtEnd(); }
-  bool Scan(const parser::DataStmtObject &);
-
-private:
-  bool Scan(const parser::Variable &);
-  bool Scan(const parser::Designator &);
-  bool Scan(const parser::DataImpliedDo &);
-  bool Scan(const parser::DataIDoObject &);
-
-  // Initializes all elements of a designator, which can be an array or section.
-  bool InitDesignator(const SomeExpr &);
-  // Initializes a single object.
-  bool InitElement(const evaluate::OffsetSymbol &, const SomeExpr &designator);
-  // If the returned flag is true, emit a warning about CHARACTER misusage.
-  std::optional<std::pair<SomeExpr, bool>> ConvertElement(
-      const SomeExpr &, const evaluate::DynamicType &);
-
-  DataInitializations &inits_;
-  evaluate::ExpressionAnalyzer &exprAnalyzer_;
-  ValueListIterator values_;
-};
-
-bool DataInitializationCompiler::Scan(const parser::DataStmtObject &object) {
-  return std::visit(
-      common::visitors{
-          [&](const common::Indirection<parser::Variable> &var) {
-            return Scan(var.value());
-          },
-          [&](const parser::DataImpliedDo &ido) { return Scan(ido); },
-      },
-      object.u);
-}
-
-bool DataInitializationCompiler::Scan(const parser::Variable &var) {
-  if (const auto *expr{GetExpr(var)}) {
-    exprAnalyzer_.GetFoldingContext().messages().SetLocation(var.GetSource());
-    if (InitDesignator(*expr)) {
-      return true;
-    }
-  }
-  return false;
-}
-
-bool DataInitializationCompiler::Scan(const parser::Designator &designator) {
-  if (auto expr{exprAnalyzer_.Analyze(designator)}) {
-    exprAnalyzer_.GetFoldingContext().messages().SetLocation(
-        parser::FindSourceLocation(designator));
-    if (InitDesignator(*expr)) {
-      return true;
-    }
-  }
-  return false;
-}
-
-bool DataInitializationCompiler::Scan(const parser::DataImpliedDo &ido) {
-  const auto &bounds{std::get<parser::DataImpliedDo::Bounds>(ido.t)};
-  auto name{bounds.name.thing.thing};
-  const auto *lowerExpr{GetExpr(bounds.lower.thing.thing)};
-  const auto *upperExpr{GetExpr(bounds.upper.thing.thing)};
-  const auto *stepExpr{
-      bounds.step ? GetExpr(bounds.step->thing.thing) : nullptr};
-  if (lowerExpr && upperExpr) {
-    auto lower{ToInt64(*lowerExpr)};
-    auto upper{ToInt64(*upperExpr)};
-    auto step{stepExpr ? ToInt64(*stepExpr) : std::nullopt};
-    auto stepVal{step.value_or(1)};
-    if (stepVal == 0) {
-      exprAnalyzer_.Say(name.source,
-          "DATA statement implied DO loop has a step value of zero"_err_en_US);
-    } else if (lower && upper) {
-      int kind{evaluate::ResultType<evaluate::ImpliedDoIndex>::kind};
-      if (const auto dynamicType{evaluate::DynamicType::From(*name.symbol)}) {
-        if (dynamicType->category() == TypeCategory::Integer) {
-          kind = dynamicType->kind();
-        }
-      }
-      if (exprAnalyzer_.AddImpliedDo(name.source, kind)) {
-        auto &value{exprAnalyzer_.GetFoldingContext().StartImpliedDo(
-            name.source, *lower)};
-        bool result{true};
-        for (auto n{(*upper - value + stepVal) / stepVal}; n > 0;
-             --n, value += stepVal) {
-          for (const auto &object :
-              std::get<std::list<parser::DataIDoObject>>(ido.t)) {
-            if (!Scan(object)) {
-              result = false;
-              break;
-            }
-          }
-        }
-        exprAnalyzer_.GetFoldingContext().EndImpliedDo(name.source);
-        exprAnalyzer_.RemoveImpliedDo(name.source);
-        return result;
-      }
-    }
-  }
-  return false;
-}
-
-bool DataInitializationCompiler::Scan(const parser::DataIDoObject &object) {
-  return std::visit(
-      common::visitors{
-          [&](const parser::Scalar<common::Indirection<parser::Designator>>
-                  &var) { return Scan(var.thing.value()); },
-          [&](const common::Indirection<parser::DataImpliedDo> &ido) {
-            return Scan(ido.value());
-          },
-      },
-      object.u);
-}
-
-bool DataInitializationCompiler::InitDesignator(const SomeExpr &designator) {
-  evaluate::FoldingContext &context{exprAnalyzer_.GetFoldingContext()};
-  evaluate::DesignatorFolder folder{context};
-  while (auto offsetSymbol{folder.FoldDesignator(designator)}) {
-    if (folder.isOutOfRange()) {
-      if (auto bad{evaluate::OffsetToDesignator(context, *offsetSymbol)}) {
-        exprAnalyzer_.context().Say(
-            "DATA statement designator '%s' is out of range"_err_en_US,
-            bad->AsFortran());
-      } else {
-        exprAnalyzer_.context().Say(
-            "DATA statement designator '%s' is out of range"_err_en_US,
-            designator.AsFortran());
-      }
-      return false;
-    } else if (!InitElement(*offsetSymbol, designator)) {
-      return false;
-    } else {
-      ++values_;
-    }
-  }
-  return folder.isEmpty();
-}
-
-std::optional<std::pair<SomeExpr, bool>>
-DataInitializationCompiler::ConvertElement(
-    const SomeExpr &expr, const evaluate::DynamicType &type) {
-  if (auto converted{evaluate::ConvertToType(type, SomeExpr{expr})}) {
-    return {std::make_pair(std::move(*converted), false)};
-  }
-  if (std::optional<std::string> chValue{evaluate::GetScalarConstantValue<
-          evaluate::Type<TypeCategory::Character, 1>>(expr)}) {
-    // Allow DATA initialization with Hollerith and kind=1 CHARACTER like
-    // (most) other Fortran compilers do.  Pad on the right with spaces
-    // when short, truncate the right if long.
-    // TODO: big-endian targets
-    std::size_t bytes{type.MeasureSizeInBytes().value()};
-    evaluate::BOZLiteralConstant bits{0};
-    for (std::size_t j{0}; j < bytes; ++j) {
-      char ch{j >= chValue->size() ? ' ' : chValue->at(j)};
-      evaluate::BOZLiteralConstant chBOZ{static_cast<unsigned char>(ch)};
-      bits = bits.IOR(chBOZ.SHIFTL(8 * j));
-    }
-    if (auto converted{evaluate::ConvertToType(type, SomeExpr{bits})}) {
-      return {std::make_pair(std::move(*converted), true)};
-    }
-  }
-  return std::nullopt;
-}
-
-bool DataInitializationCompiler::InitElement(
-    const evaluate::OffsetSymbol &offsetSymbol, const SomeExpr &designator) {
-  const Symbol &symbol{offsetSymbol.symbol()};
-  const Symbol *lastSymbol{GetLastSymbol(designator)};
-  bool isPointer{lastSymbol && IsPointer(*lastSymbol)};
-  bool isProcPointer{lastSymbol && IsProcedurePointer(*lastSymbol)};
-  evaluate::FoldingContext &context{exprAnalyzer_.GetFoldingContext()};
-
-  const auto DescribeElement{[&]() {
-    if (auto badDesignator{
-            evaluate::OffsetToDesignator(context, offsetSymbol)}) {
-      return badDesignator->AsFortran();
-    } else {
-      // Error recovery
-      std::string buf;
-      llvm::raw_string_ostream ss{buf};
-      ss << offsetSymbol.symbol().name() << " offset " << offsetSymbol.offset()
-         << " bytes for " << offsetSymbol.size() << " bytes";
-      return ss.str();
-    }
-  }};
-  const auto GetImage{[&]() -> evaluate::InitialImage & {
-    auto &symbolInit{inits_.emplace(symbol, symbol.size()).first->second};
-    symbolInit.inits.emplace_back(offsetSymbol.offset(), offsetSymbol.size());
-    return symbolInit.image;
-  }};
-  const auto OutOfRangeError{[&]() {
-    evaluate::AttachDeclaration(
-        exprAnalyzer_.context().Say(
-            "DATA statement designator '%s' is out of range for its variable '%s'"_err_en_US,
-            DescribeElement(), symbol.name()),
-        symbol);
-  }};
-
-  if (values_.hasFatalError()) {
-    return false;
-  } else if (values_.IsAtEnd()) {
-    exprAnalyzer_.context().Say(
-        "DATA statement set has no value for '%s'"_err_en_US,
-        DescribeElement());
-    return false;
-  } else if (static_cast<std::size_t>(
-                 offsetSymbol.offset() + offsetSymbol.size()) > symbol.size()) {
-    OutOfRangeError();
-    return false;
-  }
-
-  const SomeExpr *expr{*values_};
-  if (!expr) {
-    CHECK(exprAnalyzer_.context().AnyFatalError());
-  } else if (isPointer) {
-    if (static_cast<std::size_t>(offsetSymbol.offset() + offsetSymbol.size()) >
-        symbol.size()) {
-      OutOfRangeError();
-    } else if (evaluate::IsNullPointer(*expr)) {
-      // nothing to do; rely on zero initialization
-      return true;
-    } else if (evaluate::IsProcedure(*expr)) {
-      if (isProcPointer) {
-        if (CheckPointerAssignment(context, designator, *expr)) {
-          GetImage().AddPointer(offsetSymbol.offset(), *expr);
-          return true;
-        }
-      } else {
-        exprAnalyzer_.Say(values_.LocateSource(),
-            "Procedure '%s' may not be used to initialize '%s', which is not a procedure pointer"_err_en_US,
-            expr->AsFortran(), DescribeElement());
-      }
-    } else if (isProcPointer) {
-      exprAnalyzer_.Say(values_.LocateSource(),
-          "Data object '%s' may not be used to initialize '%s', which is a procedure pointer"_err_en_US,
-          expr->AsFortran(), DescribeElement());
-    } else if (CheckInitialTarget(context, designator, *expr)) {
-      GetImage().AddPointer(offsetSymbol.offset(), *expr);
-      return true;
-    }
-  } else if (evaluate::IsNullPointer(*expr)) {
-    exprAnalyzer_.Say(values_.LocateSource(),
-        "Initializer for '%s' must not be a pointer"_err_en_US,
-        DescribeElement());
-  } else if (evaluate::IsProcedure(*expr)) {
-    exprAnalyzer_.Say(values_.LocateSource(),
-        "Initializer for '%s' must not be a procedure"_err_en_US,
-        DescribeElement());
-  } else if (auto designatorType{designator.GetType()}) {
-    if (auto converted{ConvertElement(*expr, *designatorType)}) {
-      // value non-pointer initialization
-      if (std::holds_alternative<evaluate::BOZLiteralConstant>(expr->u) &&
-          designatorType->category() != TypeCategory::Integer) { // 8.6.7(11)
-        exprAnalyzer_.Say(values_.LocateSource(),
-            "BOZ literal should appear in a DATA statement only as a value for an integer object, but '%s' is '%s'"_en_US,
-            DescribeElement(), designatorType->AsFortran());
-      } else if (converted->second) {
-        exprAnalyzer_.context().Say(
-            "DATA statement value initializes '%s' of type '%s' with CHARACTER"_en_US,
-            DescribeElement(), designatorType->AsFortran());
-      }
-      auto folded{evaluate::Fold(context, std::move(converted->first))};
-      switch (
-          GetImage().Add(offsetSymbol.offset(), offsetSymbol.size(), folded)) {
-      case evaluate::InitialImage::Ok:
-        return true;
-      case evaluate::InitialImage::NotAConstant:
-        exprAnalyzer_.Say(values_.LocateSource(),
-            "DATA statement value '%s' for '%s' is not a constant"_err_en_US,
-            folded.AsFortran(), DescribeElement());
-        break;
-      case evaluate::InitialImage::OutOfRange:
-        OutOfRangeError();
-        break;
-      default:
-        CHECK(exprAnalyzer_.context().AnyFatalError());
-        break;
-      }
-    } else {
-      exprAnalyzer_.context().Say(
-          "DATA statement value could not be converted to the type '%s' of the object '%s'"_err_en_US,
-          designatorType->AsFortran(), DescribeElement());
-    }
-  } else {
-    CHECK(exprAnalyzer_.context().AnyFatalError());
-  }
-  return false;
-}
-
 void DataChecker::Leave(const parser::DataStmtSet &set) {
   if (!currentSetHasFatalErrors_) {
-    DataInitializationCompiler scanner{inits_, exprAnalyzer_, set};
-    for (const auto &object :
-        std::get<std::list<parser::DataStmtObject>>(set.t)) {
-      if (!scanner.Scan(object)) {
-        return;
-      }
-    }
-    if (scanner.HasSurplusValues()) {
-      exprAnalyzer_.context().Say(
-          "DATA statement set has more values than objects"_err_en_US);
-    }
+    AccumulateDataInitializations(inits_, exprAnalyzer_, set);
   }
   currentSetHasFatalErrors_ = false;
 }
 
-// Converts the initialization image for all the DATA statement appearances of
-// a single symbol into an init() expression in the symbol table entry.
-void DataChecker::ConstructInitializer(
-    const Symbol &symbol, SymbolDataInitialization &initialization) {
-  auto &context{exprAnalyzer_.GetFoldingContext()};
-  initialization.inits.sort();
-  ConstantSubscript next{0};
-  for (const auto &init : initialization.inits) {
-    if (init.start() < next) {
-      auto badDesignator{evaluate::OffsetToDesignator(
-          context, symbol, init.start(), init.size())};
-      CHECK(badDesignator);
-      exprAnalyzer_.Say(symbol.name(),
-          "DATA statement initializations affect '%s' more than once"_err_en_US,
-          badDesignator->AsFortran());
-    }
-    next = init.start() + init.size();
-    CHECK(next <= static_cast<ConstantSubscript>(initialization.image.size()));
-  }
-  if (const auto *proc{symbol.detailsIf<ProcEntityDetails>()}) {
-    CHECK(IsProcedurePointer(symbol));
-    const auto &procDesignator{initialization.image.AsConstantProcPointer()};
-    CHECK(!procDesignator.GetComponent());
-    auto &mutableProc{const_cast<ProcEntityDetails &>(*proc)};
-    mutableProc.set_init(DEREF(procDesignator.GetSymbol()));
-  } else if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
-    if (auto symbolType{evaluate::DynamicType::From(symbol)}) {
-      auto &mutableObject{const_cast<ObjectEntityDetails &>(*object)};
-      if (IsPointer(symbol)) {
-        mutableObject.set_init(
-            initialization.image.AsConstantDataPointer(*symbolType));
-        mutableObject.set_initWasValidated();
-      } else {
-        if (auto extents{evaluate::GetConstantExtents(context, symbol)}) {
-          mutableObject.set_init(
-              initialization.image.AsConstant(context, *symbolType, *extents));
-          mutableObject.set_initWasValidated();
-        } else {
-          exprAnalyzer_.Say(symbol.name(),
-              "internal: unknown shape for '%s' while constructing initializer from DATA"_err_en_US,
-              symbol.name());
-          return;
-        }
-      }
-    } else {
-      exprAnalyzer_.Say(symbol.name(),
-          "internal: no type for '%s' while constructing initializer from DATA"_err_en_US,
-          symbol.name());
-      return;
-    }
-    if (!object->init()) {
-      exprAnalyzer_.Say(symbol.name(),
-          "internal: could not construct an initializer from DATA statements for '%s'"_err_en_US,
-          symbol.name());
-    }
-  } else {
-    CHECK(exprAnalyzer_.context().AnyFatalError());
-  }
-}
-
 void DataChecker::CompileDataInitializationsIntoInitializers() {
-  for (auto &[symbolRef, initialization] : inits_) {
-    ConstructInitializer(*symbolRef, initialization);
-  }
+  ConvertToInitializers(inits_, exprAnalyzer_);
 }
 
 } // namespace Fortran::semantics

flang/lib/Semantics/compute-offsets.cpp

   void Compute(Scope &);
   void DoScope(Scope &);
   void DoCommonBlock(Symbol &);
+  void DoEquivalenceBlockBase(Symbol &, SizeAndAlignment &);
   void DoEquivalenceSet(const EquivalenceSet &);
   SymbolAndOffset Resolve(const SymbolAndOffset &);
   std::size_t ComputeOffset(const EquivalenceObject &);

   std::size_t alignment_{0};
   // symbol -> symbol+offset that determines its location, from EQUIVALENCE
   std::map<MutableSymbolRef, SymbolAndOffset> dependents_;
+  // base symbol -> SizeAndAlignment for each distinct EQUIVALENCE block
+  std::map<MutableSymbolRef, SizeAndAlignment> equivalenceBlock_;
 };
 
 void ComputeOffsetsHelper::Compute(Scope &scope) {

     Compute(child);
   }
   DoScope(scope);
+  dependents_.clear();
+  equivalenceBlock_.clear();
 }
 
 static bool InCommonBlock(const Symbol &symbol) {

   if (scope.symbol() && scope.IsParameterizedDerivedType()) {
     return; // only process instantiations of parameterized derived types
   }
-  // Symbols in common block get offsets from the beginning of the block
-  for (auto &pair : scope.commonBlocks()) {
-    DoCommonBlock(*pair.second);
-  }
   // Build dependents_ from equivalences: symbol -> symbol+offset
   for (const EquivalenceSet &set : scope.equivalenceSets()) {
     DoEquivalenceSet(set);
   }
   offset_ = 0;
   alignment_ = 0;
+  // Compute a base symbol and overall block size for each
+  // disjoint EQUIVALENCE storage sequence.
+  for (auto &[symbol, dep] : dependents_) {
+    dep = Resolve(dep);
+    CHECK(symbol->size() == 0);
+    auto symInfo{GetSizeAndAlignment(*symbol)};
+    symbol->set_size(symInfo.size);
+    Symbol &base{*dep.symbol};
+    auto iter{equivalenceBlock_.find(base)};
+    std::size_t minBlockSize{dep.offset + symInfo.size};
+    if (iter == equivalenceBlock_.end()) {
+      equivalenceBlock_.emplace(
+          base, SizeAndAlignment{minBlockSize, symInfo.alignment});
+    } else {
+      SizeAndAlignment &blockInfo{iter->second};
+      blockInfo.size = std::max(blockInfo.size, minBlockSize);
+      blockInfo.alignment = std::max(blockInfo.alignment, symInfo.alignment);
+    }
+  }
+  // Assign offsets for non-COMMON EQUIVALENCE blocks
+  for (auto &[symbol, blockInfo] : equivalenceBlock_) {
+    if (!InCommonBlock(*symbol)) {
+      DoSymbol(*symbol);
+      DoEquivalenceBlockBase(*symbol, blockInfo);
+      offset_ = std::max(offset_, symbol->offset() + blockInfo.size);
+    }
+  }
+  // Process remaining non-COMMON symbols; this is all of them if there
+  // was no use of EQUIVALENCE in the scope.
   for (auto &symbol : scope.GetSymbols()) {
     if (!InCommonBlock(*symbol) &&
-        dependents_.find(symbol) == dependents_.end()) {
+        dependents_.find(symbol) == dependents_.end() &&
+        equivalenceBlock_.find(symbol) == equivalenceBlock_.end()) {
       DoSymbol(*symbol);
     }
   }
+  scope.set_size(offset_);
+  scope.set_alignment(alignment_);
+  // Assign offsets in COMMON blocks.
+  for (auto &pair : scope.commonBlocks()) {
+    DoCommonBlock(*pair.second);
+  }
   for (auto &[symbol, dep] : dependents_) {
-    if (symbol->size() == 0) {
-      SizeAndAlignment s{GetSizeAndAlignment(*symbol)};
-      symbol->set_size(s.size);
-      SymbolAndOffset resolved{Resolve(dep)};
-      symbol->set_offset(dep.symbol->offset() + resolved.offset);
-      offset_ = std::max(offset_, symbol->offset() + symbol->size());
+    symbol->set_offset(dep.symbol->offset() + dep.offset);
+    if (const auto *block{FindCommonBlockContaining(*dep.symbol)}) {
+      symbol->get<ObjectEntityDetails>().set_commonBlock(*block);
     }
   }
-  scope.set_size(offset_);
-  scope.set_alignment(alignment_);
 }
 
 auto ComputeOffsetsHelper::Resolve(const SymbolAndOffset &dep)

   auto &details{commonBlock.get<CommonBlockDetails>()};
   offset_ = 0;
   alignment_ = 0;
+  std::size_t minSize{0};
+  std::size_t minAlignment{0};
   for (auto &object : details.objects()) {
-    DoSymbol(*object);
+    Symbol &symbol{*object};
+    DoSymbol(symbol);
+    auto iter{dependents_.find(symbol)};
+    if (iter == dependents_.end()) {
+      // Get full extent of any EQUIVALENCE block into size of COMMON
+      auto eqIter{equivalenceBlock_.find(symbol)};
+      if (eqIter != equivalenceBlock_.end()) {
+        SizeAndAlignment &blockInfo{eqIter->second};
+        DoEquivalenceBlockBase(symbol, blockInfo);
+        minSize = std::max(
+            minSize, std::max(offset_, symbol.offset() + blockInfo.size));
+        minAlignment = std::max(minAlignment, blockInfo.alignment);
+      }
+    } else {
+      SymbolAndOffset &dep{iter->second};
+      Symbol &base{*dep.symbol};
+      auto errorSite{
+          commonBlock.name().empty() ? symbol.name() : commonBlock.name()};
+      if (const auto *baseBlock{FindCommonBlockContaining(base)}) {
+        if (baseBlock == &commonBlock) {
+          context_.Say(errorSite,
+              "'%s' is storage associated with '%s' by EQUIVALENCE elsewhere in COMMON block /%s/"_err_en_US,
+              symbol.name(), base.name(), commonBlock.name());
+        } else { // 8.10.3(1)
+          context_.Say(errorSite,
+              "'%s' in COMMON block /%s/ must not be storage associated with '%s' in COMMON block /%s/ by EQUIVALENCE"_err_en_US,
+              symbol.name(), commonBlock.name(), base.name(),
+              baseBlock->name());
+        }
+      } else if (dep.offset > symbol.offset()) { // 8.10.3(3)
+        context_.Say(errorSite,
+            "'%s' cannot backward-extend COMMON block /%s/ via EQUIVALENCE with '%s'"_err_en_US,
+            symbol.name(), commonBlock.name(), base.name());
+      } else {
+        base.get<ObjectEntityDetails>().set_commonBlock(commonBlock);
+        base.set_offset(symbol.offset() - dep.offset);
+      }
+    }
+  }
+  commonBlock.set_size(std::max(minSize, offset_));
+  details.set_alignment(std::max(minAlignment, alignment_));
+}
+
+void ComputeOffsetsHelper::DoEquivalenceBlockBase(
+    Symbol &symbol, SizeAndAlignment &blockInfo) {
+  if (symbol.size() > blockInfo.size) {
+    blockInfo.size = symbol.size();
   }
-  commonBlock.set_size(offset_);
-  details.set_alignment(alignment_);
 }
 
 void ComputeOffsetsHelper::DoEquivalenceSet(const EquivalenceSet &set) {

flang/lib/Semantics/data-to-inits.h

+//===-- lib/Semantics/data-to-inits.h -------------------------------------===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_SEMANTICS_DATA_TO_INITS_H_
+#define FORTRAN_SEMANTICS_DATA_TO_INITS_H_
+
+#include "flang/Common/default-kinds.h"
+#include "flang/Common/interval.h"
+#include "flang/Evaluate/initial-image.h"
+#include <list>
+#include <map>
+
+namespace Fortran::parser {
+class DataStmtSet;
+}
+namespace Fortran::evaluate {
+class ExpressionAnalyzer;
+}
+namespace Fortran::semantics {
+
+class Symbol;
+
+struct SymbolDataInitialization {
+  using Range = common::Interval<common::ConstantSubscript>;
+  explicit SymbolDataInitialization(std::size_t bytes) : image{bytes} {}
+  evaluate::InitialImage image;
+  std::list<Range> inits;
+};
+
+using DataInitializations = std::map<const Symbol *, SymbolDataInitialization>;
+
+// Matches DATA statement variables with their values and checks
+// compatibility.
+void AccumulateDataInitializations(DataInitializations &,
+    evaluate::ExpressionAnalyzer &, const parser::DataStmtSet &);
+
+void ConvertToInitializers(
+    DataInitializations &, evaluate::ExpressionAnalyzer &);
+
+} // namespace Fortran::semantics
+#endif // FORTRAN_SEMANTICS_DATA_TO_INITS_H_

flang/lib/Semantics/data-to-inits.cpp

+//===-- lib/Semantics/data-to-inits.cpp -----------------------------------===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+// DATA statement object/value checking and conversion to static
+// initializers
+// - Applies specific checks to each scalar element initialization with a
+//   constant value or pointer target with class DataInitializationCompiler;
+// - Collects the elemental initializations for each symbol and converts them
+//   into a single init() expression with member function
+//   DataChecker::ConstructInitializer().
+
+#include "data-to-inits.h"
+#include "pointer-assignment.h"
+#include "flang/Evaluate/fold-designator.h"
+#include "flang/Semantics/tools.h"
+
+namespace Fortran::semantics {
+
+// Steps through a list of values in a DATA statement set; implements
+// repetition.
+class ValueListIterator {
+public:
+  explicit ValueListIterator(const parser::DataStmtSet &set)
+      : end_{std::get<std::list<parser::DataStmtValue>>(set.t).end()},
+        at_{std::get<std::list<parser::DataStmtValue>>(set.t).begin()} {
+    SetRepetitionCount();
+  }
+  bool hasFatalError() const { return hasFatalError_; }
+  bool IsAtEnd() const { return at_ == end_; }
+  const SomeExpr *operator*() const { return GetExpr(GetConstant()); }
+  parser::CharBlock LocateSource() const { return GetConstant().source; }
+  ValueListIterator &operator++() {
+    if (repetitionsRemaining_ > 0) {
+      --repetitionsRemaining_;
+    } else if (at_ != end_) {
+      ++at_;
+      SetRepetitionCount();
+    }
+    return *this;
+  }
+
+private:
+  using listIterator = std::list<parser::DataStmtValue>::const_iterator;
+  void SetRepetitionCount();
+  const parser::DataStmtConstant &GetConstant() const {
+    return std::get<parser::DataStmtConstant>(at_->t);
+  }
+
+  listIterator end_;
+  listIterator at_;
+  ConstantSubscript repetitionsRemaining_{0};
+  bool hasFatalError_{false};
+};
+
+void ValueListIterator::SetRepetitionCount() {
+  for (repetitionsRemaining_ = 1; at_ != end_; ++at_) {
+    if (at_->repetitions < 0) {
+      hasFatalError_ = true;
+    }
+    if (at_->repetitions > 0) {
+      repetitionsRemaining_ = at_->repetitions - 1;
+      return;
+    }
+  }
+  repetitionsRemaining_ = 0;
+}
+
+// Collects all of the elemental initializations from DATA statements
+// into a single image for each symbol that appears in any DATA.
+// Expands the implied DO loops and array references.
+// Applies checks that validate each distinct elemental initialization
+// of the variables in a data-stmt-set, as well as those that apply
+// to the corresponding values being use to initialize each element.
+class DataInitializationCompiler {
+public:
+  DataInitializationCompiler(DataInitializations &inits,
+      evaluate::ExpressionAnalyzer &a, const parser::DataStmtSet &set)
+      : inits_{inits}, exprAnalyzer_{a}, values_{set} {}
+  const DataInitializations &inits() const { return inits_; }
+  bool HasSurplusValues() const { return !values_.IsAtEnd(); }
+  bool Scan(const parser::DataStmtObject &);
+
+private:
+  bool Scan(const parser::Variable &);
+  bool Scan(const parser::Designator &);
+  bool Scan(const parser::DataImpliedDo &);
+  bool Scan(const parser::DataIDoObject &);
+
+  // Initializes all elements of a designator, which can be an array or section.
+  bool InitDesignator(const SomeExpr &);
+  // Initializes a single object.
+  bool InitElement(const evaluate::OffsetSymbol &, const SomeExpr &designator);
+  // If the returned flag is true, emit a warning about CHARACTER misusage.
+  std::optional<std::pair<SomeExpr, bool>> ConvertElement(
+      const SomeExpr &, const evaluate::DynamicType &);
+
+  DataInitializations &inits_;
+  evaluate::ExpressionAnalyzer &exprAnalyzer_;
+  ValueListIterator values_;
+};
+
+bool DataInitializationCompiler::Scan(const parser::DataStmtObject &object) {
+  return std::visit(
+      common::visitors{
+          [&](const common::Indirection<parser::Variable> &var) {
+            return Scan(var.value());
+          },
+          [&](const parser::DataImpliedDo &ido) { return Scan(ido); },
+      },
+      object.u);
+}
+
+bool DataInitializationCompiler::Scan(const parser::Variable &var) {
+  if (const auto *expr{GetExpr(var)}) {
+    exprAnalyzer_.GetFoldingContext().messages().SetLocation(var.GetSource());
+    if (InitDesignator(*expr)) {
+      return true;
+    }
+  }
+  return false;
+}
+
+bool DataInitializationCompiler::Scan(const parser::Designator &designator) {
+  if (auto expr{exprAnalyzer_.Analyze(designator)}) {
+    exprAnalyzer_.GetFoldingContext().messages().SetLocation(
+        parser::FindSourceLocation(designator));
+    if (InitDesignator(*expr)) {
+      return true;
+    }
+  }
+  return false;
+}
+
+bool DataInitializationCompiler::Scan(const parser::DataImpliedDo &ido) {
+  const auto &bounds{std::get<parser::DataImpliedDo::Bounds>(ido.t)};
+  auto name{bounds.name.thing.thing};
+  const auto *lowerExpr{GetExpr(bounds.lower.thing.thing)};
+  const auto *upperExpr{GetExpr(bounds.upper.thing.thing)};
+  const auto *stepExpr{
+      bounds.step ? GetExpr(bounds.step->thing.thing) : nullptr};
+  if (lowerExpr && upperExpr) {
+    auto lower{ToInt64(*lowerExpr)};
+    auto upper{ToInt64(*upperExpr)};
+    auto step{stepExpr ? ToInt64(*stepExpr) : std::nullopt};
+    auto stepVal{step.value_or(1)};
+    if (stepVal == 0) {
+      exprAnalyzer_.Say(name.source,
+          "DATA statement implied DO loop has a step value of zero"_err_en_US);
+    } else if (lower && upper) {
+      int kind{evaluate::ResultType<evaluate::ImpliedDoIndex>::kind};
+      if (const auto dynamicType{evaluate::DynamicType::From(*name.symbol)}) {
+        if (dynamicType->category() == TypeCategory::Integer) {
+          kind = dynamicType->kind();
+        }
+      }
+      if (exprAnalyzer_.AddImpliedDo(name.source, kind)) {
+        auto &value{exprAnalyzer_.GetFoldingContext().StartImpliedDo(
+            name.source, *lower)};
+        bool result{true};
+        for (auto n{(*upper - value + stepVal) / stepVal}; n > 0;
+             --n, value += stepVal) {
+          for (const auto &object :
+              std::get<std::list<parser::DataIDoObject>>(ido.t)) {
+            if (!Scan(object)) {
+              result = false;
+              break;
+            }
+          }
+        }
+        exprAnalyzer_.GetFoldingContext().EndImpliedDo(name.source);
+        exprAnalyzer_.RemoveImpliedDo(name.source);
+        return result;
+      }
+    }
+  }
+  return false;
+}
+
+bool DataInitializationCompiler::Scan(const parser::DataIDoObject &object) {
+  return std::visit(
+      common::visitors{
+          [&](const parser::Scalar<common::Indirection<parser::Designator>>
+                  &var) { return Scan(var.thing.value()); },
+          [&](const common::Indirection<parser::DataImpliedDo> &ido) {
+            return Scan(ido.value());
+          },
+      },
+      object.u);
+}
+
+bool DataInitializationCompiler::InitDesignator(const SomeExpr &designator) {
+  evaluate::FoldingContext &context{exprAnalyzer_.GetFoldingContext()};
+  evaluate::DesignatorFolder folder{context};
+  while (auto offsetSymbol{folder.FoldDesignator(designator)}) {
+    if (folder.isOutOfRange()) {
+      if (auto bad{evaluate::OffsetToDesignator(context, *offsetSymbol)}) {
+        exprAnalyzer_.context().Say(
+            "DATA statement designator '%s' is out of range"_err_en_US,
+            bad->AsFortran());
+      } else {
+        exprAnalyzer_.context().Say(
+            "DATA statement designator '%s' is out of range"_err_en_US,
+            designator.AsFortran());
+      }
+      return false;
+    } else if (!InitElement(*offsetSymbol, designator)) {
+      return false;
+    } else {
+      ++values_;
+    }
+  }
+  return folder.isEmpty();
+}
+
+std::optional<std::pair<SomeExpr, bool>>
+DataInitializationCompiler::ConvertElement(
+    const SomeExpr &expr, const evaluate::DynamicType &type) {
+  if (auto converted{evaluate::ConvertToType(type, SomeExpr{expr})}) {
+    return {std::make_pair(std::move(*converted), false)};
+  }
+  if (std::optional<std::string> chValue{evaluate::GetScalarConstantValue<
+          evaluate::Type<TypeCategory::Character, 1>>(expr)}) {
+    // Allow DATA initialization with Hollerith and kind=1 CHARACTER like
+    // (most) other Fortran compilers do.  Pad on the right with spaces
+    // when short, truncate the right if long.
+    // TODO: big-endian targets
+    std::size_t bytes{type.MeasureSizeInBytes().value()};
+    evaluate::BOZLiteralConstant bits{0};
+    for (std::size_t j{0}; j < bytes; ++j) {
+      char ch{j >= chValue->size() ? ' ' : chValue->at(j)};
+      evaluate::BOZLiteralConstant chBOZ{static_cast<unsigned char>(ch)};
+      bits = bits.IOR(chBOZ.SHIFTL(8 * j));
+    }
+    if (auto converted{evaluate::ConvertToType(type, SomeExpr{bits})}) {
+      return {std::make_pair(std::move(*converted), true)};
+    }
+  }
+  return std::nullopt;
+}
+
+bool DataInitializationCompiler::InitElement(
+    const evaluate::OffsetSymbol &offsetSymbol, const SomeExpr &designator) {
+  const Symbol &symbol{offsetSymbol.symbol()};
+  const Symbol *lastSymbol{GetLastSymbol(designator)};
+  bool isPointer{lastSymbol && IsPointer(*lastSymbol)};
+  bool isProcPointer{lastSymbol && IsProcedurePointer(*lastSymbol)};
+  evaluate::FoldingContext &context{exprAnalyzer_.GetFoldingContext()};
+
+  const auto DescribeElement{[&]() {
+    if (auto badDesignator{
+            evaluate::OffsetToDesignator(context, offsetSymbol)}) {
+      return badDesignator->AsFortran();
+    } else {
+      // Error recovery
+      std::string buf;
+      llvm::raw_string_ostream ss{buf};
+      ss << offsetSymbol.symbol().name() << " offset " << offsetSymbol.offset()
+         << " bytes for " << offsetSymbol.size() << " bytes";
+      return ss.str();
+    }
+  }};
+  const auto GetImage{[&]() -> evaluate::InitialImage & {
+    auto &symbolInit{inits_.emplace(&symbol, symbol.size()).first->second};
+    symbolInit.inits.emplace_back(offsetSymbol.offset(), offsetSymbol.size());
+    return symbolInit.image;
+  }};
+  const auto OutOfRangeError{[&]() {
+    evaluate::AttachDeclaration(
+        exprAnalyzer_.context().Say(
+            "DATA statement designator '%s' is out of range for its variable '%s'"_err_en_US,
+            DescribeElement(), symbol.name()),
+        symbol);
+  }};
+
+  if (values_.hasFatalError()) {
+    return false;
+  } else if (values_.IsAtEnd()) {
+    exprAnalyzer_.context().Say(
+        "DATA statement set has no value for '%s'"_err_en_US,
+        DescribeElement());
+    return false;
+  } else if (static_cast<std::size_t>(
+                 offsetSymbol.offset() + offsetSymbol.size()) > symbol.size()) {
+    OutOfRangeError();
+    return false;
+  }
+
+  const SomeExpr *expr{*values_};
+  if (!expr) {
+    CHECK(exprAnalyzer_.context().AnyFatalError());
+  } else if (isPointer) {
+    if (static_cast<std::size_t>(offsetSymbol.offset() + offsetSymbol.size()) >
+        symbol.size()) {
+      OutOfRangeError();
+    } else if (evaluate::IsNullPointer(*expr)) {
+      // nothing to do; rely on zero initialization
+      return true;
+    } else if (evaluate::IsProcedure(*expr)) {
+      if (isProcPointer) {
+        if (CheckPointerAssignment(context, designator, *expr)) {
+          GetImage().AddPointer(offsetSymbol.offset(), *expr);
+          return true;
+        }
+      } else {
+        exprAnalyzer_.Say(values_.LocateSource(),
+            "Procedure '%s' may not be used to initialize '%s', which is not a procedure pointer"_err_en_US,
+            expr->AsFortran(), DescribeElement());
+      }
+    } else if (isProcPointer) {
+      exprAnalyzer_.Say(values_.LocateSource(),
+          "Data object '%s' may not be used to initialize '%s', which is a procedure pointer"_err_en_US,
+          expr->AsFortran(), DescribeElement());
+    } else if (CheckInitialTarget(context, designator, *expr)) {
+      GetImage().AddPointer(offsetSymbol.offset(), *expr);
+      return true;
+    }
+  } else if (evaluate::IsNullPointer(*expr)) {
+    exprAnalyzer_.Say(values_.LocateSource(),
+        "Initializer for '%s' must not be a pointer"_err_en_US,
+        DescribeElement());
+  } else if (evaluate::IsProcedure(*expr)) {
+    exprAnalyzer_.Say(values_.LocateSource(),
+        "Initializer for '%s' must not be a procedure"_err_en_US,
+        DescribeElement());
+  } else if (auto designatorType{designator.GetType()}) {
+    if (auto converted{ConvertElement(*expr, *designatorType)}) {
+      // value non-pointer initialization
+      if (std::holds_alternative<evaluate::BOZLiteralConstant>(expr->u) &&
+          designatorType->category() != TypeCategory::Integer) { // 8.6.7(11)
+        exprAnalyzer_.Say(values_.LocateSource(),
+            "BOZ literal should appear in a DATA statement only as a value for an integer object, but '%s' is '%s'"_en_US,
+            DescribeElement(), designatorType->AsFortran());
+      } else if (converted->second) {
+        exprAnalyzer_.context().Say(
+            "DATA statement value initializes '%s' of type '%s' with CHARACTER"_en_US,
+            DescribeElement(), designatorType->AsFortran());
+      }
+      auto folded{evaluate::Fold(context, std::move(converted->first))};
+      switch (
+          GetImage().Add(offsetSymbol.offset(), offsetSymbol.size(), folded)) {
+      case evaluate::InitialImage::Ok:
+        return true;
+      case evaluate::InitialImage::NotAConstant:
+        exprAnalyzer_.Say(values_.LocateSource(),
+            "DATA statement value '%s' for '%s' is not a constant"_err_en_US,
+            folded.AsFortran(), DescribeElement());
+        break;
+      case evaluate::InitialImage::OutOfRange:
+        OutOfRangeError();
+        break;
+      default:
+        CHECK(exprAnalyzer_.context().AnyFatalError());
+        break;
+      }
+    } else {
+      exprAnalyzer_.context().Say(
+          "DATA statement value could not be converted to the type '%s' of the object '%s'"_err_en_US,
+          designatorType->AsFortran(), DescribeElement());
+    }
+  } else {
+    CHECK(exprAnalyzer_.context().AnyFatalError());
+  }
+  return false;
+}
+
+void AccumulateDataInitializations(DataInitializations &inits,
+    evaluate::ExpressionAnalyzer &exprAnalyzer,
+    const parser::DataStmtSet &set) {
+  DataInitializationCompiler scanner{inits, exprAnalyzer, set};
+  for (const auto &object :
+      std::get<std::list<parser::DataStmtObject>>(set.t)) {
+    if (!scanner.Scan(object)) {
+      return;
+    }
+  }
+  if (scanner.HasSurplusValues()) {
+    exprAnalyzer.context().Say(
+        "DATA statement set has more values than objects"_err_en_US);
+  }
+}
+
+static bool CombineSomeEquivalencedInits(
+    DataInitializations &inits, evaluate::ExpressionAnalyzer &exprAnalyzer) {
+  auto end{inits.end()};
+  for (auto iter{inits.begin()}; iter != end; ++iter) {
+    const Symbol &symbol{*iter->first};
+    Scope &scope{const_cast<Scope &>(symbol.owner())};
+    if (scope.equivalenceSets().empty()) {
+      continue; // no problem to solve here
+    }
+    const auto *commonBlock{FindCommonBlockContaining(symbol)};
+    // Sweep following DATA initializations in search of overlapping
+    // objects, accumulating into a vector; iterate to a fixed point.
+    std::vector<const Symbol *> conflicts;
+    auto minStart{symbol.offset()};
+    auto maxEnd{symbol.offset() + symbol.size()};
+    std::size_t minElementBytes{1};
+    while (true) {
+      auto prevCount{conflicts.size()};
+      conflicts.clear();
+      for (auto scan{iter}; ++scan != end;) {
+        const Symbol &other{*scan->first};
+        const Scope &otherScope{other.owner()};
+        if (&otherScope == &scope &&
+            FindCommonBlockContaining(other) == commonBlock &&
+            maxEnd > other.offset() &&
+            other.offset() + other.size() > minStart) {
+          // "other" conflicts with "symbol" or another conflict
+          conflicts.push_back(&other);
+          minStart = std::min(minStart, other.offset());
+          maxEnd = std::max(maxEnd, other.offset() + other.size());
+        }
+      }
+      if (conflicts.size() == prevCount) {
+        break;
+      }
+    }
+    if (conflicts.empty()) {
+      continue;
+    }
+    // Compute the minimum common granularity
+    if (auto dyType{evaluate::DynamicType::From(symbol)}) {
+      minElementBytes = dyType->MeasureSizeInBytes().value_or(1);
+    }
+    for (const Symbol *s : conflicts) {
+      if (auto dyType{evaluate::DynamicType::From(*s)}) {
+        minElementBytes =
+            std::min(minElementBytes, dyType->MeasureSizeInBytes().value_or(1));
+      } else {
+        minElementBytes = 1;
+      }
+    }
+    CHECK(minElementBytes > 0);
+    CHECK((minElementBytes & (minElementBytes - 1)) == 0);
+    auto bytes{static_cast<common::ConstantSubscript>(maxEnd - minStart)};
+    CHECK(bytes % minElementBytes == 0);
+    const DeclTypeSpec &typeSpec{scope.MakeNumericType(
+        TypeCategory::Integer, KindExpr{minElementBytes})};
+    // Combine "symbol" and "conflicts[]" into a compiler array temp
+    // that overlaps all of them, and merge their initial values into
+    // the temp's initializer.
+    SourceName name{exprAnalyzer.context().GetTempName(scope)};
+    auto emplaced{
+        scope.try_emplace(name, Attrs{Attr::SAVE}, ObjectEntityDetails{})};
+    CHECK(emplaced.second);
+    Symbol &combinedSymbol{*emplaced.first->second};
+    auto &details{combinedSymbol.get<ObjectEntityDetails>()};
+    combinedSymbol.set_offset(minStart);
+    combinedSymbol.set_size(bytes);
+    details.set_type(typeSpec);
+    ArraySpec arraySpec;
+    arraySpec.emplace_back(ShapeSpec::MakeExplicit(Bound{
+        bytes / static_cast<common::ConstantSubscript>(minElementBytes)}));
+    details.set_shape(arraySpec);
+    if (commonBlock) {
+      details.set_commonBlock(*commonBlock);
+    }
+    // Merge these EQUIVALENCE'd DATA initializations, and remove the
+    // original initializations from the map.
+    auto combinedInit{
+        inits.emplace(&combinedSymbol, static_cast<std::size_t>(bytes))};
+    evaluate::InitialImage &combined{combinedInit.first->second.image};
+    combined.Incorporate(symbol.offset() - minStart, iter->second.image);
+    inits.erase(iter);
+    for (const Symbol *s : conflicts) {
+      auto sIter{inits.find(s)};
+      CHECK(sIter != inits.end());
+      combined.Incorporate(s->offset() - minStart, sIter->second.image);
+      inits.erase(sIter);
+    }
+    return true; // got one
+  }
+  return false; // no remaining EQUIVALENCE'd DATA initializations
+}
+
+// Converts the initialization image for all the DATA statement appearances of
+// a single symbol into an init() expression in the symbol table entry.
+void ConstructInitializer(const Symbol &symbol,
+    SymbolDataInitialization &initialization,
+    evaluate::ExpressionAnalyzer &exprAnalyzer) {
+  auto &context{exprAnalyzer.GetFoldingContext()};
+  initialization.inits.sort();
+  ConstantSubscript next{0};
+  for (const auto &init : initialization.inits) {
+    if (init.start() < next) {
+      auto badDesignator{evaluate::OffsetToDesignator(
+          context, symbol, init.start(), init.size())};
+      CHECK(badDesignator);
+      exprAnalyzer.Say(symbol.name(),
+          "DATA statement initializations affect '%s' more than once"_err_en_US,
+          badDesignator->AsFortran());
+    }
+    next = init.start() + init.size();
+    CHECK(next <= static_cast<ConstantSubscript>(initialization.image.size()));
+  }
+  if (const auto *proc{symbol.detailsIf<ProcEntityDetails>()}) {
+    CHECK(IsProcedurePointer(symbol));
+    const auto &procDesignator{initialization.image.AsConstantProcPointer()};
+    CHECK(!procDesignator.GetComponent());
+    auto &mutableProc{const_cast<ProcEntityDetails &>(*proc)};
+    mutableProc.set_init(DEREF(procDesignator.GetSymbol()));
+  } else if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
+    if (auto symbolType{evaluate::DynamicType::From(symbol)}) {
+      auto &mutableObject{const_cast<ObjectEntityDetails &>(*object)};
+      if (IsPointer(symbol)) {
+        mutableObject.set_init(
+            initialization.image.AsConstantDataPointer(*symbolType));
+        mutableObject.set_initWasValidated();
+      } else {
+        if (auto extents{evaluate::GetConstantExtents(context, symbol)}) {
+          mutableObject.set_init(
+              initialization.image.AsConstant(context, *symbolType, *extents));
+          mutableObject.set_initWasValidated();
+        } else {
+          exprAnalyzer.Say(symbol.name(),
+              "internal: unknown shape for '%s' while constructing initializer from DATA"_err_en_US,
+              symbol.name());
+          return;
+        }
+      }
+    } else {
+      exprAnalyzer.Say(symbol.name(),
+          "internal: no type for '%s' while constructing initializer from DATA"_err_en_US,
+          symbol.name());
+      return;
+    }
+    if (!object->init()) {
+      exprAnalyzer.Say(symbol.name(),
+          "internal: could not construct an initializer from DATA statements for '%s'"_err_en_US,
+          symbol.name());
+    }
+  } else {
+    CHECK(exprAnalyzer.context().AnyFatalError());
+  }
+}
+
+void ConvertToInitializers(
+    DataInitializations &inits, evaluate::ExpressionAnalyzer &exprAnalyzer) {
+  while (CombineSomeEquivalencedInits(inits, exprAnalyzer)) {
+  }
+  for (auto &[symbolPtr, initialization] : inits) {
+    ConstructInitializer(*symbolPtr, initialization, exprAnalyzer);
+  }
+}
+} // namespace Fortran::semantics

flang/lib/Semantics/semantics.cpp

   return result;
 }
 
+SourceName SemanticsContext::GetTempName(const Scope &scope) {
+  for (const auto &str : tempNames_) {
+    SourceName name{str};
+    if (scope.find(name) == scope.end()) {
+      return name;
+    }
+  }
+  tempNames_.emplace_back(".F18.");
+  tempNames_.back() += std::to_string(tempNames_.size());
+  return {tempNames_.back()};
+}
+
 bool Semantics::Perform() {
   return ValidateLabels(context_, program_) &&
       parser::CanonicalizeDo(program_) && // force line break

flang/lib/Semantics/type.cpp

   return o << x.AsFortran();
 }
 
-Bound::Bound(int bound) : expr_{bound} {}
+Bound::Bound(common::ConstantSubscript bound) : expr_{bound} {}
 
 llvm::raw_ostream &operator<<(llvm::raw_ostream &o, const Bound &x) {
   if (x.isAssumed()) {

flang/test/Semantics/block-data01.f90

   !ERROR: An initialized variable in BLOCK DATA must be in a COMMON block
   integer :: inDataButNotCommon
   data inDataButNotCommon /1/
-  !ERROR: Two objects in the same EQUIVALENCE set may not be members of distinct COMMON blocks
   integer :: inCommonA, inCommonB
+  !ERROR: 'incommona' in COMMON block /a/ must not be storage associated with 'incommonb' in COMMON block /b/ by EQUIVALENCE
   common /a/ inCommonA, /b/ inCommonB
   equivalence(inCommonA, inCommonB)
   integer :: inCommonD, initialized ! ok
   common /d/ inCommonD
   equivalence(inCommonD, initialized)
   data initialized /2/
+  integer :: inCommonE, jarr(2)
+  equivalence(inCommonE, jarr(2))
+  !ERROR: 'incommone' cannot backward-extend COMMON block /e/ via EQUIVALENCE with 'jarr'
+  common /e/ inCommonE
+  equivalence(inCommonF1, inCommonF2)
+  integer :: inCommonF1, inCommonF2
+  !ERROR: 'incommonf1' is storage associated with 'incommonf2' by EQUIVALENCE elsewhere in COMMON block /f/
+  common /f/ inCommonF1, inCommonF2
 end block data

flang/test/Semantics/data09.f90

+! RUN: %f18 -fparse-only -fdebug-dump-symbols %s 2>&1 | FileCheck %s
+! CHECK: init:[INTEGER(4)::1065353216_4,1073741824_4,1077936128_4,1082130432_4]
+! Verify that the closure of EQUIVALENCE'd symbols with any DATA
+! initialization produces a combined initializer.
+real :: a(2), b(2), c(2)
+equivalence(a(2),b(1)),(b(2),c(1))
+data a(1)/1./,b(1)/2./,c/3.,4./
+common /block/ a
+end