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

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