[flang] DATA stmt processing (part 4/4): Check & convert DATA

[klausler]

Summary

Implement rest of DATA statement semantics and conversion of
DATA statement initializations into static initializers of
objects in their symbol table entries.

[PeteSteinfeld]

All builds, tests, and looks good.

flang/documentation/Extensions.md

 * When a dummy argument is `POINTER` or `ALLOCATABLE` and is `INTENT(IN)`, we
   relax enforcement of some requirements on actual arguments that must otherwise
   hold true for definable arguments.
 * Assignment of `LOGICAL` to `INTEGER` and vice versa (but not other types) is
   allowed.  The values are normalized.
 * An effectively empty source file (no program unit) is accepted and
   produces an empty relocatable output file.
 * A `RETURN` statement may appear in a main program.
+* DATA statement initialization is allowed for procedure pointers outside
+  structure constructors.
 
 Extensions supported when enabled by options
 --------------------------------------------
 * C-style backslash escape sequences in quoted CHARACTER literals
   (but not Hollerith) [-fbackslash]
 * Logical abbreviations `.T.`, `.F.`, `.N.`, `.A.`, `.O.`, and `.X.`
   [-flogical-abbreviations]
 * `.XOR.` as a synonym for `.NEQV.` [-fxor-operator]

flang/include/flang/Evaluate/fold-designator.h

 
 // Folds a Designator<T> into a sequence of OffsetSymbols, if it can
 // be so folded.  Array sections yield multiple results, each
 // corresponding to an element in array element order.
 class DesignatorFolder {
 public:
   explicit DesignatorFolder(FoldingContext &c) : context_{c} {}
 
-  DesignatorFolder &Reset() {
-    elementNumber_ = 0;
-    return *this;
-  }
+  bool isEmpty() const { return isEmpty_; }
+  bool isOutOfRange() const { return isOutOfRange_; }
 
   template <typename T>
   std::optional<OffsetSymbol> FoldDesignator(const Expr<T> &expr) {
     return std::visit(
         [&](const auto &x) { return FoldDesignator(x, elementNumber_++); },
         expr.u);
   }
 
 private:
+  std::optional<OffsetSymbol> FoldDesignator(const Symbol &, ConstantSubscript);
   std::optional<OffsetSymbol> FoldDesignator(
-      const Symbol &, ConstantSubscript) const;
-  std::optional<OffsetSymbol> FoldDesignator(
-      const SymbolRef &x, ConstantSubscript which) const {
+      const SymbolRef &x, ConstantSubscript which) {
     return FoldDesignator(*x, which);
   }
   std::optional<OffsetSymbol> FoldDesignator(
-      const ArrayRef &, ConstantSubscript) const;
+      const ArrayRef &, ConstantSubscript);
   std::optional<OffsetSymbol> FoldDesignator(
-      const Component &, ConstantSubscript) const;
+      const Component &, ConstantSubscript);
   std::optional<OffsetSymbol> FoldDesignator(
-      const ComplexPart &, ConstantSubscript) const;
+      const ComplexPart &, ConstantSubscript);
   std::optional<OffsetSymbol> FoldDesignator(
-      const Substring &, ConstantSubscript) const;
+      const Substring &, ConstantSubscript);
   std::optional<OffsetSymbol> FoldDesignator(
-      const DataRef &, ConstantSubscript) const;
+      const DataRef &, ConstantSubscript);
   std::optional<OffsetSymbol> FoldDesignator(
-      const NamedEntity &, ConstantSubscript) const;
+      const NamedEntity &, ConstantSubscript);
   std::optional<OffsetSymbol> FoldDesignator(
-      const CoarrayRef &, ConstantSubscript) const;
+      const CoarrayRef &, ConstantSubscript);
   std::optional<OffsetSymbol> FoldDesignator(
-      const ProcedureDesignator &, ConstantSubscript) const;
+      const ProcedureDesignator &, ConstantSubscript);
 
   template <typename T>
   std::optional<OffsetSymbol> FoldDesignator(
-      const Expr<T> &expr, ConstantSubscript which) const {
+      const Expr<T> &expr, ConstantSubscript which) {
     return std::visit(
         [&](const auto &x) { return FoldDesignator(x, which); }, expr.u);
   }
 
   template <typename A>
-  std::optional<OffsetSymbol> FoldDesignator(
-      const A &x, ConstantSubscript) const {
-    DIE("DesignatorFolder::FoldDesignator(): unexpected object in designator");
+  std::optional<OffsetSymbol> FoldDesignator(const A &x, ConstantSubscript) {
+    return std::nullopt;
   }
 
   template <typename T>
   std::optional<OffsetSymbol> FoldDesignator(
-      const Designator<T> &designator, ConstantSubscript which) const {
+      const Designator<T> &designator, ConstantSubscript which) {
     return std::visit(
         [&](const auto &x) { return FoldDesignator(x, which); }, designator.u);
   }
   template <int KIND>
   std::optional<OffsetSymbol> FoldDesignator(
       const Designator<Type<TypeCategory::Character, KIND>> &designator,
-      ConstantSubscript which) const {
+      ConstantSubscript which) {
     return std::visit(
         common::visitors{
             [&](const Substring &ss) {
               if (const auto *dataRef{ss.GetParentIf<DataRef>()}) {
                 if (auto result{FoldDesignator(*dataRef, which)}) {
                   if (auto start{ToInt64(ss.lower())}) {
                     std::optional<ConstantSubscript> end;
+                    auto len{dataRef->LEN()};
                     if (ss.upper()) {
                       end = ToInt64(*ss.upper());
-                    } else if (auto len{dataRef->LEN()}) {
+                    } else if (len) {
                       end = ToInt64(*len);
                     }
                     if (end) {
+                      if (*start < 1) {
+                        isOutOfRange_ = true;
+                      }
                       result->Augment(KIND * (*start - 1));
                       result->set_size(
                           *end >= *start ? KIND * (*end - *start + 1) : 0);
+                      if (len) {
+                        if (auto lenVal{ToInt64(*len)}) {
+                          if (*end > *lenVal) {
+                            isOutOfRange_ = true;
+                          }
+                        }
+                      }
                       return result;
                     }
                   }
                 }
               }
               return std::optional<OffsetSymbol>{};
             },
             [&](const auto &x) { return FoldDesignator(x, which); },
         },
         designator.u);
   }
 
   FoldingContext &context_;
   ConstantSubscript elementNumber_{0}; // zero-based
+  bool isEmpty_{false};
+  bool isOutOfRange_{false};
 };
 
 // Reconstructs a Designator<> from a symbol and an offset.
 std::optional<Expr<SomeType>> OffsetToDesignator(
     FoldingContext &, const Symbol &, ConstantSubscript offset, std::size_t);
 std::optional<Expr<SomeType>> OffsetToDesignator(
     FoldingContext &, const OffsetSymbol &);
 

