[flang] Implement runtime Assign()

[klausler]

Summary

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.

[jeanPerier]

Looks great, thanks !

flang/include/flang/Semantics/tools.h

 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 &);

flang/include/flang/Semantics/type.h

   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().

flang/lib/Semantics/runtime-type-info.cpp

 #include "flang/Evaluate/type.h"
 #include "flang/Semantics/scope.h"
 #include "flang/Semantics/tools.h"
+#include <functional>
 #include <list>
 #include <map>
 #include <string>

   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

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

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

     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;

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

                 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},

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

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

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

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

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

       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()) {

flang/lib/Semantics/tools.cpp

   return false;
 }
 
-bool IsFinalizable(const Symbol &symbol) {
+bool IsFinalizable(
+    const Symbol &symbol, std::set<const DerivedTypeSpec *> *inProgress) {
   if (IsPointer(symbol)) {
     return false;
   }

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

flang/module/__fortran_type_info.f90

     ! 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.

     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

   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
 

flang/runtime/CMakeLists.txt

 add_flang_library(FortranRuntime
   ISO_Fortran_binding.cpp
   allocatable.cpp
+  assign.cpp
   buffer.cpp
   complex-reduction.c
   copy.cpp

flang/runtime/allocatable.h

     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

flang/runtime/allocatable.cpp

 //===----------------------------------------------------------------------===//
 
 #include "allocatable.h"
+#include "assign.h"
 #include "derived.h"
 #include "stat.h"
 #include "terminator.h"

       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*/) {

flang/runtime/assign.h

+//===-- 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_

flang/runtime/assign.cpp

+//===-- 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

flang/runtime/derived.h

 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_

flang/runtime/derived.cpp

 
 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(

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

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

         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

flang/runtime/type-info.h

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

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

 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:

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

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

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

   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;
 

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

   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

flang/runtime/type-info.cpp

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

       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_)) {

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

   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;

   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;

flang/test/Semantics/typeinfo01.f90

   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

   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

   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

   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
 

   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
 

     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

     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
 

   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

     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
 

     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

 !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)