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:
ValueListIterator(const parser::DataStmtSet & set)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 }
hasFatalError() const44 bool hasFatalError() const { return hasFatalError_; }
IsAtEnd() const45 bool IsAtEnd() const { return at_ == end_; }
operator *() const46 const SomeExpr *operator*() const { return GetExpr(GetConstant()); }
LocateSource() const47 parser::CharBlock LocateSource() const { return GetConstant().source; }
operator ++()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();
GetConstant() const61 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
SetRepetitionCount()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:
DataInitializationCompiler(DataInitializations & inits,evaluate::ExpressionAnalyzer & a,const parser::DataStmtSet & set)92 DataInitializationCompiler(DataInitializations &inits,
93 evaluate::ExpressionAnalyzer &a, const parser::DataStmtSet &set)
94 : inits_{inits}, exprAnalyzer_{a}, values_{set} {}
inits() const95 const DataInitializations &inits() const { return inits_; }
HasSurplusValues() const96 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
Scan(const parser::DataStmtObject & object)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
Scan(const parser::Variable & var)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
Scan(const parser::Designator & designator)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
Scan(const parser::DataImpliedDo & ido)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
Scan(const parser::DataIDoObject & object)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
InitDesignator(const SomeExpr & designator)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>>
ConvertElement(const SomeExpr & expr,const evaluate::DynamicType & type)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{evaluate::GetScalarConstantValue<
238 evaluate::Type<TypeCategory::Character, 1>>(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
InitElement(const evaluate::OffsetSymbol & offsetSymbol,const SomeExpr & designator)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
AccumulateDataInitializations(DataInitializations & inits,evaluate::ExpressionAnalyzer & exprAnalyzer,const parser::DataStmtSet & set)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.
HasDefaultInitialization(const Symbol & symbol)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
PopulateWithComponentDefaults(SymbolDataInitialization & init,std::size_t offset,const DerivedTypeSpec & derived,evaluate::FoldingContext & foldingContext,const Symbol & symbol)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.
PopulateWithComponentDefaults(SymbolDataInitialization & init,std::size_t offset,const DerivedTypeSpec & derived,evaluate::FoldingContext & foldingContext)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
CheckForOverlappingInitialization(const std::list<SymbolRef> & symbols,SymbolDataInitialization & initialization,evaluate::ExpressionAnalyzer & exprAnalyzer,const std::string & what)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
IncorporateExplicitInitialization(SymbolDataInitialization & combined,DataInitializations & inits,const Symbol & symbol,ConstantSubscript firstOffset,evaluate::FoldingContext & foldingContext)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.
ComputeMinElementBytes(const std::list<SymbolRef> & associated,evaluate::FoldingContext & foldingContext)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.
CombineEquivalencedInitialization(const std::list<SymbolRef> & associated,evaluate::ExpressionAnalyzer & exprAnalyzer,DataInitializations & inits)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.
MakeDefaultInitializationExplicit(const Scope & scope,const std::list<std::list<SymbolRef>> & associations,evaluate::FoldingContext & foldingContext,DataInitializations & inits)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.
ProcessScopes(const Scope & scope,evaluate::ExpressionAnalyzer & exprAnalyzer,DataInitializations & inits)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.
ConstructInitializer(const Symbol & symbol,SymbolDataInitialization & initialization,evaluate::ExpressionAnalyzer & exprAnalyzer)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
ConvertToInitializers(DataInitializations & inits,evaluate::ExpressionAnalyzer & exprAnalyzer)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