Magic-Mirror/llvm-capstone
1
0
Fork 0
mirror of https://github.com/capstone-engine/llvm-capstone.git synced 2024-12-25 17:31:02 +00:00
Code Issues Actions 2 Packages Projects Releases Wiki Activity

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

Browse Source 
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
This commit is contained in:
peter klausler 2020-06-19 09:16:21 -07:00
parent 1feeecf224
commit a20d48d7d3
18 changed files with 862 additions and 223 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
flang/documentation/Extensions.md
View File

@ -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
--------------------------------------------

53
flang/include/flang/Evaluate/fold-designator.h
View File

@ -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 @@ public:
}
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 @@ private:
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 @@ private:
FoldingContext &context_;
ConstantSubscript elementNumber_{0}; // zero-based
bool isEmpty_{false};
bool isOutOfRange_{false};
};
// Reconstructs a Designator<> from a symbol and an offset.

71
flang/include/flang/Evaluate/initial-image.h
View File

@ -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);
}

4
flang/include/flang/Parser/parse-tree.h
View File

@ -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;
};

56
flang/lib/Evaluate/fold-designator.cpp
View File

@ -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()};

52
flang/lib/Evaluate/initial-image.cpp
View File

@ -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(

2
flang/lib/Parser/Fortran-parsers.cpp
View File

@ -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>(

544
flang/lib/Semantics/check-data.cpp
View File

@ -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 @@ public:
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 @@ public:
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 @@ public:
(*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 @@ private:
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

41
flang/lib/Semantics/check-data.h
View File

@ -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_

4
flang/lib/Semantics/expression.cpp
View File

@ -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)}) {

5
flang/lib/Semantics/resolve-names.cpp
View File

@ -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});
}
}
}

6
flang/lib/Semantics/semantics.cpp
View File

@ -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();
}

47
flang/test/Semantics/data01.f90
View File

@ -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

4
flang/test/Semantics/data03.f90
View File

@ -70,10 +70,10 @@ module m
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 /

40
flang/test/Semantics/data04.f90
View File

@ -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 @@ module m
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 @@ module m
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 @@ module m
!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 @@ module m
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 @@ module m
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

92
flang/test/Semantics/data05.f90 Normal file
View File

@ -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

50
flang/test/Semantics/data06.f90 Normal file
View File

@ -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

12
flang/test/Semantics/data07.f90 Normal file
View File

@ -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