maxjhandsome
/
llvm-project
forked from OSchip/llvm-project
1
0
Fork 0
Code Issues Pull Requests Packages Releases Wiki Activity

[flang] Handle DATA initialization of EQUIVALENCE'd objects 

Objects that are storage associated by EQUIVALENCE and
initialized with DATA are initialized by creating a
compiler temporary data object in the same scope,
assigning it an offset, type, and size that covers the
transitive closure of the associated initialized original
symbols, and combining their initializers into one common
initializer for the temporary.

Some problems with offset assignment of EQUIVALENCE'd objects
in COMMON were exposed and corrected, and some more error
cases are checked.

Remove obsolete function.
Small bugfix (nested implied dos).
Add a test.
Fix struct/class warning.

Differential Revision: https://reviews.llvm.org/D85560
This commit is contained in:
peter klausler 2020-08-07 13:25:11 -07:00
parent 3c0597a9e4
commit 4ac617f490
16 changed files with 745 additions and 482 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -87,6 +87,8 @@ public:
void AddPointer(ConstantSubscript, const Expr<SomeType> &);
void Incorporate(ConstantSubscript, const InitialImage &);
// Conversions to constant initializers
std::optional<Expr<SomeType>> AsConstant(FoldingContext &,
const DynamicType &, const ConstantSubscripts &,

2
flang/include/flang/Parser/parsing.h
View File

@ -62,8 +62,6 @@ public:
o, cooked_.GetProvenanceRange(CharBlock(at)), message, echoSourceLine);
}
bool ForTesting(std::string path, llvm::raw_ostream &);
private:
Options options_;
CookedSource cooked_;

2
flang/include/flang/Semantics/semantics.h
View File

