[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

20

[klausler]

Fixed warning (class vs struct).

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

public:
   template <typename T>
   Result Add(ConstantSubscript offset, std::size_t bytes, const Expr<T> &x) {
     return std::visit(
         [&](const auto &y) { return Add(offset, bytes, y); }, x.u);
   }
 
   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 &,
       ConstantSubscript offset = 0) const;
   std::optional<Expr<SomeType>> AsConstantDataPointer(
       const DynamicType &, ConstantSubscript offset = 0) const;
   const ProcedureDesignator &AsConstantProcPointer(
       ConstantSubscript offset = 0) const;

flang/include/flang/Parser/parsing.h

public:
   void ClearLog();
 
   void EmitMessage(llvm::raw_ostream &o, const char *at,
       const std::string &message, bool echoSourceLine = false) const {
     cooked_.allSources().EmitMessage(
         o, cooked_.GetProvenanceRange(CharBlock(at)), message, echoSourceLine);
   }
 
-  bool ForTesting(std::string path, llvm::raw_ostream &);
-
 private:
   Options options_;
   CookedSource cooked_;
   Messages messages_;
   bool consumedWholeFile_{false};
   const char *finalRestingPlace_{nullptr};
   std::optional<Program> parseTree_;
   ParsingLog log_;
 };
 } // namespace Fortran::parser
 #endif // FORTRAN_PARSER_PARSING_H_

flang/include/flang/Semantics/semantics.h

public:
   // If so, emit a message.
   void WarnIndexVarRedefine(const parser::CharBlock &, const Symbol &);
   void CheckIndexVarRedefine(const parser::CharBlock &, const Symbol &);
   void CheckIndexVarRedefine(const parser::Variable &);
   void CheckIndexVarRedefine(const parser::Name &);
   void ActivateIndexVar(const parser::Name &, IndexVarKind);
   void DeactivateIndexVar(const parser::Name &);
   SymbolVector GetIndexVars(IndexVarKind);
+  SourceName GetTempName(const Scope &);
 
 private:
   void CheckIndexVarRedefine(
       const parser::CharBlock &, const Symbol &, parser::MessageFixedText &&);
   bool CheckError(bool);
 
   const common::IntrinsicTypeDefaultKinds &defaultKinds_;
   const common::LanguageFeatureControl languageFeatures_;
private:
   parser::Messages messages_;
   evaluate::FoldingContext foldingContext_;
   ConstructStack constructStack_;
   struct IndexVarInfo {
     parser::CharBlock location;
     IndexVarKind kind;
   };
   std::map<SymbolRef, const IndexVarInfo> activeIndexVars_;
