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