llvm-project

1
//===-- lib/Semantics/data-to-inits.cpp -----------------------------------===//
2
//
3
// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
4
// See https://llvm.org/LICENSE.txt for license information.
5
// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
6
//
7
//===----------------------------------------------------------------------===//
8

9
// DATA statement object/value checking and conversion to static
10
// initializers
11
// - Applies specific checks to each scalar element initialization with a
12
//   constant value or pointer target with class DataInitializationCompiler;
13
// - Collects the elemental initializations for each symbol and converts them
14
//   into a single init() expression with member function
15
//   DataChecker::ConstructInitializer().
16

17
#include "data-to-inits.h"
18
#include "pointer-assignment.h"
19
#include "flang/Evaluate/fold-designator.h"
20
#include "flang/Evaluate/tools.h"
21
#include "flang/Semantics/tools.h"
22

23
// The job of generating explicit static initializers for objects that don't
24
// have them in order to implement default component initialization is now being
25
// done in lowering, so don't do it here in semantics; but the code remains here
26
// in case we change our minds.
27
static constexpr bool makeDefaultInitializationExplicit{false};
28

29
// Whether to delete the original "init()" initializers from storage-associated
30
// objects and pointers.
31
static constexpr bool removeOriginalInits{false};
32

33
// 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.
36
static constexpr auto maxDataInitBytes{std::size_t{1000000000}}; // 1GiB
37

