forked from OSchip/llvm-project
[flang] Run-time derived type initialization and destruction
Use derived type information tables to drive default component initialization (when needed), component destruction, and calls to final subroutines. Perform these operations automatically for ALLOCATE()/DEALLOCATE() APIs for allocatables, automatics, and pointers. Add APIs for use in lowering to perform these operations for non-allocatable/automatic non-pointer variables. Data pointer component initialization supports arbitrary constant designators, a F'2008 feature, which may be a first for Fortran implementations. Differential Revision: https://reviews.llvm.org/D106297
This commit is contained in:
peter klausler
parent
40a02fae87
commit
a48e41683a
|
|
@ -223,3 +223,13 @@ accepted if enabled by command-line options.
|
|||
from `COS(3.14159)`, for example. f18 will complain when a
|
||||
generic intrinsic function's inferred result type does not
|
||||
match an explicit declaration. This message is a warning.
|
||||
|
||||
## Standard features that might as well not be
|
||||
|
||||
* f18 supports designators with constant expressions, properly
|
||||
constrained, as initial data targets for data pointers in
|
||||
initializers of variable and component declarations and in
|
||||
`DATA` statements; e.g., `REAL, POINTER :: P => T(1:10:2)`.
|
||||
This Fortran 2008 feature might as well be viewed like an
|
||||
extension; no other compiler that we've tested can handle
|
||||
it yet.
|
||||
|
|
|
|||
|
|
@ -113,6 +113,8 @@ bool IsStaticallyInitialized(const Symbol &, bool ignoreDATAstatements = false);
|
|||
// Is the symbol explicitly or implicitly initialized in any way?
|
||||
bool IsInitialized(const Symbol &, bool ignoreDATAstatements = false,
|
||||
const Symbol *derivedType = nullptr);
|
||||
// Is the symbol a component subject to deallocation or finalization?
|
||||
bool IsDestructible(const Symbol &, const Symbol *derivedType = nullptr);
|
||||
bool HasIntrinsicTypeName(const Symbol &);
|
||||
bool IsSeparateModuleProcedureInterface(const Symbol *);
|
||||
bool IsAutomatic(const Symbol &);
|
||||
|
|
|
|||
|
|
@ -257,6 +257,7 @@ public:
|
|||
bool MightBeParameterized() const;
|
||||
bool IsForwardReferenced() const;
|
||||
bool HasDefaultInitialization() const;
|
||||
bool HasDestruction() const;
|
||||
|
||||
// The "raw" type parameter list is a simple transcription from the
|
||||
// parameter list in the parse tree, built by calling AddRawParamValue().
|
||||
|
|
|
|||
|
|
@ -226,7 +226,7 @@ bool ContainsAnyImpliedDoIndex(const ExtentExpr &expr) {
|
|||
|
||||
// Determines lower bound on a dimension. This can be other than 1 only
|
||||
// for a reference to a whole array object or component. (See LBOUND, 16.9.109).
|
||||
// ASSOCIATE construct entities may require tranversal of their referents.
|
||||
// ASSOCIATE construct entities may require traversal of their referents.
|
||||
class GetLowerBoundHelper : public Traverse<GetLowerBoundHelper, ExtentExpr> {
|
||||
public:
|
||||
using Result = ExtentExpr;
|
||||
|
|
|
|||
|
|
@ -1107,10 +1107,12 @@ bool IsSaved(const Symbol &original) {
|
|||
return false; // ASSOCIATE(non-variable)
|
||||
} else if (scopeKind == Scope::Kind::Module) {
|
||||
return true; // BLOCK DATA entities must all be in COMMON, handled below
|
||||
} else if (symbol.attrs().test(Attr::SAVE)) {
|
||||
return true;
|
||||
} else if (scopeKind == Scope::Kind::DerivedType) {
|
||||
return false; // this is a component
|
||||
} else if (symbol.attrs().test(Attr::SAVE)) {
|
||||
return true;
|
||||
} else if (symbol.test(Symbol::Flag::InDataStmt)) {
|
||||
return true;
|
||||
} else if (IsNamedConstant(symbol)) {
|
||||
return false;
|
||||
} else if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()};
|
||||
|
|
|
|||
|
|
@ -329,12 +329,14 @@ void CheckHelper::Check(const Symbol &symbol) {
|
|||
messages_.Say(
|
||||
"A dummy argument may not also be a named constant"_err_en_US);
|
||||
}
|
||||
if (IsSaved(symbol)) {
|
||||
if (!symbol.test(Symbol::Flag::InDataStmt) /*caught elsewhere*/ &&
|
||||
IsSaved(symbol)) {
|
||||
messages_.Say(
|
||||
"A dummy argument may not have the SAVE attribute"_err_en_US);
|
||||
}
|
||||
} else if (IsFunctionResult(symbol)) {
|
||||
if (IsSaved(symbol)) {
|
||||
if (!symbol.test(Symbol::Flag::InDataStmt) /*caught elsewhere*/ &&
|
||||
IsSaved(symbol)) {
|
||||
messages_.Say(
|
||||
"A function result may not have the SAVE attribute"_err_en_US);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -304,13 +304,11 @@ auto ComputeOffsetsHelper::GetSizeAndAlignment(
|
|||
// of length type parameters).
|
||||
auto &foldingContext{context_.foldingContext()};
|
||||
if (IsDescriptor(symbol) || IsProcedurePointer(symbol)) {
|
||||
int lenParams{0};
|
||||
if (const auto *derived{evaluate::GetDerivedTypeSpec(
|
||||
evaluate::DynamicType::From(symbol))}) {
|
||||
lenParams = CountLenParameters(*derived);
|
||||
}
|
||||
std::size_t size{
|
||||
runtime::Descriptor::SizeInBytes(symbol.Rank(), false, lenParams)};
|
||||
const auto *derived{
|
||||
evaluate::GetDerivedTypeSpec(evaluate::DynamicType::From(symbol))};
|
||||
int lenParams{derived ? CountLenParameters(*derived) : 0};
|
||||
std::size_t size{runtime::Descriptor::SizeInBytes(
|
||||
symbol.Rank(), derived != nullptr, lenParams)};
|
||||
return {size, foldingContext.maxAlignment()};
|
||||
}
|
||||
if (IsProcedure(symbol)) {
|
||||
|
|
|
|||
|
|
@ -3986,6 +3986,9 @@ void DeclarationVisitor::Post(const parser::DerivedTypeSpec &x) {
|
|||
currScope().IsParameterizedDerivedType()) {
|
||||
// Defer instantiation; use the derived type's definition's scope.
|
||||
derived.set_scope(DEREF(spec->typeSymbol().scope()));
|
||||
} else if (&currScope() == spec->typeSymbol().scope()) {
|
||||
// Direct recursive use of a type in the definition of one of its
|
||||
// components: defer instantiation
|
||||
} else {
|
||||
auto restorer{
|
||||
GetFoldingContext().messages().SetLocation(currStmtSource().value())};
|
||||
|
|
|
|||
|
|
@ -38,7 +38,7 @@ static int FindLenParameterIndex(
|
|||
class RuntimeTableBuilder {
|
||||
public:
|
||||
RuntimeTableBuilder(SemanticsContext &, RuntimeDerivedTypeTables &);
|
||||
void DescribeTypes(Scope &scope);
|
||||
void DescribeTypes(Scope &scope, bool inSchemata);
|
||||
|
||||
private:
|
||||
const Symbol *DescribeType(Scope &);
|
||||
|
|
@ -58,6 +58,9 @@ private:
|
|||
const std::string &distinctName, const SymbolVector *parameters);
|
||||
evaluate::StructureConstructor DescribeComponent(
|
||||
const Symbol &, const ProcEntityDetails &, Scope &);
|
||||
bool InitializeDataPointer(evaluate::StructureConstructorValues &,
|
||||
const Symbol &symbol, const ObjectEntityDetails &object, Scope &scope,
|
||||
Scope &dtScope, const std::string &distinctName);
|
||||
evaluate::StructureConstructor PackageIntValue(
|
||||
const SomeExpr &genre, std::int64_t = 0) const;
|
||||
SomeExpr PackageIntValueExpr(const SomeExpr &genre, std::int64_t = 0) const;
|
||||
|
|
@ -132,6 +135,7 @@ private:
|
|||
SomeExpr writeFormattedEnum_; // SpecialBinding::Which::WriteFormatted
|
||||
SomeExpr writeUnformattedEnum_; // SpecialBinding::Which::WriteUnformatted
|
||||
parser::CharBlock location_;
|
||||
std::set<const Scope *> ignoreScopes_;
|
||||
};
|
||||
|
||||
RuntimeTableBuilder::RuntimeTableBuilder(
|
||||
|
|
@ -152,18 +156,21 @@ RuntimeTableBuilder::RuntimeTableBuilder(
|
|||
readFormattedEnum_{GetEnumValue("readformatted")},
|
||||
readUnformattedEnum_{GetEnumValue("readunformatted")},
|
||||
writeFormattedEnum_{GetEnumValue("writeformatted")},
|
||||
writeUnformattedEnum_{GetEnumValue("writeunformatted")} {}
|
||||
writeUnformattedEnum_{GetEnumValue("writeunformatted")} {
|
||||
ignoreScopes_.insert(tables_.schemata);
|
||||
}
|
||||
|
||||
void RuntimeTableBuilder::DescribeTypes(Scope &scope) {
|
||||
if (&scope == tables_.schemata) {
|
||||
return; // don't loop trying to describe a schema...
|
||||
}
|
||||
void RuntimeTableBuilder::DescribeTypes(Scope &scope, bool inSchemata) {
|
||||
inSchemata |= ignoreScopes_.find(&scope) != ignoreScopes_.end();
|
||||
if (scope.IsDerivedType()) {
|
||||
DescribeType(scope);
|
||||
} else {
|
||||
for (Scope &child : scope.children()) {
|
||||
DescribeTypes(child);
|
||||
if (!inSchemata) { // don't loop trying to describe a schema
|
||||
DescribeType(scope);
|
||||
}
|
||||
} else {
|
||||
scope.InstantiateDerivedTypes();
|
||||
}
|
||||
for (Scope &child : scope.children()) {
|
||||
DescribeTypes(child, inSchemata);
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -314,11 +321,29 @@ static SomeExpr SaveObjectInit(
|
|||
evaluate::Designator<evaluate::SomeDerived>{symbol});
|
||||
}
|
||||
|
||||
template <int KIND> static SomeExpr IntExpr(std::int64_t n) {
|
||||
return evaluate::AsGenericExpr(
|
||||
evaluate::Constant<evaluate::Type<TypeCategory::Integer, KIND>>{n});
|
||||
}
|
||||
|
||||
const Symbol *RuntimeTableBuilder::DescribeType(Scope &dtScope) {
|
||||
if (const Symbol * info{dtScope.runtimeDerivedTypeDescription()}) {
|
||||
return info;
|
||||
}
|
||||
const DerivedTypeSpec *derivedTypeSpec{dtScope.derivedTypeSpec()};
|
||||
if (!derivedTypeSpec && !dtScope.IsParameterizedDerivedType() &&
|
||||
dtScope.symbol()) {
|
||||
// This derived type was declared (obviously, there's a Scope) but never
|
||||
// used in this compilation (no instantiated DerivedTypeSpec points here).
|
||||
// Create a DerivedTypeSpec now for it so that ComponentIterator
|
||||
// will work. This covers the case of a derived type that's declared in
|
||||
// a module but used only by clients and submodules, enabling the
|
||||
// run-time "no initialization needed here" flag to work.
|
||||
DerivedTypeSpec derived{dtScope.symbol()->name(), *dtScope.symbol()};
|
||||
DeclTypeSpec &decl{
|
||||
dtScope.MakeDerivedType(DeclTypeSpec::TypeDerived, std::move(derived))};
|
||||
derivedTypeSpec = &decl.derivedTypeSpec();
|
||||
}
|
||||
const Symbol *dtSymbol{
|
||||
derivedTypeSpec ? &derivedTypeSpec->typeSymbol() : dtScope.symbol()};
|
||||
if (!dtSymbol) {
|
||||
|
|
@ -361,18 +386,6 @@ const Symbol *RuntimeTableBuilder::DescribeType(Scope &dtScope) {
|
|||
AddValue(
|
||||
dtValues, derivedTypeSchema_, "sizeinbytes"s, IntToExpr(sizeInBytes));
|
||||
}
|
||||
const Symbol *parentDescObject{nullptr};
|
||||
if (const Scope * parentScope{dtScope.GetDerivedTypeParent()}) {
|
||||
parentDescObject = DescribeType(*const_cast<Scope *>(parentScope));
|
||||
}
|
||||
if (parentDescObject) {
|
||||
AddValue(dtValues, derivedTypeSchema_, "parent"s,
|
||||
evaluate::AsGenericExpr(evaluate::Expr<evaluate::SomeDerived>{
|
||||
evaluate::Designator<evaluate::SomeDerived>{*parentDescObject}}));
|
||||
} else {
|
||||
AddValue(dtValues, derivedTypeSchema_, "parent"s,
|
||||
SomeExpr{evaluate::NullPointer{}});
|
||||
}
|
||||
bool isPDTinstantiation{derivedTypeSpec && &dtScope != dtSymbol->scope()};
|
||||
if (isPDTinstantiation) {
|
||||
// is PDT instantiation
|
||||
|
|
@ -518,6 +531,18 @@ const Symbol *RuntimeTableBuilder::DescribeType(Scope &dtScope) {
|
|||
std::move(specials),
|
||||
evaluate::ConstantSubscripts{
|
||||
static_cast<evaluate::ConstantSubscript>(specials.size())}));
|
||||
// Note the presence/absence of a parent component
|
||||
AddValue(dtValues, derivedTypeSchema_, "hasparent"s,
|
||||
IntExpr<1>(dtScope.GetDerivedTypeParent() != nullptr));
|
||||
// To avoid wasting run time attempting to initialize derived type
|
||||
// instances without any initialized components, analyze the type
|
||||
// and set a flag if there's nothing to do for it at run time.
|
||||
AddValue(dtValues, derivedTypeSchema_, "noinitializationneeded"s,
|
||||
IntExpr<1>(
|
||||
derivedTypeSpec && !derivedTypeSpec->HasDefaultInitialization()));
|
||||
// Similarly, a flag to short-circuit destruction when not needed.
|
||||
AddValue(dtValues, derivedTypeSchema_, "nodestructionneeded"s,
|
||||
IntExpr<1>(derivedTypeSpec && !derivedTypeSpec->HasDestruction()));
|
||||
}
|
||||
dtObject.get<ObjectEntityDetails>().set_init(MaybeExpr{
|
||||
StructureExpr(Structure(derivedTypeSchema_, std::move(dtValues)))});
|
||||
|
|
@ -563,11 +588,6 @@ const DeclTypeSpec &RuntimeTableBuilder::GetSchema(
|
|||
return *spec;
|
||||
}
|
||||
|
||||
template <int KIND> static SomeExpr IntExpr(std::int64_t n) {
|
||||
return evaluate::AsGenericExpr(
|
||||
evaluate::Constant<evaluate::Type<TypeCategory::Integer, KIND>>{n});
|
||||
}
|
||||
|
||||
SomeExpr RuntimeTableBuilder::GetEnumValue(const char *name) const {
|
||||
const Symbol &symbol{GetSchemaSymbol(name)};
|
||||
auto value{evaluate::ToInt64(symbol.get<ObjectEntityDetails>().init())};
|
||||
|
|
@ -723,11 +743,8 @@ evaluate::StructureConstructor RuntimeTableBuilder::DescribeComponent(
|
|||
AddValue(values, componentSchema_, "genre"s, GetEnumValue("allocatable"));
|
||||
} else if (IsPointer(symbol)) {
|
||||
AddValue(values, componentSchema_, "genre"s, GetEnumValue("pointer"));
|
||||
hasDataInit = object.init().has_value();
|
||||
if (hasDataInit) {
|
||||
AddValue(values, componentSchema_, "initialization"s,
|
||||
SomeExpr{*object.init()});
|
||||
}
|
||||
hasDataInit = InitializeDataPointer(
|
||||
values, symbol, object, scope, dtScope, distinctName);
|
||||
} else if (IsAutomaticObject(symbol)) {
|
||||
AddValue(values, componentSchema_, "genre"s, GetEnumValue("automatic"));
|
||||
} else {
|
||||
|
|
@ -764,6 +781,70 @@ evaluate::StructureConstructor RuntimeTableBuilder::DescribeComponent(
|
|||
return {DEREF(procPtrSchema_.AsDerived()), std::move(values)};
|
||||
}
|
||||
|
||||
// Create a static pointer object with the same initialization
|
||||
// from whence the runtime can memcpy() the data pointer
|
||||
// component initialization.
|
||||
// Creates and interconnects the symbols, scopes, and types for
|
||||
// TYPE :: ptrDt
|
||||
// type, POINTER :: name
|
||||
// END TYPE
|
||||
// TYPE(ptrDt), TARGET, SAVE :: ptrInit = ptrDt(designator)
|
||||
// and then initializes the original component by setting
|
||||
// initialization = ptrInit
|
||||
// which takes the address of ptrInit because the type is C_PTR.
|
||||
// This technique of wrapping the data pointer component into
|
||||
// a derived type instance disables any reason for lowering to
|
||||
// attempt to dereference the RHS of an initializer, thereby
|
||||
// allowing the runtime to actually perform the initialization
|
||||
// by means of a simple memcpy() of the wrapped descriptor in
|
||||
// ptrInit to the data pointer component being initialized.
|
||||
bool RuntimeTableBuilder::InitializeDataPointer(
|
||||
evaluate::StructureConstructorValues &values, const Symbol &symbol,
|
||||
const ObjectEntityDetails &object, Scope &scope, Scope &dtScope,
|
||||
const std::string &distinctName) {
|
||||
if (object.init().has_value()) {
|
||||
SourceName ptrDtName{SaveObjectName(
|
||||
".dp."s + distinctName + "."s + symbol.name().ToString())};
|
||||
Symbol &ptrDtSym{
|
||||
*scope.try_emplace(ptrDtName, Attrs{}, UnknownDetails{}).first->second};
|
||||
Scope &ptrDtScope{scope.MakeScope(Scope::Kind::DerivedType, &ptrDtSym)};
|
||||
ignoreScopes_.insert(&ptrDtScope);
|
||||
ObjectEntityDetails ptrDtObj;
|
||||
ptrDtObj.set_type(DEREF(object.type()));
|
||||
ptrDtObj.set_shape(object.shape());
|
||||
Symbol &ptrDtComp{*ptrDtScope
|
||||
.try_emplace(symbol.name(), Attrs{Attr::POINTER},
|
||||
std::move(ptrDtObj))
|
||||
.first->second};
|
||||
DerivedTypeDetails ptrDtDetails;
|
||||
ptrDtDetails.add_component(ptrDtComp);
|
||||
ptrDtSym.set_details(std::move(ptrDtDetails));
|
||||
ptrDtSym.set_scope(&ptrDtScope);
|
||||
DeclTypeSpec &ptrDtDeclType{
|
||||
scope.MakeDerivedType(DeclTypeSpec::Category::TypeDerived,
|
||||
DerivedTypeSpec{ptrDtName, ptrDtSym})};
|
||||
DerivedTypeSpec &ptrDtDerived{DEREF(ptrDtDeclType.AsDerived())};
|
||||
ptrDtDerived.set_scope(ptrDtScope);
|
||||
ptrDtDerived.CookParameters(context_.foldingContext());
|
||||
ptrDtDerived.Instantiate(scope);
|
||||
ObjectEntityDetails ptrInitObj;
|
||||
ptrInitObj.set_type(ptrDtDeclType);
|
||||
evaluate::StructureConstructorValues ptrInitValues;
|
||||
AddValue(
|
||||
ptrInitValues, ptrDtDeclType, symbol.name().ToString(), *object.init());
|
||||
ptrInitObj.set_init(evaluate::AsGenericExpr(
|
||||
Structure(ptrDtDeclType, std::move(ptrInitValues))));
|
||||
AddValue(values, componentSchema_, "initialization"s,
|
||||
SaveObjectInit(scope,
|
||||
SaveObjectName(
|
||||
".di."s + distinctName + "."s + symbol.name().ToString()),
|
||||
ptrInitObj));
|
||||
return true;
|
||||
} else {
|
||||
return false;
|
||||
}
|
||||
}
|
||||
|
||||
evaluate::StructureConstructor RuntimeTableBuilder::PackageIntValue(
|
||||
const SomeExpr &genre, std::int64_t n) const {
|
||||
evaluate::StructureConstructorValues xs;
|
||||
|
|
@ -961,7 +1042,7 @@ RuntimeDerivedTypeTables BuildRuntimeDerivedTypeTables(
|
|||
result.schemata = reader.Read(schemataModule);
|
||||
if (result.schemata) {
|
||||
RuntimeTableBuilder builder{context, result};
|
||||
builder.DescribeTypes(context.globalScope());
|
||||
builder.DescribeTypes(context.globalScope(), false);
|
||||
}
|
||||
return result;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -602,6 +602,23 @@ bool IsInitialized(const Symbol &symbol, bool ignoreDATAstatements,
|
|||
return false;
|
||||
}
|
||||
|
||||
bool IsDestructible(const Symbol &symbol, const Symbol *derivedTypeSymbol) {
|
||||
if (IsAllocatable(symbol) || IsAutomatic(symbol)) {
|
||||
return true;
|
||||
} else if (IsNamedConstant(symbol) || IsFunctionResult(symbol) ||
|
||||
IsPointer(symbol)) {
|
||||
return false;
|
||||
} else if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
|
||||
if (!object->isDummy() && object->type()) {
|
||||
if (const auto *derived{object->type()->AsDerived()}) {
|
||||
return &derived->typeSymbol() != derivedTypeSymbol &&
|
||||
derived->HasDestruction();
|
||||
}
|
||||
}
|
||||
}
|
||||
return false;
|
||||
}
|
||||
|
||||
bool HasIntrinsicTypeName(const Symbol &symbol) {
|
||||
std::string name{symbol.name().ToString()};
|
||||
if (name == "doubleprecision") {
|
||||
|
|
|
|||
|
|
@ -185,6 +185,17 @@ bool DerivedTypeSpec::HasDefaultInitialization() const {
|
|||
})};
|
||||
}
|
||||
|
||||
bool DerivedTypeSpec::HasDestruction() const {
|
||||
if (!typeSymbol().get<DerivedTypeDetails>().finals().empty()) {
|
||||
return true;
|
||||
}
|
||||
DirectComponentIterator components{*this};
|
||||
return bool{std::find_if(
|
||||
components.begin(), components.end(), [&](const Symbol &component) {
|
||||
return IsDestructible(component, &typeSymbol());
|
||||
})};
|
||||
}
|
||||
|
||||
ParamValue *DerivedTypeSpec::FindParameter(SourceName target) {
|
||||
return const_cast<ParamValue *>(
|
||||
const_cast<const DerivedTypeSpec *>(this)->FindParameter(target));
|
||||
|
|
@ -233,6 +244,34 @@ static int PlumbPDTInstantiationDepth(const Scope *scope) {
|
|||
return depth;
|
||||
}
|
||||
|
||||
// Completes component derived type instantiation and initializer folding
|
||||
// for a non-parameterized derived type Scope.
|
||||
static void InstantiateNonPDTScope(Scope &typeScope, Scope &containingScope) {
|
||||
auto &context{containingScope.context()};
|
||||
auto &foldingContext{context.foldingContext()};
|
||||
for (auto &pair : typeScope) {
|
||||
Symbol &symbol{*pair.second};
|
||||
if (DeclTypeSpec * type{symbol.GetType()}) {
|
||||
if (DerivedTypeSpec * derived{type->AsDerived()}) {
|
||||
if (!(derived->IsForwardReferenced() &&
|
||||
IsAllocatableOrPointer(symbol))) {
|
||||
derived->Instantiate(containingScope);
|
||||
}
|
||||
}
|
||||
}
|
||||
if (!IsPointer(symbol)) {
|
||||
if (auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
|
||||
if (MaybeExpr & init{object->init()}) {
|
||||
auto restorer{foldingContext.messages().SetLocation(symbol.name())};
|
||||
init = evaluate::NonPointerInitializationExpr(
|
||||
symbol, std::move(*init), foldingContext);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
ComputeOffsets(context, typeScope);
|
||||
}
|
||||
|
||||
void DerivedTypeSpec::Instantiate(Scope &containingScope) {
|
||||
if (instantiated_) {
|
||||
return;
|
||||
|
|
@ -251,27 +290,13 @@ void DerivedTypeSpec::Instantiate(Scope &containingScope) {
|
|||
const Scope &typeScope{DEREF(typeSymbol_.scope())};
|
||||
if (!MightBeParameterized()) {
|
||||
scope_ = &typeScope;
|
||||
for (auto &pair : typeScope) {
|
||||
Symbol &symbol{*pair.second};
|
||||
if (DeclTypeSpec * type{symbol.GetType()}) {
|
||||
if (DerivedTypeSpec * derived{type->AsDerived()}) {
|
||||
if (!(derived->IsForwardReferenced() &&
|
||||
IsAllocatableOrPointer(symbol))) {
|
||||
derived->Instantiate(containingScope);
|
||||
}
|
||||
}
|
||||
}
|
||||
if (!IsPointer(symbol)) {
|
||||
if (auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
|
||||
if (MaybeExpr & init{object->init()}) {
|
||||
auto restorer{foldingContext.messages().SetLocation(symbol.name())};
|
||||
init = evaluate::NonPointerInitializationExpr(
|
||||
symbol, std::move(*init), foldingContext);
|
||||
}
|
||||
}
|
||||
}
|
||||
if (typeScope.derivedTypeSpec()) {
|
||||
CHECK(*this == *typeScope.derivedTypeSpec());
|
||||
} else {
|
||||
Scope &mutableTypeScope{const_cast<Scope &>(typeScope)};
|
||||
mutableTypeScope.set_derivedTypeSpec(*this);
|
||||
InstantiateNonPDTScope(mutableTypeScope, containingScope);
|
||||
}
|
||||
ComputeOffsets(context, const_cast<Scope &>(typeScope));
|
||||
return;
|
||||
}
|
||||
// New PDT instantiation. Create a new scope and populate it
|
||||
|
|
|
|||
|
|
@ -33,19 +33,22 @@ module __Fortran_type_info
|
|||
type(Binding), pointer, contiguous :: binding(:)
|
||||
character(len=:), pointer :: name
|
||||
integer(kind=int64) :: sizeInBytes
|
||||
type(DerivedType), pointer :: parent
|
||||
! Instances of parameterized derived types use the "uninstantiated"
|
||||
! component to point to the pristine original definition.
|
||||
type(DerivedType), pointer :: uninstantiated
|
||||
integer(kind=int64) :: typeHash
|
||||
integer(kind=int64), pointer, contiguous :: kindParameter(:) ! values of instance
|
||||
integer(1), pointer, contiguous :: lenParameterKind(:) ! INTEGER kinds of LEN types
|
||||
! Data components appear in alphabetic order.
|
||||
! The parent component, if any, appears explicitly.
|
||||
! Data components appear in component order.
|
||||
! The parent component, if any, appears explicitly and first.
|
||||
type(Component), pointer, contiguous :: component(:) ! data components
|
||||
type(ProcPtrComponent), pointer, contiguous :: procptr(:) ! procedure pointers
|
||||
! Special bindings of the ancestral types are not duplicated here.
|
||||
type(SpecialBinding), pointer, contiguous :: special(:)
|
||||
integer(1) :: hasParent
|
||||
integer(1) :: noInitializationNeeded ! 1 if no component w/ init
|
||||
integer(1) :: noDestructionNeeded ! 1 if no component w/ dealloc/final
|
||||
integer(1) :: __padding0(5)
|
||||
end type
|
||||
|
||||
type :: Binding
|
||||
|
|
|
|||
|
|
@ -39,6 +39,7 @@ add_flang_library(FortranRuntime
|
|||
character.cpp
|
||||
connection.cpp
|
||||
derived.cpp
|
||||
derived-api.cpp
|
||||
descriptor.cpp
|
||||
descriptor-io.cpp
|
||||
dot-product.cpp
|
||||
|
|
|
|||
|
|
@ -7,8 +7,10 @@
|
|||
//===----------------------------------------------------------------------===//
|
||||
|
||||
#include "allocatable.h"
|
||||
#include "derived.h"
|
||||
#include "stat.h"
|
||||
#include "terminator.h"
|
||||
#include "type-info.h"
|
||||
|
||||
namespace Fortran::runtime {
|
||||
extern "C" {
|
||||
|
|
@ -36,13 +38,13 @@ void RTNAME(AllocatableInitDerived)(Descriptor &descriptor,
|
|||
}
|
||||
|
||||
void RTNAME(AllocatableAssign)(Descriptor &to, const Descriptor & /*from*/) {
|
||||
INTERNAL_CHECK(false); // AllocatableAssign is not yet implemented
|
||||
INTERNAL_CHECK(false); // TODO: AllocatableAssign is not yet implemented
|
||||
}
|
||||
|
||||
int RTNAME(MoveAlloc)(Descriptor &to, const Descriptor & /*from*/,
|
||||
bool /*hasStat*/, const Descriptor * /*errMsg*/,
|
||||
const char * /*sourceFile*/, int /*sourceLine*/) {
|
||||
INTERNAL_CHECK(false); // MoveAlloc is not yet implemented
|
||||
INTERNAL_CHECK(false); // TODO: MoveAlloc is not yet implemented
|
||||
return StatOk;
|
||||
}
|
||||
|
||||
|
|
@ -76,8 +78,17 @@ int RTNAME(AllocatableAllocate)(Descriptor &descriptor, bool hasStat,
|
|||
if (descriptor.IsAllocated()) {
|
||||
return ReturnError(terminator, StatBaseNotNull, errMsg, hasStat);
|
||||
}
|
||||
return ReturnError(terminator, descriptor.Allocate(), errMsg, hasStat);
|
||||
// TODO: default component initialization
|
||||
int stat{ReturnError(terminator, descriptor.Allocate(), errMsg, hasStat)};
|
||||
if (stat == StatOk) {
|
||||
if (const DescriptorAddendum * addendum{descriptor.Addendum()}) {
|
||||
if (const auto *derived{addendum->derivedType()}) {
|
||||
if (!derived->noInitializationNeeded()) {
|
||||
stat = Initialize(descriptor, *derived, terminator, hasStat, errMsg);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
return stat;
|
||||
}
|
||||
|
||||
int RTNAME(AllocatableDeallocate)(Descriptor &descriptor, bool hasStat,
|
||||
|
|
@ -89,7 +100,19 @@ int RTNAME(AllocatableDeallocate)(Descriptor &descriptor, bool hasStat,
|
|||
if (!descriptor.IsAllocated()) {
|
||||
return ReturnError(terminator, StatBaseNull, errMsg, hasStat);
|
||||
}
|
||||
return ReturnError(terminator, descriptor.Deallocate(), errMsg, hasStat);
|
||||
return ReturnError(terminator, descriptor.Destroy(true), errMsg, hasStat);
|
||||
}
|
||||
|
||||
void RTNAME(AllocatableDeallocateNoFinal)(
|
||||
Descriptor &descriptor, const char *sourceFile, int sourceLine) {
|
||||
Terminator terminator{sourceFile, sourceLine};
|
||||
if (!descriptor.IsAllocatable()) {
|
||||
ReturnError(terminator, StatInvalidDescriptor);
|
||||
} else if (!descriptor.IsAllocated()) {
|
||||
ReturnError(terminator, StatBaseNull);
|
||||
} else {
|
||||
ReturnError(terminator, descriptor.Destroy(false));
|
||||
}
|
||||
}
|
||||
|
||||
// TODO: AllocatableCheckLengthParameter, AllocatableAllocateSource
|
||||
|
|
|
|||
|
|
@ -112,6 +112,10 @@ int RTNAME(MoveAlloc)(Descriptor &to, const Descriptor &from,
|
|||
int RTNAME(AllocatableDeallocate)(Descriptor &, bool hasStat = false,
|
||||
const Descriptor *errMsg = nullptr, const char *sourceFile = nullptr,
|
||||
int sourceLine = 0);
|
||||
}
|
||||
|
||||
// Variant of above that does not finalize; for intermediate results
|
||||
void RTNAME(AllocatableDeallocateNoFinal)(
|
||||
Descriptor &, const char *sourceFile = nullptr, int sourceLine = 0);
|
||||
} // extern "C"
|
||||
} // namespace Fortran::runtime
|
||||
#endif // FORTRAN_RUNTIME_ALLOCATABLE_H_
|
||||
|
|
|
|||
|
|
@ -0,0 +1,45 @@
|
|||
//===-- runtime/derived-api.cpp
|
||||
//-----------------------------------------------===//
|
||||
//
|
||||
// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
|
||||
// See https://llvm.org/LICENSE.txt for license information.
|
||||
// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
|
||||
//
|
||||
//===----------------------------------------------------------------------===//
|
||||
|
||||
#include "derived-api.h"
|
||||
#include "derived.h"
|
||||
#include "descriptor.h"
|
||||
#include "terminator.h"
|
||||
#include "type-info.h"
|
||||
|
||||
namespace Fortran::runtime {
|
||||
|
||||
extern "C" {
|
||||
|
||||
void RTNAME(Initialize)(
|
||||
const Descriptor &descriptor, const char *sourceFile, int sourceLine) {
|
||||
if (const DescriptorAddendum * addendum{descriptor.Addendum()}) {
|
||||
if (const auto *derived{addendum->derivedType()}) {
|
||||
if (!derived->noInitializationNeeded()) {
|
||||
Terminator terminator{sourceFile, sourceLine};
|
||||
Initialize(descriptor, *derived, terminator);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
void RTNAME(Destroy)(const Descriptor &descriptor) {
|
||||
if (const DescriptorAddendum * addendum{descriptor.Addendum()}) {
|
||||
if (const auto *derived{addendum->derivedType()}) {
|
||||
if (!derived->noDestructionNeeded()) {
|
||||
Destroy(descriptor, true, *derived);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
// TODO: Assign()
|
||||
|
||||
} // extern "C"
|
||||
} // namespace Fortran::runtime
|
||||
|
|
@ -0,0 +1,43 @@
|
|||
//===-- runtime/derived-api.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
|
||||
//
|
||||
//===----------------------------------------------------------------------===//
|
||||
|
||||
// API for lowering to use for operations on derived type objects.
|
||||
// Initialiaztion and finalization are implied for pointer and allocatable
|
||||
// ALLOCATE()/DEALLOCATE() respectively, so these APIs should be used only for
|
||||
// local variables. Whole allocatable assignment should use AllocatableAssign()
|
||||
// instead of this Assign().
|
||||
|
||||
#ifndef FLANG_RUNTIME_DERIVED_API_H_
|
||||
#define FLANG_RUNTIME_DERIVED_API_H_
|
||||
|
||||
#include "entry-names.h"
|
||||
|
||||
namespace Fortran::runtime {
|
||||
class Descriptor;
|
||||
|
||||
extern "C" {
|
||||
|
||||
// Initializes and allocates an object's components, if it has a derived type
|
||||
// with any default component initialization or automatic components.
|
||||
// The descriptor must be initialized and non-null.
|
||||
void RTNAME(Initialize)(
|
||||
const Descriptor &, const char *sourceFile = nullptr, int sourceLine = 0);
|
||||
|
||||
// Finalizes an object and its components. Deallocates any
|
||||
// allocatable/automatic components. Does not deallocate the descriptor's
|
||||
// storage.
|
||||
void RTNAME(Destroy)(const Descriptor &);
|
||||
|
||||
// Intrinsic or defined assignment, with scalar expansion but not type
|
||||
// conversion.
|
||||
void RTNAME(Assign)(const Descriptor &, const Descriptor &,
|
||||
const char *sourceFile = nullptr, int sourceLine = 0);
|
||||
|
||||
} // extern "C"
|
||||
} // namespace Fortran::runtime
|
||||
#endif // FLANG_RUNTIME_DERIVED_API_H_
|
||||
|
|
@ -8,10 +8,91 @@
|
|||
|
||||
#include "derived.h"
|
||||
#include "descriptor.h"
|
||||
#include "stat.h"
|
||||
#include "terminator.h"
|
||||
#include "type-info.h"
|
||||
|
||||
namespace Fortran::runtime {
|
||||
|
||||
int Initialize(const Descriptor &instance, const typeInfo::DerivedType &derived,
|
||||
Terminator &terminator, bool hasStat, const Descriptor *errMsg) {
|
||||
const Descriptor &componentDesc{derived.component()};
|
||||
std::size_t elements{instance.Elements()};
|
||||
std::size_t byteStride{instance.ElementBytes()};
|
||||
int stat{StatOk};
|
||||
// Initialize data components in each element; the per-element iteration
|
||||
// constitutes the inner loops, not outer
|
||||
std::size_t myComponents{componentDesc.Elements()};
|
||||
for (std::size_t k{0}; k < myComponents; ++k) {
|
||||
const auto &comp{
|
||||
*componentDesc.ZeroBasedIndexedElement<typeInfo::Component>(k)};
|
||||
if (comp.genre() == typeInfo::Component::Genre::Allocatable ||
|
||||
comp.genre() == typeInfo::Component::Genre::Automatic) {
|
||||
for (std::size_t j{0}; j < elements; ++j) {
|
||||
Descriptor &allocDesc{*instance.OffsetElement<Descriptor>(
|
||||
j * byteStride + comp.offset())};
|
||||
comp.EstablishDescriptor(allocDesc, instance, terminator);
|
||||
allocDesc.raw().attribute = CFI_attribute_allocatable;
|
||||
if (comp.genre() == typeInfo::Component::Genre::Automatic) {
|
||||
stat = ReturnError(terminator, allocDesc.Allocate(), errMsg, hasStat);
|
||||
if (stat == StatOk) {
|
||||
stat = Initialize(allocDesc, derived, terminator, hasStat, errMsg);
|
||||
}
|
||||
if (stat != StatOk) {
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
} else if (const void *init{comp.initialization()}) {
|
||||
// Explicit initialization of data pointers and
|
||||
// non-allocatable non-automatic components
|
||||
std::size_t bytes{comp.SizeInBytes(instance)};
|
||||
for (std::size_t j{0}; j < elements; ++j) {
|
||||
char *ptr{instance.OffsetElement<char>(j * byteStride + comp.offset())};
|
||||
std::memcpy(ptr, init, bytes);
|
||||
}
|
||||
} else if (comp.genre() == typeInfo::Component::Genre::Data &&
|
||||
comp.derivedType() && !comp.derivedType()->noInitializationNeeded()) {
|
||||
// Default initialization of non-pointer non-allocatable/automatic
|
||||
// data component. Handles parent component's elements. Recursive.
|
||||
SubscriptValue extent[maxRank];
|
||||
const typeInfo::Value *bounds{comp.bounds()};
|
||||
for (int dim{0}; dim < comp.rank(); ++dim) {
|
||||
typeInfo::TypeParameterValue lb{
|
||||
bounds[2 * dim].GetValue(&instance).value_or(0)};
|
||||
typeInfo::TypeParameterValue ub{
|
||||
bounds[2 * dim + 1].GetValue(&instance).value_or(0)};
|
||||
extent[dim] = ub >= lb ? ub - lb + 1 : 0;
|
||||
}
|
||||
StaticDescriptor<maxRank, true, 0> staticDescriptor;
|
||||
Descriptor &compDesc{staticDescriptor.descriptor()};
|
||||
const typeInfo::DerivedType &compType{*comp.derivedType()};
|
||||
for (std::size_t j{0}; j < elements; ++j) {
|
||||
compDesc.Establish(compType,
|
||||
instance.OffsetElement<char>(j * byteStride + comp.offset()),
|
||||
comp.rank(), extent);
|
||||
stat = Initialize(compDesc, compType, terminator, hasStat, errMsg);
|
||||
if (stat != StatOk) {
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
// Initialize procedure pointer components in each element
|
||||
const Descriptor &procPtrDesc{derived.procPtr()};
|
||||
std::size_t myProcPtrs{procPtrDesc.Elements()};
|
||||
for (std::size_t k{0}; k < myProcPtrs; ++k) {
|
||||
const auto &comp{
|
||||
*procPtrDesc.ZeroBasedIndexedElement<typeInfo::ProcPtrComponent>(k)};
|
||||
for (std::size_t j{0}; j < elements; ++j) {
|
||||
auto &pptr{*instance.OffsetElement<typeInfo::ProcedurePointer>(
|
||||
j * byteStride + comp.offset)};
|
||||
pptr = comp.procInitialization;
|
||||
}
|
||||
}
|
||||
return stat;
|
||||
}
|
||||
|
||||
static const typeInfo::SpecialBinding *FindFinal(
|
||||
const typeInfo::DerivedType &derived, int rank) {
|
||||
const typeInfo::SpecialBinding *elemental{nullptr};
|
||||
|
|
@ -40,19 +121,38 @@ static const typeInfo::SpecialBinding *FindFinal(
|
|||
static void CallFinalSubroutine(
|
||||
const Descriptor &descriptor, const typeInfo::DerivedType &derived) {
|
||||
if (const auto *special{FindFinal(derived, descriptor.rank())}) {
|
||||
// The following code relies on the fact that finalizable objects
|
||||
// must be contiguous.
|
||||
if (special->which() == typeInfo::SpecialBinding::Which::ElementalFinal) {
|
||||
std::size_t byteStride{descriptor.ElementBytes()};
|
||||
auto *p{special->GetProc<void (*)(char *)>()};
|
||||
// Finalizable objects must be contiguous.
|
||||
std::size_t elements{descriptor.Elements()};
|
||||
for (std::size_t j{0}; j < elements; ++j) {
|
||||
p(descriptor.OffsetElement<char>(j * byteStride));
|
||||
if (special->IsArgDescriptor(0)) {
|
||||
StaticDescriptor<maxRank, true, 8 /*?*/> statDesc;
|
||||
Descriptor &elemDesc{statDesc.descriptor()};
|
||||
elemDesc = descriptor;
|
||||
elemDesc.raw().attribute = CFI_attribute_pointer;
|
||||
elemDesc.raw().rank = 0;
|
||||
auto *p{special->GetProc<void (*)(const Descriptor &)>()};
|
||||
for (std::size_t j{0}; j < elements; ++j) {
|
||||
elemDesc.set_base_addr(
|
||||
descriptor.OffsetElement<char>(j * byteStride));
|
||||
p(elemDesc);
|
||||
}
|
||||
} else {
|
||||
auto *p{special->GetProc<void (*)(char *)>()};
|
||||
for (std::size_t j{0}; j < elements; ++j) {
|
||||
p(descriptor.OffsetElement<char>(j * byteStride));
|
||||
}
|
||||
}
|
||||
} else if (special->IsArgDescriptor(0)) {
|
||||
StaticDescriptor<maxRank, true, 8 /*?*/> statDesc;
|
||||
Descriptor &tmpDesc{statDesc.descriptor()};
|
||||
tmpDesc = descriptor;
|
||||
tmpDesc.raw().attribute = CFI_attribute_pointer;
|
||||
tmpDesc.Addendum()->set_derivedType(&derived);
|
||||
auto *p{special->GetProc<void (*)(const Descriptor &)>()};
|
||||
p(descriptor);
|
||||
p(tmpDesc);
|
||||
} else {
|
||||
// Finalizable objects must be contiguous.
|
||||
auto *p{special->GetProc<void (*)(char *)>()};
|
||||
p(descriptor.OffsetElement<char>());
|
||||
}
|
||||
|
|
@ -68,20 +168,38 @@ void Destroy(const Descriptor &descriptor, bool finalize,
|
|||
CallFinalSubroutine(descriptor, derived);
|
||||
}
|
||||
const Descriptor &componentDesc{derived.component()};
|
||||
auto myComponents{static_cast<SubscriptValue>(componentDesc.Elements())};
|
||||
std::size_t myComponents{componentDesc.Elements()};
|
||||
std::size_t elements{descriptor.Elements()};
|
||||
std::size_t byteStride{descriptor.ElementBytes()};
|
||||
for (unsigned k{0}; k < myComponents; ++k) {
|
||||
// If there's a finalizable parent component, handle it last, as required
|
||||
// by the Fortran standard (7.5.6.2), and do so recursively with the same
|
||||
// descriptor so that the rank is preserved. Otherwise, destroy the parent
|
||||
// component like any other.
|
||||
const auto *parentType{derived.GetParentType()};
|
||||
bool recurse{finalize && parentType && !parentType->noDestructionNeeded()};
|
||||
for (auto k{recurse
|
||||
? std::size_t{1} /* skip first component, it's the parent */
|
||||
: 0};
|
||||
k < myComponents; ++k) {
|
||||
const auto &comp{
|
||||
*componentDesc.ZeroBasedIndexedElement<typeInfo::Component>(k)};
|
||||
if (comp.genre() == typeInfo::Component::Genre::Allocatable ||
|
||||
comp.genre() == typeInfo::Component::Genre::Automatic) {
|
||||
if (const typeInfo::DerivedType * compType{comp.derivedType()}) {
|
||||
if (!compType->noDestructionNeeded()) {
|
||||
for (std::size_t j{0}; j < elements; ++j) {
|
||||
Destroy(*descriptor.OffsetElement<Descriptor>(
|
||||
j * byteStride + comp.offset()),
|
||||
finalize, *compType);
|
||||
}
|
||||
}
|
||||
}
|
||||
for (std::size_t j{0}; j < elements; ++j) {
|
||||
descriptor.OffsetElement<Descriptor>(j * byteStride + comp.offset())
|
||||
->Deallocate(finalize);
|
||||
->Deallocate();
|
||||
}
|
||||
} else if (comp.genre() == typeInfo::Component::Genre::Data &&
|
||||
comp.derivedType()) {
|
||||
comp.derivedType() && !comp.derivedType()->noDestructionNeeded()) {
|
||||
SubscriptValue extent[maxRank];
|
||||
const typeInfo::Value *bounds{comp.bounds()};
|
||||
for (int dim{0}; dim < comp.rank(); ++dim) {
|
||||
|
|
@ -99,9 +217,11 @@ void Destroy(const Descriptor &descriptor, bool finalize,
|
|||
}
|
||||
}
|
||||
}
|
||||
const Descriptor &parentDesc{derived.parent()};
|
||||
if (const auto *parent{parentDesc.OffsetElement<typeInfo::DerivedType>()}) {
|
||||
Destroy(descriptor, finalize, *parent);
|
||||
if (recurse) {
|
||||
Destroy(descriptor, finalize, *parentType);
|
||||
}
|
||||
}
|
||||
|
||||
// TODO: Assign()
|
||||
|
||||
} // namespace Fortran::runtime
|
||||
|
|
|
|||
|
|
@ -6,6 +6,8 @@
|
|||
//
|
||||
//===----------------------------------------------------------------------===//
|
||||
|
||||
// Internal runtime utilities for derived type operations.
|
||||
|
||||
#ifndef FLANG_RUNTIME_DERIVED_H_
|
||||
#define FLANG_RUNTIME_DERIVED_H_
|
||||
|
||||
|
|
@ -15,6 +17,23 @@ class DerivedType;
|
|||
|
||||
namespace Fortran::runtime {
|
||||
class Descriptor;
|
||||
class Terminator;
|
||||
|
||||
// Perform default component initialization, allocate automatic components.
|
||||
// Returns a STAT= code (0 when all's well).
|
||||
int Initialize(const Descriptor &, const typeInfo::DerivedType &, Terminator &,
|
||||
bool hasStat = false, const Descriptor *errMsg = nullptr);
|
||||
|
||||
// Call FINAL subroutines, deallocate allocatable & automatic components.
|
||||
// Does not deallocate the original descriptor.
|
||||
void Destroy(const Descriptor &, bool finalize, const typeInfo::DerivedType &);
|
||||
|
||||
// Assigns one object to another via intrinsic assignment (F'2018 10.2.1.3) or
|
||||
// defined assignment (10.2.1.4), as appropriate. Performs scalar expansion
|
||||
// or allocatable reallocation as needed. Does not perform intrinsic
|
||||
// assignment implicit type conversion.
|
||||
void Assign(Descriptor &, const Descriptor &, const typeInfo::DerivedType &,
|
||||
Terminator &);
|
||||
|
||||
} // namespace Fortran::runtime
|
||||
#endif // FLANG_RUNTIME_FINAL_H_
|
||||
#endif // FLANG_RUNTIME_DERIVED_H_
|
||||
|
|
|
|||
|
|
@ -233,7 +233,7 @@ static bool DefaultFormattedComponentIO(IoStatementState &io,
|
|||
// Create a descriptor for the component
|
||||
StaticDescriptor<maxRank, true, 16 /*?*/> statDesc;
|
||||
Descriptor &desc{statDesc.descriptor()};
|
||||
component.EstablishDescriptor(
|
||||
component.CreatePointerDescriptor(
|
||||
desc, origDescriptor, origSubscripts, terminator);
|
||||
return DescriptorIO<DIR>(io, desc);
|
||||
} else {
|
||||
|
|
|
|||
|
|
@ -9,6 +9,7 @@
|
|||
#include "descriptor.h"
|
||||
#include "derived.h"
|
||||
#include "memory.h"
|
||||
#include "stat.h"
|
||||
#include "terminator.h"
|
||||
#include "type-info.h"
|
||||
#include <cassert>
|
||||
|
|
@ -19,12 +20,6 @@ namespace Fortran::runtime {
|
|||
|
||||
Descriptor::Descriptor(const Descriptor &that) { *this = that; }
|
||||
|
||||
Descriptor::~Descriptor() {
|
||||
if (raw_.attribute != CFI_attribute_pointer) {
|
||||
Deallocate();
|
||||
}
|
||||
}
|
||||
|
||||
Descriptor &Descriptor::operator=(const Descriptor &that) {
|
||||
std::memcpy(this, &that, that.SizeInBytes());
|
||||
return *this;
|
||||
|
|
@ -139,7 +134,6 @@ int Descriptor::Allocate() {
|
|||
return CFI_ERROR_MEM_ALLOCATION;
|
||||
}
|
||||
// TODO: image synchronization
|
||||
// TODO: derived type initialization
|
||||
raw_.base_addr = p;
|
||||
if (int dims{rank()}) {
|
||||
std::size_t stride{ElementBytes()};
|
||||
|
|
@ -152,19 +146,23 @@ int Descriptor::Allocate() {
|
|||
return 0;
|
||||
}
|
||||
|
||||
int Descriptor::Deallocate(bool finalize) {
|
||||
Destroy(finalize);
|
||||
return ISO::CFI_deallocate(&raw_);
|
||||
}
|
||||
|
||||
void Descriptor::Destroy(bool finalize) const {
|
||||
if (const DescriptorAddendum * addendum{Addendum()}) {
|
||||
if (const typeInfo::DerivedType * dt{addendum->derivedType()}) {
|
||||
runtime::Destroy(*this, finalize, *dt);
|
||||
int Descriptor::Destroy(bool finalize) {
|
||||
if (raw_.attribute == CFI_attribute_pointer) {
|
||||
return StatOk;
|
||||
} else {
|
||||
if (auto *addendum{Addendum()}) {
|
||||
if (const auto *derived{addendum->derivedType()}) {
|
||||
if (!derived->noDestructionNeeded()) {
|
||||
runtime::Destroy(*this, finalize, *derived);
|
||||
}
|
||||
}
|
||||
}
|
||||
return Deallocate();
|
||||
}
|
||||
}
|
||||
|
||||
int Descriptor::Deallocate() { return ISO::CFI_deallocate(&raw_); }
|
||||
|
||||
bool Descriptor::IncrementSubscripts(
|
||||
SubscriptValue *subscript, const int *permutation) const {
|
||||
for (int j{0}; j < raw_.rank; ++j) {
|
||||
|
|
|
|||
|
|
@ -113,6 +113,7 @@ public:
|
|||
|
||||
private:
|
||||
const typeInfo::DerivedType *derivedType_;
|
||||
std::uint64_t __unused_flags_{0}; // TODO: delete
|
||||
typeInfo::TypeParameterValue len_[1]; // must be the last component
|
||||
// The LEN type parameter values can also include captured values of
|
||||
// specification expressions that were used for bounds and for LEN type
|
||||
|
|
@ -135,7 +136,6 @@ public:
|
|||
// descriptor.
|
||||
|
||||
Descriptor(const Descriptor &);
|
||||
~Descriptor();
|
||||
Descriptor &operator=(const Descriptor &);
|
||||
|
||||
static constexpr std::size_t BytesFor(TypeCategory category, int kind) {
|
||||
|
|
@ -291,11 +291,17 @@ public:
|
|||
// Allocate() assumes Elements() and ElementBytes() work;
|
||||
// define the extents of the dimensions and the element length
|
||||
// before calling. It (re)computes the byte strides after
|
||||
// allocation.
|
||||
// TODO: SOURCE= and MOLD=
|
||||
// allocation. Does not allocate automatic components or
|
||||
// perform default component initialization.
|
||||
int Allocate();
|
||||
int Deallocate(bool finalize = true);
|
||||
void Destroy(bool finalize = true) const;
|
||||
|
||||
// Deallocates storage; does not call FINAL subroutines or
|
||||
// deallocate allocatable/automatic components.
|
||||
int Deallocate();
|
||||
|
||||
// Deallocates storage, including allocatable and automatic
|
||||
// components. Optionally invokes FINAL subroutines.
|
||||
int Destroy(bool finalize = false);
|
||||
|
||||
bool IsContiguous(int leadingDimensions = maxRank) const {
|
||||
auto bytes{static_cast<SubscriptValue>(ElementBytes())};
|
||||
|
|
@ -342,8 +348,6 @@ public:
|
|||
static constexpr std::size_t byteSize{
|
||||
Descriptor::SizeInBytes(maxRank, hasAddendum, maxLengthTypeParameters)};
|
||||
|
||||
~StaticDescriptor() { descriptor().~Descriptor(); }
|
||||
|
||||
Descriptor &descriptor() { return *reinterpret_cast<Descriptor *>(storage_); }
|
||||
const Descriptor &descriptor() const {
|
||||
return *reinterpret_cast<const Descriptor *>(storage_);
|
||||
|
|
|
|||
|
|
@ -233,7 +233,7 @@ static bool HandleComponent(IoStatementState &io, Descriptor &desc,
|
|||
type{addendum ? addendum->derivedType() : nullptr}) {
|
||||
if (const typeInfo::Component *
|
||||
comp{type->FindDataComponent(compName, std::strlen(compName))}) {
|
||||
comp->EstablishDescriptor(desc, source, nullptr, handler);
|
||||
comp->CreatePointerDescriptor(desc, source, nullptr, handler);
|
||||
return true;
|
||||
} else {
|
||||
handler.SignalError(
|
||||
|
|
|
|||
|
|
@ -7,9 +7,11 @@
|
|||
//===----------------------------------------------------------------------===//
|
||||
|
||||
#include "pointer.h"
|
||||
#include "derived.h"
|
||||
#include "stat.h"
|
||||
#include "terminator.h"
|
||||
#include "tools.h"
|
||||
#include "type-info.h"
|
||||
|
||||
namespace Fortran::runtime {
|
||||
extern "C" {
|
||||
|
|
@ -115,8 +117,17 @@ int RTNAME(PointerAllocate)(Descriptor &pointer, bool hasStat,
|
|||
if (!pointer.IsPointer()) {
|
||||
return ReturnError(terminator, StatInvalidDescriptor, errMsg, hasStat);
|
||||
}
|
||||
return ReturnError(terminator, pointer.Allocate(), errMsg, hasStat);
|
||||
// TODO: default component initialization
|
||||
int stat{ReturnError(terminator, pointer.Allocate(), errMsg, hasStat)};
|
||||
if (stat == StatOk) {
|
||||
if (const DescriptorAddendum * addendum{pointer.Addendum()}) {
|
||||
if (const auto *derived{addendum->derivedType()}) {
|
||||
if (!derived->noInitializationNeeded()) {
|
||||
stat = Initialize(pointer, *derived, terminator, hasStat, errMsg);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
return stat;
|
||||
}
|
||||
|
||||
int RTNAME(PointerDeallocate)(Descriptor &pointer, bool hasStat,
|
||||
|
|
@ -128,7 +139,7 @@ int RTNAME(PointerDeallocate)(Descriptor &pointer, bool hasStat,
|
|||
if (!pointer.IsAllocated()) {
|
||||
return ReturnError(terminator, StatBaseNull, errMsg, hasStat);
|
||||
}
|
||||
return ReturnError(terminator, pointer.Deallocate(), errMsg, hasStat);
|
||||
return ReturnError(terminator, pointer.Destroy(true), errMsg, hasStat);
|
||||
}
|
||||
|
||||
bool RTNAME(PointerIsAssociated)(const Descriptor &pointer) {
|
||||
|
|
|
|||
|
|
@ -29,10 +29,64 @@ std::optional<TypeParameterValue> Value::GetValue(
|
|||
}
|
||||
}
|
||||
|
||||
std::size_t Component::GetElementByteSize(const Descriptor &instance) const {
|
||||
switch (category()) {
|
||||
case TypeCategory::Integer:
|
||||
case TypeCategory::Real:
|
||||
case TypeCategory::Logical:
|
||||
return kind_;
|
||||
case TypeCategory::Complex:
|
||||
return 2 * kind_;
|
||||
case TypeCategory::Character:
|
||||
if (auto value{characterLen_.GetValue(&instance)}) {
|
||||
return kind_ * *value;
|
||||
}
|
||||
break;
|
||||
case TypeCategory::Derived:
|
||||
if (const auto *type{derivedType()}) {
|
||||
return type->sizeInBytes();
|
||||
}
|
||||
break;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
std::size_t Component::GetElements(const Descriptor &instance) const {
|
||||
std::size_t elements{1};
|
||||
if (int rank{rank_}) {
|
||||
if (const Value * boundValues{bounds()}) {
|
||||
for (int j{0}; j < rank; ++j) {
|
||||
TypeParameterValue lb{
|
||||
boundValues[2 * j].GetValue(&instance).value_or(0)};
|
||||
TypeParameterValue ub{
|
||||
boundValues[2 * j + 1].GetValue(&instance).value_or(0)};
|
||||
if (ub >= lb) {
|
||||
elements *= ub - lb + 1;
|
||||
} else {
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
} else {
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
return elements;
|
||||
}
|
||||
|
||||
std::size_t Component::SizeInBytes(const Descriptor &instance) const {
|
||||
if (genre() == Genre::Data) {
|
||||
return GetElementByteSize(instance) * GetElements(instance);
|
||||
} else if (category() == TypeCategory::Derived) {
|
||||
const DerivedType *type{derivedType()};
|
||||
return Descriptor::SizeInBytes(
|
||||
rank_, true, type ? type->LenParameters() : 0);
|
||||
} else {
|
||||
return Descriptor::SizeInBytes(rank_);
|
||||
}
|
||||
}
|
||||
|
||||
void Component::EstablishDescriptor(Descriptor &descriptor,
|
||||
const Descriptor &container, const SubscriptValue subscripts[],
|
||||
Terminator &terminator) const {
|
||||
RUNTIME_CHECK(terminator, genre_ == Genre::Data);
|
||||
const Descriptor &container, Terminator &terminator) const {
|
||||
TypeCategory cat{category()};
|
||||
if (cat == TypeCategory::Character) {
|
||||
auto length{characterLen_.GetValue(&container)};
|
||||
|
|
@ -45,7 +99,7 @@ void Component::EstablishDescriptor(Descriptor &descriptor,
|
|||
} else {
|
||||
descriptor.Establish(cat, kind_, nullptr, rank_);
|
||||
}
|
||||
if (rank_) {
|
||||
if (rank_ && genre_ != Genre::Allocatable) {
|
||||
const typeInfo::Value *boundValues{bounds()};
|
||||
RUNTIME_CHECK(terminator, boundValues != nullptr);
|
||||
auto byteStride{static_cast<SubscriptValue>(descriptor.ElementBytes())};
|
||||
|
|
@ -59,7 +113,25 @@ void Component::EstablishDescriptor(Descriptor &descriptor,
|
|||
byteStride *= dim.Extent();
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
void Component::CreatePointerDescriptor(Descriptor &descriptor,
|
||||
const Descriptor &container, const SubscriptValue subscripts[],
|
||||
Terminator &terminator) const {
|
||||
RUNTIME_CHECK(terminator, genre_ == Genre::Data);
|
||||
EstablishDescriptor(descriptor, container, terminator);
|
||||
descriptor.set_base_addr(container.Element<char>(subscripts) + offset_);
|
||||
descriptor.raw().attribute = CFI_attribute_pointer;
|
||||
}
|
||||
|
||||
const DerivedType *DerivedType::GetParentType() const {
|
||||
if (hasParent_) {
|
||||
const Descriptor &compDesc{component()};
|
||||
const Component &component{*compDesc.OffsetElement<const Component>()};
|
||||
return component.derivedType();
|
||||
} else {
|
||||
return nullptr;
|
||||
}
|
||||
}
|
||||
|
||||
const Component *DerivedType::FindDataComponent(
|
||||
|
|
@ -77,9 +149,8 @@ const Component *DerivedType::FindDataComponent(
|
|||
return component;
|
||||
}
|
||||
}
|
||||
const DerivedType *ancestor{parent().OffsetElement<DerivedType>()};
|
||||
return ancestor ? ancestor->FindDataComponent(compName, compNameLen)
|
||||
: nullptr;
|
||||
const DerivedType *parent{GetParentType()};
|
||||
return parent ? parent->FindDataComponent(compName, compNameLen) : nullptr;
|
||||
}
|
||||
|
||||
const SpecialBinding *DerivedType::FindSpecialBinding(
|
||||
|
|
@ -116,7 +187,7 @@ FILE *DerivedType::Dump(FILE *f) const {
|
|||
const std::uint64_t *uints{reinterpret_cast<const std::uint64_t *>(this)};
|
||||
for (int j{0}; j < 64; ++j) {
|
||||
int offset{j * static_cast<int>(sizeof *uints)};
|
||||
std::fprintf(f, " [+%3d](0x%p) %#016jx", offset,
|
||||
std::fprintf(f, " [+%3d](0x%p) 0x%016jx", offset,
|
||||
reinterpret_cast<const void *>(&uints[j]),
|
||||
static_cast<std::uintmax_t>(uints[j]));
|
||||
if (offset == offsetof(DerivedType, binding_)) {
|
||||
|
|
@ -125,8 +196,6 @@ FILE *DerivedType::Dump(FILE *f) const {
|
|||
std::fputs(" <-- name_\n", f);
|
||||
} else if (offset == offsetof(DerivedType, sizeInBytes_)) {
|
||||
std::fputs(" <-- sizeInBytes_\n", f);
|
||||
} else if (offset == offsetof(DerivedType, parent_)) {
|
||||
std::fputs(" <-- parent_\n", f);
|
||||
} else if (offset == offsetof(DerivedType, uninstantiated_)) {
|
||||
std::fputs(" <-- uninstantiated_\n", f);
|
||||
} else if (offset == offsetof(DerivedType, typeHash_)) {
|
||||
|
|
@ -141,6 +210,12 @@ FILE *DerivedType::Dump(FILE *f) const {
|
|||
std::fputs(" <-- procPtr_\n", f);
|
||||
} else if (offset == offsetof(DerivedType, special_)) {
|
||||
std::fputs(" <-- special_\n", f);
|
||||
} else if (offset == offsetof(DerivedType, special_)) {
|
||||
std::fputs(" <-- special_\n", f);
|
||||
} else if (offset == offsetof(DerivedType, hasParent_)) {
|
||||
std::fputs(
|
||||
" <-- hasParent_, noInitializationNeeded_, noDestructionNeeded_\n",
|
||||
f);
|
||||
} else {
|
||||
std::fputc('\n', f);
|
||||
}
|
||||
|
|
@ -195,6 +270,14 @@ FILE *Component::Dump(FILE *f) const {
|
|||
}
|
||||
std::fprintf(f, " category %d kind %d rank %d offset 0x%zx\n", category_,
|
||||
kind_, rank_, static_cast<std::size_t>(offset_));
|
||||
if (initialization_) {
|
||||
std::fprintf(f, " initialization @ 0x%p:\n", initialization_);
|
||||
for (int j{0}; j < 128; j += sizeof(std::uint64_t)) {
|
||||
std::fprintf(f, " [%3d] 0x%016jx\n", j,
|
||||
static_cast<std::uintmax_t>(
|
||||
*reinterpret_cast<const std::uint64_t *>(initialization_ + j)));
|
||||
}
|
||||
}
|
||||
return f;
|
||||
}
|
||||
|
||||
|
|
@ -235,7 +318,7 @@ FILE *SpecialBinding::Dump(FILE *f) const {
|
|||
break;
|
||||
}
|
||||
std::fprintf(f, "\n rank: %d\n", rank_);
|
||||
std::fprintf(f, " isArgDescriptoSetr: 0x%x\n", isArgDescriptorSet_);
|
||||
std::fprintf(f, " isArgDescriptorSet: 0x%x\n", isArgDescriptorSet_);
|
||||
std::fprintf(f, " proc: 0x%p\n", reinterpret_cast<void *>(proc_));
|
||||
return f;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -73,8 +73,19 @@ public:
|
|||
}
|
||||
const char *initialization() const { return initialization_; }
|
||||
|
||||
// Creates a pointer descriptor from a component description.
|
||||
void EstablishDescriptor(Descriptor &, const Descriptor &container,
|
||||
std::size_t GetElementByteSize(const Descriptor &) const;
|
||||
std::size_t GetElements(const Descriptor &) const;
|
||||
|
||||
// For ocmponents that are descriptors, returns size of descriptor;
|
||||
// for Genre::Data, returns elemental byte size times element count.
|
||||
std::size_t SizeInBytes(const Descriptor &) const;
|
||||
|
||||
// Establishes a descriptor from this component description.
|
||||
void EstablishDescriptor(
|
||||
Descriptor &, const Descriptor &container, Terminator &) const;
|
||||
|
||||
// Creates a pointer descriptor from this component description.
|
||||
void CreatePointerDescriptor(Descriptor &, const Descriptor &container,
|
||||
const SubscriptValue[], Terminator &) const;
|
||||
|
||||
FILE *Dump(FILE * = stdout) const;
|
||||
|
|
@ -100,7 +111,7 @@ private:
|
|||
struct ProcPtrComponent {
|
||||
StaticDescriptor<0> name; // CHARACTER(:), POINTER
|
||||
std::uint64_t offset{0};
|
||||
ProcedurePointer procInitialization; // for Genre::Procedure
|
||||
ProcedurePointer procInitialization;
|
||||
};
|
||||
|
||||
class SpecialBinding {
|
||||
|
|
@ -175,7 +186,6 @@ public:
|
|||
const Descriptor &binding() const { return binding_.descriptor(); }
|
||||
const Descriptor &name() const { return name_.descriptor(); }
|
||||
std::uint64_t sizeInBytes() const { return sizeInBytes_; }
|
||||
const Descriptor &parent() const { return parent_.descriptor(); }
|
||||
std::uint64_t typeHash() const { return typeHash_; }
|
||||
const Descriptor &uninstatiated() const {
|
||||
return uninstantiated_.descriptor();
|
||||
|
|
@ -189,9 +199,14 @@ public:
|
|||
const Descriptor &component() const { return component_.descriptor(); }
|
||||
const Descriptor &procPtr() const { return procPtr_.descriptor(); }
|
||||
const Descriptor &special() const { return special_.descriptor(); }
|
||||
bool hasParent() const { return hasParent_; }
|
||||
bool noInitializationNeeded() const { return noInitializationNeeded_; }
|
||||
bool noDestructionNeeded() const { return noDestructionNeeded_; }
|
||||
|
||||
std::size_t LenParameters() const { return lenParameterKind().Elements(); }
|
||||
|
||||
const DerivedType *GetParentType() const;
|
||||
|
||||
// Finds a data component by name in this derived type or tis ancestors.
|
||||
const Component *FindDataComponent(
|
||||
const char *name, std::size_t nameLen) const;
|
||||
|
|
@ -211,7 +226,6 @@ private:
|
|||
StaticDescriptor<0> name_; // CHARACTER(:), POINTER
|
||||
|
||||
std::uint64_t sizeInBytes_{0};
|
||||
StaticDescriptor<0, true> parent_; // TYPE(DERIVEDTYPE), POINTER
|
||||
|
||||
// Instantiations of a parameterized derived type with KIND type
|
||||
// parameters will point this data member to the description of
|
||||
|
|
@ -242,6 +256,10 @@ private:
|
|||
// Does not include special bindings from ancestral types.
|
||||
StaticDescriptor<1, true>
|
||||
special_; // TYPE(SPECIALBINDING), POINTER, DIMENSION(:), CONTIGUOUS
|
||||
|
||||
bool hasParent_{false};
|
||||
bool noInitializationNeeded_{false};
|
||||
bool noDestructionNeeded_{false};
|
||||
};
|
||||
|
||||
} // namespace Fortran::runtime::typeInfo
|
||||
|
|
|
|||
|
|
@ -88,7 +88,7 @@ module m
|
|||
real, save :: v1
|
||||
!ERROR: A pure subprogram may not have a variable with the SAVE attribute
|
||||
real :: v2 = 0.
|
||||
!TODO: once we have DATA: !ERROR: A pure subprogram may not have a variable with the SAVE attribute
|
||||
!ERROR: A pure subprogram may not have a variable with the SAVE attribute
|
||||
real :: v3
|
||||
data v3/0./
|
||||
!ERROR: A pure subprogram may not have a variable with the SAVE attribute
|
||||
|
|
|
|||
|
|
@ -47,8 +47,8 @@ subroutine s5(n)
|
|||
integer, len :: l2
|
||||
real :: b(l1, l2)
|
||||
end type
|
||||
type(t1(n)) :: x1 !CHECK: x1 size=40 offset=
|
||||
type(t2(n,n)) :: x2 !CHECK: x2 size=48 offset=
|
||||
type(t1(n)) :: x1 !CHECK: x1 size=48 offset=
|
||||
type(t2(n,n)) :: x2 !CHECK: x2 size=56 offset=
|
||||
!CHECK: a size=48 offset=0:
|
||||
!CHECK: b size=72 offset=0:
|
||||
end
|
||||
|
|
|
|||
|
|
@ -7,7 +7,7 @@ module m01
|
|||
end type
|
||||
!CHECK: Module scope: m01
|
||||
!CHECK: .c.t1, SAVE, TARGET: ObjectEntity type: TYPE(component) shape: 0_8:0_8 init:[component::component(name=.n.n,genre=1_1,category=0_1,kind=4_1,rank=0_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL())]
|
||||
!CHECK: .dt.t1, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t1,sizeinbytes=4_8,parent=NULL(),uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.t1,procptr=NULL(),special=NULL())
|
||||
!CHECK: .dt.t1, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t1,sizeinbytes=4_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.t1,procptr=NULL(),special=NULL(),hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1)
|
||||
!CHECK: .n.n, SAVE, TARGET: ObjectEntity type: CHARACTER(1_8,1) init:"n"
|
||||
!CHECK: .n.t1, SAVE, TARGET: ObjectEntity type: CHARACTER(2_8,1) init:"t1"
|
||||
!CHECK: DerivedType scope: t1
|
||||
|
|
@ -22,8 +22,8 @@ module m02
|
|||
end type
|
||||
!CHECK: .c.child, SAVE, TARGET: ObjectEntity type: TYPE(component) shape: 0_8:1_8 init:[component::component(name=.n.parent,genre=1_1,category=5_1,kind=0_1,rank=0_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=.dt.parent,lenvalue=NULL(),bounds=NULL(),initialization=NULL()),component(name=.n.cn,genre=1_1,category=0_1,kind=4_1,rank=0_1,offset=4_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL())]
|
||||
!CHECK: .c.parent, SAVE, TARGET: ObjectEntity type: TYPE(component) shape: 0_8:0_8 init:[component::component(name=.n.pn,genre=1_1,category=0_1,kind=4_1,rank=0_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL())]
|
||||
!CHECK: .dt.child, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.child,sizeinbytes=8_8,parent=.dt.parent,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.child,procptr=NULL(),special=NULL())
|
||||
!CHECK: .dt.parent, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.parent,sizeinbytes=4_8,parent=NULL(),uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.parent,procptr=NULL(),special=NULL())
|
||||
!CHECK: .dt.child, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.child,sizeinbytes=8_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.child,procptr=NULL(),special=NULL(),hasparent=1_1,noinitializationneeded=1_1,nodestructionneeded=1_1)
|
||||
!CHECK: .dt.parent, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.parent,sizeinbytes=4_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.parent,procptr=NULL(),special=NULL(),hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1)
|
||||
end module
|
||||
|
||||
module m03
|
||||
|
|
@ -33,8 +33,8 @@ module m03
|
|||
end type
|
||||
type(kpdt(4)) :: x
|
||||
!CHECK: .c.kpdt.0, SAVE, TARGET: ObjectEntity type: TYPE(component) shape: 0_8:0_8 init:[component::component(name=.n.a,genre=1_1,category=1_1,kind=4_1,rank=0_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL())]
|
||||
!CHECK: .dt.kpdt, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(name=.n.kpdt,parent=NULL(),uninstantiated=NULL(),kindparameter=.kp.kpdt,lenparameterkind=NULL())
|
||||
!CHECK: .dt.kpdt.0, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.kpdt,sizeinbytes=4_8,parent=NULL(),uninstantiated=.dt.kpdt,kindparameter=.kp.kpdt.0,lenparameterkind=NULL(),component=.c.kpdt.0,procptr=NULL(),special=NULL())
|
||||
!CHECK: .dt.kpdt, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(name=.n.kpdt,uninstantiated=NULL(),kindparameter=.kp.kpdt,lenparameterkind=NULL())
|
||||
!CHECK: .dt.kpdt.0, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.kpdt,sizeinbytes=4_8,uninstantiated=.dt.kpdt,kindparameter=.kp.kpdt.0,lenparameterkind=NULL(),component=.c.kpdt.0,procptr=NULL(),special=NULL(),hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1)
|
||||
!CHECK: .kp.kpdt, SAVE, TARGET: ObjectEntity type: INTEGER(8) shape: 0_8:0_8 init:[INTEGER(8)::1_8]
|
||||
!CHECK: .kp.kpdt.0, SAVE, TARGET: ObjectEntity type: INTEGER(8) shape: 0_8:0_8 init:[INTEGER(8)::4_8]
|
||||
end module
|
||||
|
|
@ -49,7 +49,7 @@ module m04
|
|||
subroutine s1(x)
|
||||
class(tbps), intent(in) :: x
|
||||
end subroutine
|
||||
!CHECK: .dt.tbps, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=.v.tbps,name=.n.tbps,sizeinbytes=0_8,parent=NULL(),uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=NULL())
|
||||
!CHECK: .dt.tbps, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=.v.tbps,name=.n.tbps,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=NULL(),hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1)
|
||||
!CHECK: .v.tbps, SAVE, TARGET: ObjectEntity type: TYPE(binding) shape: 0_8:1_8 init:[binding::binding(proc=s1,name=.n.b1),binding(proc=s1,name=.n.b2)]
|
||||
end module
|
||||
|
||||
|
|
@ -61,7 +61,7 @@ module m05
|
|||
subroutine s1(x)
|
||||
class(t), intent(in) :: x
|
||||
end subroutine
|
||||
!CHECK: .dt.t, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t,sizeinbytes=24_8,parent=NULL(),uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=.p.t,special=NULL())
|
||||
!CHECK: .dt.t, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t,sizeinbytes=24_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=.p.t,special=NULL(),hasparent=0_1,noinitializationneeded=0_1,nodestructionneeded=1_1)
|
||||
!CHECK: .p.t, SAVE, TARGET: ObjectEntity type: TYPE(procptrcomponent) shape: 0_8:0_8 init:[procptrcomponent::procptrcomponent(name=.n.p1,offset=0_8,initialization=s1)]
|
||||
end module
|
||||
|
||||
|
|
@ -85,8 +85,8 @@ module m06
|
|||
class(t), intent(in) :: y
|
||||
end subroutine
|
||||
!CHECK: .c.t2, SAVE, TARGET: ObjectEntity type: TYPE(component) shape: 0_8:0_8 init:[component::component(name=.n.t,genre=1_1,category=5_1,kind=0_1,rank=0_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=.dt.t,lenvalue=NULL(),bounds=NULL(),initialization=NULL())]
|
||||
!CHECK: .dt.t, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=.v.t,name=.n.t,sizeinbytes=0_8,parent=NULL(),uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.t)
|
||||
!CHECK: .dt.t2, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=.v.t2,name=.n.t2,sizeinbytes=0_8,parent=.dt.t,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.t2,procptr=NULL(),special=NULL())
|
||||
!CHECK: .dt.t, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=.v.t,name=.n.t,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.t,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1)
|
||||
!CHECK: .dt.t2, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=.v.t2,name=.n.t2,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.t2,procptr=NULL(),special=NULL(),hasparent=1_1,noinitializationneeded=1_1,nodestructionneeded=1_1)
|
||||
!CHECK: .s.t, SAVE, TARGET: ObjectEntity type: TYPE(specialbinding) shape: 0_8:0_8 init:[specialbinding::specialbinding(which=4_1,rank=0_1,isargdescriptorset=3_1,proc=s1)]
|
||||
!CHECK: .v.t, SAVE, TARGET: ObjectEntity type: TYPE(binding) shape: 0_8:0_8 init:[binding::binding(proc=s1,name=.n.s1)]
|
||||
!CHECK: .v.t2, SAVE, TARGET: ObjectEntity type: TYPE(binding) shape: 0_8:0_8 init:[binding::binding(proc=s2,name=.n.s1)]
|
||||
|
|
@ -103,7 +103,7 @@ module m07
|
|||
class(t), intent(out) :: x
|
||||
class(t), intent(in) :: y
|
||||
end subroutine
|
||||
!CHECK: .dt.t, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=.v.t,name=.n.t,sizeinbytes=0_8,parent=NULL(),uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.t)
|
||||
!CHECK: .dt.t, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=.v.t,name=.n.t,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.t,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1)
|
||||
!CHECK: .s.t, SAVE, TARGET: ObjectEntity type: TYPE(specialbinding) shape: 0_8:0_8 init:[specialbinding::specialbinding(which=5_1,rank=0_1,isargdescriptorset=3_1,proc=s1)]
|
||||
!CHECK: .v.t, SAVE, TARGET: ObjectEntity type: TYPE(binding) shape: 0_8:0_8 init:[binding::binding(proc=s1,name=.n.s1)]
|
||||
end module
|
||||
|
|
@ -123,7 +123,7 @@ module m08
|
|||
impure elemental subroutine s3(x)
|
||||
type(t) :: x
|
||||
end subroutine
|
||||
!CHECK: .dt.t, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t,sizeinbytes=0_8,parent=NULL(),uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.t)
|
||||
!CHECK: .dt.t, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.t,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=0_1)
|
||||
!CHECK: .s.t, SAVE, TARGET: ObjectEntity type: TYPE(specialbinding) shape: 0_8:2_8 init:[specialbinding::specialbinding(which=8_1,rank=1_1,isargdescriptorset=1_1,proc=s1),specialbinding(which=8_1,rank=2_1,isargdescriptorset=0_1,proc=s2),specialbinding(which=9_1,rank=0_1,isargdescriptorset=0_1,proc=s3)]
|
||||
end module
|
||||
|
||||
|
|
@ -165,7 +165,7 @@ module m09
|
|||
integer, intent(out) :: iostat
|
||||
character(len=*), intent(inout) :: iomsg
|
||||
end subroutine
|
||||
!CHECK: .dt.t, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=.v.t,name=.n.t,sizeinbytes=0_8,parent=NULL(),uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.t)
|
||||
!CHECK: .dt.t, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=.v.t,name=.n.t,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.t,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1)
|
||||
!CHECK: .s.t, SAVE, TARGET: ObjectEntity type: TYPE(specialbinding) shape: 0_8:3_8 init:[specialbinding::specialbinding(which=16_1,rank=0_1,isargdescriptorset=1_1,proc=rf),specialbinding(which=17_1,rank=0_1,isargdescriptorset=1_1,proc=ru),specialbinding(which=18_1,rank=0_1,isargdescriptorset=1_1,proc=wf),specialbinding(which=19_1,rank=0_1,isargdescriptorset=1_1,proc=wu)]
|
||||
!CHECK: .v.t, SAVE, TARGET: ObjectEntity type: TYPE(binding) shape: 0_8:3_8 init:[binding::binding(proc=rf,name=.n.rf),binding(proc=ru,name=.n.ru),binding(proc=wf,name=.n.wf),binding(proc=wu,name=.n.wu)]
|
||||
end module
|
||||
|
|
@ -214,7 +214,7 @@ module m10
|
|||
integer, intent(out) :: iostat
|
||||
character(len=*), intent(inout) :: iomsg
|
||||
end subroutine
|
||||
!CHECK: .dt.t, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t,sizeinbytes=0_8,parent=NULL(),uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.t)
|
||||
!CHECK: .dt.t, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.t,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1)
|
||||
!CHECK: .s.t, SAVE, TARGET: ObjectEntity type: TYPE(specialbinding) shape: 0_8:3_8 init:[specialbinding::specialbinding(which=16_1,rank=0_1,isargdescriptorset=0_1,proc=rf),specialbinding(which=17_1,rank=0_1,isargdescriptorset=0_1,proc=ru),specialbinding(which=18_1,rank=0_1,isargdescriptorset=0_1,proc=wf),specialbinding(which=19_1,rank=0_1,isargdescriptorset=0_1,proc=wu)]
|
||||
end module
|
||||
|
||||
|
|
@ -227,14 +227,18 @@ module m11
|
|||
character(len=len) :: chauto
|
||||
real :: automatic(len)
|
||||
end type
|
||||
!CHECK: .dt.t, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(name=.n.t,parent=NULL(),uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=.lpk.t)
|
||||
!CHECK: .dt.t, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(name=.n.t,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=.lpk.t)
|
||||
!CHECK: .lpk.t, SAVE, TARGET: ObjectEntity type: INTEGER(1) shape: 0_8:0_8 init:[INTEGER(1)::8_1]
|
||||
contains
|
||||
subroutine s1(x)
|
||||
!CHECK: .b.t.1.automatic, SAVE, TARGET: ObjectEntity type: TYPE(value) shape: 0_8:1_8,0_8:0_8 init:reshape([value::value(genre=2_1,value=1_8),value(genre=3_1,value=0_8)],shape=[2,1])
|
||||
!CHECK: .c.t.1, SAVE, TARGET: ObjectEntity type: TYPE(component) shape: 0_8:3_8 init:[component::component(name=.n.allocatable,genre=3_1,category=1_1,kind=4_1,rank=1_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL()),component(name=.n.pointer,genre=2_1,category=1_1,kind=4_1,rank=0_1,offset=48_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=target),component(name=.n.chauto,genre=4_1,category=3_1,kind=1_1,rank=0_1,offset=72_8,characterlen=value(genre=3_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL()),component(name=.n.automatic,genre=4_1,category=1_1,kind=4_1,rank=1_1,offset=96_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=.b.t.1.automatic,initialization=NULL())]
|
||||
!CHECK: .dt.t.1, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t,sizeinbytes=144_8,parent=NULL(),uninstantiated=.dt.t,kindparameter=NULL(),lenparameterkind=.lpk.t.1,component=.c.t.1,procptr=NULL(),special=NULL())
|
||||
!CHECK: .c.t.1, SAVE, TARGET: ObjectEntity type: TYPE(component) shape: 0_8:3_8 init:[component::component(name=.n.allocatable,genre=3_1,category=1_1,kind=4_1,rank=1_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL()),component(name=.n.pointer,genre=2_1,category=1_1,kind=4_1,rank=0_1,offset=48_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=.di.t.1.pointer),component(name=.n.chauto,genre=4_1,category=3_1,kind=1_1,rank=0_1,offset=72_8,characterlen=value(genre=3_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL()),component(name=.n.automatic,genre=4_1,category=1_1,kind=4_1,rank=1_1,offset=96_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=.b.t.1.automatic,initialization=NULL())]
|
||||
!CHECK: .di.t.1.pointer, SAVE, TARGET: ObjectEntity type: TYPE(.dp.t.1.pointer) init:.dp.t.1.pointer(pointer=target)
|
||||
!CHECK: .dp.t.1.pointer: DerivedType components: pointer
|
||||
!CHECK: .dt.t.1, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t,sizeinbytes=144_8,uninstantiated=.dt.t,kindparameter=NULL(),lenparameterkind=.lpk.t.1,component=.c.t.1,procptr=NULL(),special=NULL(),hasparent=0_1,noinitializationneeded=0_1,nodestructionneeded=0_1)
|
||||
!CHECK: .lpk.t.1, SAVE, TARGET: ObjectEntity type: INTEGER(1) shape: 0_8:0_8 init:[INTEGER(1)::8_1]
|
||||
!CHECK: DerivedType scope: .dp.t.1.pointer size=24 alignment=8 instantiation of .dp.t.1.pointer
|
||||
!CHECK: pointer, POINTER size=24 offset=0: ObjectEntity type: REAL(4)
|
||||
type(t(*)), intent(in) :: x
|
||||
end subroutine
|
||||
end module
|
||||
|
|
|
|||
Loading…
Reference in New Issue