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