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

source code of flang/lib/Semantics/data-to-inits.cpp