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

   1 //===-- lib/Semantics/data-to-inits.cpp -----------------------------------===//
   2 //
   3 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
   4 // See https://llvm.org/LICENSE.txt for license information.
   5 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
   6 //
   7 //===----------------------------------------------------------------------===//
   8
   9 // DATA statement object/value checking and conversion to static
  10 // initializers
  11 // - Applies specific checks to each scalar element initialization with a
  12 //   constant value or pointer target with class DataInitializationCompiler;
  13 // - Collects the elemental initializations for each symbol and converts them
  14 //   into a single init() expression with member function
  15 //   DataChecker::ConstructInitializer().
  16
  17 #include "data-to-inits.h"
  18 #include "pointer-assignment.h"
  19 #include "flang/Evaluate/fold-designator.h"
  20 #include "flang/Evaluate/tools.h"
  21 #include "flang/Semantics/tools.h"
  22
  23 // The job of generating explicit static initializers for objects that don't
  24 // have them in order to implement default component initialization is now being
  25 // done in lowering, so don't do it here in semantics; but the code remains here
  26 // in case we change our minds.
  27 static constexpr bool makeDefaultInitializationExplicit{false};
  28
  29 // Whether to delete the original "init()" initializers from storage-associated
  30 // objects and pointers.
  31 static constexpr bool removeOriginalInits{false};
  32
  33 // Impose a hard limit that's more than large enough for real applications but
  34 // small enough to cause artificial stress tests to fail reasonably instead of
  35 // crashing the compiler with a memory allocation failure.
  36 static constexpr auto maxDataInitBytes{std::size_t{1000000000}}; // 1GiB
  37
  38 namespace Fortran::semantics {
  39
  40 // Steps through a list of values in a DATA statement set; implements
  41 // repetition.
  42 template <typename DSV = parser::DataStmtValue> class ValueListIterator {
  43 public:
  44   ValueListIterator(SemanticsContext &context, const std::list<DSV> &list)
  45       : context_{context}, end_{list.end()}, at_{list.begin()} {
  46     SetRepetitionCount();
  47   }
  48   bool hasFatalError() const { return hasFatalError_; }
  49   bool IsAtEnd() const { return at_ == end_; }
  50   const SomeExpr *operator*() const { return GetExpr(context_, GetConstant()); }
  51   std::optional<parser::CharBlock> LocateSource() const {
  52     if (!hasFatalError_) {
  53       return GetConstant().source;
  54     }
  55     return {};
  56   }
  57   ValueListIterator &operator++() {
  58     if (repetitionsRemaining_ > 0) {
  59       --repetitionsRemaining_;
  60     } else if (at_ != end_) {
  61       ++at_;
  62       SetRepetitionCount();
  63     }
  64     return *this;
  65   }
  66
  67 private:
  68   using listIterator = typename std::list<DSV>::const_iterator;
  69   void SetRepetitionCount();
  70   const parser::DataStmtValue &GetValue() const {
  71     return DEREF(common::Unwrap<const parser::DataStmtValue>(*at_));
  72   }
  73   const parser::DataStmtConstant &GetConstant() const {
  74     return std::get<parser::DataStmtConstant>(GetValue().t);
  75   }
  76
  77   SemanticsContext &context_;
  78   listIterator end_, at_;
  79   ConstantSubscript repetitionsRemaining_{0};
  80   bool hasFatalError_{false};
  81 };
  82
  83 template <typename DSV> void ValueListIterator<DSV>::SetRepetitionCount() {
  84   for (repetitionsRemaining_ = 1; at_ != end_; ++at_) {
  85     auto repetitions{GetValue().repetitions};
  86     if (repetitions < 0) {
  87       hasFatalError_ = true;
  88     } else if (repetitions > 0) {
  89       repetitionsRemaining_ = repetitions - 1;
  90       return;
  91     }
  92   }
  93   repetitionsRemaining_ = 0;
  94 }
  95
  96 // Collects all of the elemental initializations from DATA statements
  97 // into a single image for each symbol that appears in any DATA.
  98 // Expands the implied DO loops and array references.
  99 // Applies checks that validate each distinct elemental initialization
 100 // of the variables in a data-stmt-set, as well as those that apply
 101 // to the corresponding values being used to initialize each element.
 102 template <typename DSV = parser::DataStmtValue>
 103 class DataInitializationCompiler {
 104 public:
 105   DataInitializationCompiler(DataInitializations &inits,
 106       evaluate::ExpressionAnalyzer &a, const std::list<DSV> &list)
 107       : inits_{inits}, exprAnalyzer_{a}, values_{a.context(), list} {}
 108   const DataInitializations &inits() const { return inits_; }
 109   bool HasSurplusValues() const { return !values_.IsAtEnd(); }
 110   bool Scan(const parser::DataStmtObject &);
 111   // Initializes all elements of whole variable or component
 112   bool Scan(const Symbol &);
 113
 114 private:
 115   bool Scan(const parser::Variable &);
 116   bool Scan(const parser::Designator &);
 117   bool Scan(const parser::DataImpliedDo &);
 118   bool Scan(const parser::DataIDoObject &);
 119
 120   // Initializes all elements of a designator, which can be an array or section.
 121   bool InitDesignator(const SomeExpr &);
 122   // Initializes a single scalar object.
 123   bool InitElement(const evaluate::OffsetSymbol &, const SomeExpr &designator);
 124   // If the returned flag is true, emit a warning about CHARACTER misusage.
 125   std::optional<std::pair<SomeExpr, bool>> ConvertElement(
 126       const SomeExpr &, const evaluate::DynamicType &);
 127
 128   DataInitializations &inits_;
 129   evaluate::ExpressionAnalyzer &exprAnalyzer_;
 130   ValueListIterator<DSV> values_;
 131   const Scope *scope_{nullptr};
 132 };
 133
 134 template <typename DSV>
 135 bool DataInitializationCompiler<DSV>::Scan(
 136     const parser::DataStmtObject &object) {
 137   return common::visit(
 138       common::visitors{
 139           [&](const common::Indirection<parser::Variable> &var) {
 140             return Scan(var.value());
 141           },
 142           [&](const parser::DataImpliedDo &ido) { return Scan(ido); },
 143       },
 144       object.u);
 145 }
 146
 147 template <typename DSV>
 148 bool DataInitializationCompiler<DSV>::Scan(const parser::Variable &var) {
 149   if (const auto *expr{GetExpr(exprAnalyzer_.context(), var)}) {
 150     parser::CharBlock at{var.GetSource()};
 151     exprAnalyzer_.GetFoldingContext().messages().SetLocation(at);
 152     scope_ = &exprAnalyzer_.context().FindScope(at);
 153     if (InitDesignator(*expr)) {
 154       return true;
 155     }
 156   }
 157   return false;
 158 }
 159
 160 template <typename DSV>
 161 bool DataInitializationCompiler<DSV>::Scan(
 162     const parser::Designator &designator) {
 163   MaybeExpr expr;
 164   { // The out-of-range subscript errors from the designator folder are a
 165     // more specific than the default ones from expression semantics, so
 166     // disable those to avoid piling on.
 167     auto restorer{exprAnalyzer_.GetContextualMessages().DiscardMessages()};
 168     expr = exprAnalyzer_.Analyze(designator);
 169   }
 170   if (expr) {
 171     parser::CharBlock at{parser::FindSourceLocation(designator)};
 172     exprAnalyzer_.GetFoldingContext().messages().SetLocation(at);
 173     scope_ = &exprAnalyzer_.context().FindScope(at);
 174     if (InitDesignator(*expr)) {
 175       return true;
 176     }
 177   }
 178   return false;
 179 }
 180
 181 template <typename DSV>
 182 bool DataInitializationCompiler<DSV>::Scan(const parser::DataImpliedDo &ido) {
 183   const auto &bounds{std::get<parser::DataImpliedDo::Bounds>(ido.t)};
 184   auto name{bounds.name.thing.thing};
 185   const auto *lowerExpr{
 186       GetExpr(exprAnalyzer_.context(), bounds.lower.thing.thing)};
 187   const auto *upperExpr{
 188       GetExpr(exprAnalyzer_.context(), bounds.upper.thing.thing)};
 189   const auto *stepExpr{bounds.step
 190           ? GetExpr(exprAnalyzer_.context(), bounds.step->thing.thing)
 191           : nullptr};
 192   if (lowerExpr && upperExpr) {
 193     // Fold the bounds expressions (again) in case any of them depend
 194     // on outer implied DO loops.
 195     evaluate::FoldingContext &context{exprAnalyzer_.GetFoldingContext()};
 196     std::int64_t stepVal{1};
 197     if (stepExpr) {
 198       auto foldedStep{evaluate::Fold(context, SomeExpr{*stepExpr})};
 199       stepVal = ToInt64(foldedStep).value_or(1);
 200       if (stepVal == 0) {
 201         exprAnalyzer_.Say(name.source,
 202             "DATA statement implied DO loop has a step value of zero"_err_en_US);
 203         return false;
 204       }
 205     }
 206     auto foldedLower{evaluate::Fold(context, SomeExpr{*lowerExpr})};
 207     auto lower{ToInt64(foldedLower)};
 208     auto foldedUpper{evaluate::Fold(context, SomeExpr{*upperExpr})};
 209     auto upper{ToInt64(foldedUpper)};
 210     if (lower && upper) {
 211       int kind{evaluate::ResultType<evaluate::ImpliedDoIndex>::kind};
 212       if (const auto dynamicType{evaluate::DynamicType::From(*name.symbol)}) {
 213         if (dynamicType->category() == TypeCategory::Integer) {
 214           kind = dynamicType->kind();
 215         }
 216       }
 217       if (exprAnalyzer_.AddImpliedDo(name.source, kind)) {
 218         auto &value{context.StartImpliedDo(name.source, *lower)};
 219         bool result{true};
 220         for (auto n{(*upper - value + stepVal) / stepVal}; n > 0;
 221              --n, value += stepVal) {
 222           for (const auto &object :
 223               std::get<std::list<parser::DataIDoObject>>(ido.t)) {
 224             if (!Scan(object)) {
 225               result = false;
 226               break;
 227             }
 228           }
 229         }
 230         context.EndImpliedDo(name.source);
 231         exprAnalyzer_.RemoveImpliedDo(name.source);
 232         return result;
 233       }
 234     }
 235   }
 236   return false;
 237 }
 238
 239 template <typename DSV>
 240 bool DataInitializationCompiler<DSV>::Scan(
 241     const parser::DataIDoObject &object) {
 242   return common::visit(
 243       common::visitors{
 244           [&](const parser::Scalar<common::Indirection<parser::Designator>>
 245                   &var) { return Scan(var.thing.value()); },
 246           [&](const common::Indirection<parser::DataImpliedDo> &ido) {
 247             return Scan(ido.value());
 248           },
 249       },
 250       object.u);
 251 }
 252
 253 template <typename DSV>
 254 bool DataInitializationCompiler<DSV>::Scan(const Symbol &symbol) {
 255   auto designator{exprAnalyzer_.Designate(evaluate::DataRef{symbol})};
 256   CHECK(designator.has_value());
 257   return InitDesignator(*designator);
 258 }
 259
 260 template <typename DSV>
 261 bool DataInitializationCompiler<DSV>::InitDesignator(
 262     const SomeExpr &designator) {
 263   evaluate::FoldingContext &context{exprAnalyzer_.GetFoldingContext()};
 264   evaluate::DesignatorFolder folder{context};
 265   while (auto offsetSymbol{folder.FoldDesignator(designator)}) {
 266     if (folder.isOutOfRange()) {
 267       if (auto bad{evaluate::OffsetToDesignator(context, *offsetSymbol)}) {
 268         exprAnalyzer_.context().Say(
 269             "DATA statement designator '%s' is out of range"_err_en_US,
 270             bad->AsFortran());
 271       } else {
 272         exprAnalyzer_.context().Say(
 273             "DATA statement designator '%s' is out of range"_err_en_US,
 274             designator.AsFortran());
 275       }
 276       return false;
 277     } else if (!InitElement(*offsetSymbol, designator)) {
 278       return false;
 279     } else {
 280       ++values_;
 281     }
 282   }
 283   return folder.isEmpty();
 284 }
 285
 286 template <typename DSV>
 287 std::optional<std::pair<SomeExpr, bool>>
 288 DataInitializationCompiler<DSV>::ConvertElement(
 289     const SomeExpr &expr, const evaluate::DynamicType &type) {
 290   if (auto converted{evaluate::ConvertToType(type, SomeExpr{expr})}) {
 291     return {std::make_pair(std::move(*converted), false)};
 292   }
 293   // Allow DATA initialization with Hollerith and kind=1 CHARACTER like
 294   // (most) other Fortran compilers do.
 295   if (auto converted{evaluate::HollerithToBOZ(
 296           exprAnalyzer_.GetFoldingContext(), expr, type)}) {
 297     return {std::make_pair(std::move(*converted), true)};
 298   }
 299   SemanticsContext &context{exprAnalyzer_.context()};
 300   if (context.IsEnabled(common::LanguageFeature::LogicalIntegerAssignment)) {
 301     if (MaybeExpr converted{evaluate::DataConstantConversionExtension(
 302             exprAnalyzer_.GetFoldingContext(), type, expr)}) {
 303       if (context.ShouldWarn(
 304               common::LanguageFeature::LogicalIntegerAssignment)) {
 305         context.Say(
 306             "nonstandard usage: initialization of %s with %s"_port_en_US,
 307             type.AsFortran(), expr.GetType().value().AsFortran());
 308       }
 309       return {std::make_pair(std::move(*converted), false)};
 310     }
 311   }
 312   return std::nullopt;
 313 }
 314
 315 template <typename DSV>
 316 bool DataInitializationCompiler<DSV>::InitElement(
 317     const evaluate::OffsetSymbol &offsetSymbol, const SomeExpr &designator) {
 318   const Symbol &symbol{offsetSymbol.symbol()};
 319   const Symbol *lastSymbol{GetLastSymbol(designator)};
 320   bool isPointer{lastSymbol && IsPointer(*lastSymbol)};
 321   bool isProcPointer{lastSymbol && IsProcedurePointer(*lastSymbol)};
 322   evaluate::FoldingContext &context{exprAnalyzer_.GetFoldingContext()};
 323   auto &messages{context.messages()};
 324   auto restorer{
 325       messages.SetLocation(values_.LocateSource().value_or(messages.at()))};
 326
 327   const auto DescribeElement{[&]() {
 328     if (auto badDesignator{
 329             evaluate::OffsetToDesignator(context, offsetSymbol)}) {
 330       return badDesignator->AsFortran();
 331     } else {
 332       // Error recovery
 333       std::string buf;
 334       llvm::raw_string_ostream ss{buf};
 335       ss << offsetSymbol.symbol().name() << " offset " << offsetSymbol.offset()
 336          << " bytes for " << offsetSymbol.size() << " bytes";
 337       return ss.str();
 338     }
 339   }};
 340   const auto GetImage{[&]() -> evaluate::InitialImage & {
 341     auto iter{inits_.emplace(&symbol, symbol.size())};
 342     auto &symbolInit{iter.first->second};
 343     symbolInit.initializedRanges.emplace_back(
 344         offsetSymbol.offset(), offsetSymbol.size());
 345     return symbolInit.image;
 346   }};
 347   const auto OutOfRangeError{[&]() {
 348     evaluate::AttachDeclaration(
 349         exprAnalyzer_.context().Say(
 350             "DATA statement designator '%s' is out of range for its variable '%s'"_err_en_US,
 351             DescribeElement(), symbol.name()),
 352         symbol);
 353   }};
 354
 355   if (values_.hasFatalError()) {
 356     return false;
 357   } else if (values_.IsAtEnd()) {
 358     exprAnalyzer_.context().Say(
 359         "DATA statement set has no value for '%s'"_err_en_US,
 360         DescribeElement());
 361     return false;
 362   } else if (static_cast<std::size_t>(
 363                  offsetSymbol.offset() + offsetSymbol.size()) > symbol.size()) {
 364     OutOfRangeError();
 365     return false;
 366   }
 367
 368   const SomeExpr *expr{*values_};
 369   if (!expr) {
 370     CHECK(exprAnalyzer_.context().AnyFatalError());
 371   } else if (symbol.size() > maxDataInitBytes) {
 372     evaluate::AttachDeclaration(
 373         exprAnalyzer_.context().Say(
 374             "'%s' is too large to initialize with a DATA statement"_todo_en_US,
 375             symbol.name()),
 376         symbol);
 377     return false;
 378   } else if (isPointer) {
 379     if (static_cast<std::size_t>(offsetSymbol.offset() + offsetSymbol.size()) >
 380         symbol.size()) {
 381       OutOfRangeError();
 382     } else if (evaluate::IsNullPointer(*expr)) {
 383       // nothing to do; rely on zero initialization
 384       return true;
 385     } else if (isProcPointer) {
 386       if (evaluate::IsProcedure(*expr)) {
 387         if (CheckPointerAssignment(context, designator, *expr, DEREF(scope_))) {
 388           if (lastSymbol->has<ProcEntityDetails>()) {
 389             GetImage().AddPointer(offsetSymbol.offset(), *expr);
 390             return true;
 391           } else {
 392             evaluate::AttachDeclaration(
 393                 exprAnalyzer_.context().Say(
 394                     "DATA statement initialization of procedure pointer '%s' declared using a POINTER statement and an INTERFACE instead of a PROCEDURE statement"_todo_en_US,
 395                     DescribeElement()),
 396                 *lastSymbol);
 397           }
 398         }
 399       } else {
 400         exprAnalyzer_.Say(
 401             "Data object '%s' may not be used to initialize '%s', which is a procedure pointer"_err_en_US,
 402             expr->AsFortran(), DescribeElement());
 403       }
 404     } else if (evaluate::IsProcedure(*expr)) {
 405       exprAnalyzer_.Say(
 406           "Procedure '%s' may not be used to initialize '%s', which is not a procedure pointer"_err_en_US,
 407           expr->AsFortran(), DescribeElement());
 408     } else if (CheckInitialTarget(context, designator, *expr, DEREF(scope_))) {
 409       GetImage().AddPointer(offsetSymbol.offset(), *expr);
 410       return true;
 411     }
 412   } else if (evaluate::IsNullPointer(*expr)) {
 413     exprAnalyzer_.Say("Initializer for '%s' must not be a pointer"_err_en_US,
 414         DescribeElement());
 415   } else if (evaluate::IsProcedure(*expr)) {
 416     exprAnalyzer_.Say("Initializer for '%s' must not be a procedure"_err_en_US,
 417         DescribeElement());
 418   } else if (auto designatorType{designator.GetType()}) {
 419     if (expr->Rank() > 0) {
 420       // Because initial-data-target is ambiguous with scalar-constant and
 421       // scalar-constant-subobject at parse time, enforcement of scalar-*
 422       // must be deferred to here.
 423       exprAnalyzer_.Say(
 424           "DATA statement value initializes '%s' with an array"_err_en_US,
 425           DescribeElement());
 426     } else if (auto converted{ConvertElement(*expr, *designatorType)}) {
 427       // value non-pointer initialization
 428       if (IsBOZLiteral(*expr) &&
 429           designatorType->category() != TypeCategory::Integer) { // 8.6.7(11)
 430         exprAnalyzer_.Say(
 431             "BOZ literal should appear in a DATA statement only as a value for an integer object, but '%s' is '%s'"_port_en_US,
 432             DescribeElement(), designatorType->AsFortran());
 433       } else if (converted->second) {
 434         exprAnalyzer_.context().Say(
 435             "DATA statement value initializes '%s' of type '%s' with CHARACTER"_port_en_US,
 436             DescribeElement(), designatorType->AsFortran());
 437       }
 438       auto folded{evaluate::Fold(context, std::move(converted->first))};
 439       // Rewritten from a switch() in order to avoid getting complaints
 440       // about a missing "default:" from some compilers and complaints
 441       // about a redundant "default:" from others.
 442       auto status{GetImage().Add(
 443           offsetSymbol.offset(), offsetSymbol.size(), folded, context)};
 444       if (status == evaluate::InitialImage::Ok) {
 445         return true;
 446       } else if (status == evaluate::InitialImage::NotAConstant) {
 447         exprAnalyzer_.Say(
 448             "DATA statement value '%s' for '%s' is not a constant"_err_en_US,
 449             folded.AsFortran(), DescribeElement());
 450       } else if (status == evaluate::InitialImage::OutOfRange) {
 451         OutOfRangeError();
 452       } else if (status == evaluate::InitialImage::SizeMismatch) {
 453         exprAnalyzer_.Say(
 454             "DATA statement value '%s' for '%s' has the wrong length"_warn_en_US,
 455             folded.AsFortran(), DescribeElement());
 456       } else {
 457         CHECK(exprAnalyzer_.context().AnyFatalError());
 458       }
 459     } else {
 460       exprAnalyzer_.context().Say(
 461           "DATA statement value could not be converted to the type '%s' of the object '%s'"_err_en_US,
 462           designatorType->AsFortran(), DescribeElement());
 463     }
 464   } else {
 465     CHECK(exprAnalyzer_.context().AnyFatalError());
 466   }
 467   return false;
 468 }
 469
 470 void AccumulateDataInitializations(DataInitializations &inits,
 471     evaluate::ExpressionAnalyzer &exprAnalyzer,
 472     const parser::DataStmtSet &set) {
 473   DataInitializationCompiler scanner{
 474       inits, exprAnalyzer, std::get<std::list<parser::DataStmtValue>>(set.t)};
 475   for (const auto &object :
 476       std::get<std::list<parser::DataStmtObject>>(set.t)) {
 477     if (!scanner.Scan(object)) {
 478       return;
 479     }
 480   }
 481   if (scanner.HasSurplusValues()) {
 482     exprAnalyzer.context().Say(
 483         "DATA statement set has more values than objects"_err_en_US);
 484   }
 485 }
 486
 487 void AccumulateDataInitializations(DataInitializations &inits,
 488     evaluate::ExpressionAnalyzer &exprAnalyzer, const Symbol &symbol,
 489     const std::list<common::Indirection<parser::DataStmtValue>> &list) {
 490   DataInitializationCompiler<common::Indirection<parser::DataStmtValue>>
 491       scanner{inits, exprAnalyzer, list};
 492   if (scanner.Scan(symbol) && scanner.HasSurplusValues()) {
 493     exprAnalyzer.context().Say(
 494         "DATA statement set has more values than objects"_err_en_US);
 495   }
 496 }
 497
 498 // Looks for default derived type component initialization -- but
 499 // *not* allocatables.
 500 static const DerivedTypeSpec *HasDefaultInitialization(const Symbol &symbol) {
 501   if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
 502     if (object->init().has_value()) {
 503       return nullptr; // init is explicit, not default
 504     } else if (!object->isDummy() && object->type()) {
 505       if (const DerivedTypeSpec * derived{object->type()->AsDerived()}) {
 506         DirectComponentIterator directs{*derived};
 507         if (std::find_if(
 508                 directs.begin(), directs.end(), [](const Symbol &component) {
 509                   return !IsAllocatable(component) &&
 510                       HasDeclarationInitializer(component);
 511                 })) {
 512           return derived;
 513         }
 514       }
 515     }
 516   }
 517   return nullptr;
 518 }
 519
 520 // PopulateWithComponentDefaults() adds initializations to an instance
 521 // of SymbolDataInitialization containing all of the default component
 522 // initializers
 523
 524 static void PopulateWithComponentDefaults(SymbolDataInitialization &init,
 525     std::size_t offset, const DerivedTypeSpec &derived,
 526     evaluate::FoldingContext &foldingContext);
 527
 528 static void PopulateWithComponentDefaults(SymbolDataInitialization &init,
 529     std::size_t offset, const DerivedTypeSpec &derived,
 530     evaluate::FoldingContext &foldingContext, const Symbol &symbol) {
 531   if (auto extents{evaluate::GetConstantExtents(foldingContext, symbol)}) {
 532     const Scope &scope{derived.scope() ? *derived.scope()
 533                                        : DEREF(derived.typeSymbol().scope())};
 534     std::size_t stride{scope.size()};
 535     if (std::size_t alignment{scope.alignment().value_or(0)}) {
 536       stride = ((stride + alignment - 1) / alignment) * alignment;
 537     }
 538     for (auto elements{evaluate::GetSize(*extents)}; elements-- > 0;
 539          offset += stride) {
 540       PopulateWithComponentDefaults(init, offset, derived, foldingContext);
 541     }
 542   }
 543 }
 544
 545 // F'2018 19.5.3(10) allows storage-associated default component initialization
 546 // when the values are identical.
 547 static void PopulateWithComponentDefaults(SymbolDataInitialization &init,
 548     std::size_t offset, const DerivedTypeSpec &derived,
 549     evaluate::FoldingContext &foldingContext) {
 550   const Scope &scope{
 551       derived.scope() ? *derived.scope() : DEREF(derived.typeSymbol().scope())};
 552   for (const auto &pair : scope) {
 553     const Symbol &component{*pair.second};
 554     std::size_t componentOffset{offset + component.offset()};
 555     if (const auto *object{component.detailsIf<ObjectEntityDetails>()}) {
 556       if (!IsAllocatable(component) && !IsAutomatic(component)) {
 557         bool initialized{false};
 558         if (object->init()) {
 559           initialized = true;
 560           if (IsPointer(component)) {
 561             if (auto extant{init.image.AsConstantPointer(componentOffset)}) {
 562               initialized = !(*extant == *object->init());
 563             }
 564             if (initialized) {
 565               init.image.AddPointer(componentOffset, *object->init());
 566             }
 567           } else { // data, not pointer
 568             if (auto dyType{evaluate::DynamicType::From(component)}) {
 569               if (auto extents{evaluate::GetConstantExtents(
 570                       foldingContext, component)}) {
 571                 if (auto extant{init.image.AsConstant(foldingContext, *dyType,
 572                         std::nullopt, *extents, false /*don't pad*/,
 573                         componentOffset)}) {
 574                   initialized = !(*extant == *object->init());
 575                 }
 576               }
 577             }
 578             if (initialized) {
 579               init.image.Add(componentOffset, component.size(), *object->init(),
 580                   foldingContext);
 581             }
 582           }
 583         } else if (const DeclTypeSpec * type{component.GetType()}) {
 584           if (const DerivedTypeSpec * componentDerived{type->AsDerived()}) {
 585             PopulateWithComponentDefaults(init, componentOffset,
 586                 *componentDerived, foldingContext, component);
 587           }
 588         }
 589         if (initialized) {
 590           init.initializedRanges.emplace_back(
 591               componentOffset, component.size());
 592         }
 593       }
 594     } else if (const auto *proc{component.detailsIf<ProcEntityDetails>()}) {
 595       if (proc->init() && *proc->init()) {
 596         SomeExpr procPtrInit{evaluate::ProcedureDesignator{**proc->init()}};
 597         auto extant{init.image.AsConstantPointer(componentOffset)};
 598         if (!extant || !(*extant == procPtrInit)) {
 599           init.initializedRanges.emplace_back(
 600               componentOffset, component.size());
 601           init.image.AddPointer(componentOffset, std::move(procPtrInit));
 602         }
 603       }
 604     }
 605   }
 606 }
 607
 608 static bool CheckForOverlappingInitialization(
 609     const std::list<SymbolRef> &symbols,
 610     SymbolDataInitialization &initialization,
 611     evaluate::ExpressionAnalyzer &exprAnalyzer, const std::string &what) {
 612   bool result{true};
 613   auto &context{exprAnalyzer.GetFoldingContext()};
 614   initialization.initializedRanges.sort();
 615   ConstantSubscript next{0};
 616   for (const auto &range : initialization.initializedRanges) {
 617     if (range.start() < next) {
 618       result = false; // error: overlap
 619       bool hit{false};
 620       for (const Symbol &symbol : symbols) {
 621         auto offset{range.start() -
 622             static_cast<ConstantSubscript>(
 623                 symbol.offset() - symbols.front()->offset())};
 624         if (offset >= 0) {
 625           if (auto badDesignator{evaluate::OffsetToDesignator(
 626                   context, symbol, offset, range.size())}) {
 627             hit = true;
 628             exprAnalyzer.Say(symbol.name(),
 629                 "%s affect '%s' more than once"_err_en_US, what,
 630                 badDesignator->AsFortran());
 631           }
 632         }
 633       }
 634       CHECK(hit);
 635     }
 636     next = range.start() + range.size();
 637     CHECK(next <= static_cast<ConstantSubscript>(initialization.image.size()));
 638   }
 639   return result;
 640 }
 641
 642 static void IncorporateExplicitInitialization(
 643     SymbolDataInitialization &combined, DataInitializations &inits,
 644     const Symbol &symbol, ConstantSubscript firstOffset,
 645     evaluate::FoldingContext &foldingContext) {
 646   auto iter{inits.find(&symbol)};
 647   const auto offset{symbol.offset() - firstOffset};
 648   if (iter != inits.end()) { // DATA statement initialization
 649     for (const auto &range : iter->second.initializedRanges) {
 650       auto at{offset + range.start()};
 651       combined.initializedRanges.emplace_back(at, range.size());
 652       combined.image.Incorporate(
 653           at, iter->second.image, range.start(), range.size());
 654     }
 655     if (removeOriginalInits) {
 656       inits.erase(iter);
 657     }
 658   } else { // Declaration initialization
 659     Symbol &mutableSymbol{const_cast<Symbol &>(symbol)};
 660     if (IsPointer(mutableSymbol)) {
 661       if (auto *object{mutableSymbol.detailsIf<ObjectEntityDetails>()}) {
 662         if (object->init()) {
 663           combined.initializedRanges.emplace_back(offset, mutableSymbol.size());
 664           combined.image.AddPointer(offset, *object->init());
 665           if (removeOriginalInits) {
 666             object->init().reset();
 667           }
 668         }
 669       } else if (auto *proc{mutableSymbol.detailsIf<ProcEntityDetails>()}) {
 670         if (proc->init() && *proc->init()) {
 671           combined.initializedRanges.emplace_back(offset, mutableSymbol.size());
 672           combined.image.AddPointer(
 673               offset, SomeExpr{evaluate::ProcedureDesignator{**proc->init()}});
 674           if (removeOriginalInits) {
 675             proc->init().reset();
 676           }
 677         }
 678       }
 679     } else if (auto *object{mutableSymbol.detailsIf<ObjectEntityDetails>()}) {
 680       if (!IsNamedConstant(mutableSymbol) && object->init()) {
 681         combined.initializedRanges.emplace_back(offset, mutableSymbol.size());
 682         combined.image.Add(
 683             offset, mutableSymbol.size(), *object->init(), foldingContext);
 684         if (removeOriginalInits) {
 685           object->init().reset();
 686         }
 687       }
 688     }
 689   }
 690 }
 691
 692 // Finds the size of the smallest element type in a list of
 693 // storage-associated objects.
 694 static std::size_t ComputeMinElementBytes(
 695     const std::list<SymbolRef> &associated,
 696     evaluate::FoldingContext &foldingContext) {
 697   std::size_t minElementBytes{1};
 698   const Symbol &first{*associated.front()};
 699   for (const Symbol &s : associated) {
 700     if (auto dyType{evaluate::DynamicType::From(s)}) {
 701       auto size{static_cast<std::size_t>(
 702           evaluate::ToInt64(dyType->MeasureSizeInBytes(foldingContext, true))
 703               .value_or(1))};
 704       if (std::size_t alignment{
 705               dyType->GetAlignment(foldingContext.targetCharacteristics())}) {
 706         size = ((size + alignment - 1) / alignment) * alignment;
 707       }
 708       if (&s == &first) {
 709         minElementBytes = size;
 710       } else {
 711         minElementBytes = std::min(minElementBytes, size);
 712       }
 713     } else {
 714       minElementBytes = 1;
 715     }
 716   }
 717   return minElementBytes;
 718 }
 719
 720 // Checks for overlapping initialization errors in a list of
 721 // storage-associated objects.  Default component initializations
 722 // are allowed to be overridden by explicit initializations.
 723 // If the objects are static, save the combined initializer as
 724 // a compiler-created object that covers all of them.
 725 static bool CombineEquivalencedInitialization(
 726     const std::list<SymbolRef> &associated,
 727     evaluate::ExpressionAnalyzer &exprAnalyzer, DataInitializations &inits) {
 728   // Compute the minimum common granularity and total size
 729   const Symbol &first{*associated.front()};
 730   std::size_t maxLimit{0};
 731   for (const Symbol &s : associated) {
 732     CHECK(s.offset() >= first.offset());
 733     auto limit{s.offset() + s.size()};
 734     if (limit > maxLimit) {
 735       maxLimit = limit;
 736     }
 737   }
 738   auto bytes{static_cast<common::ConstantSubscript>(maxLimit - first.offset())};
 739   Scope &scope{const_cast<Scope &>(first.owner())};
 740   // Combine the initializations of the associated objects.
 741   // Apply all default initializations first.
 742   SymbolDataInitialization combined{static_cast<std::size_t>(bytes)};
 743   auto &foldingContext{exprAnalyzer.GetFoldingContext()};
 744   for (const Symbol &s : associated) {
 745     if (!IsNamedConstant(s)) {
 746       if (const auto *derived{HasDefaultInitialization(s)}) {
 747         PopulateWithComponentDefaults(
 748             combined, s.offset() - first.offset(), *derived, foldingContext, s);
 749       }
 750     }
 751   }
 752   if (!CheckForOverlappingInitialization(associated, combined, exprAnalyzer,
 753           "Distinct default component initializations of equivalenced objects"s)) {
 754     return false;
 755   }
 756   // Don't complain about overlap between explicit initializations and
 757   // default initializations.
 758   combined.initializedRanges.clear();
 759   // Now overlay all explicit initializations from DATA statements and
 760   // from initializers in declarations.
 761   for (const Symbol &symbol : associated) {
 762     IncorporateExplicitInitialization(
 763         combined, inits, symbol, first.offset(), foldingContext);
 764   }
 765   if (!CheckForOverlappingInitialization(associated, combined, exprAnalyzer,
 766           "Explicit initializations of equivalenced objects"s)) {
 767     return false;
 768   }
 769   // If the items are in static storage, save the final initialization.
 770   if (std::find_if(associated.begin(), associated.end(),
 771           [](SymbolRef ref) { return IsSaved(*ref); }) != associated.end()) {
 772     // Create a compiler array temp that overlaps all the items.
 773     SourceName name{exprAnalyzer.context().GetTempName(scope)};
 774     auto emplaced{
 775         scope.try_emplace(name, Attrs{Attr::SAVE}, ObjectEntityDetails{})};
 776     CHECK(emplaced.second);
 777     Symbol &combinedSymbol{*emplaced.first->second};
 778     combinedSymbol.set(Symbol::Flag::CompilerCreated);
 779     inits.emplace(&combinedSymbol, std::move(combined));
 780     auto &details{combinedSymbol.get<ObjectEntityDetails>()};
 781     combinedSymbol.set_offset(first.offset());
 782     combinedSymbol.set_size(bytes);
 783     std::size_t minElementBytes{
 784         ComputeMinElementBytes(associated, foldingContext)};
 785     if (!exprAnalyzer.GetFoldingContext().targetCharacteristics().IsTypeEnabled(
 786             TypeCategory::Integer, minElementBytes) ||
 787         (bytes % minElementBytes) != 0) {
 788       minElementBytes = 1;
 789     }
 790     const DeclTypeSpec &typeSpec{scope.MakeNumericType(
 791         TypeCategory::Integer, KindExpr{minElementBytes})};
 792     details.set_type(typeSpec);
 793     ArraySpec arraySpec;
 794     arraySpec.emplace_back(ShapeSpec::MakeExplicit(Bound{
 795         bytes / static_cast<common::ConstantSubscript>(minElementBytes)}));
 796     details.set_shape(arraySpec);
 797     if (const auto *commonBlock{FindCommonBlockContaining(first)}) {
 798       details.set_commonBlock(*commonBlock);
 799     }
 800     // Add an EQUIVALENCE set to the scope so that the new object appears in
 801     // the results of GetStorageAssociations().
 802     auto &newSet{scope.equivalenceSets().emplace_back()};
 803     newSet.emplace_back(combinedSymbol);
 804     newSet.emplace_back(const_cast<Symbol &>(first));
 805   }
 806   return true;
 807 }
 808
 809 // When a statically-allocated derived type variable has no explicit
 810 // initialization, but its type has at least one nonallocatable ultimate
 811 // component with default initialization, make its initialization explicit.
 812 [[maybe_unused]] static void MakeDefaultInitializationExplicit(
 813     const Scope &scope, const std::list<std::list<SymbolRef>> &associations,
 814     evaluate::FoldingContext &foldingContext, DataInitializations &inits) {
 815   UnorderedSymbolSet equivalenced;
 816   for (const std::list<SymbolRef> &association : associations) {
 817     for (const Symbol &symbol : association) {
 818       equivalenced.emplace(symbol);
 819     }
 820   }
 821   for (const auto &pair : scope) {
 822     const Symbol &symbol{*pair.second};
 823     if (!symbol.test(Symbol::Flag::InDataStmt) &&
 824         !HasDeclarationInitializer(symbol) && IsSaved(symbol) &&
 825         equivalenced.find(symbol) == equivalenced.end()) {
 826       // Static object, no local storage association, no explicit initialization
 827       if (const DerivedTypeSpec * derived{HasDefaultInitialization(symbol)}) {
 828         auto newInitIter{inits.emplace(&symbol, symbol.size())};
 829         CHECK(newInitIter.second);
 830         auto &newInit{newInitIter.first->second};
 831         PopulateWithComponentDefaults(
 832             newInit, 0, *derived, foldingContext, symbol);
 833       }
 834     }
 835   }
 836 }
 837
 838 // Traverses the Scopes to:
 839 // 1) combine initialization of equivalenced objects, &
 840 // 2) optionally make initialization explicit for otherwise uninitialized static
 841 //    objects of derived types with default component initialization
 842 // Returns false on error.
 843 static bool ProcessScopes(const Scope &scope,
 844     evaluate::ExpressionAnalyzer &exprAnalyzer, DataInitializations &inits) {
 845   bool result{true}; // no error
 846   switch (scope.kind()) {
 847   case Scope::Kind::Global:
 848   case Scope::Kind::Module:
 849   case Scope::Kind::MainProgram:
 850   case Scope::Kind::Subprogram:
 851   case Scope::Kind::BlockData:
 852   case Scope::Kind::BlockConstruct: {
 853     std::list<std::list<SymbolRef>> associations{GetStorageAssociations(scope)};
 854     for (const std::list<SymbolRef> &associated : associations) {
 855       if (std::find_if(associated.begin(), associated.end(), [](SymbolRef ref) {
 856             return IsInitialized(*ref);
 857           }) != associated.end()) {
 858         result &=
 859             CombineEquivalencedInitialization(associated, exprAnalyzer, inits);
 860       }
 861     }
 862     if constexpr (makeDefaultInitializationExplicit) {
 863       MakeDefaultInitializationExplicit(
 864           scope, associations, exprAnalyzer.GetFoldingContext(), inits);
 865     }
 866     for (const Scope &child : scope.children()) {
 867       result &= ProcessScopes(child, exprAnalyzer, inits);
 868     }
 869   } break;
 870   default:;
 871   }
 872   return result;
 873 }
 874
 875 // Converts the static initialization image for a single symbol with
 876 // one or more DATA statement appearances.
 877 void ConstructInitializer(const Symbol &symbol,
 878     SymbolDataInitialization &initialization,
 879     evaluate::ExpressionAnalyzer &exprAnalyzer) {
 880   std::list<SymbolRef> symbols{symbol};
 881   CheckForOverlappingInitialization(
 882       symbols, initialization, exprAnalyzer, "DATA statement initializations"s);
 883   auto &context{exprAnalyzer.GetFoldingContext()};
 884   if (const auto *proc{symbol.detailsIf<ProcEntityDetails>()}) {
 885     CHECK(IsProcedurePointer(symbol));
 886     auto &mutableProc{const_cast<ProcEntityDetails &>(*proc)};
 887     if (MaybeExpr expr{initialization.image.AsConstantPointer()}) {
 888       if (const auto *procDesignator{
 889               std::get_if<evaluate::ProcedureDesignator>(&expr->u)}) {
 890         CHECK(!procDesignator->GetComponent());
 891         mutableProc.set_init(DEREF(procDesignator->GetSymbol()));
 892       } else {
 893         CHECK(evaluate::IsNullProcedurePointer(*expr));
 894         mutableProc.set_init(nullptr);
 895       }
 896     } else {
 897       mutableProc.set_init(nullptr);
 898     }
 899   } else if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
 900     auto &mutableObject{const_cast<ObjectEntityDetails &>(*object)};
 901     if (IsPointer(symbol)) {
 902       if (auto ptr{initialization.image.AsConstantPointer()}) {
 903         mutableObject.set_init(*ptr);
 904       } else {
 905         mutableObject.set_init(SomeExpr{evaluate::NullPointer{}});
 906       }
 907     } else if (auto symbolType{evaluate::DynamicType::From(symbol)}) {
 908       if (auto extents{evaluate::GetConstantExtents(context, symbol)}) {
 909         mutableObject.set_init(initialization.image.AsConstant(
 910             context, *symbolType, std::nullopt, *extents));
 911       } else {
 912         exprAnalyzer.Say(symbol.name(),
 913             "internal: unknown shape for '%s' while constructing initializer from DATA"_err_en_US,
 914             symbol.name());
 915         return;
 916       }
 917     } else {
 918       exprAnalyzer.Say(symbol.name(),
 919           "internal: no type for '%s' while constructing initializer from DATA"_err_en_US,
 920           symbol.name());
 921       return;
 922     }
 923     if (!object->init()) {
 924       exprAnalyzer.Say(symbol.name(),
 925           "internal: could not construct an initializer from DATA statements for '%s'"_err_en_US,
 926           symbol.name());
 927     }
 928   } else {
 929     CHECK(exprAnalyzer.context().AnyFatalError());
 930   }
 931 }
 932
 933 void ConvertToInitializers(
 934     DataInitializations &inits, evaluate::ExpressionAnalyzer &exprAnalyzer) {
 935   if (ProcessScopes(
 936           exprAnalyzer.context().globalScope(), exprAnalyzer, inits)) {
 937     for (auto &[symbolPtr, initialization] : inits) {
 938       ConstructInitializer(*symbolPtr, initialization, exprAnalyzer);
 939     }
 940   }
 941 }
 942 } // namespace Fortran::semantics