[flang-commits] [flang] 65f5290 - [flang] Implement runtime Assign()
peter klausler via flang-commits
flang-commits at lists.llvm.org
Mon Aug 9 09:31:52 PDT 2021
Author: peter klausler
Date: 2021-08-09T09:31:32-07:00
New Revision: 65f52904324735da7bb4bc9ef5060a3f784e6bea
URL: https://github.com/llvm/llvm-project/commit/65f52904324735da7bb4bc9ef5060a3f784e6bea
DIFF: https://github.com/llvm/llvm-project/commit/65f52904324735da7bb4bc9ef5060a3f784e6bea.diff
LOG: [flang] Implement runtime Assign()
Define an API for, and implement, runtime support for arbitrary
assignment of one descriptor's data to another, with full support for
(re)allocation of allocatables with finalization when necessary,
user-defined derived type assignment TBP calls, and intrinsic (default)
componentwise assignment of derived type instances with allocation of
automatic components. Also clean up API and implementation of
finalization/destruction using knowledge gained while studying
edge cases for assignment in the 2018 standard.
The look-up procedure for special procedure bindings in derived
types has been optimized from O(N) to O(1) since it will probably
matter more. This required some analysis in runtime derived type
description table construction in semantics and some changes to the
table schemata.
Executable Fortran tests have been developed; they'll be added
to the test base once they can be lowered and run by f18.
Differential Revision: https://reviews.llvm.org/D107678
Added:
flang/runtime/assign.cpp
flang/runtime/assign.h
Modified:
flang/include/flang/Semantics/tools.h
flang/include/flang/Semantics/type.h
flang/lib/Semantics/runtime-type-info.cpp
flang/lib/Semantics/tools.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/type-info.cpp
flang/runtime/type-info.h
flang/test/Semantics/typeinfo01.f90
Removed:
################################################################################
diff --git a/flang/include/flang/Semantics/tools.h b/flang/include/flang/Semantics/tools.h
index 9b1a4318572ff..1e92275eb6011 100644
--- a/flang/include/flang/Semantics/tools.h
+++ b/flang/include/flang/Semantics/tools.h
@@ -166,8 +166,10 @@ inline bool IsProtected(const Symbol &symbol) {
inline bool IsImpliedDoIndex(const Symbol &symbol) {
return symbol.owner().kind() == Scope::Kind::ImpliedDos;
}
-bool IsFinalizable(const Symbol &);
-bool IsFinalizable(const DerivedTypeSpec &);
+bool IsFinalizable(
+ const Symbol &, std::set<const DerivedTypeSpec *> * = nullptr);
+bool IsFinalizable(
+ const DerivedTypeSpec &, std::set<const DerivedTypeSpec *> * = nullptr);
bool HasImpureFinal(const DerivedTypeSpec &);
bool IsCoarray(const Symbol &);
bool IsInBlankCommon(const Symbol &);
diff --git a/flang/include/flang/Semantics/type.h b/flang/include/flang/Semantics/type.h
index 44068184046d0..1ddfe0160a51f 100644
--- a/flang/include/flang/Semantics/type.h
+++ b/flang/include/flang/Semantics/type.h
@@ -258,6 +258,7 @@ class DerivedTypeSpec {
bool IsForwardReferenced() const;
bool HasDefaultInitialization() const;
bool HasDestruction() const;
+ bool HasFinalization() 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/Semantics/runtime-type-info.cpp b/flang/lib/Semantics/runtime-type-info.cpp
index cb833cf01b876..f8c74460e7421 100644
--- a/flang/lib/Semantics/runtime-type-info.cpp
+++ b/flang/lib/Semantics/runtime-type-info.cpp
@@ -14,6 +14,7 @@
#include "flang/Evaluate/type.h"
#include "flang/Semantics/scope.h"
#include "flang/Semantics/tools.h"
+#include <functional>
#include <list>
#include <map>
#include <string>
@@ -68,12 +69,12 @@ class RuntimeTableBuilder {
std::vector<evaluate::StructureConstructor> DescribeBindings(
const Scope &dtScope, Scope &);
void DescribeGeneric(
- const GenericDetails &, std::vector<evaluate::StructureConstructor> &);
- void DescribeSpecialProc(std::vector<evaluate::StructureConstructor> &,
+ const GenericDetails &, std::map<int, evaluate::StructureConstructor> &);
+ void DescribeSpecialProc(std::map<int, evaluate::StructureConstructor> &,
const Symbol &specificOrBinding, bool isAssignment, bool isFinal,
std::optional<GenericKind::DefinedIo>);
void IncorporateDefinedIoGenericInterfaces(
- std::vector<evaluate::StructureConstructor> &, SourceName,
+ std::map<int, evaluate::StructureConstructor> &, SourceName,
GenericKind::DefinedIo, const Scope *);
// Instantiated for ParamValue and Bound
@@ -124,16 +125,16 @@ class RuntimeTableBuilder {
SomeExpr deferredEnum_; // Value::Genre::Deferred
SomeExpr explicitEnum_; // Value::Genre::Explicit
SomeExpr lenParameterEnum_; // Value::Genre::LenParameter
- SomeExpr assignmentEnum_; // SpecialBinding::Which::Assignment
+ SomeExpr scalarAssignmentEnum_; // SpecialBinding::Which::ScalarAssignment
SomeExpr
elementalAssignmentEnum_; // SpecialBinding::Which::ElementalAssignment
- SomeExpr finalEnum_; // SpecialBinding::Which::Final
- SomeExpr elementalFinalEnum_; // SpecialBinding::Which::ElementalFinal
- SomeExpr assumedRankFinalEnum_; // SpecialBinding::Which::AssumedRankFinal
SomeExpr readFormattedEnum_; // SpecialBinding::Which::ReadFormatted
SomeExpr readUnformattedEnum_; // SpecialBinding::Which::ReadUnformatted
SomeExpr writeFormattedEnum_; // SpecialBinding::Which::WriteFormatted
SomeExpr writeUnformattedEnum_; // SpecialBinding::Which::WriteUnformatted
+ SomeExpr elementalFinalEnum_; // SpecialBinding::Which::ElementalFinal
+ SomeExpr assumedRankFinalEnum_; // SpecialBinding::Which::AssumedRankFinal
+ SomeExpr scalarFinalEnum_; // SpecialBinding::Which::ScalarFinal
parser::CharBlock location_;
std::set<const Scope *> ignoreScopes_;
};
@@ -148,15 +149,15 @@ RuntimeTableBuilder::RuntimeTableBuilder(
"deferred")},
explicitEnum_{GetEnumValue("explicit")}, lenParameterEnum_{GetEnumValue(
"lenparameter")},
- assignmentEnum_{GetEnumValue("assignment")},
+ scalarAssignmentEnum_{GetEnumValue("scalarassignment")},
elementalAssignmentEnum_{GetEnumValue("elementalassignment")},
- finalEnum_{GetEnumValue("final")}, elementalFinalEnum_{GetEnumValue(
- "elementalfinal")},
- assumedRankFinalEnum_{GetEnumValue("assumedrankfinal")},
readFormattedEnum_{GetEnumValue("readformatted")},
readUnformattedEnum_{GetEnumValue("readunformatted")},
writeFormattedEnum_{GetEnumValue("writeformatted")},
- writeUnformattedEnum_{GetEnumValue("writeunformatted")} {
+ writeUnformattedEnum_{GetEnumValue("writeunformatted")},
+ elementalFinalEnum_{GetEnumValue("elementalfinal")},
+ assumedRankFinalEnum_{GetEnumValue("assumedrankfinal")},
+ scalarFinalEnum_{GetEnumValue("scalarfinal")} {
ignoreScopes_.insert(tables_.schemata);
}
@@ -399,9 +400,6 @@ const Symbol *RuntimeTableBuilder::DescribeType(Scope &dtScope) {
AddValue(dtValues, derivedTypeSchema_, "uninstantiated"s,
SomeExpr{evaluate::NullPointer{}});
}
-
- // TODO: compute typeHash
-
using Int8 = evaluate::Type<TypeCategory::Integer, 8>;
using Int1 = evaluate::Type<TypeCategory::Integer, 1>;
std::vector<Int8::Scalar> kinds;
@@ -442,7 +440,7 @@ const Symbol *RuntimeTableBuilder::DescribeType(Scope &dtScope) {
if (!isPDTdefinition) {
std::vector<const Symbol *> dataComponentSymbols;
std::vector<evaluate::StructureConstructor> procPtrComponents;
- std::vector<evaluate::StructureConstructor> specials;
+ std::map<int, evaluate::StructureConstructor> specials;
for (const auto &pair : dtScope) {
const Symbol &symbol{*pair.second};
auto locationRestorer{common::ScopedSet(location_, symbol.name())};
@@ -507,12 +505,10 @@ const Symbol *RuntimeTableBuilder::DescribeType(Scope &dtScope) {
static_cast<evaluate::ConstantSubscript>(bindings.size())}));
// Describe "special" bindings to defined assignments, FINAL subroutines,
// and user-defined derived type I/O subroutines.
- if (dtScope.symbol()) {
- for (const auto &pair :
- dtScope.symbol()->get<DerivedTypeDetails>().finals()) {
- DescribeSpecialProc(specials, *pair.second, false /*!isAssignment*/,
- true, std::nullopt);
- }
+ const DerivedTypeDetails &dtDetails{dtSymbol->get<DerivedTypeDetails>()};
+ for (const auto &pair : dtDetails.finals()) {
+ DescribeSpecialProc(
+ specials, *pair.second, false /*!isAssignment*/, true, std::nullopt);
}
IncorporateDefinedIoGenericInterfaces(specials,
SourceName{"read(formatted)", 15},
@@ -526,11 +522,24 @@ const Symbol *RuntimeTableBuilder::DescribeType(Scope &dtScope) {
IncorporateDefinedIoGenericInterfaces(specials,
SourceName{"write(unformatted)", 18},
GenericKind::DefinedIo::WriteUnformatted, &scope);
+ // Pack the special procedure bindings in ascending order of their "which"
+ // code values, and compile a little-endian bit-set of those codes for
+ // use in O(1) look-up at run time.
+ std::vector<evaluate::StructureConstructor> sortedSpecials;
+ std::uint32_t specialBitSet{0};
+ for (auto &pair : specials) {
+ auto bit{std::uint32_t{1} << pair.first};
+ CHECK(!(specialBitSet & bit));
+ specialBitSet |= bit;
+ sortedSpecials.emplace_back(std::move(pair.second));
+ }
AddValue(dtValues, derivedTypeSchema_, "special"s,
SaveDerivedPointerTarget(scope, SaveObjectName(".s."s + distinctName),
- std::move(specials),
+ std::move(sortedSpecials),
evaluate::ConstantSubscripts{
static_cast<evaluate::ConstantSubscript>(specials.size())}));
+ AddValue(dtValues, derivedTypeSchema_, "specialbitset"s,
+ IntExpr<4>(specialBitSet));
// Note the presence/absence of a parent component
AddValue(dtValues, derivedTypeSchema_, "hasparent"s,
IntExpr<1>(dtScope.GetDerivedTypeParent() != nullptr));
@@ -543,6 +552,9 @@ const Symbol *RuntimeTableBuilder::DescribeType(Scope &dtScope) {
// Similarly, a flag to short-circuit destruction when not needed.
AddValue(dtValues, derivedTypeSchema_, "nodestructionneeded"s,
IntExpr<1>(derivedTypeSpec && !derivedTypeSpec->HasDestruction()));
+ // Similarly, a flag to short-circuit finalization when not needed.
+ AddValue(dtValues, derivedTypeSchema_, "nofinalizationneeded"s,
+ IntExpr<1>(derivedTypeSpec && !IsFinalizable(*derivedTypeSpec)));
}
dtObject.get<ObjectEntityDetails>().set_init(MaybeExpr{
StructureExpr(Structure(derivedTypeSchema_, std::move(dtValues)))});
@@ -904,7 +916,7 @@ RuntimeTableBuilder::DescribeBindings(const Scope &dtScope, Scope &scope) {
}
void RuntimeTableBuilder::DescribeGeneric(const GenericDetails &generic,
- std::vector<evaluate::StructureConstructor> &specials) {
+ std::map<int, evaluate::StructureConstructor> &specials) {
std::visit(common::visitors{
[&](const GenericKind::OtherKind &k) {
if (k == GenericKind::OtherKind::Assignment) {
@@ -933,21 +945,21 @@ void RuntimeTableBuilder::DescribeGeneric(const GenericDetails &generic,
}
void RuntimeTableBuilder::DescribeSpecialProc(
- std::vector<evaluate::StructureConstructor> &specials,
+ std::map<int, evaluate::StructureConstructor> &specials,
const Symbol &specificOrBinding, bool isAssignment, bool isFinal,
std::optional<GenericKind::DefinedIo> io) {
const auto *binding{specificOrBinding.detailsIf<ProcBindingDetails>()};
const Symbol &specific{*(binding ? &binding->symbol() : &specificOrBinding)};
if (auto proc{evaluate::characteristics::Procedure::Characterize(
specific, context_.foldingContext())}) {
- std::uint8_t rank{0};
std::uint8_t isArgDescriptorSet{0};
int argThatMightBeDescriptor{0};
MaybeExpr which;
if (isAssignment) { // only type-bound asst's are germane to runtime
CHECK(binding != nullptr);
CHECK(proc->dummyArguments.size() == 2);
- which = proc->IsElemental() ? elementalAssignmentEnum_ : assignmentEnum_;
+ which = proc->IsElemental() ? elementalAssignmentEnum_
+ : scalarAssignmentEnum_;
if (binding && binding->passName() &&
*binding->passName() == proc->dummyArguments[1].name) {
argThatMightBeDescriptor = 1;
@@ -971,10 +983,10 @@ void RuntimeTableBuilder::DescribeSpecialProc(
which = assumedRankFinalEnum_;
isArgDescriptorSet |= 1;
} else {
- which = finalEnum_;
- rank = evaluate::GetRank(typeAndShape.shape());
- if (rank > 0) {
+ which = scalarFinalEnum_;
+ if (int rank{evaluate::GetRank(typeAndShape.shape())}; rank > 0) {
argThatMightBeDescriptor = 1;
+ which = IntExpr<1>(ToInt64(which).value() + rank);
}
}
}
@@ -1004,19 +1016,22 @@ void RuntimeTableBuilder::DescribeSpecialProc(
isArgDescriptorSet |= 1 << (argThatMightBeDescriptor - 1);
}
evaluate::StructureConstructorValues values;
+ auto index{evaluate::ToInt64(which)};
+ CHECK(index.has_value());
AddValue(
values, specialSchema_, "which"s, SomeExpr{std::move(which.value())});
- AddValue(values, specialSchema_, "rank"s, IntExpr<1>(rank));
AddValue(values, specialSchema_, "isargdescriptorset"s,
IntExpr<1>(isArgDescriptorSet));
AddValue(values, specialSchema_, "proc"s,
SomeExpr{evaluate::ProcedureDesignator{specific}});
- specials.emplace_back(DEREF(specialSchema_.AsDerived()), std::move(values));
+ auto pair{specials.try_emplace(
+ *index, DEREF(specialSchema_.AsDerived()), std::move(values))};
+ CHECK(pair.second); // ensure not already present
}
}
void RuntimeTableBuilder::IncorporateDefinedIoGenericInterfaces(
- std::vector<evaluate::StructureConstructor> &specials, SourceName name,
+ std::map<int, evaluate::StructureConstructor> &specials, SourceName name,
GenericKind::DefinedIo definedIo, const Scope *scope) {
for (; !scope->IsGlobal(); scope = &scope->parent()) {
if (auto asst{scope->find(name)}; asst != scope->end()) {
diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp
index feb07f7a8fdda..7cd6382fea6d9 100644
--- a/flang/lib/Semantics/tools.cpp
+++ b/flang/lib/Semantics/tools.cpp
@@ -687,7 +687,8 @@ bool IsAutomatic(const Symbol &symbol) {
return false;
}
-bool IsFinalizable(const Symbol &symbol) {
+bool IsFinalizable(
+ const Symbol &symbol, std::set<const DerivedTypeSpec *> *inProgress) {
if (IsPointer(symbol)) {
return false;
}
@@ -696,19 +697,33 @@ bool IsFinalizable(const Symbol &symbol) {
return false;
}
const DeclTypeSpec *type{object->type()};
- const DerivedTypeSpec *derived{type ? type->AsDerived() : nullptr};
- return derived && IsFinalizable(*derived);
+ const DerivedTypeSpec *typeSpec{type ? type->AsDerived() : nullptr};
+ return typeSpec && IsFinalizable(*typeSpec, inProgress);
}
return false;
}
-bool IsFinalizable(const DerivedTypeSpec &derived) {
+bool IsFinalizable(const DerivedTypeSpec &derived,
+ std::set<const DerivedTypeSpec *> *inProgress) {
if (!derived.typeSymbol().get<DerivedTypeDetails>().finals().empty()) {
return true;
}
- DirectComponentIterator components{derived};
- return bool{std::find_if(components.begin(), components.end(),
- [](const Symbol &component) { return IsFinalizable(component); })};
+ std::set<const DerivedTypeSpec *> basis;
+ if (inProgress) {
+ if (inProgress->find(&derived) != inProgress->end()) {
+ return false; // don't loop on recursive type
+ }
+ } else {
+ inProgress = &basis;
+ }
+ auto iterator{inProgress->insert(&derived).first};
+ PotentialComponentIterator components{derived};
+ bool result{bool{std::find_if(
+ components.begin(), components.end(), [=](const Symbol &component) {
+ return IsFinalizable(component, inProgress);
+ })}};
+ inProgress->erase(iterator);
+ return result;
}
bool HasImpureFinal(const DerivedTypeSpec &derived) {
diff --git a/flang/module/__fortran_type_info.f90 b/flang/module/__fortran_type_info.f90
index dcdc5619a8614..f3a5904728983 100644
--- a/flang/module/__fortran_type_info.f90
+++ b/flang/module/__fortran_type_info.f90
@@ -36,7 +36,6 @@
! 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 component order.
@@ -44,11 +43,15 @@
type(Component), pointer, contiguous :: component(:) ! data components
type(ProcPtrComponent), pointer, contiguous :: procptr(:) ! procedure pointers
! Special bindings of the ancestral types are not duplicated here.
+ ! Bindings are in ascending order of their "which" code values.
type(SpecialBinding), pointer, contiguous :: special(:)
+ ! A little-endian bit set of SpecialBinding::Which codes present in "special"
+ integer(4) :: specialBitSet
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)
+ integer(1) :: noFinalizationNeeded ! 1 if nothing finalizaable
+ integer(1) :: __padding0(4)
end type
type :: Binding
@@ -101,17 +104,17 @@
end type
enum, bind(c) ! SpecialBinding::Which
- enumerator :: Assignment = 4, ElementalAssignment = 5
- enumerator :: Final = 8, ElementalFinal = 9, AssumedRankFinal = 10
- enumerator :: ReadFormatted = 16, ReadUnformatted = 17
- enumerator :: WriteFormatted = 18, WriteUnformatted = 19
+ enumerator :: ScalarAssignment = 1, ElementalAssignment = 2
+ enumerator :: ReadFormatted = 3, ReadUnformatted = 4
+ enumerator :: WriteFormatted = 5, WriteUnformatted = 6
+ enumerator :: ElementalFinal = 7, AssumedRankFinal = 8
+ enumerator :: ScalarFinal = 9 ! higher-rank final procedures follow
end enum
type, bind(c) :: SpecialBinding
integer(1) :: which ! SpecialBinding::Which
- integer(1) :: rank ! for which == SpecialBinding::Which::Final only
integer(1) :: isArgDescriptorSet
- integer(1) :: __padding0(5)
+ integer(1) :: __padding0(6)
type(__builtin_c_funptr) :: proc
end type
diff --git a/flang/runtime/CMakeLists.txt b/flang/runtime/CMakeLists.txt
index 971ce90e10a02..bc5c2d1e27643 100644
--- a/flang/runtime/CMakeLists.txt
+++ b/flang/runtime/CMakeLists.txt
@@ -33,6 +33,7 @@ include_directories(AFTER ${CMAKE_CURRENT_BINARY_DIR})
add_flang_library(FortranRuntime
ISO_Fortran_binding.cpp
allocatable.cpp
+ assign.cpp
buffer.cpp
complex-reduction.c
copy.cpp
diff --git a/flang/runtime/allocatable.cpp b/flang/runtime/allocatable.cpp
index 9416590fa5721..10ccb68637cbe 100644
--- a/flang/runtime/allocatable.cpp
+++ b/flang/runtime/allocatable.cpp
@@ -7,6 +7,7 @@
//===----------------------------------------------------------------------===//
#include "allocatable.h"
+#include "assign.h"
#include "derived.h"
#include "stat.h"
#include "terminator.h"
@@ -37,10 +38,6 @@ void RTNAME(AllocatableInitDerived)(Descriptor &descriptor,
derivedType, nullptr, rank, nullptr, CFI_attribute_allocatable);
}
-void RTNAME(AllocatableAssign)(Descriptor &to, const Descriptor & /*from*/) {
- 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*/) {
diff --git a/flang/runtime/allocatable.h b/flang/runtime/allocatable.h
index 91c58c65b05f4..0a7332e0f9c10 100644
--- a/flang/runtime/allocatable.h
+++ b/flang/runtime/allocatable.h
@@ -89,15 +89,6 @@ int RTNAME(AllocatableAllocateSource)(Descriptor &, const Descriptor &source,
bool hasStat = false, const Descriptor *errMsg = nullptr,
const char *sourceFile = nullptr, int sourceLine = 0);
-// Assigns to a whole allocatable, with automatic (re)allocation when the
-// destination is unallocated or nonconforming (Fortran 2003 semantics).
-// The descriptor must be initialized.
-// Recursively assigns components with (re)allocation as necessary.
-// TODO: Consider renaming to a more general name that will work for
-// assignments to pointers, dummy arguments, and anything else with a
-// descriptor.
-void RTNAME(AllocatableAssign)(Descriptor &to, const Descriptor &from);
-
// Implements the intrinsic subroutine MOVE_ALLOC (16.9.137 in F'2018,
// but note the order of first two arguments is reversed for consistency
// with the other APIs for allocatables.) The destination descriptor
diff --git a/flang/runtime/assign.cpp b/flang/runtime/assign.cpp
new file mode 100644
index 0000000000000..5f31ad0a86b5d
--- /dev/null
+++ b/flang/runtime/assign.cpp
@@ -0,0 +1,285 @@
+//===-- runtime/assign.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 "assign.h"
+#include "derived.h"
+#include "descriptor.h"
+#include "stat.h"
+#include "terminator.h"
+#include "type-info.h"
+
+namespace Fortran::runtime {
+
+static void DoScalarDefinedAssignment(const Descriptor &to,
+ const Descriptor &from, const typeInfo::SpecialBinding &special) {
+ bool toIsDesc{special.IsArgDescriptor(0)};
+ bool fromIsDesc{special.IsArgDescriptor(1)};
+ if (toIsDesc) {
+ if (fromIsDesc) {
+ auto *p{
+ special.GetProc<void (*)(const Descriptor &, const Descriptor &)>()};
+ p(to, from);
+ } else {
+ auto *p{special.GetProc<void (*)(const Descriptor &, void *)>()};
+ p(to, from.raw().base_addr);
+ }
+ } else {
+ if (fromIsDesc) {
+ auto *p{special.GetProc<void (*)(void *, const Descriptor &)>()};
+ p(to.raw().base_addr, from);
+ } else {
+ auto *p{special.GetProc<void (*)(void *, void *)>()};
+ p(to.raw().base_addr, from.raw().base_addr);
+ }
+ }
+}
+
+static void DoElementalDefinedAssignment(const Descriptor &to,
+ const Descriptor &from, const typeInfo::SpecialBinding &special,
+ std::size_t toElements, SubscriptValue toAt[], SubscriptValue fromAt[]) {
+ StaticDescriptor<maxRank, true, 8 /*?*/> statDesc[2];
+ Descriptor &toElementDesc{statDesc[0].descriptor()};
+ Descriptor &fromElementDesc{statDesc[1].descriptor()};
+ toElementDesc = to;
+ toElementDesc.raw().attribute = CFI_attribute_pointer;
+ toElementDesc.raw().rank = 0;
+ fromElementDesc = from;
+ fromElementDesc.raw().attribute = CFI_attribute_pointer;
+ fromElementDesc.raw().rank = 0;
+ for (std::size_t j{0}; j < toElements;
+ ++j, to.IncrementSubscripts(toAt), from.IncrementSubscripts(fromAt)) {
+ toElementDesc.set_base_addr(to.Element<char>(toAt));
+ fromElementDesc.set_base_addr(from.Element<char>(fromAt));
+ DoScalarDefinedAssignment(toElementDesc, fromElementDesc, special);
+ }
+}
+
+void Assign(Descriptor &to, const Descriptor &from, Terminator &terminator) {
+ DescriptorAddendum *toAddendum{to.Addendum()};
+ const typeInfo::DerivedType *toDerived{
+ toAddendum ? toAddendum->derivedType() : nullptr};
+ const DescriptorAddendum *fromAddendum{from.Addendum()};
+ const typeInfo::DerivedType *fromDerived{
+ fromAddendum ? fromAddendum->derivedType() : nullptr};
+ bool wasJustAllocated{false};
+ if (to.IsAllocatable()) {
+ std::size_t lenParms{fromDerived ? fromDerived->LenParameters() : 0};
+ if (to.IsAllocated()) {
+ // Top-level assignments to allocatable variables (*not* components)
+ // may first deallocate existing content if there's about to be a
+ // change in type or shape; see F'2018 10.2.1.3(3).
+ bool deallocate{false};
+ if (to.type() != from.type()) {
+ deallocate = true;
+ } else if (toDerived != fromDerived) {
+ deallocate = true;
+ } else {
+ if (toAddendum) {
+ // Distinct LEN parameters? Deallocate
+ for (std::size_t j{0}; j < lenParms; ++j) {
+ if (toAddendum->LenParameterValue(j) !=
+ fromAddendum->LenParameterValue(j)) {
+ deallocate = true;
+ break;
+ }
+ }
+ }
+ if (from.rank() > 0) {
+ // Distinct shape? Deallocate
+ int rank{to.rank()};
+ for (int j{0}; j < rank; ++j) {
+ if (to.GetDimension(j).Extent() != from.GetDimension(j).Extent()) {
+ deallocate = true;
+ break;
+ }
+ }
+ }
+ }
+ if (deallocate) {
+ to.Destroy(true /*finalize*/);
+ }
+ } else if (to.rank() != from.rank()) {
+ terminator.Crash("Assign: mismatched ranks (%d != %d) in assignment to "
+ "unallocated allocatable",
+ to.rank(), from.rank());
+ }
+ if (!to.IsAllocated()) {
+ to.raw().type = from.raw().type;
+ to.raw().elem_len = from.ElementBytes();
+ if (toAddendum) {
+ toDerived = fromDerived;
+ toAddendum->set_derivedType(toDerived);
+ for (std::size_t j{0}; j < lenParms; ++j) {
+ toAddendum->SetLenParameterValue(
+ j, fromAddendum->LenParameterValue(j));
+ }
+ }
+ // subtle: leave bounds in place when "from" is scalar (10.2.1.3(3))
+ int rank{from.rank()};
+ auto stride{static_cast<SubscriptValue>(to.ElementBytes())};
+ for (int j{0}; j < rank; ++j) {
+ auto &toDim{to.GetDimension(j)};
+ const auto &fromDim{from.GetDimension(j)};
+ toDim.SetBounds(fromDim.LowerBound(), fromDim.UpperBound());
+ toDim.SetByteStride(stride);
+ stride *= toDim.Extent();
+ }
+ ReturnError(terminator, to.Allocate());
+ if (fromDerived && !fromDerived->noInitializationNeeded()) {
+ ReturnError(terminator, Initialize(to, *toDerived, terminator));
+ }
+ wasJustAllocated = true;
+ }
+ }
+ SubscriptValue toAt[maxRank];
+ to.GetLowerBounds(toAt);
+ // Scalar expansion of the RHS is implied by using the same empty
+ // subscript values on each (seemingly) elemental reference into
+ // "from".
+ SubscriptValue fromAt[maxRank];
+ from.GetLowerBounds(fromAt);
+ std::size_t toElements{to.Elements()};
+ if (from.rank() > 0 && toElements != from.Elements()) {
+ terminator.Crash("Assign: mismatching element counts in array assignment "
+ "(to %zd, from %zd)",
+ toElements, from.Elements());
+ }
+ if (to.type() != from.type()) {
+ terminator.Crash("Assign: mismatching types (to code %d != from code %d)",
+ to.type().raw(), from.type().raw());
+ }
+ std::size_t elementBytes{to.ElementBytes()};
+ if (elementBytes != from.ElementBytes()) {
+ terminator.Crash(
+ "Assign: mismatching element sizes (to %zd bytes != from %zd bytes)",
+ elementBytes, from.ElementBytes());
+ }
+ if (toDerived) { // Derived type assignment
+ // Check for defined assignment type-bound procedures (10.2.1.4-5)
+ if (to.rank() == 0) {
+ if (const auto *special{toDerived->FindSpecialBinding(
+ typeInfo::SpecialBinding::Which::ScalarAssignment)}) {
+ return DoScalarDefinedAssignment(to, from, *special);
+ }
+ }
+ if (const auto *special{toDerived->FindSpecialBinding(
+ typeInfo::SpecialBinding::Which::ElementalAssignment)}) {
+ return DoElementalDefinedAssignment(
+ to, from, *special, toElements, toAt, fromAt);
+ }
+ // Derived type intrinsic assignment, which is componentwise and elementwise
+ // for all components, including parent components (10.2.1.2-3).
+ // The target is first finalized if still necessary (7.5.6.3(1))
+ if (!wasJustAllocated && !toDerived->noFinalizationNeeded()) {
+ Finalize(to, *toDerived);
+ }
+ // Copy the data components (incl. the parent) first.
+ const Descriptor &componentDesc{toDerived->component()};
+ std::size_t numComponents{componentDesc.Elements()};
+ for (std::size_t k{0}; k < numComponents; ++k) {
+ const auto &comp{
+ *componentDesc.ZeroBasedIndexedElement<typeInfo::Component>(
+ k)}; // TODO: exploit contiguity here
+ switch (comp.genre()) {
+ case typeInfo::Component::Genre::Data:
+ if (comp.category() == TypeCategory::Derived) {
+ StaticDescriptor<maxRank, true, 10 /*?*/> statDesc[2];
+ Descriptor &toCompDesc{statDesc[0].descriptor()};
+ Descriptor &fromCompDesc{statDesc[1].descriptor()};
+ for (std::size_t j{0}; j < toElements; ++j,
+ to.IncrementSubscripts(toAt), from.IncrementSubscripts(fromAt)) {
+ comp.CreatePointerDescriptor(toCompDesc, to, toAt, terminator);
+ comp.CreatePointerDescriptor(
+ fromCompDesc, from, fromAt, terminator);
+ Assign(toCompDesc, fromCompDesc, terminator);
+ }
+ } else { // Component has intrinsic type; simply copy raw bytes
+ std::size_t componentByteSize{comp.SizeInBytes(to)};
+ for (std::size_t j{0}; j < toElements; ++j,
+ to.IncrementSubscripts(toAt), from.IncrementSubscripts(fromAt)) {
+ std::memmove(to.Element<char>(toAt) + comp.offset(),
+ from.Element<const char>(fromAt) + comp.offset(),
+ componentByteSize);
+ }
+ }
+ break;
+ case typeInfo::Component::Genre::Pointer: {
+ std::size_t componentByteSize{comp.SizeInBytes(to)};
+ for (std::size_t j{0}; j < toElements; ++j,
+ to.IncrementSubscripts(toAt), from.IncrementSubscripts(fromAt)) {
+ std::memmove(to.Element<char>(toAt) + comp.offset(),
+ from.Element<const char>(fromAt) + comp.offset(),
+ componentByteSize);
+ }
+ } break;
+ case typeInfo::Component::Genre::Allocatable:
+ case typeInfo::Component::Genre::Automatic:
+ for (std::size_t j{0}; j < toElements; ++j,
+ to.IncrementSubscripts(toAt), from.IncrementSubscripts(fromAt)) {
+ auto *toDesc{reinterpret_cast<Descriptor *>(
+ to.Element<char>(toAt) + comp.offset())};
+ const auto *fromDesc{reinterpret_cast<const Descriptor *>(
+ from.Element<char>(fromAt) + comp.offset())};
+ if (toDesc->IsAllocatable()) {
+ if (toDesc->IsAllocated()) {
+ // Allocatable components of the LHS are unconditionally
+ // deallocated before assignment (F'2018 10.2.1.3(13)(1)),
+ // unlike a "top-level" assignment to a variable, where
+ // deallocation is optional.
+ // TODO: Consider skipping this step and deferring the
+ // deallocation to the recursive activation of Assign(),
+ // which might be able to avoid deallocation/reallocation
+ // when the existing allocation can be reoccupied.
+ toDesc->Destroy(false /*already finalized*/);
+ }
+ if (!fromDesc->IsAllocated()) {
+ continue; // F'2018 10.2.1.3(13)(2)
+ }
+ }
+ Assign(*toDesc, *fromDesc, terminator);
+ }
+ break;
+ }
+ }
+ // Copy procedure pointer components
+ const Descriptor &procPtrDesc{toDerived->procPtr()};
+ std::size_t numProcPtrs{procPtrDesc.Elements()};
+ for (std::size_t k{0}; k < numProcPtrs; ++k) {
+ const auto &procPtr{
+ *procPtrDesc.ZeroBasedIndexedElement<typeInfo::ProcPtrComponent>(k)};
+ for (std::size_t j{0}; j < toElements; ++j, to.IncrementSubscripts(toAt),
+ from.IncrementSubscripts(fromAt)) {
+ std::memmove(to.Element<char>(toAt) + procPtr.offset,
+ from.Element<const char>(fromAt) + procPtr.offset,
+ sizeof(typeInfo::ProcedurePointer));
+ }
+ }
+ } else { // intrinsic type, intrinsic assignment
+ if (to.rank() == from.rank() && to.IsContiguous() && from.IsContiguous()) {
+ // Everything is contiguous; do a single big copy
+ std::memmove(
+ to.raw().base_addr, from.raw().base_addr, toElements * elementBytes);
+ } else { // elemental copies
+ for (std::size_t n{toElements}; n-- > 0;
+ to.IncrementSubscripts(toAt), from.IncrementSubscripts(fromAt)) {
+ std::memmove(to.Element<char>(toAt), from.Element<const char>(fromAt),
+ elementBytes);
+ }
+ }
+ }
+}
+
+extern "C" {
+void RTNAME(Assign)(Descriptor &to, const Descriptor &from,
+ const char *sourceFile, int sourceLine) {
+ Terminator terminator{sourceFile, sourceLine};
+ Assign(to, from, terminator);
+}
+
+} // extern "C"
+} // namespace Fortran::runtime
diff --git a/flang/runtime/assign.h b/flang/runtime/assign.h
new file mode 100644
index 0000000000000..c68779920269c
--- /dev/null
+++ b/flang/runtime/assign.h
@@ -0,0 +1,45 @@
+//===-- runtime/assign.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
+//
+//===----------------------------------------------------------------------===//
+
+// External and internal APIs for data assignment (both intrinsic assignment
+// and TBP defined generic ASSIGNMENT(=)). Should be called by lowering
+// for any assignments possibly needing special handling. Intrinsic assignment
+// to non-allocatable variables whose types are intrinsic need not come through
+// here (though they may do so). Assignments to allocatables, and assignments
+// whose types may be polymorphic or are monomorphic and of derived types with
+// finalization, allocatable components, or components with type-bound defined
+// assignments, in the original type or the types of its non-pointer components
+// (recursively) must arrive here.
+//
+// Non-type-bound generic INTERFACE ASSIGNMENT(=) is resolved in semantics and
+// need not be handled here in the runtime; ditto for type conversions on
+// intrinsic assignments.
+
+#ifndef FLANG_RUNTIME_ASSIGN_H_
+#define FLANG_RUNTIME_ASSIGN_H_
+
+#include "entry-names.h"
+
+namespace Fortran::runtime {
+class Descriptor;
+class Terminator;
+
+// Assigns one object to another via intrinsic assignment (F'2018 10.2.1.3) or
+// type-bound (only!) defined assignment (10.2.1.4), as appropriate. Performs
+// finalization, scalar expansion, & allocatable (re)allocation as needed.
+// Does not perform intrinsic assignment implicit type conversion. Both
+// descriptors must be initialized. Recurses as needed to handle components.
+void Assign(Descriptor &, const Descriptor &, Terminator &);
+
+extern "C" {
+// API for lowering assignment
+void RTNAME(Assign)(Descriptor &to, const Descriptor &from,
+ const char *sourceFile = nullptr, int sourceLine = 0);
+} // extern "C"
+} // namespace Fortran::runtime
+#endif // FLANG_RUNTIME_ASSIGN_H_
diff --git a/flang/runtime/derived.cpp b/flang/runtime/derived.cpp
index 61511b50410c3..6ae4d3e146b31 100644
--- a/flang/runtime/derived.cpp
+++ b/flang/runtime/derived.cpp
@@ -95,27 +95,16 @@ int Initialize(const Descriptor &instance, const typeInfo::DerivedType &derived,
static const typeInfo::SpecialBinding *FindFinal(
const typeInfo::DerivedType &derived, int rank) {
- const typeInfo::SpecialBinding *elemental{nullptr};
- const Descriptor &specialDesc{derived.special()};
- std::size_t totalSpecialBindings{specialDesc.Elements()};
- for (std::size_t j{0}; j < totalSpecialBindings; ++j) {
- const auto &special{
- *specialDesc.ZeroBasedIndexedElement<typeInfo::SpecialBinding>(j)};
- switch (special.which()) {
- case typeInfo::SpecialBinding::Which::Final:
- if (special.rank() == rank) {
- return &special;
- }
- break;
- case typeInfo::SpecialBinding::Which::ElementalFinal:
- elemental = &special;
- break;
- case typeInfo::SpecialBinding::Which::AssumedRankFinal:
- return &special;
- default:;
- }
+ if (const auto *ranked{derived.FindSpecialBinding(
+ typeInfo::SpecialBinding::RankFinal(rank))}) {
+ return ranked;
+ } else if (const auto *assumed{derived.FindSpecialBinding(
+ typeInfo::SpecialBinding::Which::AssumedRankFinal)}) {
+ return assumed;
+ } else {
+ return derived.FindSpecialBinding(
+ typeInfo::SpecialBinding::Which::ElementalFinal);
}
- return elemental;
}
static void CallFinalSubroutine(
@@ -159,24 +148,22 @@ static void CallFinalSubroutine(
}
}
-// The order of finalization follows Fortran 2018 7.5.6.2, with
-// deallocation of non-parent components (and their consequent finalization)
-// taking place before parent component finalization.
-void Destroy(const Descriptor &descriptor, bool finalize,
- const typeInfo::DerivedType &derived) {
- if (finalize) {
- CallFinalSubroutine(descriptor, derived);
+// Fortran 2018 subclause 7.5.6.2
+void Finalize(
+ const Descriptor &descriptor, const typeInfo::DerivedType &derived) {
+ if (derived.noFinalizationNeeded() || !descriptor.IsAllocated()) {
+ return;
}
+ CallFinalSubroutine(descriptor, derived);
+ const auto *parentType{derived.GetParentType()};
+ bool recurse{parentType && !parentType->noFinalizationNeeded()};
+ // 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.
const Descriptor &componentDesc{derived.component()};
std::size_t myComponents{componentDesc.Elements()};
std::size_t elements{descriptor.Elements()};
std::size_t byteStride{descriptor.ElementBytes()};
- // 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};
@@ -186,20 +173,18 @@ void Destroy(const Descriptor &descriptor, bool finalize,
if (comp.genre() == typeInfo::Component::Genre::Allocatable ||
comp.genre() == typeInfo::Component::Genre::Automatic) {
if (const typeInfo::DerivedType * compType{comp.derivedType()}) {
- if (!compType->noDestructionNeeded()) {
+ if (!compType->noFinalizationNeeded()) {
for (std::size_t j{0}; j < elements; ++j) {
- Destroy(*descriptor.OffsetElement<Descriptor>(
- j * byteStride + comp.offset()),
- finalize, *compType);
+ const Descriptor &compDesc{*descriptor.OffsetElement<Descriptor>(
+ j * byteStride + comp.offset())};
+ if (compDesc.IsAllocated()) {
+ Finalize(compDesc, *compType);
+ }
}
}
}
- for (std::size_t j{0}; j < elements; ++j) {
- descriptor.OffsetElement<Descriptor>(j * byteStride + comp.offset())
- ->Deallocate();
- }
} else if (comp.genre() == typeInfo::Component::Genre::Data &&
- comp.derivedType() && !comp.derivedType()->noDestructionNeeded()) {
+ comp.derivedType() && !comp.derivedType()->noFinalizationNeeded()) {
SubscriptValue extent[maxRank];
const typeInfo::Value *bounds{comp.bounds()};
for (int dim{0}; dim < comp.rank(); ++dim) {
@@ -213,15 +198,41 @@ void Destroy(const Descriptor &descriptor, bool finalize,
compDesc.Establish(compType,
descriptor.OffsetElement<char>(j * byteStride + comp.offset()),
comp.rank(), extent);
- Destroy(compDesc, finalize, compType);
+ Finalize(compDesc, compType);
}
}
}
if (recurse) {
- Destroy(descriptor, finalize, *parentType);
+ Finalize(descriptor, *parentType);
}
}
-// TODO: Assign()
+// The order of finalization follows Fortran 2018 7.5.6.2, with
+// elementwise deallocation of non-parent components (and their consequent
+// finalizations) taking place before parent component finalization.
+void Destroy(const Descriptor &descriptor, bool finalize,
+ const typeInfo::DerivedType &derived) {
+ if (derived.noDestructionNeeded() || !descriptor.IsAllocated()) {
+ return;
+ }
+ if (finalize && !derived.noFinalizationNeeded()) {
+ Finalize(descriptor, derived);
+ }
+ const Descriptor &componentDesc{derived.component()};
+ std::size_t myComponents{componentDesc.Elements()};
+ std::size_t elements{descriptor.Elements()};
+ std::size_t byteStride{descriptor.ElementBytes()};
+ 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.OffsetElement<Descriptor>(j * byteStride + comp.offset())
+ ->Deallocate();
+ }
+ }
+ }
+}
} // namespace Fortran::runtime
diff --git a/flang/runtime/derived.h b/flang/runtime/derived.h
index 7239d82b7e653..e6b35acdd8204 100644
--- a/flang/runtime/derived.h
+++ b/flang/runtime/derived.h
@@ -24,16 +24,12 @@ class Terminator;
int Initialize(const Descriptor &, const typeInfo::DerivedType &, Terminator &,
bool hasStat = false, const Descriptor *errMsg = nullptr);
+// Call FINAL subroutines, if any
+void Finalize(const Descriptor &, const typeInfo::DerivedType &derived);
+
// 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_DERIVED_H_
diff --git a/flang/runtime/type-info.cpp b/flang/runtime/type-info.cpp
index f731182f17838..8e26a53aac0be 100644
--- a/flang/runtime/type-info.cpp
+++ b/flang/runtime/type-info.cpp
@@ -153,21 +153,6 @@ const Component *DerivedType::FindDataComponent(
return parent ? parent->FindDataComponent(compName, compNameLen) : nullptr;
}
-const SpecialBinding *DerivedType::FindSpecialBinding(
- SpecialBinding::Which which) const {
- const Descriptor &specialDesc{special()};
- std::size_t n{specialDesc.Elements()};
- SubscriptValue at[maxRank];
- specialDesc.GetLowerBounds(at);
- for (std::size_t j{0}; j < n; ++j, specialDesc.IncrementSubscripts(at)) {
- const SpecialBinding &special{*specialDesc.Element<SpecialBinding>(at)};
- if (special.which() == which) {
- return &special;
- }
- }
- return nullptr;
-}
-
static void DumpScalarCharacter(
FILE *f, const Descriptor &desc, const char *what) {
if (desc.raw().version == CFI_VERSION &&
@@ -198,8 +183,6 @@ FILE *DerivedType::Dump(FILE *f) const {
std::fputs(" <-- sizeInBytes_\n", f);
} else if (offset == offsetof(DerivedType, uninstantiated_)) {
std::fputs(" <-- uninstantiated_\n", f);
- } else if (offset == offsetof(DerivedType, typeHash_)) {
- std::fputs(" <-- typeHash_\n", f);
} else if (offset == offsetof(DerivedType, kindParameter_)) {
std::fputs(" <-- kindParameter_\n", f);
} else if (offset == offsetof(DerivedType, lenParameterKind_)) {
@@ -210,12 +193,10 @@ 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, specialBitSet_)) {
+ std::fputs(" <-- specialBitSet_\n", f);
} else if (offset == offsetof(DerivedType, hasParent_)) {
- std::fputs(
- " <-- hasParent_, noInitializationNeeded_, noDestructionNeeded_\n",
- f);
+ std::fputs(" <-- (flags)\n", f);
} else {
std::fputc('\n', f);
}
@@ -286,21 +267,12 @@ FILE *SpecialBinding::Dump(FILE *f) const {
std::fprintf(
f, "SpecialBinding @ 0x%p:\n", reinterpret_cast<const void *>(this));
switch (which_) {
- case Which::Assignment:
- std::fputs(" Assignment", f);
+ case Which::ScalarAssignment:
+ std::fputs(" ScalarAssignment", f);
break;
case Which::ElementalAssignment:
std::fputs(" ElementalAssignment", f);
break;
- case Which::Final:
- std::fputs(" Final", f);
- break;
- case Which::ElementalFinal:
- std::fputs(" ElementalFinal", f);
- break;
- case Which::AssumedRankFinal:
- std::fputs(" AssumedRankFinal", f);
- break;
case Which::ReadFormatted:
std::fputs(" ReadFormatted", f);
break;
@@ -313,12 +285,17 @@ FILE *SpecialBinding::Dump(FILE *f) const {
case Which::WriteUnformatted:
std::fputs(" WriteUnformatted", f);
break;
+ case Which::ElementalFinal:
+ std::fputs(" ElementalFinal", f);
+ break;
+ case Which::AssumedRankFinal:
+ std::fputs(" AssumedRankFinal", f);
+ break;
default:
- std::fprintf(
- f, " Unknown which: 0x%x", static_cast<std::uint8_t>(which_));
+ std::fprintf(f, " rank-%d final:",
+ static_cast<int>(which_) - static_cast<int>(Which::ScalarFinal));
break;
}
- std::fprintf(f, "\n rank: %d\n", rank_);
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 fc1bf7adc84a9..ef28536a03d4b 100644
--- a/flang/runtime/type-info.h
+++ b/flang/runtime/type-info.h
@@ -13,7 +13,9 @@
// flang/module/__fortran_type_info.f90.
#include "descriptor.h"
+#include "terminator.h"
#include "flang/Common/Fortran.h"
+#include "flang/Common/bit-population-count.h"
#include <cinttypes>
#include <memory>
#include <optional>
@@ -118,19 +120,23 @@ class SpecialBinding {
public:
enum class Which : std::uint8_t {
None = 0,
- Assignment = 4,
- ElementalAssignment = 5,
- Final = 8,
- ElementalFinal = 9,
- AssumedRankFinal = 10,
- ReadFormatted = 16,
- ReadUnformatted = 17,
- WriteFormatted = 18,
- WriteUnformatted = 19
+ ScalarAssignment = 1,
+ ElementalAssignment = 2,
+ ReadFormatted = 3,
+ ReadUnformatted = 4,
+ WriteFormatted = 5,
+ WriteUnformatted = 6,
+ ElementalFinal = 7,
+ AssumedRankFinal = 8,
+ ScalarFinal = 9,
+ // higher-ranked final procedures follow
};
+ static constexpr Which RankFinal(int rank) {
+ return static_cast<Which>(static_cast<int>(Which::ScalarFinal) + rank);
+ }
+
Which which() const { return which_; }
- int rank() const { return rank_; }
bool IsArgDescriptor(int zeroBasedArg) const {
return (isArgDescriptorSet_ >> zeroBasedArg) & 1;
}
@@ -143,12 +149,6 @@ class SpecialBinding {
private:
Which which_{Which::None};
- // Used for Which::Final only. Which::Assignment always has rank 0, as
- // type-bound defined assignment for rank > 0 must be elemental
- // due to the required passed object dummy argument, which are scalar.
- // User defined derived type I/O is always scalar.
- std::uint8_t rank_{0};
-
// The following little bit-set identifies which dummy arguments are
// passed via descriptors for their derived type arguments.
// Which::Assignment and Which::ElementalAssignment:
@@ -175,6 +175,7 @@ class SpecialBinding {
// When false, the user derived type I/O subroutine must have been
// called via a generic interface, not a generic TBP.
std::uint8_t isArgDescriptorSet_{0};
+ std::uint8_t __padding0_[6];
ProcedurePointer proc_{nullptr};
};
@@ -186,7 +187,6 @@ class DerivedType {
const Descriptor &binding() const { return binding_.descriptor(); }
const Descriptor &name() const { return name_.descriptor(); }
std::uint64_t sizeInBytes() const { return sizeInBytes_; }
- std::uint64_t typeHash() const { return typeHash_; }
const Descriptor &uninstatiated() const {
return uninstantiated_.descriptor();
}
@@ -202,6 +202,7 @@ class DerivedType {
bool hasParent() const { return hasParent_; }
bool noInitializationNeeded() const { return noInitializationNeeded_; }
bool noDestructionNeeded() const { return noDestructionNeeded_; }
+ bool noFinalizationNeeded() const { return noFinalizationNeeded_; }
std::size_t LenParameters() const { return lenParameterKind().Elements(); }
@@ -211,7 +212,24 @@ class DerivedType {
const Component *FindDataComponent(
const char *name, std::size_t nameLen) const;
- const SpecialBinding *FindSpecialBinding(SpecialBinding::Which) const;
+ // O(1) look-up of special procedure bindings
+ const SpecialBinding *FindSpecialBinding(SpecialBinding::Which which) const {
+ auto bitIndex{static_cast<std::uint32_t>(which)};
+ auto bit{std::uint32_t{1} << bitIndex};
+ if (specialBitSet_ & bit) {
+ // The index of this special procedure in the sorted array is the
+ // number of special bindings that are present with smaller "which"
+ // code values.
+ int offset{common::BitPopulationCount(specialBitSet_ & (bit - 1))};
+ const auto *binding{
+ special_.descriptor().ZeroBasedIndexedElement<SpecialBinding>(
+ offset)};
+ INTERNAL_CHECK(binding && binding->which() == which);
+ return binding;
+ } else {
+ return nullptr;
+ }
+ }
FILE *Dump(FILE * = stdout) const;
@@ -235,9 +253,6 @@ class DerivedType {
// no KIND type parameters will have a null pointer here.
StaticDescriptor<0, true> uninstantiated_; // TYPE(DERIVEDTYPE), POINTER
- // TODO: flags for SEQUENCE, BIND(C), any PRIVATE component(? see 7.5.2)
- std::uint64_t typeHash_{0};
-
// These pointer targets include all of the items from the parent, if any.
StaticDescriptor<1> kindParameter_; // pointer to rank-1 array of INTEGER(8)
StaticDescriptor<1>
@@ -253,13 +268,21 @@ class DerivedType {
StaticDescriptor<1, true>
procPtr_; // TYPE(PROCPTR), POINTER, DIMENSION(:), CONTIGUOUS
+ // Packed in ascending order of "which" code values.
// Does not include special bindings from ancestral types.
StaticDescriptor<1, true>
special_; // TYPE(SPECIALBINDING), POINTER, DIMENSION(:), CONTIGUOUS
+ // Little-endian bit-set of special procedure binding "which" code values
+ // for O(1) look-up in FindSpecialBinding() above.
+ std::uint32_t specialBitSet_{0};
+
+ // Flags
bool hasParent_{false};
bool noInitializationNeeded_{false};
bool noDestructionNeeded_{false};
+ bool noFinalizationNeeded_{false};
+ bool __padding0_[4];
};
} // namespace Fortran::runtime::typeInfo
diff --git a/flang/test/Semantics/typeinfo01.f90 b/flang/test/Semantics/typeinfo01.f90
index 2e33ba8ce28be..e760f535ea734 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,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.t1,procptr=NULL(),special=NULL(),hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1)
+!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(),specialbitset=0_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=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,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)
+!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(),specialbitset=0_4,hasparent=1_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=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(),specialbitset=0_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1)
end module
module m03
@@ -34,7 +34,7 @@ module m03
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,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: .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(),specialbitset=0_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=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,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=NULL(),hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1)
+!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(),specialbitset=0_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=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,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=.p.t,special=NULL(),hasparent=0_1,noinitializationneeded=0_1,nodestructionneeded=1_1)
+!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(),specialbitset=0_4,hasparent=0_1,noinitializationneeded=0_1,nodestructionneeded=1_1,nofinalizationneeded=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,9 +85,9 @@ 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,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: .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,specialbitset=2_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=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(),specialbitset=0_4,hasparent=1_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1)
+!CHECK: .s.t, SAVE, TARGET: ObjectEntity type: TYPE(specialbinding) shape: 0_8:0_8 init:[specialbinding::specialbinding(which=1_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)]
end module
@@ -103,8 +103,8 @@ 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,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: .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,specialbitset=4_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1)
+!CHECK: .s.t, SAVE, TARGET: ObjectEntity type: TYPE(specialbinding) shape: 0_8:0_8 init:[specialbinding::specialbinding(which=2_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,8 +123,8 @@ 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,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)]
+!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,specialbitset=3200_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=0_1,nofinalizationneeded=0_1)
+!CHECK: .s.t, SAVE, TARGET: ObjectEntity type: TYPE(specialbinding) shape: 0_8:2_8 init:[specialbinding::specialbinding(which=7_1,isargdescriptorset=0_1,proc=s3),specialbinding(which=10_1,isargdescriptorset=1_1,proc=s1),specialbinding(which=11_1,isargdescriptorset=0_1,proc=s2)]
end module
module m09
@@ -165,8 +165,8 @@ 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,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: .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,specialbitset=120_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1)
+!CHECK: .s.t, SAVE, TARGET: ObjectEntity type: TYPE(specialbinding) shape: 0_8:3_8 init:[specialbinding::specialbinding(which=3_1,isargdescriptorset=1_1,proc=rf),specialbinding(which=4_1,isargdescriptorset=1_1,proc=ru),specialbinding(which=5_1,isargdescriptorset=1_1,proc=wf),specialbinding(which=6_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,8 +214,8 @@ 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,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)]
+!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,specialbitset=120_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1)
+!CHECK: .s.t, SAVE, TARGET: ObjectEntity type: TYPE(specialbinding) shape: 0_8:3_8 init:[specialbinding::specialbinding(which=3_1,isargdescriptorset=0_1,proc=rf),specialbinding(which=4_1,isargdescriptorset=0_1,proc=ru),specialbinding(which=5_1,isargdescriptorset=0_1,proc=wf),specialbinding(which=6_1,isargdescriptorset=0_1,proc=wu)]
end module
module m11
@@ -235,7 +235,7 @@ subroutine s1(x)
!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: .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(),specialbitset=0_4,hasparent=0_1,noinitializationneeded=0_1,nodestructionneeded=0_1,nofinalizationneeded=1_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)
More information about the flang-commits
mailing list