38
namespace Fortran::semantics {
39

40
// Steps through a list of values in a DATA statement set; implements
41
// repetition.
42
template <typename DSV = parser::DataStmtValue> class ValueListIterator {
43
public:
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

67
private:
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

83
template <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.
102
template <typename DSV = parser::DataStmtValue>
103
class DataInitializationCompiler {
104
public:
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

114
private:
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

134
template <typename DSV>
135
bool 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

147
template <typename DSV>
148
bool 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

159
template <typename DSV>
160
bool 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

179
template <typename DSV>
180
bool 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

237
template <typename DSV>
238
bool 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

251
template <typename DSV>
252
bool 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

258
template <typename DSV>
259
bool 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

284
template <typename DSV>
285
std::optional<std::pair<SomeExpr, bool>>
286
DataInitializationCompiler<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

313
template <typename DSV>
314
bool 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::IsProcedureDesignator(*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::IsProcedureDesignator(*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
        if (exprAnalyzer_.context().ShouldWarn(
466
                common::UsageWarning::DataLength)) {
467
          exprAnalyzer_.Say(
468
              "DATA statement value '%s' for '%s' has the wrong length"_warn_en_US,
469
              folded.AsFortran(), DescribeElement());
470
        }
471
        return true;
472
      } else if (status == evaluate::InitialImage::TooManyElems) {
473
        exprAnalyzer_.Say("DATA statement has too many elements"_err_en_US);
474
      } else {
475
        CHECK(exprAnalyzer_.context().AnyFatalError());
476
      }
477
    } else {
478
      exprAnalyzer_.context().Say(
479
          "DATA statement value could not be converted to the type '%s' of the object '%s'"_err_en_US,
480
          designatorType->AsFortran(), DescribeElement());
481
    }
482
  } else {
483
    CHECK(exprAnalyzer_.context().AnyFatalError());
484
  }
485
  return false;
486
}
487

488
void AccumulateDataInitializations(DataInitializations &inits,
489
    evaluate::ExpressionAnalyzer &exprAnalyzer,
490
    const parser::DataStmtSet &set) {
491
  DataInitializationCompiler scanner{
492
      inits, exprAnalyzer, std::get<std::list<parser::DataStmtValue>>(set.t)};
493
  for (const auto &object :
494
      std::get<std::list<parser::DataStmtObject>>(set.t)) {
495
    if (!scanner.Scan(object)) {
496
      return;
497
    }
498
  }
499
  if (scanner.HasSurplusValues()) {
500
    exprAnalyzer.context().Say(
501
        "DATA statement set has more values than objects"_err_en_US);
502
  }
503
}
504

505
void AccumulateDataInitializations(DataInitializations &inits,
506
    evaluate::ExpressionAnalyzer &exprAnalyzer, const Symbol &symbol,
507
    const std::list<common::Indirection<parser::DataStmtValue>> &list) {
508
  DataInitializationCompiler<common::Indirection<parser::DataStmtValue>>
509
      scanner{inits, exprAnalyzer, list};
510
  if (scanner.Scan(symbol) && scanner.HasSurplusValues()) {
511
    exprAnalyzer.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.
518
static const DerivedTypeSpec *HasDefaultInitialization(const Symbol &symbol) {
519
  if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
520
    if (object->init().has_value()) {
521
      return nullptr; // init is explicit, not default
522
    } else if (!object->isDummy() && object->type()) {
523
      if (const DerivedTypeSpec * derived{object->type()->AsDerived()}) {
524
        DirectComponentIterator directs{*derived};
525
        if (std::find_if(
526
                directs.begin(), directs.end(), [](const Symbol &component) {
527
                  return !IsAllocatable(component) &&
528
                      HasDeclarationInitializer(component);
529
                }) != directs.end()) {
530
          return derived;
531
        }
532
      }
533
    }
534
  }
535
  return nullptr;
536
}
537

538
// PopulateWithComponentDefaults() adds initializations to an instance
539
// of SymbolDataInitialization containing all of the default component
540
// initializers
541

542
static void PopulateWithComponentDefaults(SymbolDataInitialization &init,
543
    std::size_t offset, const DerivedTypeSpec &derived,
544
    evaluate::FoldingContext &foldingContext);
545

546
static void PopulateWithComponentDefaults(SymbolDataInitialization &init,
547
    std::size_t offset, const DerivedTypeSpec &derived,
548
    evaluate::FoldingContext &foldingContext, const Symbol &symbol) {
549
  if (auto extents{evaluate::GetConstantExtents(foldingContext, symbol)}) {
550
    const Scope &scope{derived.scope() ? *derived.scope()
551
                                       : DEREF(derived.typeSymbol().scope())};
552
    std::size_t stride{scope.size()};
553
    if (std::size_t alignment{scope.alignment().value_or(0)}) {
554
      stride = ((stride + alignment - 1) / alignment) * alignment;
555
    }
556
    for (auto elements{evaluate::GetSize(*extents)}; elements-- > 0;
557
         offset += stride) {
558
      PopulateWithComponentDefaults(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.
565
static void PopulateWithComponentDefaults(SymbolDataInitialization &init,
566
    std::size_t offset, const DerivedTypeSpec &derived,
567
    evaluate::FoldingContext &foldingContext) {
568
  const Scope &scope{
569
      derived.scope() ? *derived.scope() : DEREF(derived.typeSymbol().scope())};
570
  for (const auto &pair : scope) {
571
    const Symbol &component{*pair.second};
572
    std::size_t componentOffset{offset + component.offset()};
573
    if (const auto *object{component.detailsIf<ObjectEntityDetails>()}) {
574
      if (!IsAllocatable(component) && !IsAutomatic(component)) {
575
        bool initialized{false};
576
        if (object->init()) {
577
          initialized = true;
578
          if (IsPointer(component)) {
579
            if (auto extant{init.image.AsConstantPointer(componentOffset)}) {
580
              initialized = !(*extant == *object->init());
581
            }
582
            if (initialized) {
583
              init.image.AddPointer(componentOffset, *object->init());
584
            }
585
          } else { // data, not pointer
586
            if (auto dyType{evaluate::DynamicType::From(component)}) {
587
              if (auto extents{evaluate::GetConstantExtents(
588
                      foldingContext, component)}) {
589
                if (auto extant{init.image.AsConstant(foldingContext, *dyType,
590
                        std::nullopt, *extents, false /*don't pad*/,
591
                        componentOffset)}) {
592
                  initialized = !(*extant == *object->init());
593
                }
594
              }
595
            }
596
            if (initialized) {
597
              init.image.Add(componentOffset, component.size(), *object->init(),
598
                  foldingContext);
599
            }
600
          }
601
        } else if (const DeclTypeSpec * type{component.GetType()}) {
602
          if (const DerivedTypeSpec * componentDerived{type->AsDerived()}) {
603
            PopulateWithComponentDefaults(init, componentOffset,
604
                *componentDerived, foldingContext, component);
605
          }
606
        }
607
        if (initialized) {
608
          init.NoteInitializedRange(componentOffset, component.size());
609
        }
610
      }
611
    } else if (const auto *proc{component.detailsIf<ProcEntityDetails>()}) {
612
      if (proc->init() && *proc->init()) {
613
        SomeExpr procPtrInit{evaluate::ProcedureDesignator{**proc->init()}};
614
        auto extant{init.image.AsConstantPointer(componentOffset)};
615
        if (!extant || !(*extant == procPtrInit)) {
616
          init.NoteInitializedRange(componentOffset, component.size());
617
          init.image.AddPointer(componentOffset, std::move(procPtrInit));
618
        }
619
      }
620
    }
621
  }
622
}
623

624
static bool CheckForOverlappingInitialization(
625
    const std::list<SymbolRef> &symbols,
626
    SymbolDataInitialization &initialization,
627
    evaluate::ExpressionAnalyzer &exprAnalyzer, const std::string &what) {
628
  bool result{true};
629
  auto &context{exprAnalyzer.GetFoldingContext()};
630
  initialization.initializedRanges.sort();
631
  ConstantSubscript next{0};
632
  for (const auto &range : initialization.initializedRanges) {
633
    if (range.start() < next) {
634
      result = false; // error: overlap
635
      bool hit{false};
636
      for (const Symbol &symbol : symbols) {
637
        auto offset{range.start() -
638
            static_cast<ConstantSubscript>(
639
                symbol.offset() - symbols.front()->offset())};
640
        if (offset >= 0) {
641
          if (auto badDesignator{evaluate::OffsetToDesignator(
642
                  context, symbol, offset, range.size())}) {
643
            hit = true;
644
            exprAnalyzer.Say(symbol.name(),
645
                "%s affect '%s' more than once"_err_en_US, what,
646
                badDesignator->AsFortran());
647
          }
648
        }
649
      }
650
      CHECK(hit);
651
    }
652
    next = range.start() + range.size();
653
    CHECK(next <= static_cast<ConstantSubscript>(initialization.image.size()));
654
  }
655
  return result;
656
}
657

658
static void IncorporateExplicitInitialization(
659
    SymbolDataInitialization &combined, DataInitializations &inits,
660
    const Symbol &symbol, ConstantSubscript firstOffset,
661
    evaluate::FoldingContext &foldingContext) {
662
  auto iter{inits.find(&symbol)};
663
  const auto offset{symbol.offset() - firstOffset};
664
  if (iter != inits.end()) { // DATA statement initialization
665
    for (const auto &range : iter->second.initializedRanges) {
666
      auto at{offset + range.start()};
667
      combined.NoteInitializedRange(at, range.size());
668
      combined.image.Incorporate(
669
          at, iter->second.image, range.start(), range.size());
670
    }
671
    if (removeOriginalInits) {
672
      inits.erase(iter);
673
    }
674
  } else { // Declaration initialization
675
    Symbol &mutableSymbol{const_cast<Symbol &>(symbol)};
676
    if (IsPointer(mutableSymbol)) {
677
      if (auto *object{mutableSymbol.detailsIf<ObjectEntityDetails>()}) {
678
        if (object->init()) {
679
          combined.NoteInitializedRange(offset, mutableSymbol.size());
680
          combined.image.AddPointer(offset, *object->init());
681
          if (removeOriginalInits) {
682
            object->init().reset();
683
          }
684
        }
685
      } else if (auto *proc{mutableSymbol.detailsIf<ProcEntityDetails>()}) {
686
        if (proc->init() && *proc->init()) {
687
          combined.NoteInitializedRange(offset, mutableSymbol.size());
688
          combined.image.AddPointer(
689
              offset, SomeExpr{evaluate::ProcedureDesignator{**proc->init()}});
690
          if (removeOriginalInits) {
691
            proc->init().reset();
692
          }
693
        }
694
      }
695
    } else if (auto *object{mutableSymbol.detailsIf<ObjectEntityDetails>()}) {
696
      if (!IsNamedConstant(mutableSymbol) && object->init()) {
697
        combined.NoteInitializedRange(offset, mutableSymbol.size());
698
        combined.image.Add(
699
            offset, mutableSymbol.size(), *object->init(), foldingContext);
700
        if (removeOriginalInits) {
701
          object->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.
710
static std::size_t ComputeMinElementBytes(
711
    const std::list<SymbolRef> &associated,
712
    evaluate::FoldingContext &foldingContext) {
713
  std::size_t minElementBytes{1};
714
  const Symbol &first{*associated.front()};
715
  for (const Symbol &s : associated) {
716
    if (auto dyType{evaluate::DynamicType::From(s)}) {
717
      auto size{static_cast<std::size_t>(
718
          evaluate::ToInt64(dyType->MeasureSizeInBytes(foldingContext, true))
719
              .value_or(1))};
720
      if (std::size_t alignment{
721
              dyType->GetAlignment(foldingContext.targetCharacteristics())}) {
722
        size = ((size + alignment - 1) / alignment) * alignment;
723
      }
724
      if (&s == &first) {
725
        minElementBytes = size;
726
      } else {
727
        minElementBytes = std::min(minElementBytes, size);
728
      }
729
    } else {
730
      minElementBytes = 1;
731
    }
732
  }
733
  return 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.
741
static bool CombineEquivalencedInitialization(
742
    const std::list<SymbolRef> &associated,
743
    evaluate::ExpressionAnalyzer &exprAnalyzer, DataInitializations &inits) {
744
  // Compute the minimum common granularity and total size
745
  const Symbol &first{*associated.front()};
746
  std::size_t maxLimit{0};
747
  for (const Symbol &s : associated) {
748
    CHECK(s.offset() >= first.offset());
749
    auto limit{s.offset() + s.size()};
750
    if (limit > maxLimit) {
751
      maxLimit = limit;
752
    }
753
  }
754
  auto bytes{static_cast<common::ConstantSubscript>(maxLimit - first.offset())};
755
  Scope &scope{const_cast<Scope &>(first.owner())};
756
  // Combine the initializations of the associated objects.
757
  // Apply all default initializations first.
758
  SymbolDataInitialization combined{static_cast<std::size_t>(bytes)};
759
  auto &foldingContext{exprAnalyzer.GetFoldingContext()};
760
  for (const Symbol &s : associated) {
761
    if (!IsNamedConstant(s)) {
762
      if (const auto *derived{HasDefaultInitialization(s)}) {
763
        PopulateWithComponentDefaults(
764
            combined, s.offset() - first.offset(), *derived, foldingContext, s);
765
      }
766
    }
767
  }
768
  if (!CheckForOverlappingInitialization(associated, combined, exprAnalyzer,
769
          "Distinct default component initializations of equivalenced objects"s)) {
770
    return false;
771
  }
772
  // Don't complain about overlap between explicit initializations and
773
  // default initializations.
774
  combined.initializedRanges.clear();
775
  // Now overlay all explicit initializations from DATA statements and
776
  // from initializers in declarations.
777
  for (const Symbol &symbol : associated) {
778
    IncorporateExplicitInitialization(
779
        combined, inits, symbol, first.offset(), foldingContext);
780
  }
781
  if (!CheckForOverlappingInitialization(associated, combined, exprAnalyzer,
782
          "Explicit initializations of equivalenced objects"s)) {
783
    return false;
784
  }
785
  // If the items are in static storage, save the final initialization.
786
  if (llvm::any_of(associated, [](SymbolRef ref) { return IsSaved(*ref); })) {
787
    // Create a compiler array temp that overlaps all the items.
788
    SourceName name{exprAnalyzer.context().GetTempName(scope)};
789
    auto emplaced{
790
        scope.try_emplace(name, Attrs{Attr::SAVE}, ObjectEntityDetails{})};
791
    CHECK(emplaced.second);
792
    Symbol &combinedSymbol{*emplaced.first->second};
793
    combinedSymbol.set(Symbol::Flag::CompilerCreated);
794
    inits.emplace(&combinedSymbol, std::move(combined));
795
    auto &details{combinedSymbol.get<ObjectEntityDetails>()};
796
    combinedSymbol.set_offset(first.offset());
797
    combinedSymbol.set_size(bytes);
798
    std::size_t minElementBytes{
799
        ComputeMinElementBytes(associated, foldingContext)};
800
    if (!exprAnalyzer.GetFoldingContext().targetCharacteristics().IsTypeEnabled(
801
            TypeCategory::Integer, minElementBytes) ||
802
        (bytes % minElementBytes) != 0) {
803
      minElementBytes = 1;
804
    }
805
    const DeclTypeSpec &typeSpec{scope.MakeNumericType(
806
        TypeCategory::Integer, KindExpr{minElementBytes})};
807
    details.set_type(typeSpec);
808
    ArraySpec arraySpec;
809
    arraySpec.emplace_back(ShapeSpec::MakeExplicit(Bound{
810
        bytes / static_cast<common::ConstantSubscript>(minElementBytes)}));
811
    details.set_shape(arraySpec);
812
    if (const auto *commonBlock{FindCommonBlockContaining(first)}) {
813
      details.set_commonBlock(*commonBlock);
814
    }
815
    // Add an EQUIVALENCE set to the scope so that the new object appears in
816
    // the results of GetStorageAssociations().
817
    auto &newSet{scope.equivalenceSets().emplace_back()};
818
    newSet.emplace_back(combinedSymbol);
819
    newSet.emplace_back(const_cast<Symbol &>(first));
820
  }
821
  return 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(
828
    const Scope &scope, const std::list<std::list<SymbolRef>> &associations,
829
    evaluate::FoldingContext &foldingContext, DataInitializations &inits) {
830
  UnorderedSymbolSet equivalenced;
831
  for (const std::list<SymbolRef> &association : associations) {
832
    for (const Symbol &symbol : association) {
833
      equivalenced.emplace(symbol);
834
    }
835
  }
836
  for (const auto &pair : scope) {
837
    const Symbol &symbol{*pair.second};
838
    if (!symbol.test(Symbol::Flag::InDataStmt) &&
839
        !HasDeclarationInitializer(symbol) && IsSaved(symbol) &&
840
        equivalenced.find(symbol) == equivalenced.end()) {
841
      // Static object, no local storage association, no explicit initialization
842
      if (const DerivedTypeSpec * derived{HasDefaultInitialization(symbol)}) {
843
        auto newInitIter{inits.emplace(&symbol, symbol.size())};
844
        CHECK(newInitIter.second);
845
        auto &newInit{newInitIter.first->second};
846
        PopulateWithComponentDefaults(
847
            newInit, 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.
858
static bool ProcessScopes(const Scope &scope,
859
    evaluate::ExpressionAnalyzer &exprAnalyzer, DataInitializations &inits) {
860
  bool result{true}; // no error
861
  switch (scope.kind()) {
862
  case Scope::Kind::Global:
863
  case Scope::Kind::Module:
864
  case Scope::Kind::MainProgram:
865
  case Scope::Kind::Subprogram:
866
  case Scope::Kind::BlockData:
867
  case Scope::Kind::BlockConstruct: {
868
    std::list<std::list<SymbolRef>> associations{GetStorageAssociations(scope)};
869
    for (const std::list<SymbolRef> &associated : associations) {
870
      if (std::find_if(associated.begin(), associated.end(), [](SymbolRef ref) {
871
            return IsInitialized(*ref);
872
          }) != associated.end()) {
873
        result &=
874
            CombineEquivalencedInitialization(associated, exprAnalyzer, inits);
875
      }
876
    }
877
    if constexpr (makeDefaultInitializationExplicit) {
878
      MakeDefaultInitializationExplicit(
879
          scope, associations, exprAnalyzer.GetFoldingContext(), inits);
880
    }
881
    for (const Scope &child : scope.children()) {
882
      result &= ProcessScopes(child, exprAnalyzer, inits);
883
    }
884
  } break;
885
  default:;
886
  }
887
  return result;
888
}
889

890
// Converts the static initialization image for a single symbol with
891
// one or more DATA statement appearances.
892
void ConstructInitializer(const Symbol &symbol,
893
    SymbolDataInitialization &initialization,
894
    evaluate::ExpressionAnalyzer &exprAnalyzer) {
895
  std::list<SymbolRef> symbols{symbol};
896
  CheckForOverlappingInitialization(
897
      symbols, initialization, exprAnalyzer, "DATA statement initializations"s);
898
  auto &context{exprAnalyzer.GetFoldingContext()};
899
  if (const auto *proc{symbol.detailsIf<ProcEntityDetails>()}) {
900
    CHECK(IsProcedurePointer(symbol));
901
    auto &mutableProc{const_cast<ProcEntityDetails &>(*proc)};
902
    if (MaybeExpr expr{initialization.image.AsConstantPointer()}) {
903
      if (const auto *procDesignator{
904
              std::get_if<evaluate::ProcedureDesignator>(&expr->u)}) {
905
        CHECK(!procDesignator->GetComponent());
906
        if (const auto *intrin{procDesignator->GetSpecificIntrinsic()}) {
907
          const Symbol *intrinSymbol{
908
              symbol.owner().FindSymbol(SourceName{intrin->name})};
909
          mutableProc.set_init(DEREF(intrinSymbol));
910
        } else {
911
          mutableProc.set_init(DEREF(procDesignator->GetSymbol()));
912
        }
913
      } else {
914
        CHECK(evaluate::IsNullProcedurePointer(*expr));
915
        mutableProc.set_init(nullptr);
916
      }
917
    } else {
918
      mutableProc.set_init(nullptr);
919
    }
920
  } else if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
921
    auto &mutableObject{const_cast<ObjectEntityDetails &>(*object)};
922
    if (IsPointer(symbol)) {
923
      if (auto ptr{initialization.image.AsConstantPointer()}) {
924
        mutableObject.set_init(*ptr);
925
      } else {
926
        mutableObject.set_init(SomeExpr{evaluate::NullPointer{}});
927
      }
928
    } else if (auto symbolType{evaluate::DynamicType::From(symbol)}) {
929
      if (auto extents{evaluate::GetConstantExtents(context, symbol)}) {
930
        mutableObject.set_init(initialization.image.AsConstant(
931
            context, *symbolType, std::nullopt, *extents));
932
      } else {
933
        exprAnalyzer.Say(symbol.name(),
934
            "internal: unknown shape for '%s' while constructing initializer from DATA"_err_en_US,
935
            symbol.name());
936
        return;
937
      }
938
    } else {
939
      exprAnalyzer.Say(symbol.name(),
940
          "internal: no type for '%s' while constructing initializer from DATA"_err_en_US,
941
          symbol.name());
942
      return;
943
    }
944
    if (!object->init()) {
945
      exprAnalyzer.Say(symbol.name(),
946
          "internal: could not construct an initializer from DATA statements for '%s'"_err_en_US,
947
          symbol.name());
948
    }
949
  } else {
950
    CHECK(exprAnalyzer.context().AnyFatalError());
951
  }
952
}
953

954
void ConvertToInitializers(
955
    DataInitializations &inits, evaluate::ExpressionAnalyzer &exprAnalyzer) {
956
  if (ProcessScopes(
957
          exprAnalyzer.context().globalScope(), exprAnalyzer, inits)) {
958
    for (auto &[symbolPtr, initialization] : inits) {
959
      ConstructInitializer(*symbolPtr, initialization, exprAnalyzer);
960
    }
961
  }
962
}
963
} // namespace Fortran::semantics
964