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