@ -170,6 +170,7 @@ public:
void ActivateIndexVar(const parser::Name &, IndexVarKind);
void DeactivateIndexVar(const parser::Name &);
SymbolVector GetIndexVars(IndexVarKind);
SourceName GetTempName(const Scope &);
private:
void CheckIndexVarRedefine(
@ -196,6 +197,7 @@ private:
IndexVarKind kind;
};
std::map<SymbolRef, const IndexVarInfo> activeIndexVars_;
std::vector<std::string> tempNames_;
};
class Semantics {

2
flang/include/flang/Semantics/type.h
View File

@ -53,7 +53,7 @@ public:
static Bound Assumed() { return Bound(Category::Assumed); }
static Bound Deferred() { return Bound(Category::Deferred); }
explicit Bound(MaybeSubscriptIntExpr &&expr) : expr_{std::move(expr)} {}
explicit Bound(int bound);
explicit Bound(common::ConstantSubscript bound);
Bound(const Bound &) = default;
Bound(Bound &&) = default;
Bound &operator=(const Bound &) = default;

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

@ -9,6 +9,7 @@
#include "flang/Evaluate/initial-image.h"
#include "flang/Semantics/scope.h"
#include "flang/Semantics/tools.h"
#include <cstring>
namespace Fortran::evaluate {
@ -53,6 +54,13 @@ void InitialImage::AddPointer(
pointers_.emplace(offset, pointer);
}
void InitialImage::Incorporate(
ConstantSubscript offset, const InitialImage &that) {
CHECK(that.pointers_.empty()); // pointers are not allowed in EQUIVALENCE
CHECK(offset + that.size() <= size());
std::memcpy(&data_[offset], &that.data_[0], that.size());
}
// Classes used with common::SearchTypes() to (re)construct Constant<> values
// of the right type to initialize each symbol from the values that have
// been placed into its initialization image by DATA statements.

20
flang/lib/Parser/parsing.cpp
View File

@ -123,24 +123,4 @@ void Parsing::Parse(llvm::raw_ostream &out) {
void Parsing::ClearLog() { log_.clear(); }
bool Parsing::ForTesting(std::string path, llvm::raw_ostream &err) {
llvm::raw_null_ostream NullStream;
Prescan(path, Options{});
if (messages_.AnyFatalError()) {
messages_.Emit(err, cooked_);
err << "could not scan " << path << '\n';
return false;
}
Parse(NullStream);
messages_.Emit(err, cooked_);
if (!consumedWholeFile_) {
EmitMessage(err, finalRestingPlace_, "parser FAIL; final position");
return false;
}
if (messages_.AnyFatalError() || !parseTree_.has_value()) {
err << "could not parse " << path << '\n';
return false;
}
return true;
}
} // namespace Fortran::parser

1
flang/lib/Semantics/CMakeLists.txt
View File

@ -26,6 +26,7 @@ add_flang_library(FortranSemantics
check-select-type.cpp
check-stop.cpp
compute-offsets.cpp
data-to-inits.cpp
expression.cpp
mod-file.cpp
pointer-assignment.cpp

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

@ -9,19 +9,16 @@
// 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().
// - Invokes conversion of DATA statement values to static initializers
#include "check-data.h"
#include "pointer-assignment.h"
#include "flang/Evaluate/fold-designator.h"
#include "data-to-inits.h"
#include "flang/Evaluate/traverse.h"
#include "flang/Parser/parse-tree.h"
#include "flang/Parser/tools.h"
#include "flang/Semantics/tools.h"
#include <algorithm>
#include <vector>
namespace Fortran::semantics {
@ -193,8 +190,8 @@ void DataChecker::Leave(const parser::DataIDoObject &object) {
}
}
}
currentSetHasFatalErrors_ = true;
}
currentSetHasFatalErrors_ = true;
}
void DataChecker::Leave(const parser::DataStmtObject &dataObject) {
@ -213,434 +210,15 @@ void DataChecker::Leave(const parser::DataStmtObject &dataObject) {
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);
// If the returned flag is true, emit a warning about CHARACTER misusage.
std::optional<std::pair<SomeExpr, bool>> ConvertElement(
const SomeExpr &, const evaluate::DynamicType &);
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();
}
std::optional<std::pair<SomeExpr, bool>>
DataInitializationCompiler::ConvertElement(
const SomeExpr &expr, const evaluate::DynamicType &type) {
if (auto converted{evaluate::ConvertToType(type, SomeExpr{expr})}) {
return {std::make_pair(std::move(*converted), false)};
}
if (std::optional<std::string> chValue{evaluate::GetScalarConstantValue<
evaluate::Type<TypeCategory::Character, 1>>(expr)}) {
// Allow DATA initialization with Hollerith and kind=1 CHARACTER like
// (most) other Fortran compilers do. Pad on the right with spaces
// when short, truncate the right if long.
// TODO: big-endian targets
std::size_t bytes{type.MeasureSizeInBytes().value()};
evaluate::BOZLiteralConstant bits{0};
for (std::size_t j{0}; j < bytes; ++j) {
char ch{j >= chValue->size() ? ' ' : chValue->at(j)};
evaluate::BOZLiteralConstant chBOZ{static_cast<unsigned char>(ch)};
bits = bits.IOR(chBOZ.SHIFTL(8 * j));
}
if (auto converted{evaluate::ConvertToType(type, SomeExpr{bits})}) {
return {std::make_pair(std::move(*converted), true)};
}
}
return std::nullopt;
}
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{ConvertElement(*expr, *designatorType)}) {
// 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());
} else if (converted->second) {
exprAnalyzer_.context().Say(
"DATA statement value initializes '%s' of type '%s' with CHARACTER"_en_US,
DescribeElement(), designatorType->AsFortran());
}
auto folded{evaluate::Fold(context, std::move(converted->first))};
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);
}
AccumulateDataInitializations(inits_, exprAnalyzer_, set);
}
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);
}
ConvertToInitializers(inits_, exprAnalyzer_);
}
} // namespace Fortran::semantics

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