+  std::vector<std::string> tempNames_;
 };
 
 class Semantics {
 public:
   explicit Semantics(SemanticsContext &context, parser::Program &program,
       parser::CookedSource &cooked, bool debugModuleWriter = false)
       : context_{context}, program_{program}, cooked_{cooked} {
     context.set_debugModuleWriter(debugModuleWriter);

flang/include/flang/Semantics/type.h

 using KindExpr = SubscriptIntExpr;
 
 // An array spec bound: an explicit integer expression or ASSUMED or DEFERRED
 class Bound {
 public:
   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;
   Bound &operator=(Bound &&) = default;
   bool isExplicit() const { return category_ == Category::Explicit; }
   bool isAssumed() const { return category_ == Category::Assumed; }
   bool isDeferred() const { return category_ == Category::Deferred; }
   MaybeSubscriptIntExpr &GetExplicit() { return expr_; }

flang/lib/Evaluate/initial-image.cpp

 //===-- lib/Evaluate/initial-image.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
 //
 //===----------------------------------------------------------------------===//
 
 #include "flang/Evaluate/initial-image.h"
 #include "flang/Semantics/scope.h"
 #include "flang/Semantics/tools.h"
+#include <cstring>
 
 namespace Fortran::evaluate {
 
 auto InitialImage::Add(ConstantSubscript offset, std::size_t bytes,
     const Constant<SomeDerived> &x) -> Result {
   if (offset < 0 || offset + bytes > data_.size()) {
     return OutOfRange;
   } else {
auto InitialImage::Add(ConstantSubscript offset, std::size_t bytes,
   }
 }
 
 void InitialImage::AddPointer(
     ConstantSubscript offset, const Expr<SomeType> &pointer) {
   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.
 class AsConstantHelper {
 public:
   using Result = std::optional<Expr<SomeType>>;
   using Types = AllTypes;
   AsConstantHelper(FoldingContext &context, const DynamicType &type,

flang/lib/Parser/parsing.cpp

CHECK(
       !parseState.anyErrorRecovery() || parseState.messages().AnyFatalError());
   consumedWholeFile_ = parseState.IsAtEnd();
   messages_.Annex(std::move(parseState.messages()));
   finalRestingPlace_ = parseState.GetLocation();
 }
 
 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

add_flang_library(FortranSemantics
   check-nullify.cpp
   check-omp-structure.cpp
   check-purity.cpp
   check-return.cpp
   check-select-rank.cpp
   check-select-type.cpp
   check-stop.cpp
   compute-offsets.cpp
+  data-to-inits.cpp
   expression.cpp
   mod-file.cpp
   pointer-assignment.cpp
   program-tree.cpp
   resolve-labels.cpp
   resolve-directives.cpp
   resolve-names-utils.cpp
   resolve-names.cpp

flang/lib/Semantics/check-data.h

 //===-------lib/Semantics/check-data.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_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"
 #include "flang/Semantics/expression.h"
 #include "flang/Semantics/semantics.h"
 #include <list>
 #include <map>
 #include <vector>
 
 namespace Fortran::parser {
 struct DataStmtRepeat;
 struct DataStmtObject;
 struct DataIDoObject;
 class DataStmtImpliedDo;
 struct DataStmtSet;
 } // namespace Fortran::parser
 
 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} {}
   void Leave(const parser::DataStmtObject &);
   void Leave(const parser::DataIDoObject &);
   void Enter(const parser::DataImpliedDo &);
   void Leave(const parser::DataImpliedDo &);
   void Leave(const parser::DataStmtSet &);
 
   // After all DATA statements have been processed, converts their
   // initializations into per-symbol static initializers.
   void CompileDataInitializationsIntoInitializers();
 
 private:
   ConstantSubscript GetRepetitionCount(const parser::DataStmtRepeat &);
   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_;
   bool currentSetHasFatalErrors_{false};
 };
 } // namespace Fortran::semantics
 #endif // FORTRAN_SEMANTICS_CHECK_DATA_H_

flang/lib/Semantics/check-data.cpp

 //===-- lib/Semantics/check-data.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 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 {
 
 // Ensures that references to an implied DO loop control variable are
 // represented as such in the "body" of the implied DO loop.
 void DataChecker::Enter(const parser::DataImpliedDo &x) {
   auto name{std::get<parser::DataImpliedDo::Bounds>(x.t).name.thing.thing};
   int kind{evaluate::ResultType<evaluate::ImpliedDoIndex>::kind};
if (MaybeExpr expr{exprAnalyzer_.Analyze(*designator)}) {
             exprAnalyzer_.context().Say(source,
                 "Data implied do structure component must be subscripted"_err_en_US);
           } else {
             return;
           }
         }
       }
     }
-  }
     currentSetHasFatalErrors_ = true;
   }
+}
 
 void DataChecker::Leave(const parser::DataStmtObject &dataObject) {
   std::visit(common::visitors{
                  [](const parser::DataImpliedDo &) { // has own Enter()/Leave()
                  },
                  [&](const auto &var) {
                    auto expr{exprAnalyzer_.Analyze(var)};
                    if (!expr ||
                        !DataVarChecker{exprAnalyzer_.context(),
                            parser::FindSourceLocation(dataObject)}(*expr)) {
                      currentSetHasFatalErrors_ = true;
                    }
                  },
              },
       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

struct SymbolAndOffset {
     Symbol *symbol;
     std::size_t offset;
     const EquivalenceObject *object;
   };
 
   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 &);
   void DoSymbol(Symbol &);
   SizeAndAlignment GetSizeAndAlignment(const Symbol &);
   SizeAndAlignment GetElementSize(const Symbol &);
   std::size_t CountElements(const Symbol &);
   static std::size_t Align(std::size_t, std::size_t);
   static SizeAndAlignment GetIntrinsicSizeAndAlignment(TypeCategory, int);
 
   SemanticsContext &context_;
   evaluate::FoldingContext &foldingContext_{context_.foldingContext()};
   std::size_t offset_{0};
   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) {
   for (Scope &child : scope.children()) {
     Compute(child);
   }
   DoScope(scope);
+  dependents_.clear();
+  equivalenceBlock_.clear();
 }
 
 static bool InCommonBlock(const Symbol &symbol) {
   const auto *details{symbol.detailsIf<ObjectEntityDetails>()};
   return details && details->commonBlock();
 }
 
 void ComputeOffsetsHelper::DoScope(Scope &scope) {
   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)
     -> SymbolAndOffset {
   auto it{dependents_.find(*dep.symbol)};
   if (it == dependents_.end()) {
     return dep;
   } else {
     SymbolAndOffset result{Resolve(it->second)};
     result.offset += dep.offset;
     result.object = dep.object;
     return result;
   }
 }
 
 void ComputeOffsetsHelper::DoCommonBlock(Symbol &commonBlock) {
   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) {
   std::vector<SymbolAndOffset> symbolOffsets;
   std::optional<std::size_t> representative;
   for (const EquivalenceObject &object : set) {
     std::size_t offset{ComputeOffset(object)};
     SymbolAndOffset resolved{

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 {
+struct 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/check-data.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 semantic analysis.
-// - Applies static semantic checks to the variables in each data-stmt-set with
-//   class DataVarChecker;
+// DATA statement object/value checking and conversion to static
+// initializers
 // - Applies specific checks to each scalar element initialization with a
-//   constant value or pointer tareg with class DataInitializationCompiler;
+//   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 "check-data.h"
+#include "data-to-inits.h"
 #include "pointer-assignment.h"
 #include "flang/Evaluate/fold-designator.h"
-#include "flang/Evaluate/traverse.h"
-#include "flang/Parser/parse-tree.h"
-#include "flang/Parser/tools.h"
 #include "flang/Semantics/tools.h"
 
 namespace Fortran::semantics {
 
-// Ensures that references to an implied DO loop control variable are
-// represented as such in the "body" of the implied DO loop.
-void DataChecker::Enter(const parser::DataImpliedDo &x) {
-  auto name{std::get<parser::DataImpliedDo::Bounds>(x.t).name.thing.thing};
-  int kind{evaluate::ResultType<evaluate::ImpliedDoIndex>::kind};
-  if (const auto dynamicType{evaluate::DynamicType::From(*name.symbol)}) {
-    if (dynamicType->category() == TypeCategory::Integer) {
-      kind = dynamicType->kind();
-    }
-  }
-  exprAnalyzer_.AddImpliedDo(name.source, kind);
-}
-
-void DataChecker::Leave(const parser::DataImpliedDo &x) {
-  auto name{std::get<parser::DataImpliedDo::Bounds>(x.t).name.thing.thing};
-  exprAnalyzer_.RemoveImpliedDo(name.source);
-}
-
-// DataVarChecker applies static checks once to each variable that appears
-// in a data-stmt-set.  These checks are independent of the values that
-// correspond to the variables.
-class DataVarChecker : public evaluate::AllTraverse<DataVarChecker, true> {
-public:
-  using Base = evaluate::AllTraverse<DataVarChecker, true>;
-  DataVarChecker(SemanticsContext &c, parser::CharBlock src)
-      : Base{*this}, context_{c}, source_{src} {}
-  using Base::operator();
-  bool HasComponentWithoutSubscripts() const {
-    return hasComponent_ && !hasSubscript_;
-  }
-  bool operator()(const Symbol &symbol) { // C876
-    // 8.6.7p(2) - precludes non-pointers of derived types with
-    // 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"
-                : IsInBlankCommon(symbol)      ? "Blank COMMON object"
-                : 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"
-                                                  : nullptr}) {
-      context_.Say(source_,
-          "%s '%s' must not be initialized in a DATA statement"_err_en_US,
-          whyNot, symbol.name());
-      return false;
-    } else if (IsProcedurePointer(symbol)) {
-      context_.Say(source_,
-          "Procedure pointer '%s' in a DATA statement is not standard"_en_US,
-          symbol.name());
-    }
-    return true;
-  }
-  bool operator()(const evaluate::Component &component) {
-    hasComponent_ = true;
-    const Symbol &lastSymbol{component.GetLastSymbol()};
-    if (isPointerAllowed_) {
-      if (IsPointer(lastSymbol) && hasSubscript_) { // C877
-        context_.Say(source_,
-            "Rightmost data object pointer '%s' must not be subscripted"_err_en_US,
-            lastSymbol.name().ToString());
-        return false;
-      }
-      RestrictPointer();
-    } else {
-      if (IsPointer(lastSymbol)) { // C877
-        context_.Say(source_,
-            "Data object must not contain pointer '%s' as a non-rightmost part"_err_en_US,
-            lastSymbol.name().ToString());
-        return false;
-      }
-    }
-    return (*this)(component.base()) && (*this)(lastSymbol);
-  }
-  bool operator()(const evaluate::ArrayRef &arrayRef) {
-    hasSubscript_ = true;
-    return (*this)(arrayRef.base()) && (*this)(arrayRef.subscript());
-  }
-  bool operator()(const evaluate::Substring &substring) {
-    hasSubscript_ = true;
-    return (*this)(substring.parent()) && (*this)(substring.lower()) &&
-        (*this)(substring.upper());
-  }
-  bool operator()(const evaluate::CoarrayRef &) { // C874
-    context_.Say(
-        source_, "Data object must not be a coindexed variable"_err_en_US);
-    return false;
-  }
-  bool operator()(const evaluate::Subscript &subs) {
-    DataVarChecker subscriptChecker{context_, source_};
-    subscriptChecker.RestrictPointer();
-    return std::visit(
-               common::visitors{
-                   [&](const evaluate::IndirectSubscriptIntegerExpr &expr) {
-                     return CheckSubscriptExpr(expr);
-                   },
-                   [&](const evaluate::Triplet &triplet) {
-                     return CheckSubscriptExpr(triplet.lower()) &&
-                         CheckSubscriptExpr(triplet.upper()) &&
-                         CheckSubscriptExpr(triplet.stride());
-                   },
-               },
-               subs.u) &&
-        subscriptChecker(subs.u);
-  }
-  template <typename T>
-  bool operator()(const evaluate::FunctionRef<T> &) const { // C875
-    context_.Say(source_,
-        "Data object variable must not be a function reference"_err_en_US);
-    return false;
-  }
-  void RestrictPointer() { isPointerAllowed_ = false; }
-
-private:
-  bool CheckSubscriptExpr(
-      const std::optional<evaluate::IndirectSubscriptIntegerExpr> &x) const {
-    return !x || CheckSubscriptExpr(*x);
-  }
-  bool CheckSubscriptExpr(
-      const evaluate::IndirectSubscriptIntegerExpr &expr) const {
-    return CheckSubscriptExpr(expr.value());
-  }
-  bool CheckSubscriptExpr(
-      const evaluate::Expr<evaluate::SubscriptInteger> &expr) const {
-    if (!evaluate::IsConstantExpr(expr)) { // C875,C881
-      context_.Say(
-          source_, "Data object must have constant subscripts"_err_en_US);
-      return false;
-    } else {
-      return true;
-    }
-  }
-
-  SemanticsContext &context_;
-  parser::CharBlock source_;
-  bool hasComponent_{false};
-  bool hasSubscript_{false};
-  bool isPointerAllowed_{true};
-  bool isFirstSymbol_{true};
-};
-
-void DataChecker::Leave(const parser::DataIDoObject &object) {
-  if (const auto *designator{
-          std::get_if<parser::Scalar<common::Indirection<parser::Designator>>>(
-              &object.u)}) {
-    if (MaybeExpr expr{exprAnalyzer_.Analyze(*designator)}) {
-      auto source{designator->thing.value().source};
-      if (evaluate::IsConstantExpr(*expr)) { // C878,C879
-        exprAnalyzer_.context().Say(
-            source, "Data implied do object must be a variable"_err_en_US);
-      } else {
-        DataVarChecker checker{exprAnalyzer_.context(), source};
-        if (checker(*expr)) {
-          if (checker.HasComponentWithoutSubscripts()) { // C880
-            exprAnalyzer_.context().Say(source,
-                "Data implied do structure component must be subscripted"_err_en_US);
-          } else {
-            return;
-          }
-        }
-      }
-    }
-  }
-  currentSetHasFatalErrors_ = true;
-}
-
-void DataChecker::Leave(const parser::DataStmtObject &dataObject) {
-  std::visit(common::visitors{
-                 [](const parser::DataImpliedDo &) { // has own Enter()/Leave()
-                 },
-                 [&](const auto &var) {
-                   auto expr{exprAnalyzer_.Analyze(var)};
-                   if (!expr ||
-                       !DataVarChecker{exprAnalyzer_.context(),
-                           parser::FindSourceLocation(dataObject)}(*expr)) {
-                     currentSetHasFatalErrors_ = true;
-                   }
-                 },
-             },
-      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();
if (auto badDesignator{
       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};
+    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()),
if (auto converted{ConvertElement(*expr, *designatorType)}) {
           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);
-    }
-  }
-  currentSetHasFatalErrors_ = false;
+void AccumulateDataInitializations(DataInitializations &inits,
+    evaluate::ExpressionAnalyzer &exprAnalyzer,
+    const parser::DataStmtSet &set) {
+  DataInitializationCompiler scanner{inits, exprAnalyzer, set};
+    exprAnalyzer.context().Say(
+
+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 DataChecker::ConstructInitializer(
-    const Symbol &symbol, SymbolDataInitialization &initialization) {
-  auto &context{exprAnalyzer_.GetFoldingContext()};
+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(),
+      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));
if (auto symbolType{evaluate::DynamicType::From(symbol)}) {
             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(),
+          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(),
+      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(),
+      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());
+    CHECK(exprAnalyzer.context().AnyFatalError());
   }
 }
 
-void DataChecker::CompileDataInitializationsIntoInitializers() {
-  for (auto &[symbolRef, initialization] : inits_) {
-    ConstructInitializer(*symbolRef, initialization);
+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

SymbolVector SemanticsContext::GetIndexVars(IndexVarKind kind) {
   for (const auto &[symbol, info] : activeIndexVars_) {
     if (info.kind == kind) {
       result.push_back(symbol);
     }
   }
   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
       CanonicalizeAcc(context_.messages(), program_) &&
       CanonicalizeOmp(context_.messages(), program_) &&
       PerformStatementSemantics(context_, program_) &&
       ModFileWriter{context_}.WriteAll();
 }

flang/lib/Semantics/type.cpp

std::string DerivedTypeSpec::AsFortran() const {
   }
   return ss.str();
 }
 
 llvm::raw_ostream &operator<<(llvm::raw_ostream &o, const DerivedTypeSpec &x) {
   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()) {
     o << '*';
   } else if (x.isDeferred()) {
     o << ':';
   } else if (x.expr_) {
     x.expr_->AsFortran(o);

flang/test/Semantics/block-data01.f90

 ! RUN: %S/test_errors.sh %s %t %f18
 ! Test BLOCK DATA subprogram (14.3)
 block data foo
   !ERROR: IMPORT is not allowed in a BLOCK DATA subprogram
   import
   real :: pi = asin(-1.0) ! ok
   !ERROR: An initialized variable in BLOCK DATA must be in a COMMON block
   integer :: notInCommon = 1
   integer :: uninitialized ! ok
   !ERROR: 'p' may not appear in a BLOCK DATA subprogram
   procedure(sin), pointer :: p => cos
   !ERROR: 'p' is already declared as a procedure
   common /block/ pi, p
   !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