[flang-commits] [flang] a48e416 - [flang] Run-time derived type initialization and destruction
peter klausler via flang-commits
flang-commits at lists.llvm.org
Tue Jul 20 15:24:29 PDT 2021
Author: peter klausler
Date: 2021-07-20T15:24:16-07:00
New Revision: a48e41683ae1a9b9a5bde750d3b418a205c28cc8
URL: https://github.com/llvm/llvm-project/commit/a48e41683ae1a9b9a5bde750d3b418a205c28cc8
DIFF: https://github.com/llvm/llvm-project/commit/a48e41683ae1a9b9a5bde750d3b418a205c28cc8.diff
LOG: [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
Added:
flang/runtime/derived-api.cpp
flang/runtime/derived-api.h
Modified:
flang/docs/Extensions.md
flang/include/flang/Semantics/tools.h
flang/include/flang/Semantics/type.h
flang/lib/Evaluate/shape.cpp
flang/lib/Evaluate/tools.cpp
flang/lib/Semantics/check-declarations.cpp
flang/lib/Semantics/compute-offsets.cpp
flang/lib/Semantics/resolve-names.cpp
flang/lib/Semantics/runtime-type-info.cpp
flang/lib/Semantics/tools.cpp
flang/lib/Semantics/type.cpp
flang/module/__fortran_type_info.f90
flang/runtime/CMakeLists.txt
flang/runtime/allocatable.cpp
flang/runtime/allocatable.h
flang/runtime/derived.cpp
flang/runtime/derived.h
flang/runtime/descriptor-io.h
flang/runtime/descriptor.cpp
flang/runtime/descriptor.h
flang/runtime/namelist.cpp
flang/runtime/pointer.cpp
flang/runtime/type-info.cpp
flang/runtime/type-info.h
flang/test/Semantics/call10.f90
flang/test/Semantics/offsets01.f90
flang/test/Semantics/typeinfo01.f90
Removed:
################################################################################
diff --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md
index 87dcb0cfde29..e55be8b1bc94 100644
--- a/flang/docs/Extensions.md
+++ b/flang/docs/Extensions.md
@@ -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.
diff --git a/flang/include/flang/Semantics/tools.h b/flang/include/flang/Semantics/tools.h
index 776594ed23fc..9b1a4318572f 100644
--- a/flang/include/flang/Semantics/tools.h
+++ b/flang/include/flang/Semantics/tools.h
@@ -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 &);
diff --git a/flang/include/flang/Semantics/type.h b/flang/include/flang/Semantics/type.h
index 764b65941c12..44068184046d 100644
--- a/flang/include/flang/Semantics/type.h
+++ b/flang/include/flang/Semantics/type.h
@@ -257,6 +257,7 @@ class DerivedTypeSpec {
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().
diff --git a/flang/lib/Evaluate/shape.cpp b/flang/lib/Evaluate/shape.cpp
index 988d11e92051..7e8158da5cee 100644
--- a/flang/lib/Evaluate/shape.cpp
+++ b/flang/lib/Evaluate/shape.cpp
@@ -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;
diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp
index 7b218933304e..80b1cdaf078a 100644
--- a/flang/lib/Evaluate/tools.cpp
+++ b/flang/lib/Evaluate/tools.cpp
@@ -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>()};
diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index b57d19b8a62e..e27000d3e997 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -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);
}
diff --git a/flang/lib/Semantics/compute-offsets.cpp b/flang/lib/Semantics/compute-offsets.cpp
index 4b1538ca785f..2ceb8f4336a5 100644
--- a/flang/lib/Semantics/compute-offsets.cpp
+++ b/flang/lib/Semantics/compute-offsets.cpp
@@ -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)) {
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 7fa3dee3fd21..b7db7d4018e7 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -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())};
diff --git a/flang/lib/Semantics/runtime-type-info.cpp b/flang/lib/Semantics/runtime-type-info.cpp
index f336117ab3a5..cb833cf01b87 100644
--- a/flang/lib/Semantics/runtime-type-info.cpp
+++ b/flang/lib/Semantics/runtime-type-info.cpp
@@ -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 @@ class RuntimeTableBuilder {
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 @@ class RuntimeTableBuilder {
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;
}
diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp
index e84629b063b8..feb07f7a8fdd 100644
--- a/flang/lib/Semantics/tools.cpp
+++ b/flang/lib/Semantics/tools.cpp
@@ -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") {
diff --git a/flang/lib/Semantics/type.cpp b/flang/lib/Semantics/type.cpp
index 81a87c3e57de..dc9be0022bb2 100644
--- a/flang/lib/Semantics/type.cpp
+++ b/flang/lib/Semantics/type.cpp
@@ -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
diff --git a/flang/module/__fortran_type_info.f90 b/flang/module/__fortran_type_info.f90
index c2a9ed16e10b..dcdc5619a861 100644
--- a/flang/module/__fortran_type_info.f90
+++ b/flang/module/__fortran_type_info.f90
@@ -33,19 +33,22 @@
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
diff --git a/flang/runtime/CMakeLists.txt b/flang/runtime/CMakeLists.txt
index 69f68e436040..971ce90e10a0 100644
--- a/flang/runtime/CMakeLists.txt
+++ b/flang/runtime/CMakeLists.txt
@@ -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
diff --git a/flang/runtime/allocatable.cpp b/flang/runtime/allocatable.cpp
index ffdee674a9ef..9416590fa572 100644
--- a/flang/runtime/allocatable.cpp
+++ b/flang/runtime/allocatable.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
diff --git a/flang/runtime/allocatable.h b/flang/runtime/allocatable.h
index cd2c566fe776..91c58c65b05f 100644
--- a/flang/runtime/allocatable.h
+++ b/flang/runtime/allocatable.h
@@ -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_
diff --git a/flang/runtime/derived-api.cpp b/flang/runtime/derived-api.cpp
new file mode 100644
index 000000000000..98a0096e1d5a
--- /dev/null
+++ b/flang/runtime/derived-api.cpp
@@ -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
diff --git a/flang/runtime/derived-api.h b/flang/runtime/derived-api.h
new file mode 100644
index 000000000000..44cd5d6963c6
--- /dev/null
+++ b/flang/runtime/derived-api.h
@@ -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_
diff --git a/flang/runtime/derived.cpp b/flang/runtime/derived.cpp
index 4875ef2a4bc5..61511b50410c 100644
--- a/flang/runtime/derived.cpp
+++ b/flang/runtime/derived.cpp
@@ -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
diff --git a/flang/runtime/derived.h b/flang/runtime/derived.h
index 314c05772670..7239d82b7e65 100644
--- a/flang/runtime/derived.h
+++ b/flang/runtime/derived.h
@@ -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_
diff --git a/flang/runtime/descriptor-io.h b/flang/runtime/descriptor-io.h
index 2ebb449e46d1..52b328b8c837 100644
--- a/flang/runtime/descriptor-io.h
+++ b/flang/runtime/descriptor-io.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 {
diff --git a/flang/runtime/descriptor.cpp b/flang/runtime/descriptor.cpp
index 0103f46ad33f..274cdd7b376a 100644
--- a/flang/runtime/descriptor.cpp
+++ b/flang/runtime/descriptor.cpp
@@ -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) {
diff --git a/flang/runtime/descriptor.h b/flang/runtime/descriptor.h
index 88e306c5f590..f524b54841e0 100644
--- a/flang/runtime/descriptor.h
+++ b/flang/runtime/descriptor.h
@@ -113,6 +113,7 @@ class DescriptorAddendum {
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 @@ class Descriptor {
// descriptor.
Descriptor(const Descriptor &);
- ~Descriptor();
Descriptor &operator=(const Descriptor &);
static constexpr std::size_t BytesFor(TypeCategory category, int kind) {
@@ -291,11 +291,17 @@ class Descriptor {
// 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 @@ class alignas(Descriptor) StaticDescriptor {
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_);
diff --git a/flang/runtime/namelist.cpp b/flang/runtime/namelist.cpp
index 0b334b40dea2..72d669f1b89b 100644
--- a/flang/runtime/namelist.cpp
+++ b/flang/runtime/namelist.cpp
@@ -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(
diff --git a/flang/runtime/pointer.cpp b/flang/runtime/pointer.cpp
index 6f34feb049ec..9b6bfee38019 100644
--- a/flang/runtime/pointer.cpp
+++ b/flang/runtime/pointer.cpp
@@ -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) {
diff --git a/flang/runtime/type-info.cpp b/flang/runtime/type-info.cpp
index 9385eabf2dc8..0268a204a982 100644
--- a/flang/runtime/type-info.cpp
+++ b/flang/runtime/type-info.cpp
@@ -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;
}
diff --git a/flang/runtime/type-info.h b/flang/runtime/type-info.h
index 0dfb4b64ffd3..fc1bf7adc84a 100644
--- a/flang/runtime/type-info.h
+++ b/flang/runtime/type-info.h
@@ -73,8 +73,19 @@ class Component {
}
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 @@ class Component {
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 @@ class DerivedType {
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 @@ class DerivedType {
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 @@ class DerivedType {
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 @@ class DerivedType {
// 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
diff --git a/flang/test/Semantics/call10.f90 b/flang/test/Semantics/call10.f90
index 7fa4a8075a0a..2ef3a5add604 100644
--- a/flang/test/Semantics/call10.f90
+++ b/flang/test/Semantics/call10.f90
@@ -88,7 +88,7 @@ pure subroutine s05 ! C1589
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
diff --git a/flang/test/Semantics/offsets01.f90 b/flang/test/Semantics/offsets01.f90
index c3d66a5bc94a..50974876e8d9 100644
--- a/flang/test/Semantics/offsets01.f90
+++ b/flang/test/Semantics/offsets01.f90
@@ -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
diff --git a/flang/test/Semantics/typeinfo01.f90 b/flang/test/Semantics/typeinfo01.f90
index 088c6e56b6b7..2e33ba8ce28b 100644
--- a/flang/test/Semantics/typeinfo01.f90
+++ b/flang/test/Semantics/typeinfo01.f90
@@ -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 @@ subroutine s2(x, y)
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 @@ impure elemental subroutine s1(x, y)
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 @@ subroutine s2(x)
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 @@ subroutine wu(x,u,iostat,iomsg)
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 @@ subroutine wu(x,u,iostat,iomsg)
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
More information about the flang-commits
mailing list