flang/include/flang/Evaluate/initial-image.h

 #include <map>
 #include <optional>
 #include <vector>
 
 namespace Fortran::evaluate {
 
 class InitialImage {
 public:
+  enum Result {
+    Ok,
+    NotAConstant,
+    OutOfRange,
+    SizeMismatch,
+  };
+
   explicit InitialImage(std::size_t bytes) : data_(bytes) {}
 
   std::size_t size() const { return data_.size(); }
 
-  template <typename A> bool Add(ConstantSubscript, std::size_t, const A &) {
-    return false;
+  template <typename A> Result Add(ConstantSubscript, std::size_t, const A &) {
+    return NotAConstant;
   }
   template <typename T>
-  bool Add(ConstantSubscript offset, std::size_t bytes, const Constant<T> &x) {
-    CHECK(offset >= 0 && offset + bytes <= data_.size());
+  Result Add(
+      ConstantSubscript offset, std::size_t bytes, const Constant<T> &x) {
+    if (offset < 0 || offset + bytes > data_.size()) {
+      return OutOfRange;
+    } else {
       auto elementBytes{x.GetType().MeasureSizeInBytes()};
-    CHECK(elementBytes && bytes == x.values().size() * *elementBytes);
+      if (!elementBytes || bytes != x.values().size() * *elementBytes) {
+        return SizeMismatch;
+      } else {
         std::memcpy(&data_.at(offset), &x.values().at(0), bytes);
-    return true;
+        return Ok;
+      }
+    }
   }
   template <int KIND>
-  bool Add(ConstantSubscript offset, std::size_t bytes,
+  Result Add(ConstantSubscript offset, std::size_t bytes,
       const Constant<Type<TypeCategory::Character, KIND>> &x) {
-    CHECK(offset >= 0 && offset + bytes <= data_.size());
+    if (offset < 0 || offset + bytes > data_.size()) {
+      return OutOfRange;
+    } else {
       auto elements{TotalElementCount(x.shape())};
       auto elementBytes{bytes > 0 ? bytes / elements : 0};
-    CHECK(elements * elementBytes == bytes);
+      if (elements * elementBytes != bytes) {
+        return SizeMismatch;
+      } else {
         for (auto at{x.lbounds()}; elements-- > 0; x.IncrementSubscripts(at)) {
           auto scalar{x.At(at)}; // this is a std string; size() in chars
           // Subtle: an initializer for a substring may have been
           // expanded to the length of the entire string.
-      CHECK(scalar.size() * KIND == elementBytes ||
-          (elements == 0 && scalar.size() * KIND > elementBytes));
+          auto scalarBytes{scalar.size() * KIND};
+          if (scalarBytes < elementBytes ||
+              (scalarBytes > elementBytes && elements != 0)) {
+            return SizeMismatch;
+          }
           std::memcpy(&data_[offset], scalar.data(), elementBytes);
           offset += elementBytes;
         }
-    return true;
+        return Ok;
+      }
+    }
   }
-  bool Add(ConstantSubscript, std::size_t, const Constant<SomeDerived> &);
+  Result Add(ConstantSubscript, std::size_t, const Constant<SomeDerived> &);
   template <typename T>
-  bool Add(ConstantSubscript offset, std::size_t bytes, const Expr<T> &x) {
+  Result Add(ConstantSubscript offset, std::size_t bytes, const Expr<T> &x) {
     return std::visit(
         [&](const auto &y) { return Add(offset, bytes, y); }, x.u);
   }
 
   void AddPointer(ConstantSubscript, const Expr<SomeType> &);
 
   // Conversions to constant initializers
   std::optional<Expr<SomeType>> AsConstant(FoldingContext &,

flang/include/flang/Parser/parse-tree.h

 //        constant-structure-constructor    <- added "constant-"
 struct DataStmtConstant {
   UNION_CLASS_BOILERPLATE(DataStmtConstant);
   CharBlock source;
   mutable TypedExpr typedExpr;
   std::variant<Scalar<ConstantValue>, Scalar<ConstantSubobject>,
       SignedIntLiteralConstant, SignedRealLiteralConstant,
       SignedComplexLiteralConstant, NullInit, InitialDataTarget,
-      Constant<StructureConstructor>>
+      StructureConstructor>
       u;
 };
 
 // R844 data-stmt-repeat -> scalar-int-constant | scalar-int-constant-subobject
 // R607 int-constant -> constant
 // R604 constant -> literal-constant | named-constant
 // (only literal-constant -> int-literal-constant applies)
 struct DataStmtRepeat {
   UNION_CLASS_BOILERPLATE(DataStmtRepeat);
   std::variant<IntLiteralConstant, Scalar<Integer<ConstantSubobject>>> u;
 };
 
 // R843 data-stmt-value -> [data-stmt-repeat *] data-stmt-constant
 struct DataStmtValue {
   TUPLE_CLASS_BOILERPLATE(DataStmtValue);
-  mutable std::size_t repetitions{1}; // replaced during semantics
+  mutable std::int64_t repetitions{1}; // replaced during semantics
   std::tuple<std::optional<DataStmtRepeat>, DataStmtConstant> t;
 };
 
 // R841 data-i-do-object ->
 //        array-element | scalar-structure-component | data-implied-do
 struct DataIDoObject {
   UNION_CLASS_BOILERPLATE(DataIDoObject);
   std::variant<Scalar<common::Indirection<Designator>>,

flang/lib/Evaluate/fold-designator.cpp

 //===-- lib/Evaluate/designate.cpp ------------------------------*- C++ -*-===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #include "flang/Evaluate/fold-designator.h"
 #include "flang/Semantics/tools.h"
 
 namespace Fortran::evaluate {
 
 DEFINE_DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTS(OffsetSymbol)
 
 std::optional<OffsetSymbol> DesignatorFolder::FoldDesignator(
-    const Symbol &symbol, ConstantSubscript which) const {
+    const Symbol &symbol, ConstantSubscript which) {
   if (semantics::IsPointer(symbol) || semantics::IsAllocatable(symbol)) {
     // A pointer may appear as a DATA statement object if it is the
     // rightmost symbol in a designator and has no subscripts.
     // An allocatable may appear if its initializer is NULL().
-    if (which == 0) {
+    if (which > 0) {
+      isEmpty_ = true;
+    } else {
       return OffsetSymbol{symbol, symbol.size()};
     }
-  } else if (symbol.has<semantics::ObjectEntityDetails>()) {
+  } else if (symbol.has<semantics::ObjectEntityDetails>() &&
+      !IsNamedConstant(symbol)) {
     if (auto type{DynamicType::From(symbol)}) {
       if (auto bytes{type->MeasureSizeInBytes()}) {
         if (auto extents{GetConstantExtents(context_, symbol)}) {
           OffsetSymbol result{symbol, *bytes};
           auto stride{static_cast<ConstantSubscript>(*bytes)};
           for (auto extent : *extents) {
             if (extent == 0) {
               return std::nullopt;
             }
             auto quotient{which / extent};
             auto remainder{which - extent * quotient};
             result.Augment(stride * remainder);
             which = quotient;
             stride *= extent;
           }
-          if (which == 0) {
+          if (which > 0) {
+            isEmpty_ = true;
+          } else {
             return std::move(result);
           }
         }
       }
     }
   }
   return std::nullopt;
 }
 
 std::optional<OffsetSymbol> DesignatorFolder::FoldDesignator(
-    const ArrayRef &x, ConstantSubscript which) const {
+    const ArrayRef &x, ConstantSubscript which) {
   const Symbol &array{x.base().GetLastSymbol()};
   if (auto type{DynamicType::From(array)}) {
     if (auto bytes{type->MeasureSizeInBytes()}) {
       if (auto extents{GetConstantExtents(context_, array)}) {
         Shape lbs{GetLowerBounds(context_, x.base())};
         if (auto lowerBounds{AsConstantExtents(context_, lbs)}) {
           std::optional<OffsetSymbol> result;
           if (!x.base().IsSymbol() &&
if (auto bytes{type->MeasureSizeInBytes()}) {
                                   folded)}) {
                             CHECK(value->Rank() <= 1);
                             if (value->size() != 0) {
                               // Apply subscript, possibly vector-valued
                               auto quotient{which / value->size()};
                               auto remainder{which - value->size() * quotient};
                               ConstantSubscript at{
                                   value->values().at(remainder).ToInt64()};
-                              if (at >= lower && at <= upper) {
-                                result->Augment((at - lower) * stride);
-                                which = quotient;
-                                return true;
-                              }
-                            }
-                          }
+                              if (at < lower || at > upper) {
+                                isOutOfRange_ = true;
+                              }
                           return false;
                         },
                         [&](const Triplet &triplet) {
                           auto start{ToInt64(Fold(context_,
                               triplet.lower().value_or(ExtentExpr{lower})))};
                           auto end{ToInt64(Fold(context_,
                               triplet.upper().value_or(ExtentExpr{upper})))};
                           auto step{ToInt64(Fold(context_, triplet.stride()))};
if (auto bytes{type->MeasureSizeInBytes()}) {
                         },
                     },
                     subscript.u)) {
               return std::nullopt;
             }
             ++dim;
             stride *= extent;
           }
-          if (which == 0) {
+          if (which > 0) {
+            isEmpty_ = true;
+          } else {
             return result;
           }
         }
       }
     }
   }
   return std::nullopt;
 }
 
 std::optional<OffsetSymbol> DesignatorFolder::FoldDesignator(
-    const Component &component, ConstantSubscript which) const {
+    const Component &component, ConstantSubscript which) {
   const Symbol &comp{component.GetLastSymbol()};
   const DataRef &base{component.base()};
   std::optional<OffsetSymbol> result, baseResult;
   if (base.Rank() == 0) { // A%X(:) - apply "which" to component
     baseResult = FoldDesignator(base, 0);
     result = FoldDesignator(comp, which);
   } else { // A(:)%X - apply "which" to base
     baseResult = FoldDesignator(base, which);
     result = FoldDesignator(comp, 0);
   }
   if (result && baseResult) {
     result->set_symbol(baseResult->symbol());
     result->Augment(baseResult->offset() + comp.offset());
     return result;
   } else {
     return std::nullopt;
   }
 }
 
 std::optional<OffsetSymbol> DesignatorFolder::FoldDesignator(
-    const ComplexPart &z, ConstantSubscript which) const {
+    const ComplexPart &z, ConstantSubscript which) {
   if (auto result{FoldDesignator(z.complex(), which)}) {
     result->set_size(result->size() >> 1);
     if (z.part() == ComplexPart::Part::IM) {
       result->Augment(result->size());
     }
     return result;
   } else {
     return std::nullopt;
   }
 }
 
 std::optional<OffsetSymbol> DesignatorFolder::FoldDesignator(
-    const DataRef &dataRef, ConstantSubscript which) const {
+    const DataRef &dataRef, ConstantSubscript which) {
   return std::visit(
       [&](const auto &x) { return FoldDesignator(x, which); }, dataRef.u);
 }
 
 std::optional<OffsetSymbol> DesignatorFolder::FoldDesignator(
-    const NamedEntity &entity, ConstantSubscript which) const {
+    const NamedEntity &entity, ConstantSubscript which) {
   return entity.IsSymbol() ? FoldDesignator(entity.GetLastSymbol(), which)
                            : FoldDesignator(entity.GetComponent(), which);
 }
 
 std::optional<OffsetSymbol> DesignatorFolder::FoldDesignator(
-    const CoarrayRef &, ConstantSubscript) const {
+    const CoarrayRef &, ConstantSubscript) {
   return std::nullopt;
 }
 
 std::optional<OffsetSymbol> DesignatorFolder::FoldDesignator(
-    const ProcedureDesignator &proc, ConstantSubscript which) const {
+    const ProcedureDesignator &proc, ConstantSubscript which) {
   if (const Symbol * symbol{proc.GetSymbol()}) {
     if (const Component * component{proc.GetComponent()}) {
       return FoldDesignator(*component, which);
-    } else if (which == 0) {
+    } else if (which > 0) {
+      isEmpty_ = true;
+    } else {
       return FoldDesignator(*symbol, 0);
     }
   }
   return std::nullopt;
 }
 
 // Conversions of offset symbols (back) to Designators
 
if (!extents || !lower || !elementBytes || *elementBytes <= 0) {
     return std::nullopt;
   }
   int rank{GetRank(shape)};
   CHECK(extents->size() == static_cast<std::size_t>(rank) &&
       lower->size() == extents->size());
   auto element{offset / *elementBytes};
   std::vector<Subscript> subscripts;
   auto at{element};
-  for (int dim{0}; dim < rank; ++dim) {
+  for (int dim{0}; dim + 1 < rank; ++dim) {
     auto extent{(*extents)[dim]};
     if (extent <= 0) {
       return std::nullopt;
     }
     auto quotient{at / extent};
     auto remainder{at - quotient * extent};
     subscripts.emplace_back(ExtentExpr{(*lower)[dim] + remainder});
     at = quotient;
   }
-  if (at == 0) {
-    offset -= element * *elementBytes;
-    return ArrayRef{std::move(entity), std::move(subscripts)};
-  }
-  return std::nullopt;
-}
+  // This final subscript might be out of range for use in error reporting.
+  subscripts.emplace_back(ExtentExpr{(*lower)[rank - 1] + at});
 
 // Maps an offset back to a component, when unambiguous.
 static const Symbol *OffsetToUniqueComponent(
     const semantics::DerivedTypeSpec &spec, ConstantSubscript offset) {
   const Symbol *result{nullptr};
   if (const semantics::Scope * scope{spec.scope()}) {
     for (const auto &pair : *scope) {
       const Symbol &component{*pair.second};
       if (offset >= static_cast<ConstantSubscript>(component.offset()) &&
           offset < static_cast<ConstantSubscript>(
                        component.offset() + component.size())) {
         if (result) {
           return nullptr; // MAP overlap or error recovery
         }
         result = &component;
       }
     }
   }
   return result;
 }
 
 // Converts an offset into subscripts &/or component references.  Recursive.
+// Any remaining offset is left in place in the "offset" reference argument.
 static std::optional<DataRef> OffsetToDataRef(FoldingContext &context,
     NamedEntity &&entity, ConstantSubscript &offset, std::size_t size) {
   const Symbol &symbol{entity.GetLastSymbol()};
   if (IsAllocatableOrPointer(symbol)) {
     return entity.IsSymbol() ? DataRef{symbol}
                              : DataRef{std::move(entity.GetComponent())};
   }
   std::optional<DataRef> result;

flang/lib/Evaluate/initial-image.cpp

 //===-- lib/Evaluate/initial-image.cpp ------------------------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #include "flang/Evaluate/initial-image.h"
 #include "flang/Semantics/scope.h"
 #include "flang/Semantics/tools.h"
 
 namespace Fortran::evaluate {
 
-bool InitialImage::Add(ConstantSubscript offset, std::size_t bytes,
-    const Constant<SomeDerived> &x) {
-  CHECK(offset >= 0 && offset + bytes <= data_.size());
+auto InitialImage::Add(ConstantSubscript offset, std::size_t bytes,
+    const Constant<SomeDerived> &x) -> Result {
+  if (offset < 0 || offset + bytes > data_.size()) {
+    return OutOfRange;
+  } else {
     auto elements{TotalElementCount(x.shape())};
     auto elementBytes{bytes > 0 ? bytes / elements : 0};
-  CHECK(elements * elementBytes == bytes);
+    if (elements * elementBytes != bytes) {
+      return SizeMismatch;
+    } else {
       auto at{x.lbounds()};
       for (auto elements{TotalElementCount(x.shape())}; elements-- > 0;
            x.IncrementSubscripts(at)) {
         auto scalar{x.At(at)};
         // TODO: length type parameter values?
         for (const auto &[symbolRef, indExpr] : scalar) {
           const Symbol &component{*symbolRef};
-      CHECK(component.offset() + component.size() <= elementBytes);
-      if (IsPointer(component)) {
+          if (component.offset() + component.size() > elementBytes) {
+            return SizeMismatch;
+          } else if (IsPointer(component)) {
             AddPointer(offset + component.offset(), indExpr.value());
-      } else if (!Add(offset + component.offset(), component.size(),
-                     indExpr.value())) {
-        return false;
+          } else {
+            Result added{Add(offset + component.offset(), component.size(),
+                indExpr.value())};
+            if (added != Ok) {
+              return Ok;
+            }
           }
         }
         offset += elementBytes;
       }
-  return true;
+    }
+    return Ok;
+  }
 }
 
 void InitialImage::AddPointer(
     ConstantSubscript offset, const Expr<SomeType> &pointer) {
   pointers_.emplace(offset, pointer);
 }
 
 // Classes used with common::SearchTypes() to (re)construct Constant<> values

flang/lib/Parser/Fortran-parsers.cpp

 //        signed-int-literal-constant | signed-real-literal-constant |
 //        null-init | initial-data-target | structure-constructor
 // TODO: Some structure constructors can be misrecognized as array
 // references into constant subobjects.
 TYPE_PARSER(sourced(first(
     construct<DataStmtConstant>(scalar(Parser<ConstantValue>{})),
     construct<DataStmtConstant>(nullInit),
     construct<DataStmtConstant>(scalar(constantSubobject)) / !"("_tok,
-    construct<DataStmtConstant>(constant(Parser<StructureConstructor>{})),
+    construct<DataStmtConstant>(Parser<StructureConstructor>{}),
     construct<DataStmtConstant>(signedRealLiteralConstant),
     construct<DataStmtConstant>(signedIntLiteralConstant),
     extension<LanguageFeature::SignedComplexLiteral>(
         construct<DataStmtConstant>(Parser<SignedComplexLiteralConstant>{})),
     construct<DataStmtConstant>(initialDataTarget))))
 
 // R848 dimension-stmt ->
 //        DIMENSION [::] array-name ( array-spec )

flang/lib/Semantics/check-data.h

 //===-------lib/Semantics/check-data.h ------------------------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #ifndef FORTRAN_SEMANTICS_CHECK_DATA_H_
 #define FORTRAN_SEMANTICS_CHECK_DATA_H_
 
-#include "flang/Parser/parse-tree.h"
-#include "flang/Parser/tools.h"
+#include "flang/Common/interval.h"
+#include "flang/Evaluate/fold-designator.h"
+#include "flang/Evaluate/initial-image.h"
 #include "flang/Semantics/expression.h"
 #include "flang/Semantics/semantics.h"
-#include "flang/Semantics/tools.h"
+#include <list>
+#include <map>
+#include <vector>
+
+namespace Fortran::parser {
+struct DataStmtRepeat;
+struct DataStmtObject;
+struct DataIDoObject;
+class DataStmtImpliedDo;
+struct DataStmtSet;
+} // namespace Fortran::parser
 
 namespace Fortran::semantics {
+
+struct SymbolDataInitialization {
+  using Range = common::Interval<ConstantSubscript>;
+  explicit SymbolDataInitialization(std::size_t bytes) : image{bytes} {}
+  evaluate::InitialImage image;
+  std::list<Range> inits;
+};
+
+using DataInitializations = std::map<SymbolRef, SymbolDataInitialization>;
+
 class DataChecker : public virtual BaseChecker {
 public:
   explicit DataChecker(SemanticsContext &context) : exprAnalyzer_{context} {}
   void Leave(const parser::DataStmtObject &);
+  void Leave(const parser::DataIDoObject &);
   void Enter(const parser::DataImpliedDo &);
   void Leave(const parser::DataImpliedDo &);
-  void Leave(const parser::DataIDoObject &);
+  void Leave(const parser::DataStmtSet &);
+
+  // After all DATA statements have been processed, converts their
+  // initializations into per-symbol static initializers.
+  void CompileDataInitializationsIntoInitializers();
 
 private:
-  evaluate::ExpressionAnalyzer exprAnalyzer_;
+  ConstantSubscript GetRepetitionCount(const parser::DataStmtRepeat &);
   template <typename T> void CheckIfConstantSubscript(const T &);
   void CheckSubscript(const parser::SectionSubscript &);
   bool CheckAllSubscriptsInDataRef(const parser::DataRef &, parser::CharBlock);
+  void ConstructInitializer(const Symbol &, SymbolDataInitialization &);
+
+  DataInitializations inits_;
+  evaluate::ExpressionAnalyzer exprAnalyzer_;
+  bool currentSetHasFatalErrors_{false};
 };
 } // namespace Fortran::semantics
 #endif // FORTRAN_SEMANTICS_CHECK_DATA_H_

flang/lib/Semantics/check-data.cpp

 //===-- lib/Semantics/check-data.cpp --------------------------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
+// DATA statement semantic analysis.
+// - Applies static semantic checks to the variables in each data-stmt-set with
+//   class DataVarChecker;
+// - Applies specific checks to each scalar element initialization with a
+//   constant value or pointer tareg with class DataInitializationCompiler;
+// - Collects the elemental initializations for each symbol and converts them
+//   into a single init() expression with member function
+//   DataChecker::ConstructInitializer().
+
 #include "check-data.h"
+#include "pointer-assignment.h"
+#include "flang/Evaluate/fold-designator.h"
 #include "flang/Evaluate/traverse.h"
-#include "flang/Semantics/expression.h"
+#include "flang/Parser/parse-tree.h"
+#include "flang/Parser/tools.h"
+#include "flang/Semantics/tools.h"
 
 namespace Fortran::semantics {
 
 // Ensures that references to an implied DO loop control variable are
 // represented as such in the "body" of the implied DO loop.
 void DataChecker::Enter(const parser::DataImpliedDo &x) {
   auto name{std::get<parser::DataImpliedDo::Bounds>(x.t).name.thing.thing};
   int kind{evaluate::ResultType<evaluate::ImpliedDoIndex>::kind};
   if (const auto dynamicType{evaluate::DynamicType::From(*name.symbol)}) {
+    if (dynamicType->category() == TypeCategory::Integer) {
       kind = dynamicType->kind();
     }
+  }
   exprAnalyzer_.AddImpliedDo(name.source, kind);
 }
 
 void DataChecker::Leave(const parser::DataImpliedDo &x) {
   auto name{std::get<parser::DataImpliedDo::Bounds>(x.t).name.thing.thing};
   exprAnalyzer_.RemoveImpliedDo(name.source);
 }
 
+// DataVarChecker applies static checks once to each variable that appears
+// in a data-stmt-set.  These checks are independent of the values that
+// correspond to the variables.
 class DataVarChecker : public evaluate::AllTraverse<DataVarChecker, true> {
 public:
   using Base = evaluate::AllTraverse<DataVarChecker, true>;
   DataVarChecker(SemanticsContext &c, parser::CharBlock src)
       : Base{*this}, context_{c}, source_{src} {}
   using Base::operator();
   bool HasComponentWithoutSubscripts() const {
     return hasComponent_ && !hasSubscript_;
   }
+  bool operator()(const Symbol &symbol) { // C876
+    // 8.6.7p(2) - precludes non-pointers of derived types with
+    // default component values
+    const Scope &scope{context_.FindScope(source_)};
+    bool isFirstSymbol{isFirstSymbol_};
+    isFirstSymbol_ = false;
+    if (const char *whyNot{IsAutomatic(symbol)          ? "Automatic variable"
+            : IsDummy(symbol)                           ? "Dummy argument"
+            : IsFunctionResult(symbol)                  ? "Function result"
+            : IsAllocatable(symbol)                     ? "Allocatable"
+            : IsInitialized(symbol, true)               ? "Default-initialized"
+            : IsInBlankCommon(symbol)                   ? "Blank COMMON object"
+            : IsProcedure(symbol) && !IsPointer(symbol) ? "Procedure"
+            // remaining checks don't apply to components
+            : !isFirstSymbol                  ? nullptr
+            : IsHostAssociated(symbol, scope) ? "Host-associated object"
+            : IsUseAssociated(symbol, scope)  ? "USE-associated object"
+                                              : nullptr}) {
+      context_.Say(source_,
+          "%s '%s' must not be initialized in a DATA statement"_err_en_US,
+          whyNot, symbol.name());
+      return false;
+    } else if (IsProcedurePointer(symbol)) {
+      context_.Say(source_,
+          "Procedure pointer '%s' in a DATA statement is not standard"_en_US,
+          symbol.name());
+    }
+    return true;
+  }
   bool operator()(const evaluate::Component &component) {
     hasComponent_ = true;
     const Symbol &lastSymbol{component.GetLastSymbol()};
     if (isPointerAllowed_) {
       if (IsPointer(lastSymbol) && hasSubscript_) { // C877
         context_.Say(source_,
             "Rightmost data object pointer '%s' must not be subscripted"_err_en_US,
             lastSymbol.name().ToString());
         return false;
       }
       RestrictPointer();
     } else {
       if (IsPointer(lastSymbol)) { // C877
         context_.Say(source_,
             "Data object must not contain pointer '%s' as a non-rightmost part"_err_en_US,
             lastSymbol.name().ToString());
         return false;
       }
     }
-    if (!isFirstSymbolChecked_) {
-      isFirstSymbolChecked_ = true;
-      if (!CheckFirstSymbol(component.GetFirstSymbol())) {
-        return false;
-      }
-    }
     return (*this)(component.base()) && (*this)(lastSymbol);
   }
   bool operator()(const evaluate::ArrayRef &arrayRef) {
     hasSubscript_ = true;
     return (*this)(arrayRef.base()) && (*this)(arrayRef.subscript());
   }
   bool operator()(const evaluate::Substring &substring) {
     hasSubscript_ = true;
     return (*this)(substring.parent()) && (*this)(substring.lower()) &&
         (*this)(substring.upper());
   }
   bool operator()(const evaluate::CoarrayRef &) { // C874
-    hasSubscript_ = true;
     context_.Say(
         source_, "Data object must not be a coindexed variable"_err_en_US);
     return false;
   }
-  bool operator()(const evaluate::Symbol &symbol) {
-    if (!isFirstSymbolChecked_) {
-      return CheckFirstSymbol(symbol) && CheckAnySymbol(symbol);
-    } else {
-      return CheckAnySymbol(symbol);
-    }
-  }
   bool operator()(const evaluate::Subscript &subs) {
     DataVarChecker subscriptChecker{context_, source_};
     subscriptChecker.RestrictPointer();
     return std::visit(
                common::visitors{
                    [&](const evaluate::IndirectSubscriptIntegerExpr &expr) {
                      return CheckSubscriptExpr(expr);
                    },
bool CheckSubscriptExpr(
     if (!evaluate::IsConstantExpr(expr)) { // C875,C881
       context_.Say(
           source_, "Data object must have constant subscripts"_err_en_US);
       return false;
     } else {
       return true;
     }
   }
-  bool CheckFirstSymbol(const Symbol &symbol);
-  bool CheckAnySymbol(const Symbol &symbol);
 
   SemanticsContext &context_;
   parser::CharBlock source_;
   bool hasComponent_{false};
   bool hasSubscript_{false};
   bool isPointerAllowed_{true};
-  bool isFirstSymbolChecked_{false};
+  bool isFirstSymbol_{true};
 };
 
-bool DataVarChecker::CheckFirstSymbol(const Symbol &symbol) { // C876
-  const Scope &scope{context_.FindScope(source_)};
-  if (IsDummy(symbol)) {
-    context_.Say(source_,
-        "Data object part '%s' must not be a dummy argument"_err_en_US,
-        symbol.name().ToString());
-  } else if (IsFunction(symbol)) {
-    context_.Say(source_,
-        "Data object part '%s' must not be a function name"_err_en_US,
-        symbol.name().ToString());
-  } else if (symbol.IsFuncResult()) {
-    context_.Say(source_,
-        "Data object part '%s' must not be a function result"_err_en_US,
-        symbol.name().ToString());
-  } else if (IsHostAssociated(symbol, scope)) {
-    context_.Say(source_,
-        "Data object part '%s' must not be accessed by host association"_err_en_US,
-        symbol.name().ToString());
-  } else if (IsUseAssociated(symbol, scope)) {
-    context_.Say(source_,
-        "Data object part '%s' must not be accessed by use association"_err_en_US,
-        symbol.name().ToString());
-  } else if (IsInBlankCommon(symbol)) {
-    context_.Say(source_,
-        "Data object part '%s' must not be in blank COMMON"_err_en_US,
-        symbol.name().ToString());
-  } else {
-    return true;
-  }
-  return false;
-}
-
-bool DataVarChecker::CheckAnySymbol(const Symbol &symbol) { // C876
-  if (IsAutomaticObject(symbol)) {
-    context_.Say(source_,
-        "Data object part '%s' must not be an automatic object"_err_en_US,
-        symbol.name().ToString());
-  } else if (IsAllocatable(symbol)) {
-    context_.Say(source_,
-        "Data object part '%s' must not be an allocatable object"_err_en_US,
-        symbol.name().ToString());
-  } else {
-    return true;
-  }
-  return false;
-}
-
 void DataChecker::Leave(const parser::DataIDoObject &object) {
   if (const auto *designator{
           std::get_if<parser::Scalar<common::Indirection<parser::Designator>>>(
               &object.u)}) {
     if (MaybeExpr expr{exprAnalyzer_.Analyze(*designator)}) {
       auto source{designator->thing.value().source};
       if (evaluate::IsConstantExpr(*expr)) { // C878,C879
-        exprAnalyzer_.Say(
+        exprAnalyzer_.context().Say(
             source, "Data implied do object must be a variable"_err_en_US);
       } else {
         DataVarChecker checker{exprAnalyzer_.context(), source};
-        if (checker(*expr) && checker.HasComponentWithoutSubscripts()) { // C880
-          exprAnalyzer_.Say(source,
+        if (checker(*expr)) {
+          if (checker.HasComponentWithoutSubscripts()) { // C880
+            exprAnalyzer_.context().Say(source,
                 "Data implied do structure component must be subscripted"_err_en_US);
+          } else {
+            return;
           }
         }
       }
     }
   }
+  currentSetHasFatalErrors_ = true;
+}
 
 void DataChecker::Leave(const parser::DataStmtObject &dataObject) {
-  if (const auto *var{
-          std::get_if<common::Indirection<parser::Variable>>(&dataObject.u)}) {
-    if (auto expr{exprAnalyzer_.Analyze(*var)}) {
-      DataVarChecker{exprAnalyzer_.context(),
-          parser::FindSourceLocation(dataObject)}(expr);
-    }
+  std::visit(common::visitors{
+                 [](const parser::DataImpliedDo &) { // has own Enter()/Leave()
+                 },
+                 [&](const auto &var) {
+                   auto expr{exprAnalyzer_.Analyze(var)};
+                   if (!expr ||
+                       !DataVarChecker{exprAnalyzer_.context(),
+                           parser::FindSourceLocation(dataObject)}(*expr)) {
+                     currentSetHasFatalErrors_ = true;
+                   }
+                 },
+             },
+      dataObject.u);
+}
+
+// Steps through a list of values in a DATA statement set; implements
+// repetition.
+class ValueListIterator {
+public:
+  explicit ValueListIterator(const parser::DataStmtSet &set)
+      : end_{std::get<std::list<parser::DataStmtValue>>(set.t).end()},
+        at_{std::get<std::list<parser::DataStmtValue>>(set.t).begin()} {
+    SetRepetitionCount();
+  }
+  bool hasFatalError() const { return hasFatalError_; }
+  bool IsAtEnd() const { return at_ == end_; }
+  const SomeExpr *operator*() const { return GetExpr(GetConstant()); }
+  parser::CharBlock LocateSource() const { return GetConstant().source; }
+  ValueListIterator &operator++() {
+    if (repetitionsRemaining_ > 0) {
+      --repetitionsRemaining_;
+    } else if (at_ != end_) {
+      ++at_;
+      SetRepetitionCount();
+    }
+    return *this;
+  }
+
+private:
+  using listIterator = std::list<parser::DataStmtValue>::const_iterator;
+  void SetRepetitionCount();
+  const parser::DataStmtConstant &GetConstant() const {
+    return std::get<parser::DataStmtConstant>(at_->t);
+  }
+
+  listIterator end_;
+  listIterator at_;
+  ConstantSubscript repetitionsRemaining_{0};
+  bool hasFatalError_{false};
+};
+
+void ValueListIterator::SetRepetitionCount() {
+  for (repetitionsRemaining_ = 1; at_ != end_; ++at_) {
+    if (at_->repetitions < 0) {
+      hasFatalError_ = true;
+    }
+    if (at_->repetitions > 0) {
+      repetitionsRemaining_ = at_->repetitions - 1;
+      return;
+    }
+  }
+  repetitionsRemaining_ = 0;
+}
+
+// Collects all of the elemental initializations from DATA statements
+// into a single image for each symbol that appears in any DATA.
+// Expands the implied DO loops and array references.
+// Applies checks that validate each distinct elemental initialization
+// of the variables in a data-stmt-set, as well as those that apply
+// to the corresponding values being use to initialize each element.
+class DataInitializationCompiler {
+public:
+  DataInitializationCompiler(DataInitializations &inits,
+      evaluate::ExpressionAnalyzer &a, const parser::DataStmtSet &set)
+      : inits_{inits}, exprAnalyzer_{a}, values_{set} {}
+  const DataInitializations &inits() const { return inits_; }
+  bool HasSurplusValues() const { return !values_.IsAtEnd(); }
+  bool Scan(const parser::DataStmtObject &);
+
+private:
+  bool Scan(const parser::Variable &);
+  bool Scan(const parser::Designator &);
+  bool Scan(const parser::DataImpliedDo &);
+  bool Scan(const parser::DataIDoObject &);
+
+  // Initializes all elements of a designator, which can be an array or section.
+  bool InitDesignator(const SomeExpr &);
+  // Initializes a single object.
+  bool InitElement(const evaluate::OffsetSymbol &, const SomeExpr &designator);
+
+  DataInitializations &inits_;
+  evaluate::ExpressionAnalyzer &exprAnalyzer_;
+  ValueListIterator values_;
+};
+
+bool DataInitializationCompiler::Scan(const parser::DataStmtObject &object) {
+  return std::visit(
+      common::visitors{
+          [&](const common::Indirection<parser::Variable> &var) {
+            return Scan(var.value());
+          },
+          [&](const parser::DataImpliedDo &ido) { return Scan(ido); },
+      },
+      object.u);
+}
+
+bool DataInitializationCompiler::Scan(const parser::Variable &var) {
+  if (const auto *expr{GetExpr(var)}) {
+    exprAnalyzer_.GetFoldingContext().messages().SetLocation(var.GetSource());
+    if (InitDesignator(*expr)) {
+      return true;
+    }
+  }
+  return false;
+}
+
+bool DataInitializationCompiler::Scan(const parser::Designator &designator) {
+  if (auto expr{exprAnalyzer_.Analyze(designator)}) {
+    exprAnalyzer_.GetFoldingContext().messages().SetLocation(
+        parser::FindSourceLocation(designator));
+    if (InitDesignator(*expr)) {
+      return true;
+    }
+  }
+  return false;
+}
+
+bool DataInitializationCompiler::Scan(const parser::DataImpliedDo &ido) {
+  const auto &bounds{std::get<parser::DataImpliedDo::Bounds>(ido.t)};
+  auto name{bounds.name.thing.thing};
+  const auto *lowerExpr{GetExpr(bounds.lower.thing.thing)};
+  const auto *upperExpr{GetExpr(bounds.upper.thing.thing)};
+  const auto *stepExpr{
+      bounds.step ? GetExpr(bounds.step->thing.thing) : nullptr};
+  if (lowerExpr && upperExpr) {
+    auto lower{ToInt64(*lowerExpr)};
+    auto upper{ToInt64(*upperExpr)};
+    auto step{stepExpr ? ToInt64(*stepExpr) : std::nullopt};
+    auto stepVal{step.value_or(1)};
+    if (stepVal == 0) {
+      exprAnalyzer_.Say(name.source,
+          "DATA statement implied DO loop has a step value of zero"_err_en_US);
+    } else if (lower && upper) {
+      int kind{evaluate::ResultType<evaluate::ImpliedDoIndex>::kind};
+      if (const auto dynamicType{evaluate::DynamicType::From(*name.symbol)}) {
+        if (dynamicType->category() == TypeCategory::Integer) {
+          kind = dynamicType->kind();
+        }
+      }
+      if (exprAnalyzer_.AddImpliedDo(name.source, kind)) {
+        auto &value{exprAnalyzer_.GetFoldingContext().StartImpliedDo(
+            name.source, *lower)};
+        bool result{true};
+        for (auto n{(*upper - value + stepVal) / stepVal}; n > 0;
+             --n, value += stepVal) {
+          for (const auto &object :
+              std::get<std::list<parser::DataIDoObject>>(ido.t)) {
+            if (!Scan(object)) {
+              result = false;
+              break;
+            }
+          }
+        }
+        exprAnalyzer_.GetFoldingContext().EndImpliedDo(name.source);
+        exprAnalyzer_.RemoveImpliedDo(name.source);
+        return result;
+      }
+    }
+  }
+  return false;
+}
+
+bool DataInitializationCompiler::Scan(const parser::DataIDoObject &object) {
+  return std::visit(
+      common::visitors{
+          [&](const parser::Scalar<common::Indirection<parser::Designator>>
+                  &var) { return Scan(var.thing.value()); },
+          [&](const common::Indirection<parser::DataImpliedDo> &ido) {
+            return Scan(ido.value());
+          },
+      },
+      object.u);
+}
+
+bool DataInitializationCompiler::InitDesignator(const SomeExpr &designator) {
+  evaluate::FoldingContext &context{exprAnalyzer_.GetFoldingContext()};
+  evaluate::DesignatorFolder folder{context};
+  while (auto offsetSymbol{folder.FoldDesignator(designator)}) {
+    if (folder.isOutOfRange()) {
+      if (auto bad{evaluate::OffsetToDesignator(context, *offsetSymbol)}) {
+        exprAnalyzer_.context().Say(
+            "DATA statement designator '%s' is out of range"_err_en_US,
+            bad->AsFortran());
+      } else {
+        exprAnalyzer_.context().Say(
+            "DATA statement designator '%s' is out of range"_err_en_US,
+            designator.AsFortran());
+      }
+      return false;
+    } else if (!InitElement(*offsetSymbol, designator)) {
+      return false;
+    } else {
+      ++values_;
+    }
+  }
+  return folder.isEmpty();
+
+bool DataInitializationCompiler::InitElement(
+    const evaluate::OffsetSymbol &offsetSymbol, const SomeExpr &designator) {
+  const Symbol &symbol{offsetSymbol.symbol()};
+  const Symbol *lastSymbol{GetLastSymbol(designator)};
+  bool isPointer{lastSymbol && IsPointer(*lastSymbol)};
+  bool isProcPointer{lastSymbol && IsProcedurePointer(*lastSymbol)};
+  evaluate::FoldingContext &context{exprAnalyzer_.GetFoldingContext()};
+
+  const auto DescribeElement{[&]() {
+    if (auto badDesignator{
+            evaluate::OffsetToDesignator(context, offsetSymbol)}) {
+      return badDesignator->AsFortran();
+    } else {
+      // Error recovery
+      std::string buf;
+      llvm::raw_string_ostream ss{buf};
+      ss << offsetSymbol.symbol().name() << " offset " << offsetSymbol.offset()
+         << " bytes for " << offsetSymbol.size() << " bytes";
+      return ss.str();
+    }
+  }};
+  const auto GetImage{[&]() -> evaluate::InitialImage & {
+    auto &symbolInit{inits_.emplace(symbol, symbol.size()).first->second};
+    symbolInit.inits.emplace_back(offsetSymbol.offset(), offsetSymbol.size());
+    return symbolInit.image;
+  }};
+  const auto OutOfRangeError{[&]() {
+    evaluate::AttachDeclaration(
+        exprAnalyzer_.context().Say(
+            "DATA statement designator '%s' is out of range for its variable '%s'"_err_en_US,
+            DescribeElement(), symbol.name()),
+        symbol);
+  }};
+
+  if (values_.hasFatalError()) {
+    return false;
+  } else if (values_.IsAtEnd()) {
+    exprAnalyzer_.context().Say(
+        "DATA statement set has no value for '%s'"_err_en_US,
+        DescribeElement());
+    return false;
+  } else if (static_cast<std::size_t>(
+                 offsetSymbol.offset() + offsetSymbol.size()) > symbol.size()) {
+    OutOfRangeError();
+    return false;
+  }
+
+  const SomeExpr *expr{*values_};
+  if (!expr) {
+    CHECK(exprAnalyzer_.context().AnyFatalError());
+  } else if (isPointer) {
+    if (static_cast<std::size_t>(offsetSymbol.offset() + offsetSymbol.size()) >
+        symbol.size()) {
+      OutOfRangeError();
+    } else if (evaluate::IsNullPointer(*expr)) {
+      // nothing to do; rely on zero initialization
+      return true;
+    } else if (evaluate::IsProcedure(*expr)) {
+      if (isProcPointer) {
+        if (CheckPointerAssignment(context, designator, *expr)) {
+          GetImage().AddPointer(offsetSymbol.offset(), *expr);
+          return true;
         }
+      } else {
+        exprAnalyzer_.Say(values_.LocateSource(),
+            "Procedure '%s' may not be used to initialize '%s', which is not a procedure pointer"_err_en_US,
+            expr->AsFortran(), DescribeElement());
+      }
+    } else if (isProcPointer) {
+      exprAnalyzer_.Say(values_.LocateSource(),
+          "Data object '%s' may not be used to initialize '%s', which is a procedure pointer"_err_en_US,
+          expr->AsFortran(), DescribeElement());
+    } else if (CheckInitialTarget(context, designator, *expr)) {
+      GetImage().AddPointer(offsetSymbol.offset(), *expr);
+      return true;
     }
+  } else if (evaluate::IsNullPointer(*expr)) {
+    exprAnalyzer_.Say(values_.LocateSource(),
+        "Initializer for '%s' must not be a pointer"_err_en_US,
+        DescribeElement());
+  } else if (evaluate::IsProcedure(*expr)) {
+    exprAnalyzer_.Say(values_.LocateSource(),
+        "Initializer for '%s' must not be a procedure"_err_en_US,
+        DescribeElement());
+  } else if (auto designatorType{designator.GetType()}) {
+    if (auto converted{
+            evaluate::ConvertToType(*designatorType, SomeExpr{*expr})}) {
+      // value non-pointer initialization
+      if (std::holds_alternative<evaluate::BOZLiteralConstant>(expr->u) &&
+          designatorType->category() != TypeCategory::Integer) { // 8.6.7(11)
+        exprAnalyzer_.Say(values_.LocateSource(),
+            "BOZ literal should appear in a DATA statement only as a value for an integer object, but '%s' is '%s'"_en_US,
+            DescribeElement(), designatorType->AsFortran());
+      }
+      auto folded{evaluate::Fold(context, std::move(*converted))};
+      switch (
+          GetImage().Add(offsetSymbol.offset(), offsetSymbol.size(), folded)) {
+      case evaluate::InitialImage::Ok:
+        return true;
+      case evaluate::InitialImage::NotAConstant:
+        exprAnalyzer_.Say(values_.LocateSource(),
+            "DATA statement value '%s' for '%s' is not a constant"_err_en_US,
+            folded.AsFortran(), DescribeElement());
+        break;
+      case evaluate::InitialImage::OutOfRange:
+        OutOfRangeError();
+        break;
+      default:
+        CHECK(exprAnalyzer_.context().AnyFatalError());
+        break;
+      }
+    } else {
+      exprAnalyzer_.context().Say(
+          "DATA statement value could not be converted to the type '%s' of the object '%s'"_err_en_US,
+          designatorType->AsFortran(), DescribeElement());
+    }
+  } else {
+    CHECK(exprAnalyzer_.context().AnyFatalError());
+  }
+  return false;
+}
+
+void DataChecker::Leave(const parser::DataStmtSet &set) {
+  if (!currentSetHasFatalErrors_) {
+    DataInitializationCompiler scanner{inits_, exprAnalyzer_, set};
+    for (const auto &object :
+        std::get<std::list<parser::DataStmtObject>>(set.t)) {
+      if (!scanner.Scan(object)) {
+        return;
+      }
+    }
+    if (scanner.HasSurplusValues()) {
+      exprAnalyzer_.context().Say(
+          "DATA statement set has more values than objects"_err_en_US);
+    }
+  }
+  currentSetHasFatalErrors_ = false;
+}
+
+// Converts the initialization image for all the DATA statement appearances of
+// a single symbol into an init() expression in the symbol table entry.
+void DataChecker::ConstructInitializer(
+    const Symbol &symbol, SymbolDataInitialization &initialization) {
+  auto &context{exprAnalyzer_.GetFoldingContext()};
+  initialization.inits.sort();
+  ConstantSubscript next{0};
+  for (const auto &init : initialization.inits) {
+    if (init.start() < next) {
+      auto badDesignator{evaluate::OffsetToDesignator(
+          context, symbol, init.start(), init.size())};
+      CHECK(badDesignator);
+      exprAnalyzer_.Say(symbol.name(),
+          "DATA statement initializations affect '%s' more than once"_err_en_US,
+          badDesignator->AsFortran());
+    }
+    next = init.start() + init.size();
+    CHECK(next <= static_cast<ConstantSubscript>(initialization.image.size()));
+  }
+  if (const auto *proc{symbol.detailsIf<ProcEntityDetails>()}) {
+    CHECK(IsProcedurePointer(symbol));
+    const auto &procDesignator{initialization.image.AsConstantProcPointer()};
+    CHECK(!procDesignator.GetComponent());
+    auto &mutableProc{const_cast<ProcEntityDetails &>(*proc)};
+    mutableProc.set_init(DEREF(procDesignator.GetSymbol()));
+  } else if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
+    if (auto symbolType{evaluate::DynamicType::From(symbol)}) {
+      auto &mutableObject{const_cast<ObjectEntityDetails &>(*object)};
+      if (IsPointer(symbol)) {
+        mutableObject.set_init(
+            initialization.image.AsConstantDataPointer(*symbolType));
+        mutableObject.set_initWasValidated();
+      } else {
+        if (auto extents{evaluate::GetConstantExtents(context, symbol)}) {
+          mutableObject.set_init(
+              initialization.image.AsConstant(context, *symbolType, *extents));
+          mutableObject.set_initWasValidated();
+        } else {
+          exprAnalyzer_.Say(symbol.name(),
+              "internal: unknown shape for '%s' while constructing initializer from DATA"_err_en_US,
+              symbol.name());
+          return;
+        }
+      }
+    } else {
+      exprAnalyzer_.Say(symbol.name(),
+          "internal: no type for '%s' while constructing initializer from DATA"_err_en_US,
+          symbol.name());
+      return;
+    }
+    if (!object->init()) {
+      exprAnalyzer_.Say(symbol.name(),
+          "internal: could not construct an initializer from DATA statements for '%s'"_err_en_US,
+          symbol.name());
+    }
+  } else {
+    CHECK(exprAnalyzer_.context().AnyFatalError());
+  }
+}
+
+void DataChecker::CompileDataInitializationsIntoInitializers() {
+  for (auto &[symbolRef, initialization] : inits_) {
+    ConstructInitializer(*symbolRef, initialization);
+  }
+}
+
 } // namespace Fortran::semantics

flang/lib/Semantics/expression.cpp

if (std::optional<int> kind{IsImpliedDo(n.source)}) {
     }
   }
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::NamedConstant &n) {
   if (MaybeExpr value{Analyze(n.v)}) {
     Expr<SomeType> folded{Fold(std::move(*value))};
     if (IsConstantExpr(folded)) {
-      return {folded};
+      return folded;
     }
     Say(n.v.source, "must be a constant"_err_en_US); // C718
   }
   return std::nullopt;
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::NullInit &x) {
   return Expr<SomeType>{NullPointer{}};
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::InitialDataTarget &x) {
   return Analyze(x.value());
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::DataStmtValue &x) {
   if (const auto &repeat{
           std::get<std::optional<parser::DataStmtRepeat>>(x.t)}) {
-    x.repetitions = 0;
+    x.repetitions = -1;
     if (MaybeExpr expr{Analyze(repeat->u)}) {
       Expr<SomeType> folded{Fold(std::move(*expr))};
       if (auto value{ToInt64(folded)}) {
         if (*value >= 0) { // C882
           x.repetitions = *value;
         } else {
           Say(FindSourceLocation(repeat),
               "Repeat count (%jd) for data value must not be negative"_err_en_US,

flang/lib/Semantics/resolve-names.cpp

 bool ConstructVisitor::Pre(const parser::DataStmtValue &x) {
   const auto &data{std::get<parser::DataStmtConstant>(x.t)};
   auto &mutableData{const_cast<parser::DataStmtConstant &>(data)};
   if (auto *elem{parser::Unwrap<parser::ArrayElement>(mutableData)}) {
     if (const auto *name{std::get_if<parser::Name>(&elem->base.u)}) {
       if (const Symbol * symbol{FindSymbol(*name)}) {
         if (const Symbol * ultimate{GetAssociationRoot(*symbol)}) {
           if (ultimate->has<DerivedTypeDetails>()) {
-            mutableData.u = parser::Constant<parser::StructureConstructor>{
-                elem->ConvertToStructureConstructor(
-                    DerivedTypeSpec{name->source, *ultimate})};
+            mutableData.u = elem->ConvertToStructureConstructor(
+                DerivedTypeSpec{name->source, *ultimate});
           }
         }
       }
     }
   }
   return true;
 }
 

flang/lib/Semantics/semantics.cpp

 
 static bool PerformStatementSemantics(
     SemanticsContext &context, parser::Program &program) {
   ResolveNames(context, program);
   RewriteParseTree(context, program);
   ComputeOffsets(context);
   CheckDeclarations(context);
   StatementSemanticsPass1{context}.Walk(program);
-  StatementSemanticsPass2{context}.Walk(program);
+  StatementSemanticsPass2 pass2{context};
+  pass2.Walk(program);
+  if (!context.AnyFatalError()) {
+    pass2.CompileDataInitializationsIntoInitializers();
+  }
   return !context.AnyFatalError();
 }
 
 SemanticsContext::SemanticsContext(
     const common::IntrinsicTypeDefaultKinds &defaultKinds,
     const common::LanguageFeatureControl &languageFeatures,
     parser::AllSources &allSources)
     : defaultKinds_{defaultKinds}, languageFeatures_{languageFeatures},

flang/test/Semantics/data01.f90

 ! RUN: %S/test_errors.sh %s %t %f18
 !Test for checking data constraints, C882-C887
-subroutine CheckRepeat
+module m1
   type person
     integer :: age
     character(len=25) :: name
   end type
   integer, parameter::digits(5) = ( /-11,-22,-33,44,55/ )
   integer ::notConstDigits(5)
   real, parameter::numbers(5) = ( /-11.11,-22.22,-33.33,44.44,55.55/ )
   integer, parameter :: repeat = -1
-  integer :: myAge = 2 
-  type(person) myName
+  integer :: myAge = 2
+  type(person) associated
+end
+
+subroutine CheckRepeat
+  use m1
+  type(person) myName(6)
   !C882
   !ERROR: Missing initialization for parameter 'uninitialized'
   integer, parameter :: uninitialized
   !C882
   !ERROR: Repeat count (-1) for data value must not be negative
-  DATA myName%age / repeat * 35 /
+  DATA myName(1)%age / repeat * 35 /
   !C882
   !ERROR: Repeat count (-11) for data value must not be negative
-  DATA myName%age / digits(1) * 35 /
+  DATA myName(2)%age / digits(1) * 35 /
   !C882
   !ERROR: Must be a constant value
-  DATA myName%age / repet * 35 /
+  DATA myName(3)%age / repet * 35 /
   !C885
   !ERROR: Must have INTEGER type, but is REAL(4)
-  DATA myName%age / numbers(1) * 35 /
+  DATA myName(4)%age / numbers(1) * 35 /
   !C886
   !ERROR: Must be a constant value
-  DATA myName%age / notConstDigits(1) * 35 /
+  DATA myName(5)%age / notConstDigits(1) * 35 /
   !C887
   !ERROR: Must be a constant value
-  DATA myName%age / digits(myAge) * 35 /
+  DATA myName(6)%age / digits(myAge) * 35 /
 end
 
 subroutine CheckValue
-  type person
-    integer :: age
-    character(len=25) :: name
-  end type
-  integer :: myAge = 2
-  type(person) myName
+  use m1
+  !ERROR: USE-associated object 'associated' must not be initialized in a DATA statement
+  data associated / person(1, 'Abcd Ijkl') /
+  type(person) myName(3)
   !OK: constant structure constructor
-  data myname / person(1, 'Abcd Ijkl') /
+  data myname(1) / person(1, 'Abcd Ijkl') /
   !C883
   !ERROR: 'persn' is not an array
-  data myname / persn(2, 'Abcd Efgh') /
+  data myname(2) / persn(2, 'Abcd Efgh') /
   !C884
-  !ERROR: Must be a constant value
-  data myname / person(myAge, 'Abcd Ijkl') /
+  !ERROR: DATA statement value 'person(age=myage,name="Abcd Ijkl                ")' for 'myname(3_8)%age' is not a constant
+  data myname(3) / person(myAge, 'Abcd Ijkl') /
   integer, parameter :: a(5) =(/11, 22, 33, 44, 55/)
   integer :: b(5) =(/11, 22, 33, 44, 55/)
   integer :: i
-  integer :: x
+  integer :: x, y, z
   !OK: constant array element
   data x / a(1) /
   !C886, C887
   !ERROR: Must be a constant value
-  data x / a(i) /
+  data y / a(i) /
   !ERROR: Must be a constant value
-  data x / b(1) /
+  data z / b(1) /
 end

flang/test/Semantics/data03.f90

subroutine CheckObject
       !C879
       !ERROR: Data implied do object must be a variable
       DATA(newNums % numbers(i), i = 1, 5) / 5 * 1 /
       !C879
       !ERROR: Data implied do object must be a variable
       DATA(newNumsArray(i) % one, i = 1, 5) / 5 * 1 /
       !C880
       !OK: Correct use
-      DATA(largeArray(j) % nums % one, j = 1, 10) / 10 * 1 /
+      DATA(largeArray(j) % nums % one, j = 1, 5) / 5 * 1 /
       !C880
       !OK: Correct use
-      DATA(largeNumber % numsArray(j) % one, j = 1, 10) / 10 * 1 /
+      DATA(largeNumber % numsArray(j) % one, j = 1, 5) / 5 * 1 /
       !C881
       !ERROR: Data object must have constant subscripts
       DATA(b(x), i = 1, 5) / 5 * 1 /
       !C881 
       !OK: Correct use
       DATA(nums % numbers(i), i = 1, 5) / 5 * 1 /
       !C881
       !OK: Correct use
       DATA((d(i, j), i = 1, 10), j = 1, 10) / 100 * 1 /
       !C881
       !OK: Correct use
       DATA(d(i, 1), i = 1, 10) / 10 * 1 /
     end 
   end

flang/test/Semantics/data04.f90

 ! RUN: %S/test_errors.sh %s %t %f18
 !Testing data constraints : C876, C877
 module m
   integer :: first
   contains
     subroutine h
       integer a,b
       !C876
-      !ERROR: Data object part 'first' must not be accessed by host association
+      !ERROR: Host-associated object 'first' must not be initialized in a DATA statement
       DATA first /1/
     end subroutine
 
     function g(i)
       integer ::i
       g = i *1024
     end
 
     function f(i)
       integer ::i
       integer ::result
       integer, allocatable :: a
       integer :: b(i)
       character(len=i), pointer:: charPtr
       character(len=i), allocatable:: charAlloc
       !C876
-      !ERROR: Data object part 'i' must not be a dummy argument
+      !ERROR: Dummy argument 'i' must not be initialized in a DATA statement
       DATA i /1/
       !C876
-      !ERROR: Data object part 'f' must not be a function result
+      !ERROR: Function result 'f' must not be initialized in a DATA statement
       DATA f /1/
       !C876
-      !ERROR: Data object part 'g' must not be a function name
+      !ERROR: Procedure 'g' must not be initialized in a DATA statement
       DATA g /1/
       !C876
-      !ERROR: Data object part 'a' must not be an allocatable object
+      !ERROR: Allocatable 'a' must not be initialized in a DATA statement
       DATA a /1/
       !C876
-      !ERROR: Data object part 'b' must not be an automatic object
+      !ERROR: Automatic variable 'b' must not be initialized in a DATA statement
       DATA b(0) /1/
       !C876
       !Ok: As charPtr is a pointer, it is not an automatic object
       DATA charPtr / NULL() /
       !C876
-      !ERROR: Data object part 'charalloc' must not be an allocatable object
+      !ERROR: Allocatable 'charalloc' must not be initialized in a DATA statement
       DATA charAlloc / 'abc' /
       f = i *1024
     end
 
     subroutine CheckObject(i)
       type specialNumbers
         integer one
         integer numbers(5)
subroutine CheckObject(i)
       end type
       type(large) largeNumber
       type(large), allocatable :: allocatableLarge
       !ERROR: An automatic variable must not be initialized
       type(large) :: largeNumberArray(i)
       type(large) :: largeArray(5)
       character :: name(i)
       !C877
-      !OK: Correct use
+      !ERROR: Default-initialized 'largenumber' must not be initialized in a DATA statement
       DATA(largeNumber % numsArray(j) % headOfTheList, j = 1, 10) / 10 * NULL() /
       !C877
       !ERROR: Data object must not contain pointer 'headofthelist' as a non-rightmost part
-      DATA(largeNumber % numsArray(j) % headOfTheList % one, j = 1, 10) / 10 * NULL() /
+      DATA(largeNumber % numsArray(j) % headOfTheList % one, j = 1, 10) / 10 * 1 /
       !C877
       !ERROR: Rightmost data object pointer 'ptoarray' must not be subscripted
       DATA(largeNumber % numsArray(j) % ptoarray(1), j = 1, 10) / 10 * 1 /
       !C877
       !ERROR: Rightmost data object pointer 'ptochar' must not be subscripted
       DATA largeNumber % numsArray(0) % ptochar(1:2) / 'ab' /
       !C876
-      !ERROR: Data object part 'elt' must not be an allocatable object
+      !ERROR: Default-initialized 'largenumber' must not be initialized in a DATA statement
       DATA(largeNumber % elt(j) , j = 1, 10) / 10 * 1/
       !C876
-      !ERROR: Data object part 'allocval' must not be an allocatable object
+      !ERROR: Default-initialized 'largearray' must not be initialized in a DATA statement
       DATA(largeArray(j) % allocVal , j = 1, 10) / 10 * 1/
       !C876
-      !ERROR: Data object part 'allocatablelarge' must not be an allocatable object
+      !ERROR: Allocatable 'allocatablelarge' must not be initialized in a DATA statement
       DATA allocatableLarge % val / 1 /
       !C876
-      !ERROR: Data object part 'largenumberarray' must not be an automatic object
+      !ERROR: Automatic variable 'largenumberarray' must not be initialized in a DATA statement
       DATA(largeNumberArray(j) % val, j = 1, 10) / 10 * NULL() /
       !C876
-      !ERROR: Data object part 'name' must not be an automatic object
+      !ERROR: Automatic variable 'name' must not be initialized in a DATA statement
       DATA name( : 2) / 'Ancd' /
     end
   end
 
   block data foo
           integer :: a,b
           common /c/ a,b
           !C876
           !OK: Correct use
           DATA a /1/
   end block data
 
   module m2
     integer m2_i
     type newType
       integer number
     end type
     type(newType) m2_number1
     contains
 
     subroutine checkDerivedType(m2_number)
       type(newType) m2_number
       type(newType) m2_number3
       !C876
-      !ERROR: Data object part 'm2_number' must not be a dummy argument
+      !ERROR: Dummy argument 'm2_number' must not be initialized in a DATA statement
       DATA m2_number%number /1/
       !C876
-      !ERROR: Data object part 'm2_number1' must not be accessed by host association
+      !ERROR: Host-associated object 'm2_number1' must not be initialized in a DATA statement
       DATA m2_number1%number /1/
       !C876
       !OK: m2_number3 is not associated through use association
       DATA m2_number3%number /1/
     end
   end
 
   program new
     use m2
     integer a
     real    b,c
     type seqType
       sequence
       integer number
     end type
     type(SeqType) num
     COMMON b,a,c,num
     type(newType) m2_number2
     !C876
-    !ERROR: Data object part 'b' must not be in blank COMMON
+    !ERROR: Blank COMMON object 'b' must not be initialized in a DATA statement
     DATA b /1/
     !C876
-    !ERROR: Data object part 'm2_i' must not be accessed by use association
+    !ERROR: USE-associated object 'm2_i' must not be initialized in a DATA statement
     DATA m2_i /1/
     !C876
-    !ERROR: Data object part 'm2_number1' must not be accessed by use association
+    !ERROR: USE-associated object 'm2_number1' must not be initialized in a DATA statement
     DATA m2_number1%number /1/
     !C876
     !OK: m2_number2 is not associated through use association
     DATA m2_number2%number /1/
     !C876
-    !ERROR: Data object part 'num' must not be in blank COMMON
+    !ERROR: Blank COMMON object 'num' must not be initialized in a DATA statement
     DATA num%number /1/
   end program

flang/test/Semantics/data05.f90

+!RUN: %f18 -fdebug-dump-symbols -fparse-only %s | FileCheck %s
+module m
+  interface
+    integer function ifunc(n)
+      integer, intent(in) :: n
+    end function
+    real function rfunc(x)
+      real, intent(in) :: x
+    end function
+  end interface
+  external extrfunc
+  real extrfunc
+  type :: t1(kind,len)
+    integer(kind=1), kind :: kind = 4
+    integer(kind=2), len :: len = 1
+    integer(kind=kind) :: j
+    real(kind=kind) :: x(2,2)
+    complex(kind=kind) :: z
+    logical(kind=kind) :: t
+    character(kind=5-kind) :: c(2)
+    real(kind=kind), pointer :: xp(:,:)
+    procedure(ifunc), pointer, nopass :: ifptr
+    procedure(rfunc), pointer, nopass :: rp
+    procedure(real), pointer, nopass :: xrp
+  end type
+ contains
+  subroutine s1
+    procedure(ifunc), pointer :: ifptr ! CHECK: ifptr, EXTERNAL, POINTER (Function, InDataStmt) size=24 offset=0: ProcEntity ifunc => ifunc
+    data ifptr/ifunc/
+  end subroutine
+  subroutine s2
+    integer(kind=1) :: j1 ! CHECK: j1 (InDataStmt) size=1 offset=0: ObjectEntity type: INTEGER(1) init:66_1
+    data j1/66/
+  end subroutine
+  subroutine s3
+    integer :: jd ! CHECK: jd (InDataStmt) size=4 offset=0: ObjectEntity type: INTEGER(4) init:666_4
+    data jd/666/
+  end subroutine
+  subroutine s4
+    logical :: lv(2) ! CHECK: lv (InDataStmt) size=8 offset=0: ObjectEntity type: LOGICAL(4) shape: 1_8:2_8 init:[LOGICAL(4)::.false._4,.true._4]
+    data lv(1)/.false./
+    data lv(2)/.true./
+  end subroutine
+  subroutine s5
+    real :: rm(2,2) ! CHECK: rm (InDataStmt) size=16 offset=0: ObjectEntity type: REAL(4) shape: 1_8:2_8,1_8:2_8 init:reshape([REAL(4)::1._4,2._4,3._4,4._4],shape=[2,2])
+    data rm/1,2,3,4/
+  end subroutine
+  subroutine s6
+    character(len=8) :: ssd ! CHECK: ssd (InDataStmt) size=8 offset=0: ObjectEntity type: CHARACTER(8_4,1) init:"abcdefgh"
+    data ssd(1:4)/'abcd'/,ssd(5:8)/'efgh'/
+  end subroutine
+  subroutine s7
+    complex(kind=16) :: zv(-1:1) ! CHECK: zv (InDataStmt) size=96 offset=0: ObjectEntity type: COMPLEX(16) shape: -1_8:1_8 init:[COMPLEX(16)::(1._16,2._16),(3._16,4._16),(5._16,6._16)]
+    data (zv(j), j=1,0,-1)/(5,6),(3,4)/
+    data (zv(j)%im, zv(j)%re, j=-1,-1,-9)/2,1/
+  end subroutine
+  real function rfunc2(x)
+    real, intent(in) :: x
+    rfunc2 = x + 1.
+  end function
+  subroutine s8
+    procedure(rfunc), pointer :: rfptr ! CHECK: rfptr, EXTERNAL, POINTER (Function, InDataStmt) size=24 offset=0: ProcEntity rfunc => rfunc2
+    data rfptr/rfunc2/
+  end subroutine
+  subroutine s10
+    real, target, save :: arr(3,4) ! CHECK: arr, SAVE, TARGET size=48 offset=0: ObjectEntity type: REAL(4) shape: 1_8:3_8,1_8:4_8
+    real, pointer :: xpp(:,:) ! CHECK: xpp, POINTER (InDataStmt) size=72 offset=48: ObjectEntity type: REAL(4) shape: :,: init:arr
+    data xpp/arr/
+  end subroutine
+  integer function ifunc2(n)
+    integer, intent(in) :: n
+    ifunc2 = n + 1
+  end function
+  subroutine s11
+    real, target, save :: arr(3,4) ! CHECK: arr, SAVE, TARGET size=48 offset=0: ObjectEntity type: REAL(4) shape: 1_8:3_8,1_8:4_8
+    type(t1) :: d1 = t1(1,reshape([1,2,3,4],[2,2]),(6.,7.),.false.,'ab',arr,ifunc2,rfunc,extrfunc) ! CHECK: d1 size=184 offset=48: ObjectEntity type: TYPE(t1(kind=4_1,len=1_2)) init:t1(kind=4_1,len=1_2)(j=1_4,x=reshape([REAL(4)::1._4,2._4,3._4,4._4],shape=[2,2]),z=(6._4,7._4),t=.false._4,c=[CHARACTER(KIND=1,LEN=1)::"a","a"],xp=arr,ifptr=ifunc2,rp=rfunc,xrp=extrfunc)
+    type(t1(4,len=1)) :: d2 = t1(4)(xrp=extrfunc,rp=rfunc,ifptr=ifunc2,xp=arr,c='a&
+      &b',t=.false.,z=(6.,7.),x=reshape([1,2,3,4],[2,2]),j=1) ! CHECK: d2 size=184 offset=232: ObjectEntity type: TYPE(t1(kind=4_1,len=1_2)) init:t1(kind=4_1,len=1_2)(j=1_4,x=reshape([REAL(4)::1._4,2._4,3._4,4._4],shape=[2,2]),z=(6._4,7._4),t=.false._4,c=[CHARACTER(KIND=1,LEN=1)::"a","a"],xp=arr,ifptr=ifunc2,rp=rfunc,xrp=extrfunc)
+    type(t1(2+2)) :: d3 ! CHECK: d3 (InDataStmt) size=184 offset=416: ObjectEntity type: TYPE(t1(kind=4_1,len=1_2)) init:t1(kind=4_1,len=1_2)(j=1_4,x=reshape([REAL(4)::1._4,2._4,3._4,4._4],shape=[2,2]),z=(6._4,7._4),t=.false._4,c=[CHARACTER(KIND=1,LEN=1)::"a","a"],xp=arr,ifptr=ifunc2,rp=rfunc,xrp=extrfunc)
+    data d3/t1(1,reshape([1,2,3,4],[2,2]),(6.,7.),.false.,'ab',arr,ifunc2,rfunc,extrfunc)/
+    type(t1) :: d4 ! CHECK: d4 (InDataStmt) size=184 offset=600: ObjectEntity type: TYPE(t1(kind=4_1,len=1_2)) init:t1(kind=4_1,len=1_2)(j=1_4,x=reshape([REAL(4)::1._4,2._4,3._4,4._4],shape=[2,2]),z=(6._4,7._4),t=.false._4,c=[CHARACTER(KIND=1,LEN=1)::"a","a"],xp=arr,ifptr=ifunc2,rp=rfunc,xrp=extrfunc)
+    data d4/t1(4)(xrp=extrfunc,rp=rfunc,ifptr=ifunc2,xp=arr,c='ab',t=.false.,z=(6&
+      &.,7.),x=reshape([1,2,3,4],[2,2]),j=1)/
+    type(t1) :: d5 ! CHECK: d5 (InDataStmt) size=184 offset=784: ObjectEntity type: TYPE(t1(kind=4_1,len=1_2)) init:t1(kind=4_1,len=1_2)(j=1_4,x=reshape([REAL(4)::1._4,2._4,3._4,4._4],shape=[2,2]),z=(6._4,7._4),t=.false._4,c=[CHARACTER(KIND=1,LEN=1)::"a","b"],xp=arr,ifptr=ifunc2,rp=rfunc,xrp=extrfunc)
+    data d5%j/1/,d5%x/1,2,3,4/,d5%z%re/6./,d5%z%im/7./,d5%t/.false./,d5%c(1:1)/'a'/,d5%c(2:&
+      &2)/'b'/,d5%xp/arr/,d5%ifptr/ifunc2/,d5%rp/rfunc/,d5%xrp/extrfunc/
+  end subroutine
+  subroutine s12
+    procedure(rfunc), pointer :: pp ! CHECK: pp, EXTERNAL, POINTER (Function, InDataStmt) size=24 offset=0: ProcEntity rfunc => rfunc2
+    data pp/rfunc2/
+  end subroutine
+end module

flang/test/Semantics/data06.f90

+! RUN: %S/test_errors.sh %s %t %f18
+! DATA statement errors
+subroutine s1
+  type :: t1
+    integer :: j = 666
+  end type t1
+  type(t1) :: t1x
+  !ERROR: Default-initialized 't1x' must not be initialized in a DATA statement
+  data t1x%j / 777 /
+  integer :: ja = 888
+  !ERROR: Default-initialized 'ja' must not be initialized in a DATA statement
+  data ja / 999 /
+  integer :: a1(10)
+  !ERROR: DATA statement set has more values than objects
+  data a1(1:9:2) / 6 * 1 /
+  integer :: a2(10)
+  !ERROR: DATA statement set has no value for 'a2(2_8)'
+  data (a2(k),k=10,1,-2) / 4 * 1 /
+  integer :: a3(2)
+  !ERROR: DATA statement implied DO loop has a step value of zero
+  data (a3(j),j=1,2,0)/2*333/
+  integer :: a4(3)
+  !ERROR: DATA statement designator 'a4(5_8)' is out of range
+  data (a4(j),j=1,5,2) /3*222/
+  interface
+    real function rfunc(x)
+      real, intent(in) :: x
+    end function
+  end interface
+  real, pointer :: rp
+  !ERROR: Procedure 'rfunc' may not be used to initialize 'rp', which is not a procedure pointer
+  data rp/rfunc/
+  procedure(rfunc), pointer :: rpp
+  real, target :: rt
+  !ERROR: Data object 'rt' may not be used to initialize 'rpp', which is a procedure pointer
+  data rpp/rt/
+  !ERROR: Initializer for 'rt' must not be a pointer
+  data rt/null()/
+  !ERROR: Initializer for 'rt' must not be a procedure
+  data rt/rfunc/
+  integer :: jx, jy
+  !ERROR: DATA statement value could not be converted to the type 'INTEGER(4)' of the object 'jx'
+  data jx/'abc'/
+  !ERROR: DATA statement value could not be converted to the type 'INTEGER(4)' of the object 'jx'
+  data jx/t1()/
+  !ERROR: DATA statement value could not be converted to the type 'INTEGER(4)' of the object 'jx'
+  data jx/.false./
+  !ERROR: must be a constant
+  data jx/jy/
+end subroutine

flang/test/Semantics/data07.f90

+! RUN: %S/test_errors.sh %s %t %f18
+module m
+ contains
+  subroutine s1
+    !ERROR: DATA statement initializations affect 'jb(5_8)' more than once
+    integer :: ja(10), jb(10)
+    data (ja(k),k=1,9,2) / 5*1 / ! ok
+    data (ja(k),k=10,2,-2) / 5*2 / ! ok
+    data (jb(k),k=1,9,2) / 5*1 / ! ok
+    data (jb(k),k=2,10,3) / 3*2 / ! conflict at 5
+  end subroutine
+end module