1 //===-- lib/Semantics/check-data.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 semantic analysis. 10 // - Applies static semantic checks to the variables in each data-stmt-set with 11 // class DataVarChecker; 12 // - Applies specific checks to each scalar element initialization with a 13 // constant value or pointer tareg with class DataInitializationCompiler; 14 // - Collects the elemental initializations for each symbol and converts them 15 // into a single init() expression with member function 16 // DataChecker::ConstructInitializer(). 17 18 #include "check-data.h" 19 #include "pointer-assignment.h" 20 #include "flang/Evaluate/fold-designator.h" 21 #include "flang/Evaluate/traverse.h" 22 #include "flang/Parser/parse-tree.h" 23 #include "flang/Parser/tools.h" 24 #include "flang/Semantics/tools.h" 25 26 namespace Fortran::semantics { 27 28 // Ensures that references to an implied DO loop control variable are 29 // represented as such in the "body" of the implied DO loop. 30 void DataChecker::Enter(const parser::DataImpliedDo &x) { 31 auto name{std::get<parser::DataImpliedDo::Bounds>(x.t).name.thing.thing}; 32 int kind{evaluate::ResultType<evaluate::ImpliedDoIndex>::kind}; 33 if (const auto dynamicType{evaluate::DynamicType::From(*name.symbol)}) { 34 if (dynamicType->category() == TypeCategory::Integer) { 35 kind = dynamicType->kind(); 36 } 37 } 38 exprAnalyzer_.AddImpliedDo(name.source, kind); 39 } 40 41 void DataChecker::Leave(const parser::DataImpliedDo &x) { 42 auto name{std::get<parser::DataImpliedDo::Bounds>(x.t).name.thing.thing}; 43 exprAnalyzer_.RemoveImpliedDo(name.source); 44 } 45 46 // DataVarChecker applies static checks once to each variable that appears 47 // in a data-stmt-set. These checks are independent of the values that 48 // correspond to the variables. 49 class DataVarChecker : public evaluate::AllTraverse<DataVarChecker, true> { 50 public: 51 using Base = evaluate::AllTraverse<DataVarChecker, true>; 52 DataVarChecker(SemanticsContext &c, parser::CharBlock src) 53 : Base{*this}, context_{c}, source_{src} {} 54 using Base::operator(); 55 bool HasComponentWithoutSubscripts() const { 56 return hasComponent_ && !hasSubscript_; 57 } 58 bool operator()(const Symbol &symbol) { // C876 59 // 8.6.7p(2) - precludes non-pointers of derived types with 60 // default component values 61 const Scope &scope{context_.FindScope(source_)}; 62 bool isFirstSymbol{isFirstSymbol_}; 63 isFirstSymbol_ = false; 64 if (const char *whyNot{IsAutomatic(symbol) ? "Automatic variable" 65 : IsDummy(symbol) ? "Dummy argument" 66 : IsFunctionResult(symbol) ? "Function result" 67 : IsAllocatable(symbol) ? "Allocatable" 68 : IsInitialized(symbol, true) ? "Default-initialized" 69 : IsInBlankCommon(symbol) ? "Blank COMMON object" 70 : IsProcedure(symbol) && !IsPointer(symbol) ? "Procedure" 71 // remaining checks don't apply to components 72 : !isFirstSymbol ? nullptr 73 : IsHostAssociated(symbol, scope) ? "Host-associated object" 74 : IsUseAssociated(symbol, scope) ? "USE-associated object" 75 : nullptr}) { 76 context_.Say(source_, 77 "%s '%s' must not be initialized in a DATA statement"_err_en_US, 78 whyNot, symbol.name()); 79 return false; 80 } else if (IsProcedurePointer(symbol)) { 81 context_.Say(source_, 82 "Procedure pointer '%s' in a DATA statement is not standard"_en_US, 83 symbol.name()); 84 } 85 return true; 86 } 87 bool operator()(const evaluate::Component &component) { 88 hasComponent_ = true; 89 const Symbol &lastSymbol{component.GetLastSymbol()}; 90 if (isPointerAllowed_) { 91 if (IsPointer(lastSymbol) && hasSubscript_) { // C877 92 context_.Say(source_, 93 "Rightmost data object pointer '%s' must not be subscripted"_err_en_US, 94 lastSymbol.name().ToString()); 95 return false; 96 } 97 RestrictPointer(); 98 } else { 99 if (IsPointer(lastSymbol)) { // C877 100 context_.Say(source_, 101 "Data object must not contain pointer '%s' as a non-rightmost part"_err_en_US, 102 lastSymbol.name().ToString()); 103 return false; 104 } 105 } 106 return (*this)(component.base()) && (*this)(lastSymbol); 107 } 108 bool operator()(const evaluate::ArrayRef &arrayRef) { 109 hasSubscript_ = true; 110 return (*this)(arrayRef.base()) && (*this)(arrayRef.subscript()); 111 } 112 bool operator()(const evaluate::Substring &substring) { 113 hasSubscript_ = true; 114 return (*this)(substring.parent()) && (*this)(substring.lower()) && 115 (*this)(substring.upper()); 116 } 117 bool operator()(const evaluate::CoarrayRef &) { // C874 118 context_.Say( 119 source_, "Data object must not be a coindexed variable"_err_en_US); 120 return false; 121 } 122 bool operator()(const evaluate::Subscript &subs) { 123 DataVarChecker subscriptChecker{context_, source_}; 124 subscriptChecker.RestrictPointer(); 125 return std::visit( 126 common::visitors{ 127 [&](const evaluate::IndirectSubscriptIntegerExpr &expr) { 128 return CheckSubscriptExpr(expr); 129 }, 130 [&](const evaluate::Triplet &triplet) { 131 return CheckSubscriptExpr(triplet.lower()) && 132 CheckSubscriptExpr(triplet.upper()) && 133 CheckSubscriptExpr(triplet.stride()); 134 }, 135 }, 136 subs.u) && 137 subscriptChecker(subs.u); 138 } 139 template <typename T> 140 bool operator()(const evaluate::FunctionRef<T> &) const { // C875 141 context_.Say(source_, 142 "Data object variable must not be a function reference"_err_en_US); 143 return false; 144 } 145 void RestrictPointer() { isPointerAllowed_ = false; } 146 147 private: 148 bool CheckSubscriptExpr( 149 const std::optional<evaluate::IndirectSubscriptIntegerExpr> &x) const { 150 return !x || CheckSubscriptExpr(*x); 151 } 152 bool CheckSubscriptExpr( 153 const evaluate::IndirectSubscriptIntegerExpr &expr) const { 154 return CheckSubscriptExpr(expr.value()); 155 } 156 bool CheckSubscriptExpr( 157 const evaluate::Expr<evaluate::SubscriptInteger> &expr) const { 158 if (!evaluate::IsConstantExpr(expr)) { // C875,C881 159 context_.Say( 160 source_, "Data object must have constant subscripts"_err_en_US); 161 return false; 162 } else { 163 return true; 164 } 165 } 166 167 SemanticsContext &context_; 168 parser::CharBlock source_; 169 bool hasComponent_{false}; 170 bool hasSubscript_{false}; 171 bool isPointerAllowed_{true}; 172 bool isFirstSymbol_{true}; 173 }; 174 175 void DataChecker::Leave(const parser::DataIDoObject &object) { 176 if (const auto *designator{ 177 std::get_if<parser::Scalar<common::Indirection<parser::Designator>>>( 178 &object.u)}) { 179 if (MaybeExpr expr{exprAnalyzer_.Analyze(*designator)}) { 180 auto source{designator->thing.value().source}; 181 if (evaluate::IsConstantExpr(*expr)) { // C878,C879 182 exprAnalyzer_.context().Say( 183 source, "Data implied do object must be a variable"_err_en_US); 184 } else { 185 DataVarChecker checker{exprAnalyzer_.context(), source}; 186 if (checker(*expr)) { 187 if (checker.HasComponentWithoutSubscripts()) { // C880 188 exprAnalyzer_.context().Say(source, 189 "Data implied do structure component must be subscripted"_err_en_US); 190 } else { 191 return; 192 } 193 } 194 } 195 } 196 } 197 currentSetHasFatalErrors_ = true; 198 } 199 200 void DataChecker::Leave(const parser::DataStmtObject &dataObject) { 201 std::visit(common::visitors{ 202 [](const parser::DataImpliedDo &) { // has own Enter()/Leave() 203 }, 204 [&](const auto &var) { 205 auto expr{exprAnalyzer_.Analyze(var)}; 206 if (!expr || 207 !DataVarChecker{exprAnalyzer_.context(), 208 parser::FindSourceLocation(dataObject)}(*expr)) { 209 currentSetHasFatalErrors_ = true; 210 } 211 }, 212 }, 213 dataObject.u); 214 } 215 216 // Steps through a list of values in a DATA statement set; implements 217 // repetition. 218 class ValueListIterator { 219 public: 220 explicit ValueListIterator(const parser::DataStmtSet &set) 221 : end_{std::get<std::list<parser::DataStmtValue>>(set.t).end()}, 222 at_{std::get<std::list<parser::DataStmtValue>>(set.t).begin()} { 223 SetRepetitionCount(); 224 } 225 bool hasFatalError() const { return hasFatalError_; } 226 bool IsAtEnd() const { return at_ == end_; } 227 const SomeExpr *operator*() const { return GetExpr(GetConstant()); } 228 parser::CharBlock LocateSource() const { return GetConstant().source; } 229 ValueListIterator &operator++() { 230 if (repetitionsRemaining_ > 0) { 231 --repetitionsRemaining_; 232 } else if (at_ != end_) { 233 ++at_; 234 SetRepetitionCount(); 235 } 236 return *this; 237 } 238 239 private: 240 using listIterator = std::list<parser::DataStmtValue>::const_iterator; 241 void SetRepetitionCount(); 242 const parser::DataStmtConstant &GetConstant() const { 243 return std::get<parser::DataStmtConstant>(at_->t); 244 } 245 246 listIterator end_; 247 listIterator at_; 248 ConstantSubscript repetitionsRemaining_{0}; 249 bool hasFatalError_{false}; 250 }; 251 252 void ValueListIterator::SetRepetitionCount() { 253 for (repetitionsRemaining_ = 1; at_ != end_; ++at_) { 254 if (at_->repetitions < 0) { 255 hasFatalError_ = true; 256 } 257 if (at_->repetitions > 0) { 258 repetitionsRemaining_ = at_->repetitions - 1; 259 return; 260 } 261 } 262 repetitionsRemaining_ = 0; 263 } 264 265 // Collects all of the elemental initializations from DATA statements 266 // into a single image for each symbol that appears in any DATA. 267 // Expands the implied DO loops and array references. 268 // Applies checks that validate each distinct elemental initialization 269 // of the variables in a data-stmt-set, as well as those that apply 270 // to the corresponding values being use to initialize each element. 271 class DataInitializationCompiler { 272 public: 273 DataInitializationCompiler(DataInitializations &inits, 274 evaluate::ExpressionAnalyzer &a, const parser::DataStmtSet &set) 275 : inits_{inits}, exprAnalyzer_{a}, values_{set} {} 276 const DataInitializations &inits() const { return inits_; } 277 bool HasSurplusValues() const { return !values_.IsAtEnd(); } 278 bool Scan(const parser::DataStmtObject &); 279 280 private: 281 bool Scan(const parser::Variable &); 282 bool Scan(const parser::Designator &); 283 bool Scan(const parser::DataImpliedDo &); 284 bool Scan(const parser::DataIDoObject &); 285 286 // Initializes all elements of a designator, which can be an array or section. 287 bool InitDesignator(const SomeExpr &); 288 // Initializes a single object. 289 bool InitElement(const evaluate::OffsetSymbol &, const SomeExpr &designator); 290 // If the returned flag is true, emit a warning about CHARACTER misusage. 291 std::optional<std::pair<SomeExpr, bool>> ConvertElement( 292 const SomeExpr &, const evaluate::DynamicType &); 293 294 DataInitializations &inits_; 295 evaluate::ExpressionAnalyzer &exprAnalyzer_; 296 ValueListIterator values_; 297 }; 298 299 bool DataInitializationCompiler::Scan(const parser::DataStmtObject &object) { 300 return std::visit( 301 common::visitors{ 302 [&](const common::Indirection<parser::Variable> &var) { 303 return Scan(var.value()); 304 }, 305 [&](const parser::DataImpliedDo &ido) { return Scan(ido); }, 306 }, 307 object.u); 308 } 309 310 bool DataInitializationCompiler::Scan(const parser::Variable &var) { 311 if (const auto *expr{GetExpr(var)}) { 312 exprAnalyzer_.GetFoldingContext().messages().SetLocation(var.GetSource()); 313 if (InitDesignator(*expr)) { 314 return true; 315 } 316 } 317 return false; 318 } 319 320 bool DataInitializationCompiler::Scan(const parser::Designator &designator) { 321 if (auto expr{exprAnalyzer_.Analyze(designator)}) { 322 exprAnalyzer_.GetFoldingContext().messages().SetLocation( 323 parser::FindSourceLocation(designator)); 324 if (InitDesignator(*expr)) { 325 return true; 326 } 327 } 328 return false; 329 } 330 331 bool DataInitializationCompiler::Scan(const parser::DataImpliedDo &ido) { 332 const auto &bounds{std::get<parser::DataImpliedDo::Bounds>(ido.t)}; 333 auto name{bounds.name.thing.thing}; 334 const auto *lowerExpr{GetExpr(bounds.lower.thing.thing)}; 335 const auto *upperExpr{GetExpr(bounds.upper.thing.thing)}; 336 const auto *stepExpr{ 337 bounds.step ? GetExpr(bounds.step->thing.thing) : nullptr}; 338 if (lowerExpr && upperExpr) { 339 auto lower{ToInt64(*lowerExpr)}; 340 auto upper{ToInt64(*upperExpr)}; 341 auto step{stepExpr ? ToInt64(*stepExpr) : std::nullopt}; 342 auto stepVal{step.value_or(1)}; 343 if (stepVal == 0) { 344 exprAnalyzer_.Say(name.source, 345 "DATA statement implied DO loop has a step value of zero"_err_en_US); 346 } else if (lower && upper) { 347 int kind{evaluate::ResultType<evaluate::ImpliedDoIndex>::kind}; 348 if (const auto dynamicType{evaluate::DynamicType::From(*name.symbol)}) { 349 if (dynamicType->category() == TypeCategory::Integer) { 350 kind = dynamicType->kind(); 351 } 352 } 353 if (exprAnalyzer_.AddImpliedDo(name.source, kind)) { 354 auto &value{exprAnalyzer_.GetFoldingContext().StartImpliedDo( 355 name.source, *lower)}; 356 bool result{true}; 357 for (auto n{(*upper - value + stepVal) / stepVal}; n > 0; 358 --n, value += stepVal) { 359 for (const auto &object : 360 std::get<std::list<parser::DataIDoObject>>(ido.t)) { 361 if (!Scan(object)) { 362 result = false; 363 break; 364 } 365 } 366 } 367 exprAnalyzer_.GetFoldingContext().EndImpliedDo(name.source); 368 exprAnalyzer_.RemoveImpliedDo(name.source); 369 return result; 370 } 371 } 372 } 373 return false; 374 } 375 376 bool DataInitializationCompiler::Scan(const parser::DataIDoObject &object) { 377 return std::visit( 378 common::visitors{ 379 [&](const parser::Scalar<common::Indirection<parser::Designator>> 380 &var) { return Scan(var.thing.value()); }, 381 [&](const common::Indirection<parser::DataImpliedDo> &ido) { 382 return Scan(ido.value()); 383 }, 384 }, 385 object.u); 386 } 387 388 bool DataInitializationCompiler::InitDesignator(const SomeExpr &designator) { 389 evaluate::FoldingContext &context{exprAnalyzer_.GetFoldingContext()}; 390 evaluate::DesignatorFolder folder{context}; 391 while (auto offsetSymbol{folder.FoldDesignator(designator)}) { 392 if (folder.isOutOfRange()) { 393 if (auto bad{evaluate::OffsetToDesignator(context, *offsetSymbol)}) { 394 exprAnalyzer_.context().Say( 395 "DATA statement designator '%s' is out of range"_err_en_US, 396 bad->AsFortran()); 397 } else { 398 exprAnalyzer_.context().Say( 399 "DATA statement designator '%s' is out of range"_err_en_US, 400 designator.AsFortran()); 401 } 402 return false; 403 } else if (!InitElement(*offsetSymbol, designator)) { 404 return false; 405 } else { 406 ++values_; 407 } 408 } 409 return folder.isEmpty(); 410 } 411 412 std::optional<std::pair<SomeExpr, bool>> 413 DataInitializationCompiler::ConvertElement( 414 const SomeExpr &expr, const evaluate::DynamicType &type) { 415 if (auto converted{evaluate::ConvertToType(type, SomeExpr{expr})}) { 416 return {std::make_pair(std::move(*converted), false)}; 417 } 418 if (std::optional<std::string> chValue{evaluate::GetScalarConstantValue< 419 evaluate::Type<TypeCategory::Character, 1>>(expr)}) { 420 // Allow DATA initialization with Hollerith and kind=1 CHARACTER like 421 // (most) other Fortran compilers do. Pad on the right with spaces 422 // when short, truncate the right if long. 423 // TODO: big-endian targets 424 std::size_t bytes{type.MeasureSizeInBytes().value()}; 425 evaluate::BOZLiteralConstant bits{0}; 426 for (std::size_t j{0}; j < bytes; ++j) { 427 char ch{j >= chValue->size() ? ' ' : chValue->at(j)}; 428 evaluate::BOZLiteralConstant chBOZ{static_cast<unsigned char>(ch)}; 429 bits = bits.IOR(chBOZ.SHIFTL(8 * j)); 430 } 431 if (auto converted{evaluate::ConvertToType(type, SomeExpr{bits})}) { 432 return {std::make_pair(std::move(*converted), true)}; 433 } 434 } 435 return std::nullopt; 436 } 437 438 bool DataInitializationCompiler::InitElement( 439 const evaluate::OffsetSymbol &offsetSymbol, const SomeExpr &designator) { 440 const Symbol &symbol{offsetSymbol.symbol()}; 441 const Symbol *lastSymbol{GetLastSymbol(designator)}; 442 bool isPointer{lastSymbol && IsPointer(*lastSymbol)}; 443 bool isProcPointer{lastSymbol && IsProcedurePointer(*lastSymbol)}; 444 evaluate::FoldingContext &context{exprAnalyzer_.GetFoldingContext()}; 445 446 const auto DescribeElement{[&]() { 447 if (auto badDesignator{ 448 evaluate::OffsetToDesignator(context, offsetSymbol)}) { 449 return badDesignator->AsFortran(); 450 } else { 451 // Error recovery 452 std::string buf; 453 llvm::raw_string_ostream ss{buf}; 454 ss << offsetSymbol.symbol().name() << " offset " << offsetSymbol.offset() 455 << " bytes for " << offsetSymbol.size() << " bytes"; 456 return ss.str(); 457 } 458 }}; 459 const auto GetImage{[&]() -> evaluate::InitialImage & { 460 auto &symbolInit{inits_.emplace(symbol, symbol.size()).first->second}; 461 symbolInit.inits.emplace_back(offsetSymbol.offset(), offsetSymbol.size()); 462 return symbolInit.image; 463 }}; 464 const auto OutOfRangeError{[&]() { 465 evaluate::AttachDeclaration( 466 exprAnalyzer_.context().Say( 467 "DATA statement designator '%s' is out of range for its variable '%s'"_err_en_US, 468 DescribeElement(), symbol.name()), 469 symbol); 470 }}; 471 472 if (values_.hasFatalError()) { 473 return false; 474 } else if (values_.IsAtEnd()) { 475 exprAnalyzer_.context().Say( 476 "DATA statement set has no value for '%s'"_err_en_US, 477 DescribeElement()); 478 return false; 479 } else if (static_cast<std::size_t>( 480 offsetSymbol.offset() + offsetSymbol.size()) > symbol.size()) { 481 OutOfRangeError(); 482 return false; 483 } 484 485 const SomeExpr *expr{*values_}; 486 if (!expr) { 487 CHECK(exprAnalyzer_.context().AnyFatalError()); 488 } else if (isPointer) { 489 if (static_cast<std::size_t>(offsetSymbol.offset() + offsetSymbol.size()) > 490 symbol.size()) { 491 OutOfRangeError(); 492 } else if (evaluate::IsNullPointer(*expr)) { 493 // nothing to do; rely on zero initialization 494 return true; 495 } else if (evaluate::IsProcedure(*expr)) { 496 if (isProcPointer) { 497 if (CheckPointerAssignment(context, designator, *expr)) { 498 GetImage().AddPointer(offsetSymbol.offset(), *expr); 499 return true; 500 } 501 } else { 502 exprAnalyzer_.Say(values_.LocateSource(), 503 "Procedure '%s' may not be used to initialize '%s', which is not a procedure pointer"_err_en_US, 504 expr->AsFortran(), DescribeElement()); 505 } 506 } else if (isProcPointer) { 507 exprAnalyzer_.Say(values_.LocateSource(), 508 "Data object '%s' may not be used to initialize '%s', which is a procedure pointer"_err_en_US, 509 expr->AsFortran(), DescribeElement()); 510 } else if (CheckInitialTarget(context, designator, *expr)) { 511 GetImage().AddPointer(offsetSymbol.offset(), *expr); 512 return true; 513 } 514 } else if (evaluate::IsNullPointer(*expr)) { 515 exprAnalyzer_.Say(values_.LocateSource(), 516 "Initializer for '%s' must not be a pointer"_err_en_US, 517 DescribeElement()); 518 } else if (evaluate::IsProcedure(*expr)) { 519 exprAnalyzer_.Say(values_.LocateSource(), 520 "Initializer for '%s' must not be a procedure"_err_en_US, 521 DescribeElement()); 522 } else if (auto designatorType{designator.GetType()}) { 523 if (auto converted{ConvertElement(*expr, *designatorType)}) { 524 // value non-pointer initialization 525 if (std::holds_alternative<evaluate::BOZLiteralConstant>(expr->u) && 526 designatorType->category() != TypeCategory::Integer) { // 8.6.7(11) 527 exprAnalyzer_.Say(values_.LocateSource(), 528 "BOZ literal should appear in a DATA statement only as a value for an integer object, but '%s' is '%s'"_en_US, 529 DescribeElement(), designatorType->AsFortran()); 530 } else if (converted->second) { 531 exprAnalyzer_.context().Say( 532 "DATA statement value initializes '%s' of type '%s' with CHARACTER"_en_US, 533 DescribeElement(), designatorType->AsFortran()); 534 } 535 auto folded{evaluate::Fold(context, std::move(converted->first))}; 536 switch ( 537 GetImage().Add(offsetSymbol.offset(), offsetSymbol.size(), folded)) { 538 case evaluate::InitialImage::Ok: 539 return true; 540 case evaluate::InitialImage::NotAConstant: 541 exprAnalyzer_.Say(values_.LocateSource(), 542 "DATA statement value '%s' for '%s' is not a constant"_err_en_US, 543 folded.AsFortran(), DescribeElement()); 544 break; 545 case evaluate::InitialImage::OutOfRange: 546 OutOfRangeError(); 547 break; 548 default: 549 CHECK(exprAnalyzer_.context().AnyFatalError()); 550 break; 551 } 552 } else { 553 exprAnalyzer_.context().Say( 554 "DATA statement value could not be converted to the type '%s' of the object '%s'"_err_en_US, 555 designatorType->AsFortran(), DescribeElement()); 556 } 557 } else { 558 CHECK(exprAnalyzer_.context().AnyFatalError()); 559 } 560 return false; 561 } 562 563 void DataChecker::Leave(const parser::DataStmtSet &set) { 564 if (!currentSetHasFatalErrors_) { 565 DataInitializationCompiler scanner{inits_, exprAnalyzer_, set}; 566 for (const auto &object : 567 std::get<std::list<parser::DataStmtObject>>(set.t)) { 568 if (!scanner.Scan(object)) { 569 return; 570 } 571 } 572 if (scanner.HasSurplusValues()) { 573 exprAnalyzer_.context().Say( 574 "DATA statement set has more values than objects"_err_en_US); 575 } 576 } 577 currentSetHasFatalErrors_ = false; 578 } 579 580 // Converts the initialization image for all the DATA statement appearances of 581 // a single symbol into an init() expression in the symbol table entry. 582 void DataChecker::ConstructInitializer( 583 const Symbol &symbol, SymbolDataInitialization &initialization) { 584 auto &context{exprAnalyzer_.GetFoldingContext()}; 585 initialization.inits.sort(); 586 ConstantSubscript next{0}; 587 for (const auto &init : initialization.inits) { 588 if (init.start() < next) { 589 auto badDesignator{evaluate::OffsetToDesignator( 590 context, symbol, init.start(), init.size())}; 591 CHECK(badDesignator); 592 exprAnalyzer_.Say(symbol.name(), 593 "DATA statement initializations affect '%s' more than once"_err_en_US, 594 badDesignator->AsFortran()); 595 } 596 next = init.start() + init.size(); 597 CHECK(next <= static_cast<ConstantSubscript>(initialization.image.size())); 598 } 599 if (const auto *proc{symbol.detailsIf<ProcEntityDetails>()}) { 600 CHECK(IsProcedurePointer(symbol)); 601 const auto &procDesignator{initialization.image.AsConstantProcPointer()}; 602 CHECK(!procDesignator.GetComponent()); 603 auto &mutableProc{const_cast<ProcEntityDetails &>(*proc)}; 604 mutableProc.set_init(DEREF(procDesignator.GetSymbol())); 605 } else if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) { 606 if (auto symbolType{evaluate::DynamicType::From(symbol)}) { 607 auto &mutableObject{const_cast<ObjectEntityDetails &>(*object)}; 608 if (IsPointer(symbol)) { 609 mutableObject.set_init( 610 initialization.image.AsConstantDataPointer(*symbolType)); 611 mutableObject.set_initWasValidated(); 612 } else { 613 if (auto extents{evaluate::GetConstantExtents(context, symbol)}) { 614 mutableObject.set_init( 615 initialization.image.AsConstant(context, *symbolType, *extents)); 616 mutableObject.set_initWasValidated(); 617 } else { 618 exprAnalyzer_.Say(symbol.name(), 619 "internal: unknown shape for '%s' while constructing initializer from DATA"_err_en_US, 620 symbol.name()); 621 return; 622 } 623 } 624 } else { 625 exprAnalyzer_.Say(symbol.name(), 626 "internal: no type for '%s' while constructing initializer from DATA"_err_en_US, 627 symbol.name()); 628 return; 629 } 630 if (!object->init()) { 631 exprAnalyzer_.Say(symbol.name(), 632 "internal: could not construct an initializer from DATA statements for '%s'"_err_en_US, 633 symbol.name()); 634 } 635 } else { 636 CHECK(exprAnalyzer_.context().AnyFatalError()); 637 } 638 } 639 640 void DataChecker::CompileDataInitializationsIntoInitializers() { 641 for (auto &[symbolRef, initialization] : inits_) { 642 ConstructInitializer(*symbolRef, initialization); 643 } 644 } 645 646 } // namespace Fortran::semantics 647