[flang-commits] [flang] a20d48d - [flang] DATA stmt processing (part 4/4): Check & convert DATA
peter klausler via flang-commits
flang-commits at lists.llvm.org
Fri Jun 19 13:30:58 PDT 2020
Author: peter klausler
Date: 2020-06-19T13:26:20-07:00
New Revision: a20d48d7d39892ed2af2b0e6dd7f9703a3fef031
URL: https://github.com/llvm/llvm-project/commit/a20d48d7d39892ed2af2b0e6dd7f9703a3fef031
DIFF: https://github.com/llvm/llvm-project/commit/a20d48d7d39892ed2af2b0e6dd7f9703a3fef031.diff
LOG: [flang] DATA stmt processing (part 4/4): Check & convert DATA
Implement rest of DATA statement semantics and conversion of
DATA statement initializations into static initializers of
objects in their symbol table entries.
Reviewed By: tskeith, PeteSteinfeld
Differential Revision: https://reviews.llvm.org/D82207
Added:
flang/test/Semantics/data05.f90
flang/test/Semantics/data06.f90
flang/test/Semantics/data07.f90
Modified:
flang/documentation/Extensions.md
flang/include/flang/Evaluate/fold-designator.h
flang/include/flang/Evaluate/initial-image.h
flang/include/flang/Parser/parse-tree.h
flang/lib/Evaluate/fold-designator.cpp
flang/lib/Evaluate/initial-image.cpp
flang/lib/Parser/Fortran-parsers.cpp
flang/lib/Semantics/check-data.cpp
flang/lib/Semantics/check-data.h
flang/lib/Semantics/expression.cpp
flang/lib/Semantics/resolve-names.cpp
flang/lib/Semantics/semantics.cpp
flang/test/Semantics/data01.f90
flang/test/Semantics/data03.f90
flang/test/Semantics/data04.f90
Removed:
################################################################################
diff --git a/flang/documentation/Extensions.md b/flang/documentation/Extensions.md
index 126947553f28..a2420c727e82 100644
--- a/flang/documentation/Extensions.md
+++ b/flang/documentation/Extensions.md
@@ -119,6 +119,8 @@ Extensions, deletions, and legacy features supported by default
* 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
--------------------------------------------
diff --git a/flang/include/flang/Evaluate/fold-designator.h b/flang/include/flang/Evaluate/fold-designator.h
index c6b6cfe70fe0..457e86d4fdad 100644
--- a/flang/include/flang/Evaluate/fold-designator.h
+++ b/flang/include/flang/Evaluate/fold-designator.h
@@ -62,10 +62,8 @@ 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) {
@@ -75,52 +73,50 @@ class DesignatorFolder {
}
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) {
@@ -128,15 +124,26 @@ class DesignatorFolder {
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;
}
}
@@ -151,6 +158,8 @@ class DesignatorFolder {
FoldingContext &context_;
ConstantSubscript elementNumber_{0}; // zero-based
+ bool isEmpty_{false};
+ bool isOutOfRange_{false};
};
// Reconstructs a Designator<> from a symbol and an offset.
diff --git a/flang/include/flang/Evaluate/initial-image.h b/flang/include/flang/Evaluate/initial-image.h
index 33c890b02d74..2007d9770f6e 100644
--- a/flang/include/flang/Evaluate/initial-image.h
+++ b/flang/include/flang/Evaluate/initial-image.h
@@ -22,42 +22,65 @@ 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());
- auto elementBytes{x.GetType().MeasureSizeInBytes()};
- CHECK(elementBytes && bytes == x.values().size() * *elementBytes);
- std::memcpy(&data_.at(offset), &x.values().at(0), bytes);
- return true;
+ 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()};
+ if (!elementBytes || bytes != x.values().size() * *elementBytes) {
+ return SizeMismatch;
+ } else {
+ std::memcpy(&data_.at(offset), &x.values().at(0), bytes);
+ 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());
- auto elements{TotalElementCount(x.shape())};
- auto elementBytes{bytes > 0 ? bytes / elements : 0};
- CHECK(elements * elementBytes == bytes);
- 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));
- std::memcpy(&data_[offset], scalar.data(), elementBytes);
- offset += elementBytes;
+ if (offset < 0 || offset + bytes > data_.size()) {
+ return OutOfRange;
+ } else {
+ auto elements{TotalElementCount(x.shape())};
+ auto elementBytes{bytes > 0 ? bytes / elements : 0};
+ 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.
+ auto scalarBytes{scalar.size() * KIND};
+ if (scalarBytes < elementBytes ||
+ (scalarBytes > elementBytes && elements != 0)) {
+ return SizeMismatch;
+ }
+ std::memcpy(&data_[offset], scalar.data(), elementBytes);
+ offset += elementBytes;
+ }
+ return Ok;
+ }
}
- return true;
}
- 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);
}
diff --git a/flang/include/flang/Parser/parse-tree.h b/flang/include/flang/Parser/parse-tree.h
index c561c9e60903..933638d039d3 100644
--- a/flang/include/flang/Parser/parse-tree.h
+++ b/flang/include/flang/Parser/parse-tree.h
@@ -1409,7 +1409,7 @@ struct DataStmtConstant {
std::variant<Scalar<ConstantValue>, Scalar<ConstantSubobject>,
SignedIntLiteralConstant, SignedRealLiteralConstant,
SignedComplexLiteralConstant, NullInit, InitialDataTarget,
- Constant<StructureConstructor>>
+ StructureConstructor>
u;
};
@@ -1425,7 +1425,7 @@ struct DataStmtRepeat {
// 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;
};
diff --git a/flang/lib/Evaluate/fold-designator.cpp b/flang/lib/Evaluate/fold-designator.cpp
index b33436296e95..5c56cd2acf5e 100644
--- a/flang/lib/Evaluate/fold-designator.cpp
+++ b/flang/lib/Evaluate/fold-designator.cpp
@@ -14,15 +14,18 @@ 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)}) {
@@ -38,7 +41,9 @@ std::optional<OffsetSymbol> DesignatorFolder::FoldDesignator(
which = quotient;
stride *= extent;
}
- if (which == 0) {
+ if (which > 0) {
+ isEmpty_ = true;
+ } else {
return std::move(result);
}
}
@@ -49,7 +54,7 @@ std::optional<OffsetSymbol> DesignatorFolder::FoldDesignator(
}
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()}) {
@@ -88,11 +93,12 @@ std::optional<OffsetSymbol> DesignatorFolder::FoldDesignator(
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;
}
+ result->Augment((at - lower) * stride);
+ which = quotient;
+ return true;
}
}
return false;
@@ -124,7 +130,9 @@ std::optional<OffsetSymbol> DesignatorFolder::FoldDesignator(
++dim;
stride *= extent;
}
- if (which == 0) {
+ if (which > 0) {
+ isEmpty_ = true;
+ } else {
return result;
}
}
@@ -135,7 +143,7 @@ std::optional<OffsetSymbol> DesignatorFolder::FoldDesignator(
}
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;
@@ -156,7 +164,7 @@ std::optional<OffsetSymbol> DesignatorFolder::FoldDesignator(
}
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) {
@@ -169,28 +177,30 @@ std::optional<OffsetSymbol> DesignatorFolder::FoldDesignator(
}
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);
}
}
@@ -217,7 +227,7 @@ static std::optional<ArrayRef> OffsetToArrayRef(FoldingContext &context,
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;
@@ -227,11 +237,10 @@ static std::optional<ArrayRef> OffsetToArrayRef(FoldingContext &context,
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});
+ offset -= element * *elementBytes;
+ return ArrayRef{std::move(entity), std::move(subscripts)};
}
// Maps an offset back to a component, when unambiguous.
@@ -255,6 +264,7 @@ static const Symbol *OffsetToUniqueComponent(
}
// 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()};
diff --git a/flang/lib/Evaluate/initial-image.cpp b/flang/lib/Evaluate/initial-image.cpp
index a32d359cbb01..6c6c74d49c01 100644
--- a/flang/lib/Evaluate/initial-image.cpp
+++ b/flang/lib/Evaluate/initial-image.cpp
@@ -12,30 +12,40 @@
namespace Fortran::evaluate {
-bool InitialImage::Add(ConstantSubscript offset, std::size_t bytes,
- const Constant<SomeDerived> &x) {
- CHECK(offset >= 0 && offset + bytes <= data_.size());
- auto elements{TotalElementCount(x.shape())};
- auto elementBytes{bytes > 0 ? bytes / elements : 0};
- CHECK(elements * elementBytes == bytes);
- 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)) {
- AddPointer(offset + component.offset(), indExpr.value());
- } else if (!Add(offset + component.offset(), component.size(),
- indExpr.value())) {
- return false;
+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};
+ 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};
+ if (component.offset() + component.size() > elementBytes) {
+ return SizeMismatch;
+ } else if (IsPointer(component)) {
+ AddPointer(offset + component.offset(), indExpr.value());
+ } else {
+ Result added{Add(offset + component.offset(), component.size(),
+ indExpr.value())};
+ if (added != Ok) {
+ return Ok;
+ }
+ }
+ }
+ offset += elementBytes;
}
}
- offset += elementBytes;
+ return Ok;
}
- return true;
}
void InitialImage::AddPointer(
diff --git a/flang/lib/Parser/Fortran-parsers.cpp b/flang/lib/Parser/Fortran-parsers.cpp
index 6368b985d1aa..3192781d4bcc 100644
--- a/flang/lib/Parser/Fortran-parsers.cpp
+++ b/flang/lib/Parser/Fortran-parsers.cpp
@@ -833,7 +833,7 @@ 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>(
diff --git a/flang/lib/Semantics/check-data.cpp b/flang/lib/Semantics/check-data.cpp
index 7c5557714f46..7e86790a529e 100644
--- a/flang/lib/Semantics/check-data.cpp
+++ b/flang/lib/Semantics/check-data.cpp
@@ -6,9 +6,22 @@
//
//===----------------------------------------------------------------------===//
+// 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 {
@@ -18,7 +31,9 @@ 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)}) {
- kind = dynamicType->kind();
+ if (dynamicType->category() == TypeCategory::Integer) {
+ kind = dynamicType->kind();
+ }
}
exprAnalyzer_.AddImpliedDo(name.source, kind);
}
@@ -28,6 +43,9 @@ void DataChecker::Leave(const parser::DataImpliedDo &x) {
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>;
@@ -37,6 +55,35 @@ class DataVarChecker : public evaluate::AllTraverse<DataVarChecker, true> {
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()};
@@ -56,12 +103,6 @@ class DataVarChecker : public evaluate::AllTraverse<DataVarChecker, true> {
return false;
}
}
- if (!isFirstSymbolChecked_) {
- isFirstSymbolChecked_ = true;
- if (!CheckFirstSymbol(component.GetFirstSymbol())) {
- return false;
- }
- }
return (*this)(component.base()) && (*this)(lastSymbol);
}
bool operator()(const evaluate::ArrayRef &arrayRef) {
@@ -74,18 +115,10 @@ class DataVarChecker : public evaluate::AllTraverse<DataVarChecker, true> {
(*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();
@@ -130,64 +163,15 @@ class DataVarChecker : public evaluate::AllTraverse<DataVarChecker, true> {
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>>>(
@@ -195,26 +179,436 @@ void DataChecker::Leave(const parser::DataIDoObject &object) {
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,
- "Data implied do structure component must be subscripted"_err_en_US);
+ 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
diff --git a/flang/lib/Semantics/check-data.h b/flang/lib/Semantics/check-data.h
index fa65737ecefb..a6681831ea9d 100644
--- a/flang/lib/Semantics/check-data.h
+++ b/flang/lib/Semantics/check-data.h
@@ -9,26 +9,57 @@
#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_
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index afd70d065108..60e705f0ee88 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -707,7 +707,7 @@ 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
}
@@ -725,7 +725,7 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::InitialDataTarget &x) {
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)}) {
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 9efc7991b4ae..2b257fce9fd6 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -5059,9 +5059,8 @@ bool ConstructVisitor::Pre(const parser::DataStmtValue &x) {
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});
}
}
}
diff --git a/flang/lib/Semantics/semantics.cpp b/flang/lib/Semantics/semantics.cpp
index b8327213682b..681e1dc5ca27 100644
--- a/flang/lib/Semantics/semantics.cpp
+++ b/flang/lib/Semantics/semantics.cpp
@@ -168,7 +168,11 @@ static bool PerformStatementSemantics(
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();
}
diff --git a/flang/test/Semantics/data01.f90 b/flang/test/Semantics/data01.f90
index 8fa36991801e..aea40f0c78ba 100644
--- a/flang/test/Semantics/data01.f90
+++ b/flang/test/Semantics/data01.f90
@@ -1,6 +1,6 @@
! 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
@@ -9,55 +9,58 @@ subroutine CheckRepeat
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
diff --git a/flang/test/Semantics/data03.f90 b/flang/test/Semantics/data03.f90
index fdab401d9b9b..f5b65035f73d 100644
--- a/flang/test/Semantics/data03.f90
+++ b/flang/test/Semantics/data03.f90
@@ -70,10 +70,10 @@ subroutine CheckObject
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 /
diff --git a/flang/test/Semantics/data04.f90 b/flang/test/Semantics/data04.f90
index a34f59337f71..f1f772e48051 100644
--- a/flang/test/Semantics/data04.f90
+++ b/flang/test/Semantics/data04.f90
@@ -6,7 +6,7 @@ module m
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
@@ -23,25 +23,25 @@ function f(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
@@ -67,11 +67,11 @@ subroutine CheckObject(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 /
@@ -79,19 +79,19 @@ subroutine CheckObject(i)
!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
@@ -116,10 +116,10 @@ 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
@@ -139,18 +139,18 @@ program new
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
diff --git a/flang/test/Semantics/data05.f90 b/flang/test/Semantics/data05.f90
new file mode 100644
index 000000000000..a138b067942e
--- /dev/null
+++ b/flang/test/Semantics/data05.f90
@@ -0,0 +1,92 @@
+!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
diff --git a/flang/test/Semantics/data06.f90 b/flang/test/Semantics/data06.f90
new file mode 100644
index 000000000000..c21b99e8e484
--- /dev/null
+++ b/flang/test/Semantics/data06.f90
@@ -0,0 +1,50 @@
+! 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
diff --git a/flang/test/Semantics/data07.f90 b/flang/test/Semantics/data07.f90
new file mode 100644
index 000000000000..6f47c261f89a
--- /dev/null
+++ b/flang/test/Semantics/data07.f90
@@ -0,0 +1,12 @@
+! 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
More information about the flang-commits
mailing list