@ -9,6 +9,7 @@
#ifndef FORTRAN_SEMANTICS_CHECK_DATA_H_
#define FORTRAN_SEMANTICS_CHECK_DATA_H_
#include "data-to-inits.h"
#include "flang/Common/interval.h"
#include "flang/Evaluate/fold-designator.h"
#include "flang/Evaluate/initial-image.h"
@ -28,15 +29,6 @@ struct DataStmtSet;
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} {}
@ -55,7 +47,6 @@ private:
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_;

114
flang/lib/Semantics/compute-offsets.cpp
View File

@ -51,6 +51,7 @@ private:
void Compute(Scope &);
void DoScope(Scope &);
void DoCommonBlock(Symbol &);
void DoEquivalenceBlockBase(Symbol &, SizeAndAlignment &);
void DoEquivalenceSet(const EquivalenceSet &);
SymbolAndOffset Resolve(const SymbolAndOffset &);
std::size_t ComputeOffset(const EquivalenceObject &);
@ -67,6 +68,8 @@ private:
std::size_t alignment_{0};
// symbol -> symbol+offset that determines its location, from EQUIVALENCE
std::map<MutableSymbolRef, SymbolAndOffset> dependents_;
// base symbol -> SizeAndAlignment for each distinct EQUIVALENCE block
std::map<MutableSymbolRef, SizeAndAlignment> equivalenceBlock_;
};
void ComputeOffsetsHelper::Compute(Scope &scope) {
@ -74,6 +77,8 @@ void ComputeOffsetsHelper::Compute(Scope &scope) {
Compute(child);
}
DoScope(scope);
dependents_.clear();
equivalenceBlock_.clear();
}
static bool InCommonBlock(const Symbol &symbol) {
@ -85,33 +90,60 @@ void ComputeOffsetsHelper::DoScope(Scope &scope) {
if (scope.symbol() && scope.IsParameterizedDerivedType()) {
return; // only process instantiations of parameterized derived types
}
// Symbols in common block get offsets from the beginning of the block
for (auto &pair : scope.commonBlocks()) {
DoCommonBlock(*pair.second);
}
// Build dependents_ from equivalences: symbol -> symbol+offset
for (const EquivalenceSet &set : scope.equivalenceSets()) {
DoEquivalenceSet(set);
}
offset_ = 0;
alignment_ = 0;
for (auto &symbol : scope.GetSymbols()) {
if (!InCommonBlock(*symbol) &&
dependents_.find(symbol) == dependents_.end()) {
DoSymbol(*symbol);
// Compute a base symbol and overall block size for each
// disjoint EQUIVALENCE storage sequence.
for (auto &[symbol, dep] : dependents_) {
dep = Resolve(dep);
CHECK(symbol->size() == 0);
auto symInfo{GetSizeAndAlignment(*symbol)};
symbol->set_size(symInfo.size);
Symbol &base{*dep.symbol};
auto iter{equivalenceBlock_.find(base)};
std::size_t minBlockSize{dep.offset + symInfo.size};
if (iter == equivalenceBlock_.end()) {
equivalenceBlock_.emplace(
base, SizeAndAlignment{minBlockSize, symInfo.alignment});
} else {
SizeAndAlignment &blockInfo{iter->second};
blockInfo.size = std::max(blockInfo.size, minBlockSize);
blockInfo.alignment = std::max(blockInfo.alignment, symInfo.alignment);
}
}
for (auto &[symbol, dep] : dependents_) {
if (symbol->size() == 0) {
SizeAndAlignment s{GetSizeAndAlignment(*symbol)};
symbol->set_size(s.size);
SymbolAndOffset resolved{Resolve(dep)};
symbol->set_offset(dep.symbol->offset() + resolved.offset);
offset_ = std::max(offset_, symbol->offset() + symbol->size());
// Assign offsets for non-COMMON EQUIVALENCE blocks
for (auto &[symbol, blockInfo] : equivalenceBlock_) {
if (!InCommonBlock(*symbol)) {
DoSymbol(*symbol);
DoEquivalenceBlockBase(*symbol, blockInfo);
offset_ = std::max(offset_, symbol->offset() + blockInfo.size);
}
}
// Process remaining non-COMMON symbols; this is all of them if there
// was no use of EQUIVALENCE in the scope.
for (auto &symbol : scope.GetSymbols()) {
if (!InCommonBlock(*symbol) &&
dependents_.find(symbol) == dependents_.end() &&
equivalenceBlock_.find(symbol) == equivalenceBlock_.end()) {
DoSymbol(*symbol);
}
}
scope.set_size(offset_);
scope.set_alignment(alignment_);
// Assign offsets in COMMON blocks.
for (auto &pair : scope.commonBlocks()) {
DoCommonBlock(*pair.second);
}
for (auto &[symbol, dep] : dependents_) {
symbol->set_offset(dep.symbol->offset() + dep.offset);
if (const auto *block{FindCommonBlockContaining(*dep.symbol)}) {
symbol->get<ObjectEntityDetails>().set_commonBlock(*block);
}
}
}
auto ComputeOffsetsHelper::Resolve(const SymbolAndOffset &dep)
@ -131,11 +163,57 @@ void ComputeOffsetsHelper::DoCommonBlock(Symbol &commonBlock) {
auto &details{commonBlock.get<CommonBlockDetails>()};
offset_ = 0;
alignment_ = 0;
std::size_t minSize{0};
std::size_t minAlignment{0};
for (auto &object : details.objects()) {
DoSymbol(*object);
Symbol &symbol{*object};
DoSymbol(symbol);
auto iter{dependents_.find(symbol)};
if (iter == dependents_.end()) {
// Get full extent of any EQUIVALENCE block into size of COMMON
auto eqIter{equivalenceBlock_.find(symbol)};
if (eqIter != equivalenceBlock_.end()) {
SizeAndAlignment &blockInfo{eqIter->second};
DoEquivalenceBlockBase(symbol, blockInfo);
minSize = std::max(
minSize, std::max(offset_, symbol.offset() + blockInfo.size));
minAlignment = std::max(minAlignment, blockInfo.alignment);
}
} else {
SymbolAndOffset &dep{iter->second};
Symbol &base{*dep.symbol};
auto errorSite{
commonBlock.name().empty() ? symbol.name() : commonBlock.name()};
if (const auto *baseBlock{FindCommonBlockContaining(base)}) {
if (baseBlock == &commonBlock) {
context_.Say(errorSite,
"'%s' is storage associated with '%s' by EQUIVALENCE elsewhere in COMMON block /%s/"_err_en_US,
symbol.name(), base.name(), commonBlock.name());
} else { // 8.10.3(1)
context_.Say(errorSite,
"'%s' in COMMON block /%s/ must not be storage associated with '%s' in COMMON block /%s/ by EQUIVALENCE"_err_en_US,
symbol.name(), commonBlock.name(), base.name(),
baseBlock->name());
}
} else if (dep.offset > symbol.offset()) { // 8.10.3(3)
context_.Say(errorSite,
"'%s' cannot backward-extend COMMON block /%s/ via EQUIVALENCE with '%s'"_err_en_US,
symbol.name(), commonBlock.name(), base.name());
} else {
base.get<ObjectEntityDetails>().set_commonBlock(commonBlock);
base.set_offset(symbol.offset() - dep.offset);
}
}
}
commonBlock.set_size(std::max(minSize, offset_));
details.set_alignment(std::max(minAlignment, alignment_));
}
void ComputeOffsetsHelper::DoEquivalenceBlockBase(
Symbol &symbol, SizeAndAlignment &blockInfo) {
if (symbol.size() > blockInfo.size) {
blockInfo.size = symbol.size();
}
commonBlock.set_size(offset_);
details.set_alignment(alignment_);
}
void ComputeOffsetsHelper::DoEquivalenceSet(const EquivalenceSet &set) {

550
flang/lib/Semantics/data-to-inits.cpp Normal file
View File

@ -0,0 +1,550 @@
//===-- lib/Semantics/data-to-inits.cpp -----------------------------------===//
//
// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
// See https://llvm.org/LICENSE.txt for license information.
// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
//
//===----------------------------------------------------------------------===//
// DATA statement object/value checking and conversion to static
// initializers
// - Applies specific checks to each scalar element initialization with a
// constant value or pointer target with class DataInitializationCompiler;
// - Collects the elemental initializations for each symbol and converts them
// into a single init() expression with member function
// DataChecker::ConstructInitializer().
#include "data-to-inits.h"
#include "pointer-assignment.h"
#include "flang/Evaluate/fold-designator.h"
#include "flang/Semantics/tools.h"
namespace Fortran::semantics {
// 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);
// If the returned flag is true, emit a warning about CHARACTER misusage.
std::optional<std::pair<SomeExpr, bool>> ConvertElement(
const SomeExpr &, const evaluate::DynamicType &);
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();
}
std::optional<std::pair<SomeExpr, bool>>
DataInitializationCompiler::ConvertElement(
const SomeExpr &expr, const evaluate::DynamicType &type) {
if (auto converted{evaluate::ConvertToType(type, SomeExpr{expr})}) {
return {std::make_pair(std::move(*converted), false)};
}
if (std::optional<std::string> chValue{evaluate::GetScalarConstantValue<
evaluate::Type<TypeCategory::Character, 1>>(expr)}) {
// Allow DATA initialization with Hollerith and kind=1 CHARACTER like
// (most) other Fortran compilers do. Pad on the right with spaces
// when short, truncate the right if long.
// TODO: big-endian targets
std::size_t bytes{type.MeasureSizeInBytes().value()};
evaluate::BOZLiteralConstant bits{0};
for (std::size_t j{0}; j < bytes; ++j) {
char ch{j >= chValue->size() ? ' ' : chValue->at(j)};
evaluate::BOZLiteralConstant chBOZ{static_cast<unsigned char>(ch)};
bits = bits.IOR(chBOZ.SHIFTL(8 * j));
}
if (auto converted{evaluate::ConvertToType(type, SomeExpr{bits})}) {
return {std::make_pair(std::move(*converted), true)};
}
}
return std::nullopt;
}
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{ConvertElement(*expr, *designatorType)}) {
// 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());
} else if (converted->second) {
exprAnalyzer_.context().Say(
"DATA statement value initializes '%s' of type '%s' with CHARACTER"_en_US,
DescribeElement(), designatorType->AsFortran());
}
auto folded{evaluate::Fold(context, std::move(converted->first))};
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 AccumulateDataInitializations(DataInitializations &inits,
evaluate::ExpressionAnalyzer &exprAnalyzer,
const parser::DataStmtSet &set) {
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);
}
}
static bool CombineSomeEquivalencedInits(
DataInitializations &inits, evaluate::ExpressionAnalyzer &exprAnalyzer) {
auto end{inits.end()};
for (auto iter{inits.begin()}; iter != end; ++iter) {
const Symbol &symbol{*iter->first};
Scope &scope{const_cast<Scope &>(symbol.owner())};
if (scope.equivalenceSets().empty()) {
continue; // no problem to solve here
}
const auto *commonBlock{FindCommonBlockContaining(symbol)};
// Sweep following DATA initializations in search of overlapping
// objects, accumulating into a vector; iterate to a fixed point.
std::vector<const Symbol *> conflicts;
auto minStart{symbol.offset()};
auto maxEnd{symbol.offset() + symbol.size()};
std::size_t minElementBytes{1};
while (true) {
auto prevCount{conflicts.size()};
conflicts.clear();
for (auto scan{iter}; ++scan != end;) {
const Symbol &other{*scan->first};
const Scope &otherScope{other.owner()};
if (&otherScope == &scope &&
FindCommonBlockContaining(other) == commonBlock &&
maxEnd > other.offset() &&
other.offset() + other.size() > minStart) {
// "other" conflicts with "symbol" or another conflict
conflicts.push_back(&other);
minStart = std::min(minStart, other.offset());
maxEnd = std::max(maxEnd, other.offset() + other.size());
}
}
if (conflicts.size() == prevCount) {
break;
}
}
if (conflicts.empty()) {
continue;
}
// Compute the minimum common granularity
if (auto dyType{evaluate::DynamicType::From(symbol)}) {
minElementBytes = dyType->MeasureSizeInBytes().value_or(1);
}
for (const Symbol *s : conflicts) {
if (auto dyType{evaluate::DynamicType::From(*s)}) {
minElementBytes =
std::min(minElementBytes, dyType->MeasureSizeInBytes().value_or(1));
} else {
minElementBytes = 1;
}
}
CHECK(minElementBytes > 0);
CHECK((minElementBytes & (minElementBytes - 1)) == 0);
auto bytes{static_cast<common::ConstantSubscript>(maxEnd - minStart)};
CHECK(bytes % minElementBytes == 0);
const DeclTypeSpec &typeSpec{scope.MakeNumericType(
TypeCategory::Integer, KindExpr{minElementBytes})};
// Combine "symbol" and "conflicts[]" into a compiler array temp
// that overlaps all of them, and merge their initial values into
// the temp's initializer.
SourceName name{exprAnalyzer.context().GetTempName(scope)};
auto emplaced{
scope.try_emplace(name, Attrs{Attr::SAVE}, ObjectEntityDetails{})};
CHECK(emplaced.second);
Symbol &combinedSymbol{*emplaced.first->second};
auto &details{combinedSymbol.get<ObjectEntityDetails>()};
combinedSymbol.set_offset(minStart);
combinedSymbol.set_size(bytes);
details.set_type(typeSpec);
ArraySpec arraySpec;
arraySpec.emplace_back(ShapeSpec::MakeExplicit(Bound{
bytes / static_cast<common::ConstantSubscript>(minElementBytes)}));
details.set_shape(arraySpec);
if (commonBlock) {
details.set_commonBlock(*commonBlock);
}
// Merge these EQUIVALENCE'd DATA initializations, and remove the
// original initializations from the map.
auto combinedInit{
inits.emplace(&combinedSymbol, static_cast<std::size_t>(bytes))};
evaluate::InitialImage &combined{combinedInit.first->second.image};
combined.Incorporate(symbol.offset() - minStart, iter->second.image);
inits.erase(iter);
for (const Symbol *s : conflicts) {
auto sIter{inits.find(s)};
CHECK(sIter != inits.end());
combined.Incorporate(s->offset() - minStart, sIter->second.image);
inits.erase(sIter);
}
return true; // got one
}
return false; // no remaining EQUIVALENCE'd DATA initializations
}
// Converts the initialization image for all the DATA statement appearances of
// a single symbol into an init() expression in the symbol table entry.
void ConstructInitializer(const Symbol &symbol,
SymbolDataInitialization &initialization,
evaluate::ExpressionAnalyzer &exprAnalyzer) {
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 ConvertToInitializers(
DataInitializations &inits, evaluate::ExpressionAnalyzer &exprAnalyzer) {
while (CombineSomeEquivalencedInits(inits, exprAnalyzer)) {
}
for (auto &[symbolPtr, initialization] : inits) {
ConstructInitializer(*symbolPtr, initialization, exprAnalyzer);
}
}
} // namespace Fortran::semantics

46
flang/lib/Semantics/data-to-inits.h Normal file
View File

@ -0,0 +1,46 @@
//===-- lib/Semantics/data-to-inits.h -------------------------------------===//
//
// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
// See https://llvm.org/LICENSE.txt for license information.
// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
//
//===----------------------------------------------------------------------===//
#ifndef FORTRAN_SEMANTICS_DATA_TO_INITS_H_
#define FORTRAN_SEMANTICS_DATA_TO_INITS_H_
#include "flang/Common/default-kinds.h"
#include "flang/Common/interval.h"
#include "flang/Evaluate/initial-image.h"
#include <list>
#include <map>
namespace Fortran::parser {
struct DataStmtSet;
}
namespace Fortran::evaluate {
class ExpressionAnalyzer;
}
namespace Fortran::semantics {
class Symbol;
struct SymbolDataInitialization {
using Range = common::Interval<common::ConstantSubscript>;
explicit SymbolDataInitialization(std::size_t bytes) : image{bytes} {}
evaluate::InitialImage image;
std::list<Range> inits;
};
using DataInitializations = std::map<const Symbol *, SymbolDataInitialization>;
// Matches DATA statement variables with their values and checks
// compatibility.
void AccumulateDataInitializations(DataInitializations &,
evaluate::ExpressionAnalyzer &, const parser::DataStmtSet &);
void ConvertToInitializers(
DataInitializations &, evaluate::ExpressionAnalyzer &);
} // namespace Fortran::semantics
#endif // FORTRAN_SEMANTICS_DATA_TO_INITS_H_

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

@ -324,6 +324,18 @@ SymbolVector SemanticsContext::GetIndexVars(IndexVarKind kind) {
return result;
}
SourceName SemanticsContext::GetTempName(const Scope &scope) {
for (const auto &str : tempNames_) {
SourceName name{str};
if (scope.find(name) == scope.end()) {
return name;
}
}
tempNames_.emplace_back(".F18.");
tempNames_.back() += std::to_string(tempNames_.size());
return {tempNames_.back()};
}
bool Semantics::Perform() {
return ValidateLabels(context_, program_) &&
parser::CanonicalizeDo(program_) && // force line break

2
flang/lib/Semantics/type.cpp
View File

@ -439,7 +439,7 @@ llvm::raw_ostream &operator<<(llvm::raw_ostream &o, const DerivedTypeSpec &x) {
return o << x.AsFortran();
}
Bound::Bound(int bound) : expr_{bound} {}
Bound::Bound(common::ConstantSubscript bound) : expr_{bound} {}
llvm::raw_ostream &operator<<(llvm::raw_ostream &o, const Bound &x) {
if (x.isAssumed()) {

10
flang/test/Semantics/block-data01.f90
View File

@ -14,12 +14,20 @@ block data foo
!ERROR: An initialized variable in BLOCK DATA must be in a COMMON block
integer :: inDataButNotCommon
data inDataButNotCommon /1/
!ERROR: Two objects in the same EQUIVALENCE set may not be members of distinct COMMON blocks
integer :: inCommonA, inCommonB
!ERROR: 'incommona' in COMMON block /a/ must not be storage associated with 'incommonb' in COMMON block /b/ by EQUIVALENCE
common /a/ inCommonA, /b/ inCommonB
equivalence(inCommonA, inCommonB)
integer :: inCommonD, initialized ! ok
common /d/ inCommonD
equivalence(inCommonD, initialized)
data initialized /2/
integer :: inCommonE, jarr(2)
equivalence(inCommonE, jarr(2))
!ERROR: 'incommone' cannot backward-extend COMMON block /e/ via EQUIVALENCE with 'jarr'
common /e/ inCommonE
equivalence(inCommonF1, inCommonF2)
integer :: inCommonF1, inCommonF2
!ERROR: 'incommonf1' is storage associated with 'incommonf2' by EQUIVALENCE elsewhere in COMMON block /f/
common /f/ inCommonF1, inCommonF2
end block data

9
flang/test/Semantics/data09.f90 Normal file
View File

@ -0,0 +1,9 @@
! RUN: %f18 -fparse-only -fdebug-dump-symbols %s 2>&1 | FileCheck %s
! CHECK: init:[INTEGER(4)::1065353216_4,1073741824_4,1077936128_4,1082130432_4]
! Verify that the closure of EQUIVALENCE'd symbols with any DATA
! initialization produces a combined initializer.
real :: a(2), b(2), c(2)
equivalence(a(2),b(1)),(b(2),c(1))
data a(1)/1./,b(1)/2./,c/3.,4./
common /block/ a
end