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