[flang] Rework handling of non-type-bound user-defined I/O

[klausler]

Summary

A fairly recent introduction of runtime I/O APIs called OutputDerivedType()
and InputDerivedType() didn't cover NAMELIST I/O's need to access
non-type-bound generic interfaces for user-defined derived type I/O
when those generic interfaces are defined in some scope other than the
one that defines the derived type.

The patch adds a new data structure shared between lowering
and the runtime that can represent all of the cases that can
arise with non-type-bound defined I/O. It can represent
scopes in which non-type-bound defined I/O generic interfaces
are inaccessible, too, due to IMPORT statements.

The data structure is now an operand to OutputDerivedType() and
InputDerivedType() as well as a data member in the NamelistGroup
structure.

flang/include/flang/Common/Fortran.h

ENUM_CLASS(IoSpecKind, Access, Action, Advance, Asynchronous, Blank, Decimal,
     Id, Iomsg, Iostat, Name, Named, Newunit, Nextrec, Nml, Number, Opened, Pad,
     Pending, Pos, Position, Read, Readwrite, Rec, Recl, Round, Sequential, Sign,
     Size, Status, Stream, Unformatted, Unit, Write,
     Carriagecontrol, // nonstandard
     Convert, // nonstandard
     Dispose, // nonstandard
 )
 
+// Defined I/O variants
+ENUM_CLASS(
+    DefinedIo, ReadFormatted, ReadUnformatted, WriteFormatted, WriteUnformatted)
+const char *AsFortran(DefinedIo);
+
 // Floating-point rounding modes; these are packed into a byte to save
 // room in the runtime's format processing context structure.
 enum class RoundingMode : std::uint8_t {
   TiesToEven, // ROUND=NEAREST, RN - default IEEE rounding
   ToZero, // ROUND=ZERO, RZ - truncation
   Down, // ROUND=DOWN, RD
   Up, // ROUND=UP, RU
   TiesAwayFromZero, // ROUND=COMPATIBLE, RC - ties round away from zero
 };
 
 // Fortran label. Must be in [1..99999].
 using Label = std::uint64_t;
 
 // Fortran arrays may have up to 15 dimensions (See Fortran 2018 section 5.4.6).
 static constexpr int maxRank{15};
 
 // Fortran names may have up to 63 characters (See Fortran 2018 C601).
 static constexpr int maxNameLen{63};
+
 } // namespace Fortran::common
 #endif // FORTRAN_COMMON_FORTRAN_H_

flang/include/flang/Runtime/io-api.h

 #include <cstddef>
 
 namespace Fortran::runtime {
 class Descriptor;
 } // namespace Fortran::runtime
 
 namespace Fortran::runtime::io {
 
+class NonTbpDefinedIoTable;
 class NamelistGroup;
 class IoStatementState;
 using Cookie = IoStatementState *;
 using ExternalUnit = int;
 using AsynchronousId = int;
 static constexpr ExternalUnit DefaultUnit{-1}; // READ(*), WRITE(*), PRINT
 
 // INQUIRE specifiers are encoded as simple base-26 packings of

 bool IONAME(OutputLogical)(Cookie, bool);
 bool IONAME(InputLogical)(Cookie, bool &);
 
 // NAMELIST I/O must be the only data item in an (otherwise)
 // list-directed I/O statement.
 bool IONAME(OutputNamelist)(Cookie, const NamelistGroup &);
 bool IONAME(InputNamelist)(Cookie, const NamelistGroup &);
 
-// When an I/O list item has a derived type with a specific user-defined
+// When an I/O list item has a derived type with a specific defined
 // I/O subroutine of the appropriate generic kind for the active
 // I/O data transfer statement (read/write, formatted/unformatted)
-// and that I/O subroutine is a specific procedure for an explicit
-// generic INTERFACE or GENERIC statement that is *not* type-bound,
-// this data item transfer API enables the use of that procedure
-// for the item.  Pass 'true' for 'isPolymorphic' when the first ("dtv")
-// dummy argument of the specific procedure is CLASS(t), not TYPE(t).
-// If the procedure pointer is null, or when the next edit descriptor for
-// formatted I/O is not DT, the procedure will not be called and the
-// behavior will be as if (Output/Input)Descriptor had been called.
+// that pertains to the type or its components, and those subroutines
+// are dynamic or neither type-bound nor defined with interfaces
+// in the same scope as the derived type (or an IMPORT statement has
+// made such a generic interface inaccessible), these data item transfer
+// APIs enable the I/O runtime to make the right calls to defined I/O
+// subroutines.
 bool IONAME(OutputDerivedType)(
-    Cookie, const Descriptor &, void (*)(), bool isPolymorphic);
+    Cookie, const Descriptor &, const NonTbpDefinedIoTable *);
 bool IONAME(InputDerivedType)(
-    Cookie, const Descriptor &, void (*)(), bool isPolymorphic);
+    Cookie, const Descriptor &, const NonTbpDefinedIoTable *);
 
 // Additional specifier interfaces for the connection-list of
 // on OPEN statement (only).  SetBlank(), SetDecimal(),
 // SetDelim(), GetIoMsg(), SetPad(), SetRound(), SetSign(),
 // & SetAsynchronous() are also acceptable for OPEN.
 // ACCESS=SEQUENTIAL, DIRECT, STREAM
 bool IONAME(SetAccess)(Cookie, const char *, std::size_t);
 // ACTION=READ, WRITE, or READWRITE

flang/include/flang/Semantics/runtime-type-info.h

 // and parameterized derived type instantiations into the type descriptions
 // defined in module/__fortran_type_info.f90, packaging these descriptions
 // as static initializers for compiler-created objects.
 
 #ifndef FORTRAN_SEMANTICS_RUNTIME_TYPE_INFO_H_
 #define FORTRAN_SEMANTICS_RUNTIME_TYPE_INFO_H_
 
 #include "flang/Common/reference.h"
+#include "flang/Semantics/symbol.h"
+#include <map>
 #include <set>
 #include <string>
 #include <vector>
 
 namespace llvm {
 class raw_ostream;
 }
 
 namespace Fortran::semantics {
-class Scope;
-class SemanticsContext;
-class Symbol;
-
-using SymbolRef = common::Reference<const Symbol>;
-using SymbolVector = std::vector<SymbolRef>;
 
 struct RuntimeDerivedTypeTables {
   Scope *schemata{nullptr};
   std::set<std::string> names;
 };
 
 RuntimeDerivedTypeTables BuildRuntimeDerivedTypeTables(SemanticsContext &);
 
 /// Name of the builtin module that defines builtin derived types meant
 /// to describe other derived types at runtime in flang descriptor.
 constexpr char typeInfoBuiltinModule[]{"__fortran_type_info"};
 
 /// Name of the bindings descriptor component in the DerivedType type of the
 /// __Fortran_type_info module
 constexpr char bindingDescCompName[]{"binding"};
 
 /// Name of the __builtin_c_funptr component in the Binding type  of the
 /// __Fortran_type_info module
 constexpr char procCompName[]{"proc"};
 
 SymbolVector CollectBindings(const Scope &dtScope);
 
+struct NonTbpDefinedIo {
+  const Symbol *subroutine;
+  common::DefinedIo definedIo;
+  bool isDtvArgPolymorphic;
+};
+
+std::multimap<const Symbol *, NonTbpDefinedIo>
+CollectNonTbpDefinedIoGenericInterfaces(const Scope &scope);
+
 } // namespace Fortran::semantics
 #endif // FORTRAN_SEMANTICS_RUNTIME_TYPE_INFO_H_

flang/include/flang/Semantics/symbol.h

 private:
   SymbolRef symbol_;
 };
 
 // A GenericKind is one of: generic name, defined operator,
 // defined assignment, intrinsic operator, or defined I/O.
 struct GenericKind {
   ENUM_CLASS(OtherKind, Name, DefinedOp, Assignment, Concat)
-  ENUM_CLASS(DefinedIo, // defined io
-      ReadFormatted, ReadUnformatted, WriteFormatted, WriteUnformatted)
   GenericKind() : u{OtherKind::Name} {}
   template <typename T> GenericKind(const T &x) { u = x; }
   bool IsName() const { return Is(OtherKind::Name); }
   bool IsAssignment() const { return Is(OtherKind::Assignment); }
   bool IsDefinedOperator() const { return Is(OtherKind::DefinedOp); }
   bool IsIntrinsicOperator() const;
   bool IsOperator() const;
   std::string ToString() const;
-  static SourceName AsFortran(DefinedIo);
+  static SourceName AsFortran(common::DefinedIo);
   std::variant<OtherKind, common::NumericOperator, common::LogicalOperator,
-      common::RelationalOperator, DefinedIo>
+      common::RelationalOperator, common::DefinedIo>
       u;
 
 private:
   template <typename T> bool Has() const {
     return std::holds_alternative<T>(u);
   }
   bool Is(OtherKind) const;
 };

flang/include/flang/Semantics/tools.h

const std::optional<parser::Name> &MaybeGetNodeName(
     const ConstructNode &construct);
 
 // Convert evaluate::GetShape() result into an ArraySpec
 std::optional<ArraySpec> ToArraySpec(
     evaluate::FoldingContext &, const evaluate::Shape &);
 std::optional<ArraySpec> ToArraySpec(
     evaluate::FoldingContext &, const std::optional<evaluate::Shape> &);
 
-// Searches a derived type and a scope for a particular user defined I/O
-// procedure.
+// Searches a derived type and a scope for a particular defined I/O procedure.
 bool HasDefinedIo(
-    GenericKind::DefinedIo, const DerivedTypeSpec &, const Scope * = nullptr);
+    common::DefinedIo, const DerivedTypeSpec &, const Scope * = nullptr);
 
 // Some intrinsic operators have more than one name (e.g. `operator(.eq.)` and
 // `operator(==)`). GetAllNames() returns them all, including symbolName.
 std::forward_list<std::string> GetAllNames(
     const SemanticsContext &, const SourceName &);
 
 // Determines the derived type of a procedure's initial "dtv" dummy argument,
-// assuming that the procedure is a specific procedure of a user-defined
-// derived type I/O generic interface,
+// assuming that the procedure is a specific procedure of a defined I/O
+// generic interface,
 const DerivedTypeSpec *GetDtvArgDerivedType(const Symbol &);
 
-// Locates a non-type-bound generic interface in the enclosing scopes for a
-// given user-defined derived type I/O operation, given a specific derived type
-// spec. Intended for use when lowering I/O data list items to identify a remote
-// or dynamic non-type-bound UDDTIO subroutine so that it can be passed to the
-// I/O runtime's NonTypeBoundDefinedIo() API.
-std::pair<const Symbol *, bool /*isPolymorphic*/> FindNonTypeBoundDefinedIo(
-    const SemanticsContext, const parser::OutputItem &, bool isFormatted);
-std::pair<const Symbol *, bool /*isPolymorphic*/> FindNonTypeBoundDefinedIo(
-    const SemanticsContext, const parser::InputItem &, bool isFormatted);
-
 } // namespace Fortran::semantics
 #endif // FORTRAN_SEMANTICS_TOOLS_H_

flang/lib/Common/Fortran.cpp

case RelationalOperator::NE:
     return "/=";
   case RelationalOperator::GE:
     return ">=";
   case RelationalOperator::GT:
     return ">";
   }
 }
 
+const char *AsFortran(DefinedIo x) {
+  switch (x) {
+    SWITCH_COVERS_ALL_CASES
+  case DefinedIo::ReadFormatted:
+    return "read(formatted)";
+  case DefinedIo::ReadUnformatted:
+    return "read(unformatted)";
+  case DefinedIo::WriteFormatted:
+    return "write(formatted)";
+  case DefinedIo::WriteUnformatted:
+    return "write(unformatted)";
+  }
+}
+
 } // namespace Fortran::common

flang/lib/Semantics/check-declarations.cpp

private:
   }
   bool IsResultOkToDiffer(const FunctionResult &);
   void CheckGlobalName(const Symbol &);
   void CheckExplicitSave(const Symbol &);
   void CheckBindC(const Symbol &);
   void CheckBindCFunctionResult(const Symbol &);
   // Check functions for defined I/O procedures
   void CheckDefinedIoProc(
-      const Symbol &, const GenericDetails &, GenericKind::DefinedIo);
+      const Symbol &, const GenericDetails &, common::DefinedIo);
   bool CheckDioDummyIsData(const Symbol &, const Symbol *, std::size_t);
-  void CheckDioDummyIsDerived(const Symbol &, const Symbol &,
-      GenericKind::DefinedIo ioKind, const Symbol &);
+  void CheckDioDummyIsDerived(
+      const Symbol &, const Symbol &, common::DefinedIo ioKind, const Symbol &);
   void CheckDioDummyIsDefaultInteger(const Symbol &, const Symbol &);
   void CheckDioDummyIsScalar(const Symbol &, const Symbol &);
   void CheckDioDummyAttrs(const Symbol &, const Symbol &, Attr);
   void CheckDioDtvArg(
-      const Symbol &, const Symbol *, GenericKind::DefinedIo, const Symbol &);
+      const Symbol &, const Symbol *, common::DefinedIo, const Symbol &);
   void CheckGenericVsIntrinsic(const Symbol &, const GenericDetails &);
   void CheckDefaultIntegerArg(const Symbol &, const Symbol *, Attr);
   void CheckDioAssumedLenCharacterArg(
       const Symbol &, const Symbol *, std::size_t, Attr);
   void CheckDioVlistArg(const Symbol &, const Symbol *, std::size_t);
-  void CheckDioArgCount(
-      const Symbol &, GenericKind::DefinedIo ioKind, std::size_t);
+  void CheckDioArgCount(const Symbol &, common::DefinedIo ioKind, std::size_t);
   struct TypeWithDefinedIo {
     const DerivedTypeSpec &type;
-    GenericKind::DefinedIo ioKind;
+    common::DefinedIo ioKind;
     const Symbol &proc;
     const Symbol &generic;
   };
-  void CheckAlreadySeenDefinedIo(const DerivedTypeSpec &,
-      GenericKind::DefinedIo, const Symbol &, const Symbol &generic);
+  void CheckAlreadySeenDefinedIo(const DerivedTypeSpec &, common::DefinedIo,
+      const Symbol &, const Symbol &generic);
   void CheckModuleProcedureDef(const Symbol &);
 
   SemanticsContext &context_;
   evaluate::FoldingContext &foldingContext_{context_.foldingContext()};
   parser::ContextualMessages &messages_{foldingContext_.messages()};
   const Scope *scope_{nullptr};
   bool scopeIsUninstantiatedPDT_{false};
   // This symbol is the one attached to the innermost enclosing scope
if (hostSymbol.test(Symbol::Flag::ImplicitOrError)) {
     }
   }
 }
 
 void CheckHelper::CheckGeneric(
     const Symbol &symbol, const GenericDetails &details) {
   CheckSpecifics(symbol, details);
   common::visit(common::visitors{
-                    [&](const GenericKind::DefinedIo &io) {
+                    [&](const common::DefinedIo &io) {
                       CheckDefinedIoProc(symbol, details, io);
                     },
                     [&](const GenericKind::OtherKind &other) {
                       if (other == GenericKind::OtherKind::Name) {
                         CheckGenericVsIntrinsic(symbol, details);
                       }
                     },
                     [](const auto &) {},
if (arg) {
           "Dummy argument %d of '%s' must be a data object"_err_en_US, position,
           subp.name());
     }
     return false;
   }
 }
 
 void CheckHelper::CheckAlreadySeenDefinedIo(const DerivedTypeSpec &derivedType,
-    GenericKind::DefinedIo ioKind, const Symbol &proc, const Symbol &generic) {
-  // Check for conflict between non-type-bound UDDTIO and type-bound generics.
-  // It's okay to have two or more distinct derived type I/O procedures
-  // for the same type if they're coming from distinct non-type-bound
-  // interfaces.  (The non-type-bound interfaces would have been merged into
-  // a single generic -- with errors where indistinguishable --  if both were
-  // visible in the same scope.)
+    common::DefinedIo ioKind, const Symbol &proc, const Symbol &generic) {
+  // Check for conflict between non-type-bound defined I/O and type-bound
+  // generics. It's okay to have two or more distinct defined I/O procedures for
+  // the same type if they're coming from distinct non-type-bound interfaces.
+  // (The non-type-bound interfaces would have been merged into a single generic
+  //  -- with errors where indistinguishable --  when both were visible from the
+  // same scope.)
   if (generic.owner().IsDerivedType()) {
     return;
   }
   if (const Scope * dtScope{derivedType.scope()}) {
     if (auto iter{dtScope->find(generic.name())}; iter != dtScope->end()) {
       for (auto specRef : iter->second->get<GenericDetails>().specificProcs()) {
         const Symbol &specific{specRef->get<ProcBindingDetails>().symbol()};
         if (specific == proc) { // unambiguous, accept
           continue;
         }
         if (const auto *specDT{GetDtvArgDerivedType(specific)};
             specDT && evaluate::AreSameDerivedType(derivedType, *specDT)) {
           SayWithDeclaration(*specRef, proc.name(),
               "Derived type '%s' has conflicting type-bound input/output procedure '%s'"_err_en_US,
               derivedType.name(), GenericKind::AsFortran(ioKind));
           return;
         }
       }
     }
   }
 }
 
 void CheckHelper::CheckDioDummyIsDerived(const Symbol &subp, const Symbol &arg,
-    GenericKind::DefinedIo ioKind, const Symbol &generic) {
+    common::DefinedIo ioKind, const Symbol &generic) {
   if (const DeclTypeSpec *type{arg.GetType()}) {
     if (const DerivedTypeSpec *derivedType{type->AsDerived()}) {
       CheckAlreadySeenDefinedIo(*derivedType, ioKind, subp, generic);
       bool isPolymorphic{type->IsPolymorphic()};
       if (isPolymorphic != IsExtensibleType(derivedType)) {
         messages_.Say(arg.name(),
             "Dummy argument '%s' of a defined input/output procedure must be %s when the derived type is %s"_err_en_US,
             arg.name(), isPolymorphic ? "TYPE()" : "CLASS()",
if (arg.Rank() > 0 || arg.Corank() > 0) {
     messages_.Say(arg.name(),
         "Dummy argument '%s' of a defined input/output procedure"
         " must be a scalar"_err_en_US,
         arg.name());
   }
 }
 
 void CheckHelper::CheckDioDtvArg(const Symbol &subp, const Symbol *arg,
-    GenericKind::DefinedIo ioKind, const Symbol &generic) {
+    common::DefinedIo ioKind, const Symbol &generic) {
   // Dtv argument looks like: dtv-type-spec, INTENT(INOUT) :: dtv
   if (CheckDioDummyIsData(subp, arg, 0)) {
     CheckDioDummyIsDerived(subp, *arg, ioKind, generic);
     CheckDioDummyAttrs(subp, *arg,
-        ioKind == GenericKind::DefinedIo::ReadFormatted ||
-                ioKind == GenericKind::DefinedIo::ReadUnformatted
+        ioKind == common::DefinedIo::ReadFormatted ||
+                ioKind == common::DefinedIo::ReadUnformatted
             ? Attr::INTENT_INOUT
             : Attr::INTENT_IN);
   }
 }
 
 // If an explicit INTRINSIC name is a function, so must all the specifics be,
 // and similarly for subroutines
 void CheckHelper::CheckGenericVsIntrinsic(
if (!objectDetails || !objectDetails->shape().CanBeDeferredShape()) {
           "Dummy argument '%s' of a defined input/output procedure must be"
           " deferred shape"_err_en_US,
           arg->name());
     }
   }
 }
 
 void CheckHelper::CheckDioArgCount(
-    const Symbol &subp, GenericKind::DefinedIo ioKind, std::size_t argCount) {
+    const Symbol &subp, common::DefinedIo ioKind, std::size_t argCount) {
   const std::size_t requiredArgCount{
-      (std::size_t)(ioKind == GenericKind::DefinedIo::ReadFormatted ||
-                  ioKind == GenericKind::DefinedIo::WriteFormatted
+      (std::size_t)(ioKind == common::DefinedIo::ReadFormatted ||
+                  ioKind == common::DefinedIo::WriteFormatted
               ? 6
               : 4)};
   if (argCount != requiredArgCount) {
     SayWithDeclaration(subp,
         "Defined input/output procedure '%s' must have"
         " %d dummy arguments rather than %d"_err_en_US,
         subp.name(), requiredArgCount, argCount);
     context_.SetError(subp);
messages_.Say(arg.name(),
         "Dummy argument '%s' of a defined input/output procedure may not have"
         " any attributes"_err_en_US,
         arg.name());
   }
 }
 
 // Enforce semantics for defined input/output procedures (12.6.4.8.2) and C777
 void CheckHelper::CheckDefinedIoProc(const Symbol &symbol,
-    const GenericDetails &details, GenericKind::DefinedIo ioKind) {
+    const GenericDetails &details, common::DefinedIo ioKind) {
   for (auto ref : details.specificProcs()) {
     const Symbol &ultimate{ref->GetUltimate()};
     const auto *binding{ultimate.detailsIf<ProcBindingDetails>()};
     const Symbol &specific{*(binding ? &binding->symbol() : &ultimate)};
     if (ultimate.attrs().test(Attr::NOPASS)) { // C774
       messages_.Say("Defined input/output procedure '%s' may not have NOPASS "
                     "attribute"_err_en_US,
           ultimate.name());
if (const auto *subpDetails{specific.detailsIf<SubprogramDetails>()}) {
           // dtv-type-spec, INTENT(INOUT) :: dtv
           CheckDioDtvArg(specific, arg, ioKind, symbol);
           break;
         case 1:
           // INTEGER, INTENT(IN) :: unit
           CheckDefaultIntegerArg(specific, arg, Attr::INTENT_IN);
           break;
         case 2:
-          if (ioKind == GenericKind::DefinedIo::ReadFormatted ||
-              ioKind == GenericKind::DefinedIo::WriteFormatted) {
+          if (ioKind == common::DefinedIo::ReadFormatted ||
+              ioKind == common::DefinedIo::WriteFormatted) {
             // CHARACTER (LEN=*), INTENT(IN) :: iotype
             CheckDioAssumedLenCharacterArg(
                 specific, arg, argCount, Attr::INTENT_IN);
           } else {
             // INTEGER, INTENT(OUT) :: iostat
             CheckDefaultIntegerArg(specific, arg, Attr::INTENT_OUT);
           }
           break;
         case 3:
-          if (ioKind == GenericKind::DefinedIo::ReadFormatted ||
-              ioKind == GenericKind::DefinedIo::WriteFormatted) {
+          if (ioKind == common::DefinedIo::ReadFormatted ||
+              ioKind == common::DefinedIo::WriteFormatted) {
             // INTEGER, INTENT(IN) :: v_list(:)
             CheckDioVlistArg(specific, arg, argCount);
           } else {
             // CHARACTER (LEN=*), INTENT(INOUT) :: iomsg
             CheckDioAssumedLenCharacterArg(
                 specific, arg, argCount, Attr::INTENT_INOUT);
           }
           break;

flang/lib/Semantics/check-io.h

private:
   void CheckForProhibitedSpecifier(bool, const std::string &, IoSpecKind) const;
 
   template <typename A>
   void CheckForDefinableVariable(const A &var, const std::string &s) const;
 
   void CheckForPureSubprogram() const;
 
   parser::Message *CheckForBadIoType(const evaluate::DynamicType &,
-      GenericKind::DefinedIo, parser::CharBlock) const;
+      common::DefinedIo, parser::CharBlock) const;
   void CheckForBadIoType(
-      const SomeExpr &, GenericKind::DefinedIo, parser::CharBlock) const;
+      const SomeExpr &, common::DefinedIo, parser::CharBlock) const;
   parser::Message *CheckForBadIoType(
-      const Symbol &, GenericKind::DefinedIo, parser::CharBlock) const;
+      const Symbol &, common::DefinedIo, parser::CharBlock) const;
 
   void CheckNamelist(
-      const Symbol &, GenericKind::DefinedIo, parser::CharBlock) const;
+      const Symbol &, common::DefinedIo, parser::CharBlock) const;
 
   void Init(IoStmtKind s) {
     stmt_ = s;
     specifierSet_.reset();
     flags_.reset();
   }
 
   void Done() { stmt_ = IoStmtKind::None; }

flang/lib/Semantics/check-io.cpp

void IoChecker::Enter(const parser::InputItem &spec) {
   flags_.set(Flag::DataList);
   const parser::Variable *var{std::get_if<parser::Variable>(&spec.u)};
   if (!var) {
     return;
   }
   CheckForDefinableVariable(*var, "Input");
   if (auto expr{AnalyzeExpr(context_, *var)}) {
     CheckForBadIoType(*expr,
-        flags_.test(Flag::FmtOrNml) ? GenericKind::DefinedIo::ReadFormatted
-                                    : GenericKind::DefinedIo::ReadUnformatted,
+        flags_.test(Flag::FmtOrNml) ? common::DefinedIo::ReadFormatted
+                                    : common::DefinedIo::ReadUnformatted,
         var->GetSource());
   }
 }
 
 void IoChecker::Enter(const parser::InquireSpec &spec) {
   // InquireSpec context FileNameExpr
   if (std::get_if<parser::FileNameExpr>(&spec.u)) {
     SetSpecifier(IoSpecKind::File);
if (const auto *expr{GetExpr(context_, *x)}) {
       if (evaluate::IsBOZLiteral(*expr)) {
         context_.Say(parser::FindSourceLocation(*x), // C7109
             "Output item must not be a BOZ literal constant"_err_en_US);
       } else if (IsProcedure(*expr)) {
         context_.Say(parser::FindSourceLocation(*x),
             "Output item must not be a procedure"_err_en_US); // C1233
       }
       CheckForBadIoType(*expr,
-          flags_.test(Flag::FmtOrNml)
-              ? GenericKind::DefinedIo::WriteFormatted
-              : GenericKind::DefinedIo::WriteUnformatted,
+          flags_.test(Flag::FmtOrNml) ? common::DefinedIo::WriteFormatted
+                                      : common::DefinedIo::WriteUnformatted,
           parser::FindSourceLocation(item));
     }
   }
 }
 
 void IoChecker::Enter(const parser::StatusExpr &spec) {
   SetSpecifier(IoSpecKind::Status);
   if (const std::optional<std::string> charConst{

 }
 
 void IoChecker::Leave(const parser::ReadStmt &readStmt) {
   if (!flags_.test(Flag::InternalUnit)) {
     CheckForPureSubprogram();
   }
   if (const parser::Name * namelist{FindNamelist(readStmt.controls)}) {
     if (namelist->symbol) {
-      CheckNamelist(*namelist->symbol, GenericKind::DefinedIo::ReadFormatted,
+      CheckNamelist(*namelist->symbol, common::DefinedIo::ReadFormatted,
           namelist->source);
     }
   }
   CheckForDoVariable(readStmt, context_);
   if (!flags_.test(Flag::IoControlList)) {
     Done();
     return;
   }

 }
 
 void IoChecker::Leave(const parser::WriteStmt &writeStmt) {
   if (!flags_.test(Flag::InternalUnit)) {
     CheckForPureSubprogram();
   }
   if (const parser::Name * namelist{FindNamelist(writeStmt.controls)}) {
     if (namelist->symbol) {
-      CheckNamelist(*namelist->symbol, GenericKind::DefinedIo::WriteFormatted,
+      CheckNamelist(*namelist->symbol, common::DefinedIo::WriteFormatted,
           namelist->source);
     }
   }
   LeaveReadWrite();
   CheckForProhibitedSpecifier(IoSpecKind::Blank); // C1213
   CheckForProhibitedSpecifier(IoSpecKind::End); // C1213
   CheckForProhibitedSpecifier(IoSpecKind::Eor); // C1213
   CheckForProhibitedSpecifier(IoSpecKind::Pad); // C1213
if (FindPureProcedureContaining(*scope)) {
           "External I/O is not allowed in a pure subprogram"_err_en_US);
     }
   }
 }
 
 // Seeks out an allocatable or pointer ultimate component that is not
 // nested in a nonallocatable/nonpointer component with a specific
 // defined I/O procedure.
-static const Symbol *FindUnsafeIoDirectComponent(GenericKind::DefinedIo which,
+static const Symbol *FindUnsafeIoDirectComponent(common::DefinedIo which,
     const DerivedTypeSpec &derived, const Scope &scope) {
   if (HasDefinedIo(which, derived, &scope)) {
     return nullptr;
   }
   if (const Scope * dtScope{derived.scope()}) {
     for (const auto &pair : *dtScope) {
       const Symbol &symbol{*pair.second};
       if (IsAllocatableOrPointer(symbol)) {
if (const Scope * dtScope{derived.scope()}) {
     }
   }
   return nullptr;
 }
 
 // For a type that does not have a defined I/O subroutine, finds a direct
 // component that is a witness to an accessibility violation outside the module
 // in which the type was defined.
-static const Symbol *FindInaccessibleComponent(GenericKind::DefinedIo which,
+static const Symbol *FindInaccessibleComponent(common::DefinedIo which,
     const DerivedTypeSpec &derived, const Scope &scope) {
   if (const Scope * dtScope{derived.scope()}) {
     if (const Scope * module{FindModuleContaining(*dtScope)}) {
       for (const auto &pair : *dtScope) {
         const Symbol &symbol{*pair.second};
         if (IsAllocatableOrPointer(symbol)) {
           continue; // already an error
         }
if (const Scope * module{FindModuleContaining(*dtScope)}) {
       }
     }
   }
   return nullptr;
 }
 
 // Fortran 2018, 12.6.3 paragraphs 5 & 7
 parser::Message *IoChecker::CheckForBadIoType(const evaluate::DynamicType &type,
-    GenericKind::DefinedIo which, parser::CharBlock where) const {
+    common::DefinedIo which, parser::CharBlock where) const {
   if (type.IsUnlimitedPolymorphic()) {
     return &context_.Say(
         where, "I/O list item may not be unlimited polymorphic"_err_en_US);
   } else if (type.category() == TypeCategory::Derived) {
     const auto &derived{type.GetDerivedTypeSpec()};
     const Scope &scope{context_.FindScope(where)};
     if (const Symbol *
         bad{FindUnsafeIoDirectComponent(which, derived, scope)}) {
if (!HasDefinedIo(which, derived, &scope)) {
             "I/O of the derived type '%s' may not be performed without defined I/O in a scope in which a direct component like '%s' is inaccessible"_err_en_US,
             derived.name(), bad->name());
       }
     }
   }
   return nullptr;
 }
 
-void IoChecker::CheckForBadIoType(const SomeExpr &expr,
-    GenericKind::DefinedIo which, parser::CharBlock where) const {
+void IoChecker::CheckForBadIoType(const SomeExpr &expr, common::DefinedIo which,
+    parser::CharBlock where) const {
   if (auto type{expr.GetType()}) {
     CheckForBadIoType(*type, which, where);
   }
 }
 
 parser::Message *IoChecker::CheckForBadIoType(const Symbol &symbol,
-    GenericKind::DefinedIo which, parser::CharBlock where) const {
+    common::DefinedIo which, parser::CharBlock where) const {
   if (auto type{evaluate::DynamicType::From(symbol)}) {
     if (auto *msg{CheckForBadIoType(*type, which, where)}) {
       evaluate::AttachDeclaration(*msg, symbol);
       return msg;
     }
   }
   return nullptr;
 }
 
-void IoChecker::CheckNamelist(const Symbol &namelist,
-    GenericKind::DefinedIo which, parser::CharBlock namelistLocation) const {
+void IoChecker::CheckNamelist(const Symbol &namelist, common::DefinedIo which,
+    parser::CharBlock namelistLocation) const {
   const auto &details{namelist.GetUltimate().get<NamelistDetails>()};
   for (const Symbol &object : details.objects()) {
     context_.CheckIndexVarRedefine(namelistLocation, object);
     if (auto *msg{CheckForBadIoType(object, which, namelistLocation)}) {
       evaluate::AttachDeclaration(*msg, namelist);
     }
   }
 }
 
 } // namespace Fortran::semantics

flang/lib/Semantics/resolve-names-utils.cpp

kind_ = common::visit(
                     },
                 },
                 y.u);
           },
           [&](const parser::GenericSpec::Assignment &) -> GenericKind {
             return GenericKind::OtherKind::Assignment;
           },
           [&](const parser::GenericSpec::ReadFormatted &) -> GenericKind {
-            return GenericKind::DefinedIo::ReadFormatted;
+            return common::DefinedIo::ReadFormatted;
           },
           [&](const parser::GenericSpec::ReadUnformatted &) -> GenericKind {
-            return GenericKind::DefinedIo::ReadUnformatted;
+            return common::DefinedIo::ReadUnformatted;
           },
           [&](const parser::GenericSpec::WriteFormatted &) -> GenericKind {
-            return GenericKind::DefinedIo::WriteFormatted;
+            return common::DefinedIo::WriteFormatted;
           },
           [&](const parser::GenericSpec::WriteUnformatted &) -> GenericKind {
-            return GenericKind::DefinedIo::WriteUnformatted;
+            return common::DefinedIo::WriteUnformatted;
           },
       },
       x.u);
 }
 
 llvm::raw_ostream &operator<<(
     llvm::raw_ostream &os, const GenericSpecInfo &info) {
   os << "GenericSpecInfo: kind=" << info.kind_.ToString();

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>
 
+// The symbols added by this code to various scopes in the program include:
+//   .b.TYPE.NAME  - Bounds values for an array component
+//   .c.TYPE       - TYPE(Component) descriptions for TYPE
+//   .di.TYPE.NAME - Data initialization for a component
+//   .dp.TYPE.NAME - Data pointer initialization for a component
+//   .dt.TYPE      - TYPE(DerivedType) description for TYPE
+//   .kp.TYPE      - KIND type parameter values for TYPE
+//   .lpk.TYPE     - Integer kinds of LEN type parameter values
+//   .lv.TYPE.NAME - LEN type parameter values for a component's type
+//   .n.NAME       - Character representation of a name
+//   .p.TYPE       - TYPE(ProcPtrComponent) descriptions for TYPE
+//   .s.TYPE       - TYPE(SpecialBinding) bindings for TYPE
+//   .v.TYPE       - TYPE(Binding) bindings for TYPE
+
 namespace Fortran::semantics {
 
 static int FindLenParameterIndex(
     const SymbolVector &parameters, const Symbol &symbol) {
   int lenIndex{0};
   for (SymbolRef ref : parameters) {
     if (&*ref == &symbol) {
       return lenIndex;
private:
   std::map<int, evaluate::StructureConstructor> DescribeSpecialGenerics(
       const Scope &dtScope, const Scope &thisScope,
       const DerivedTypeSpec *) const;
   void DescribeSpecialGeneric(const GenericDetails &,
       std::map<int, evaluate::StructureConstructor> &, const Scope &,
       const DerivedTypeSpec *) const;
   void DescribeSpecialProc(std::map<int, evaluate::StructureConstructor> &,
       const Symbol &specificOrBinding, bool isAssignment, bool isFinal,
-      std::optional<GenericKind::DefinedIo>, const Scope *,
-      const DerivedTypeSpec *) const;
+      std::optional<common::DefinedIo>, const Scope *, const DerivedTypeSpec *,
+      bool isTypeBound) const;
   void IncorporateDefinedIoGenericInterfaces(
-      std::map<int, evaluate::StructureConstructor> &, GenericKind::DefinedIo,
+      std::map<int, evaluate::StructureConstructor> &, common::DefinedIo,
       const Scope *, const DerivedTypeSpec *);
 
   // Instantiated for ParamValue and Bound
   template <typename A>
   evaluate::StructureConstructor GetValue(
       const A &x, const SymbolVector *parameters) {
     if (x.isExplicit()) {
       return GetValue(x.GetExplicit(), parameters);
: context_{c}, tables_{t}, derivedTypeSchema_{GetSchema("derivedtype")},
       writeFormattedEnum_{GetEnumValue("writeformatted")},
       writeUnformattedEnum_{GetEnumValue("writeunformatted")},
       elementalFinalEnum_{GetEnumValue("elementalfinal")},
       assumedRankFinalEnum_{GetEnumValue("assumedrankfinal")},
       scalarFinalEnum_{GetEnumValue("scalarfinal")} {
   ignoreScopes_.insert(tables_.schemata);
 }
 
+static void SetReadOnlyCompilerCreatedFlags(Symbol &symbol) {
+  symbol.set(Symbol::Flag::CompilerCreated);
+  // Runtime type info symbols may have types that are incompatible with the
+  // PARAMETER attribute (the main issue is that they may be TARGET, and normal
+  // Fortran parameters cannot be TARGETs).
+  if (symbol.has<semantics::ObjectEntityDetails>() ||
+      symbol.has<semantics::ProcEntityDetails>()) {
+    symbol.set(Symbol::Flag::ReadOnly);
+  }
+}
+
+// Save an arbitrarily shaped array constant of some derived type
+// as an initialized data object in a scope.
+static SomeExpr SaveDerivedPointerTarget(Scope &scope, SourceName name,
+    std::vector<evaluate::StructureConstructor> &&x,
+    evaluate::ConstantSubscripts &&shape) {
+  if (x.empty()) {
+    return SomeExpr{evaluate::NullPointer{}};
+  } else {
+    const auto &derivedType{x.front().GetType().GetDerivedTypeSpec()};
+    ObjectEntityDetails object;
+    DeclTypeSpec typeSpec{DeclTypeSpec::TypeDerived, derivedType};
+    if (const DeclTypeSpec * spec{scope.FindType(typeSpec)}) {
+      object.set_type(*spec);
+    } else {
+      object.set_type(scope.MakeDerivedType(
+          DeclTypeSpec::TypeDerived, common::Clone(derivedType)));
+    }
+    if (!shape.empty()) {
+      ArraySpec arraySpec;
+      for (auto n : shape) {
+        arraySpec.push_back(ShapeSpec::MakeExplicit(Bound{0}, Bound{n - 1}));
+      }
+      object.set_shape(arraySpec);
+    }
+    object.set_init(
+        evaluate::AsGenericExpr(evaluate::Constant<evaluate::SomeDerived>{
+            derivedType, std::move(x), std::move(shape)}));
+    Symbol &symbol{*scope
+                        .try_emplace(name, Attrs{Attr::TARGET, Attr::SAVE},
+                            std::move(object))
+                        .first->second};
+    SetReadOnlyCompilerCreatedFlags(symbol);
+    return evaluate::AsGenericExpr(
+        evaluate::Designator<evaluate::SomeDerived>{symbol});
+  }
+}
+
 void RuntimeTableBuilder::DescribeTypes(Scope &scope, bool inSchemata) {
   inSchemata |= ignoreScopes_.find(&scope) != ignoreScopes_.end();
   if (scope.IsDerivedType()) {
     if (!inSchemata) { // don't loop trying to describe a schema
       DescribeType(scope);
     }
   } else {
     scope.InstantiateDerivedTypes();

 }
 
 static int GetIntegerKind(const Symbol &symbol) {
   auto dyType{evaluate::DynamicType::From(symbol)};
   CHECK(dyType && dyType->category() == TypeCategory::Integer);
   return dyType->kind();
 }
 
-static void SetReadOnlyCompilerCreatedFlags(Symbol &symbol) {
-  symbol.set(Symbol::Flag::CompilerCreated);
-  // Runtime type info symbols may have types that are incompatible with the
-  // PARAMETER attribute (the main issue is that they may be TARGET, and normal
-  // Fortran parameters cannot be TARGETs).
-  if (symbol.has<semantics::ObjectEntityDetails>() ||
-      symbol.has<semantics::ProcEntityDetails>()) {
-    symbol.set(Symbol::Flag::ReadOnly);
-  }
-}
-
 // Save a rank-1 array constant of some numeric type as an
 // initialized data object in a scope.
 template <typename T>
 static SomeExpr SaveNumericPointerTarget(
     Scope &scope, SourceName name, std::vector<typename T::Scalar> &&x) {
   if (x.empty()) {
     return SomeExpr{evaluate::NullPointer{}};
   } else {
Symbol &symbol{*scope
                             std::move(object))
                         .first->second};
     SetReadOnlyCompilerCreatedFlags(symbol);
     return evaluate::AsGenericExpr(
         evaluate::Expr<T>{evaluate::Designator<T>{symbol}});
   }
 }
 
-// Save an arbitrarily shaped array constant of some derived type
-// as an initialized data object in a scope.
-static SomeExpr SaveDerivedPointerTarget(Scope &scope, SourceName name,
-    std::vector<evaluate::StructureConstructor> &&x,
-    evaluate::ConstantSubscripts &&shape) {
-  if (x.empty()) {
-    return SomeExpr{evaluate::NullPointer{}};
-  } else {
-    const auto &derivedType{x.front().GetType().GetDerivedTypeSpec()};
-    ObjectEntityDetails object;
-    DeclTypeSpec typeSpec{DeclTypeSpec::TypeDerived, derivedType};
-    if (const DeclTypeSpec * spec{scope.FindType(typeSpec)}) {
-      object.set_type(*spec);
-    } else {
-      object.set_type(scope.MakeDerivedType(
-          DeclTypeSpec::TypeDerived, common::Clone(derivedType)));
-    }
-    if (!shape.empty()) {
-      ArraySpec arraySpec;
-      for (auto n : shape) {
-        arraySpec.push_back(ShapeSpec::MakeExplicit(Bound{0}, Bound{n - 1}));
-      }
-      object.set_shape(arraySpec);
-    }
-    object.set_init(
-        evaluate::AsGenericExpr(evaluate::Constant<evaluate::SomeDerived>{
-            derivedType, std::move(x), std::move(shape)}));
-    Symbol &symbol{*scope
-                        .try_emplace(name, Attrs{Attr::TARGET, Attr::SAVE},
-                            std::move(object))
-                        .first->second};
-    SetReadOnlyCompilerCreatedFlags(symbol);
-    return evaluate::AsGenericExpr(
-        evaluate::Designator<evaluate::SomeDerived>{symbol});
-  }
-}
-
 static SomeExpr SaveObjectInit(
     Scope &scope, SourceName name, const ObjectEntityDetails &object) {
   Symbol &symbol{*scope
                       .try_emplace(name, Attrs{Attr::TARGET, Attr::SAVE},
                           ObjectEntityDetails{object})
                       .first->second};
   CHECK(symbol.get<ObjectEntityDetails>().init().has_value());
   SetReadOnlyCompilerCreatedFlags(symbol);
if (auto alignment{dtScope.alignment().value_or(0)}) {
       sizeInBytes /= alignment;
       sizeInBytes *= alignment;
     }
     AddValue(
         dtValues, derivedTypeSchema_, "sizeinbytes"s, IntToExpr(sizeInBytes));
   }
   bool isPDTinstantiation{derivedTypeSpec && &dtScope != dtSymbol->scope()};
   if (isPDTinstantiation) {
-    // is PDT instantiation
     const Symbol *uninstDescObject{
         DescribeType(DEREF(const_cast<Scope *>(dtSymbol->scope())))};
     AddValue(dtValues, derivedTypeSchema_, "uninstantiated"s,
         evaluate::AsGenericExpr(evaluate::Expr<evaluate::SomeDerived>{
             evaluate::Designator<evaluate::SomeDerived>{
                 DEREF(uninstDescObject)}}));
   } else {
     AddValue(dtValues, derivedTypeSchema_, "uninstantiated"s,
if (!isAbstractType) {
       std::vector<evaluate::StructureConstructor> bindings{
           DescribeBindings(dtScope, scope)};
       AddValue(dtValues, derivedTypeSchema_, bindingDescCompName,
           SaveDerivedPointerTarget(scope, SaveObjectName(".v."s + distinctName),
               std::move(bindings),
               evaluate::ConstantSubscripts{
                   static_cast<evaluate::ConstantSubscript>(bindings.size())}));
       // Describe "special" bindings to defined assignments, FINAL subroutines,
-      // and user-defined derived type I/O subroutines.  Defined assignments
-      // and I/O subroutines override any parent bindings; FINAL subroutines
-      // do not (the runtime will call all of them).
+      // and defined derived type I/O subroutines.  Defined assignments and I/O
+      // subroutines override any parent bindings, but FINAL subroutines do not
+      // (the runtime will call all of them).
       std::map<int, evaluate::StructureConstructor> specials{
           DescribeSpecialGenerics(dtScope, dtScope, derivedTypeSpec)};
       if (derivedTypeSpec) {
         for (auto &ref : FinalsForDerivedTypeInstantiation(*derivedTypeSpec)) {
           DescribeSpecialProc(specials, *ref, false /*!isAssignment*/, true,
-              std::nullopt, nullptr, derivedTypeSpec);
+              std::nullopt, nullptr, derivedTypeSpec, true);
         }
         IncorporateDefinedIoGenericInterfaces(specials,
-            GenericKind::DefinedIo::ReadFormatted, &scope, derivedTypeSpec);
+            common::DefinedIo::ReadFormatted, &scope, derivedTypeSpec);
         IncorporateDefinedIoGenericInterfaces(specials,
-            GenericKind::DefinedIo::ReadUnformatted, &scope, derivedTypeSpec);
+            common::DefinedIo::ReadUnformatted, &scope, derivedTypeSpec);
         IncorporateDefinedIoGenericInterfaces(specials,
-            GenericKind::DefinedIo::WriteFormatted, &scope, derivedTypeSpec);
+            common::DefinedIo::WriteFormatted, &scope, derivedTypeSpec);
         IncorporateDefinedIoGenericInterfaces(specials,
-            GenericKind::DefinedIo::WriteUnformatted, &scope, derivedTypeSpec);
+            common::DefinedIo::WriteUnformatted, &scope, derivedTypeSpec);
       }
       // 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;
       for (auto &pair : specials) {
         auto bit{std::uint32_t{1} << pair.first};
         CHECK(!(specialBitSet & bit));
void RuntimeTableBuilder::DescribeSpecialGeneric(const GenericDetails &generic,
     std::map<int, evaluate::StructureConstructor> &specials,
     const Scope &dtScope, const DerivedTypeSpec *derivedTypeSpec) const {
   common::visit(common::visitors{
                     [&](const GenericKind::OtherKind &k) {
                       if (k == GenericKind::OtherKind::Assignment) {
                         for (auto ref : generic.specificProcs()) {
                           DescribeSpecialProc(specials, *ref, true,
                               false /*!final*/, std::nullopt, &dtScope,
-                              derivedTypeSpec);
+                              derivedTypeSpec, true);
                         }
                       }
                     },
-                    [&](const GenericKind::DefinedIo &io) {
+                    [&](const common::DefinedIo &io) {
                       switch (io) {
-                      case GenericKind::DefinedIo::ReadFormatted:
-                      case GenericKind::DefinedIo::ReadUnformatted:
-                      case GenericKind::DefinedIo::WriteFormatted:
-                      case GenericKind::DefinedIo::WriteUnformatted:
+                      case common::DefinedIo::ReadFormatted:
+                      case common::DefinedIo::ReadUnformatted:
+                      case common::DefinedIo::WriteFormatted:
+                      case common::DefinedIo::WriteUnformatted:
                         for (auto ref : generic.specificProcs()) {
                           DescribeSpecialProc(specials, *ref, false,
-                              false /*!final*/, io, &dtScope, derivedTypeSpec);
+                              false /*!final*/, io, &dtScope, derivedTypeSpec,
+                              true);
                         }
                         break;
                       }
                     },
                     [](const auto &) {},
                 },
       generic.kind().u);
 }
 
 void RuntimeTableBuilder::DescribeSpecialProc(
     std::map<int, evaluate::StructureConstructor> &specials,
     const Symbol &specificOrBinding, bool isAssignment, bool isFinal,
-    std::optional<GenericKind::DefinedIo> io, const Scope *dtScope,
-    const DerivedTypeSpec *derivedTypeSpec) const {
+    std::optional<common::DefinedIo> io, const Scope *dtScope,
+    const DerivedTypeSpec *derivedTypeSpec, bool isTypeBound) const {
   const auto *binding{specificOrBinding.detailsIf<ProcBindingDetails>()};
   if (binding && dtScope) { // use most recent override
     binding = &DEREF(dtScope->FindComponent(specificOrBinding.name()))
                    .get<ProcBindingDetails>();
   }
   const Symbol &specific{*(binding ? &binding->symbol() : &specificOrBinding)};
   if (auto proc{evaluate::characteristics::Procedure::Characterize(
           specific, context_.foldingContext())}) {
if (isAssignment) {
         } else {
           which = scalarFinalEnum_;
           if (int rank{evaluate::GetRank(typeAndShape.shape())}; rank > 0) {
             argThatMightBeDescriptor = 1;
             which = IntExpr<1>(ToInt64(which).value() + rank);
           }
         }
       }
-    } else { // user defined derived type I/O
+    } else { // defined derived type I/O
       CHECK(proc->dummyArguments.size() >= 4);
       const auto *ddo{std::get_if<evaluate::characteristics::DummyDataObject>(
           &proc->dummyArguments[0].u)};
       if (!ddo) {
         return;
       }
       if (derivedTypeSpec &&
           !ddo->type.type().IsTkCompatibleWith(
               evaluate::DynamicType{*derivedTypeSpec})) {
         // Defined I/O specific procedure is not for this derived type.
         return;
       }
       if (ddo->type.type().IsPolymorphic()) {
         isArgDescriptorSet |= 1;
       }
       switch (io.value()) {
-      case GenericKind::DefinedIo::ReadFormatted:
+      case common::DefinedIo::ReadFormatted:
         which = readFormattedEnum_;
         break;
-      case GenericKind::DefinedIo::ReadUnformatted:
+      case common::DefinedIo::ReadUnformatted:
         which = readUnformattedEnum_;
         break;
-      case GenericKind::DefinedIo::WriteFormatted:
+      case common::DefinedIo::WriteFormatted:
         which = writeFormattedEnum_;
         break;
-      case GenericKind::DefinedIo::WriteUnformatted:
+      case common::DefinedIo::WriteUnformatted:
         which = writeUnformattedEnum_;
         break;
       }
     }
     if (argThatMightBeDescriptor != 0 &&
         !proc->dummyArguments.at(argThatMightBeDescriptor - 1)
              .CanBePassedViaImplicitInterface()) {
       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_, "isargdescriptorset"s,
         IntExpr<1>(isArgDescriptorSet));
+    AddValue(values, specialSchema_, "istypebound"s,
+        IntExpr<1>(isTypeBound ? 1 : 0));
     AddValue(values, specialSchema_, procCompName,
         SomeExpr{evaluate::ProcedureDesignator{specific}});
     // index might already be present in the case of an override
     specials.emplace(*index,
         evaluate::StructureConstructor{
             DEREF(specialSchema_.AsDerived()), std::move(values)});
   }
 }
 
 void RuntimeTableBuilder::IncorporateDefinedIoGenericInterfaces(
     std::map<int, evaluate::StructureConstructor> &specials,
-    GenericKind::DefinedIo definedIo, const Scope *scope,
+    common::DefinedIo definedIo, const Scope *scope,
     const DerivedTypeSpec *derivedTypeSpec) {
   SourceName name{GenericKind::AsFortran(definedIo)};
   for (; !scope->IsGlobal(); scope = &scope->parent()) {
     if (auto asst{scope->find(name)}; asst != scope->end()) {
       const Symbol &generic{asst->second->GetUltimate()};
       const auto &genericDetails{generic.get<GenericDetails>()};
-      CHECK(std::holds_alternative<GenericKind::DefinedIo>(
-          genericDetails.kind().u));
-      CHECK(std::get<GenericKind::DefinedIo>(genericDetails.kind().u) ==
-          definedIo);
+      CHECK(std::holds_alternative<common::DefinedIo>(genericDetails.kind().u));
+      CHECK(std::get<common::DefinedIo>(genericDetails.kind().u) == definedIo);
       for (auto ref : genericDetails.specificProcs()) {
-        DescribeSpecialProc(
-            specials, *ref, false, false, definedIo, nullptr, derivedTypeSpec);
+        DescribeSpecialProc(specials, *ref, false, false, definedIo, nullptr,
+            derivedTypeSpec, false);
       }
     }
   }
 }
 
 RuntimeDerivedTypeTables BuildRuntimeDerivedTypeTables(
     SemanticsContext &context) {
   RuntimeDerivedTypeTables result;
   result.schemata = context.GetBuiltinModule(typeInfoBuiltinModule);
   if (result.schemata) {
     RuntimeTableBuilder builder{context, result};
     builder.DescribeTypes(context.globalScope(), false);
   }
   return result;
 }
 
+std::multimap<const Symbol *, NonTbpDefinedIo>
+CollectNonTbpDefinedIoGenericInterfaces(const Scope &scope) {
+  std::multimap<const Symbol *, NonTbpDefinedIo> result;
+  if (!scope.IsTopLevel() &&
+      (scope.GetImportKind() == Scope::ImportKind::All ||
+          scope.GetImportKind() == Scope::ImportKind::Default)) {
+    result = CollectNonTbpDefinedIoGenericInterfaces(scope.parent());
+  }
+  if (scope.kind() != Scope::Kind::DerivedType) {
+    for (common::DefinedIo which :
+        {common::DefinedIo::ReadFormatted, common::DefinedIo::ReadUnformatted,
+            common::DefinedIo::WriteFormatted,
+            common::DefinedIo::WriteUnformatted}) {
+      if (auto iter{scope.find(GenericKind::AsFortran(which))};
+          iter != scope.end()) {
+        const Symbol &generic{iter->second->GetUltimate()};
+        const auto *genericDetails{generic.detailsIf<GenericDetails>()};
+        CHECK(genericDetails != nullptr);
+        CHECK(std::holds_alternative<common::DefinedIo>(
+            genericDetails->kind().u));
+        CHECK(std::get<common::DefinedIo>(genericDetails->kind().u) == which);
+        for (auto specific : genericDetails->specificProcs()) {
+          const Symbol *interface {
+            &specific->GetUltimate()
+          };
+          if (const auto *procEntity{
+                  specific->detailsIf<ProcEntityDetails>()}) {
+            interface = procEntity->procInterface();
+          }
+          const SubprogramDetails *subprogram{
+              interface ? interface->detailsIf<SubprogramDetails>() : nullptr};
+          const Symbol *dtvArg{subprogram && subprogram->dummyArgs().size() > 0
+                  ? subprogram->dummyArgs().at(0)
+                  : nullptr};
+          const DeclTypeSpec *declType{dtvArg ? dtvArg->GetType() : nullptr};
+          const DerivedTypeSpec *derived{
+              declType ? declType->AsDerived() : nullptr};
+          if (const Symbol *
+              dtDesc{derived && derived->scope()
+                      ? derived->scope()->runtimeDerivedTypeDescription()
+                      : nullptr}) {
+            if (&derived->scope()->parent() == &generic.owner()) {
+              // This non-TBP defined I/O generic was defined in the
+              // same scope as the derived type, and it will be
+              // included in the derived type's special bindings
+              // by IncorporateDefinedIoGenericInterfaces().
+            } else {
+              // Local scope's specific overrides host's for this type
+              bool updated{false};
+              for (auto [iter, end]{result.equal_range(dtDesc)}; iter != end;
+                   ++iter) {
+                NonTbpDefinedIo &nonTbp{iter->second};
+                if (nonTbp.definedIo == which) {
+                  nonTbp.subroutine = &*specific;
+                  nonTbp.isDtvArgPolymorphic = declType->IsPolymorphic();
+                  updated = true;
+                }
+              }
+              if (!updated) {
+                result.emplace(dtDesc,
+                    NonTbpDefinedIo{
+                        &*specific, which, declType->IsPolymorphic()});
+              }
+            }
+          }
+        }
+      }
+    }
+  }
+  return result;
+}
+
 } // namespace Fortran::semantics

flang/lib/Semantics/symbol.cpp

 bool GenericKind::IsOperator() const {
   return IsDefinedOperator() || IsIntrinsicOperator();
 }
 
 std::string GenericKind::ToString() const {
   return common::visit(
       common::visitors {
         [](const OtherKind &x) { return std::string{EnumToString(x)}; },
-            [](const DefinedIo &x) { return AsFortran(x).ToString(); },
+            [](const common::DefinedIo &x) { return AsFortran(x).ToString(); },
 #if !__clang__ && __GNUC__ == 7 && __GNUC_MINOR__ == 2
             [](const common::NumericOperator &x) {
               return std::string{common::EnumToString(x)};
             },
             [](const common::LogicalOperator &x) {
               return std::string{common::EnumToString(x)};
             },
             [](const common::RelationalOperator &x) {
               return std::string{common::EnumToString(x)};
             },
 #else
             [](const auto &x) { return std::string{common::EnumToString(x)}; },
 #endif
       },
       u);
 }
 
-SourceName GenericKind::AsFortran(DefinedIo x) {
-  const char *name{nullptr};
-  switch (x) {
-    SWITCH_COVERS_ALL_CASES
-  case DefinedIo::ReadFormatted:
-    name = "read(formatted)";
-    break;
-  case DefinedIo::ReadUnformatted:
-    name = "read(unformatted)";
-    break;
-  case DefinedIo::WriteFormatted:
-    name = "write(formatted)";
-    break;
-  case DefinedIo::WriteUnformatted:
-    name = "write(unformatted)";
-    break;
-  }
+SourceName GenericKind::AsFortran(common::DefinedIo x) {
+  const char *name{common::AsFortran(x)};
   return {name, std::strlen(name)};
 }
 
 bool GenericKind::Is(GenericKind::OtherKind x) const {
   const OtherKind *y{std::get_if<OtherKind>(&u)};
   return y && *y == x;
 }
 

flang/lib/Semantics/tools.cpp

 const DerivedTypeSpec *GetDtvArgDerivedType(const Symbol &proc) {
   if (const auto *type{GetDtvArgTypeSpec(proc)}) {
     return type->AsDerived();
   } else {
     return nullptr;
   }
 }
 
-bool HasDefinedIo(GenericKind::DefinedIo which, const DerivedTypeSpec &derived,
+bool HasDefinedIo(common::DefinedIo which, const DerivedTypeSpec &derived,
     const Scope *scope) {
   if (const Scope * dtScope{derived.scope()}) {
     for (const auto &pair : *dtScope) {
       const Symbol &symbol{*pair.second};
       if (const auto *generic{symbol.detailsIf<GenericDetails>()}) {
         GenericKind kind{generic->kind()};
-        if (const auto *io{std::get_if<GenericKind::DefinedIo>(&kind.u)}) {
+        if (const auto *io{std::get_if<common::DefinedIo>(&kind.u)}) {
           if (*io == which) {
             return true; // type-bound GENERIC exists
           }
         }
       }
     }
   }
   if (scope) {
for (; scope && !scope->IsGlobal(); scope = &scope->parent()) {
           }
         }
       }
     }
   }
   return false;
 }
 
-static std::pair<const Symbol *, bool /*isPolymorphic*/>
-FindNonTypeBoundDefinedIo(const Scope &scope, const evaluate::DynamicType &type,
-    GenericKind::DefinedIo io) {
-  if (const DerivedTypeSpec * derived{evaluate::GetDerivedTypeSpec(type)}) {
-    if (const Symbol * symbol{scope.FindSymbol(GenericKind::AsFortran(io))}) {
-      if (const auto *generic{symbol->detailsIf<GenericDetails>()}) {
-        for (const auto &ref : generic->specificProcs()) {
-          const Symbol &specific{ref->GetUltimate()};
-          if (const DeclTypeSpec * dtvTypeSpec{GetDtvArgTypeSpec(specific)}) {
-            if (const DerivedTypeSpec * dtvDerived{dtvTypeSpec->AsDerived()}) {
-              if (evaluate::AreSameDerivedType(*derived, *dtvDerived)) {
-                return {&specific, dtvTypeSpec->IsPolymorphic()};
-              }
-            }
-          }
-        }
-      }
-    }
-  }
-  return {nullptr, false};
-}
-
-std::pair<const Symbol *, bool /*isPolymorphic*/> FindNonTypeBoundDefinedIo(
-    const SemanticsContext &context, const parser::OutputItem &item,
-    bool isFormatted) {
-  if (const auto *expr{std::get_if<parser::Expr>(&item.u)};
-      expr && expr->typedExpr && expr->typedExpr->v) {
-    if (auto type{expr->typedExpr->v->GetType()}) {
-      return FindNonTypeBoundDefinedIo(context.FindScope(expr->source), *type,
-          isFormatted ? GenericKind::DefinedIo::WriteFormatted
-                      : GenericKind::DefinedIo::WriteUnformatted);
-    }
-  }
-  return {nullptr, false};
-}
-
-std::pair<const Symbol *, bool /*isPolymorphic*/> FindNonTypeBoundDefinedIo(
-    const SemanticsContext &context, const parser::InputItem &item,
-    bool isFormatted) {
-  if (const auto *var{std::get_if<parser::Variable>(&item.u)};
-      var && var->typedExpr && var->typedExpr->v) {
-    if (auto type{var->typedExpr->v->GetType()}) {
-      return FindNonTypeBoundDefinedIo(context.FindScope(var->GetSource()),
-          *type,
-          isFormatted ? GenericKind::DefinedIo::ReadFormatted
-                      : GenericKind::DefinedIo::ReadUnformatted);
-    }
-  }
-  return {nullptr, false};
-}
-
 } // namespace Fortran::semantics

flang/module/__fortran_type_info.f90

enum, bind(c) ! SpecialBinding::Which
     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) :: isArgDescriptorSet
-    integer(1) :: __padding0(6)
+    integer(1) :: isTypeBound
+    integer(1) :: __padding0(5)
     type(__builtin_c_funptr) :: proc
   end type
 
 end module

flang/runtime/CMakeLists.txt

add_flang_library(FortranRuntime
   io-error.cpp
   io-stmt.cpp
   main.cpp
   matmul-transpose.cpp
   matmul.cpp
   memory.cpp
   misc-intrinsic.cpp
   namelist.cpp
+  non-tbp-dio.cpp
   numeric.cpp
   ragged.cpp
   random.cpp
   reduction.cpp
   pointer.cpp
   product.cpp
   stat.cpp
   stop.cpp

flang/runtime/descriptor-io.h

 // Implementation of I/O data list item transfers based on descriptors.
 // (All I/O items come through here so that the code is exercised for test;
 // some scalar I/O data transfer APIs could be changed to bypass their use
 // of descriptors in the future for better efficiency.)
 
 #include "edit-input.h"
 #include "edit-output.h"
 #include "io-stmt.h"
+#include "namelist.h"
 #include "terminator.h"
 #include "type-info.h"
 #include "unit.h"
 #include "flang/Common/uint128.h"
 #include "flang/Runtime/cpp-type.h"
 #include "flang/Runtime/descriptor.h"
 
 namespace Fortran::runtime::io::descr {
if (!descriptor.IncrementSubscripts(subscripts) && j + 1 < numElements) {
       io.GetIoErrorHandler().Crash(
           "FormattedLogicalIO: subscripts out of bounds");
     }
   }
   return true;
 }
 
 template <Direction DIR>
-static bool DescriptorIO(IoStatementState &, const Descriptor &);
+static bool DescriptorIO(IoStatementState &, const Descriptor &,
+    const NonTbpDefinedIoTable * = nullptr);
 
-// For default (not user-defined) derived type I/O, formatted & unformatted
+// For intrinsic (not defined) derived type I/O, formatted & unformatted
 template <Direction DIR>
 static bool DefaultComponentIO(IoStatementState &io,
     const typeInfo::Component &component, const Descriptor &origDescriptor,
-    const SubscriptValue origSubscripts[], Terminator &terminator) {
+    const SubscriptValue origSubscripts[], Terminator &terminator,
+    const NonTbpDefinedIoTable *table) {
   if (component.genre() == typeInfo::Component::Genre::Data) {
     // Create a descriptor for the component
     StaticDescriptor<maxRank, true, 16 /*?*/> statDesc;
     Descriptor &desc{statDesc.descriptor()};
     component.CreatePointerDescriptor(
         desc, origDescriptor, terminator, origSubscripts);
-    return DescriptorIO<DIR>(io, desc);
+    return DescriptorIO<DIR>(io, desc, table);
   } else {
     // Component is itself a descriptor
     char *pointer{
         origDescriptor.Element<char>(origSubscripts) + component.offset()};
     RUNTIME_CHECK(
         terminator, component.genre() == typeInfo::Component::Genre::Automatic);
     const Descriptor &compDesc{*reinterpret_cast<const Descriptor *>(pointer)};
-    return DescriptorIO<DIR>(io, compDesc);
+    return DescriptorIO<DIR>(io, compDesc, table);
   }
 }
 
 template <Direction DIR>
 static bool DefaultComponentwiseIO(IoStatementState &io,
-    const Descriptor &descriptor, const typeInfo::DerivedType &type) {
+    const Descriptor &descriptor, const typeInfo::DerivedType &type,
+    const NonTbpDefinedIoTable *table) {
   IoErrorHandler &handler{io.GetIoErrorHandler()};
   const Descriptor &compArray{type.component()};
   RUNTIME_CHECK(handler, compArray.rank() == 1);
   std::size_t numComponents{compArray.Elements()};
   std::size_t numElements{descriptor.Elements()};
   SubscriptValue subscripts[maxRank];
   descriptor.GetLowerBounds(subscripts);
   for (std::size_t j{0}; j < numElements;
        ++j, descriptor.IncrementSubscripts(subscripts)) {
     SubscriptValue at[maxRank];
     compArray.GetLowerBounds(at);
     for (std::size_t k{0}; k < numComponents;
          ++k, compArray.IncrementSubscripts(at)) {
       const typeInfo::Component &component{
           *compArray.Element<typeInfo::Component>(at)};
       if (!DefaultComponentIO<DIR>(
-              io, component, descriptor, subscripts, handler)) {
+              io, component, descriptor, subscripts, handler, table)) {
         return false;
       }
     }
   }
   return true;
 }
 
 std::optional<bool> DefinedFormattedIo(IoStatementState &, const Descriptor &,
     const typeInfo::DerivedType &, const typeInfo::SpecialBinding &);
 
 template <Direction DIR>
-static bool FormattedDerivedTypeIO(
-    IoStatementState &io, const Descriptor &descriptor) {
+static bool FormattedDerivedTypeIO(IoStatementState &io,
+    const Descriptor &descriptor, const NonTbpDefinedIoTable *table) {
   IoErrorHandler &handler{io.GetIoErrorHandler()};
   // Derived type information must be present for formatted I/O.
   const DescriptorAddendum *addendum{descriptor.Addendum()};
   RUNTIME_CHECK(handler, addendum != nullptr);
   const typeInfo::DerivedType *type{addendum->derivedType()};
   RUNTIME_CHECK(handler, type != nullptr);
+  if (table) {
+    if (const auto *definedIo{table->Find(*type,
+            DIR == Direction::Input ? common::DefinedIo::ReadFormatted
+                                    : common::DefinedIo::WriteFormatted)}) {
+      if (definedIo->subroutine) {
+        typeInfo::SpecialBinding special{DIR == Direction::Input
+                ? typeInfo::SpecialBinding::Which::ReadFormatted
+                : typeInfo::SpecialBinding::Which::WriteFormatted,
+            definedIo->subroutine, definedIo->isDtvArgPolymorphic, false};
+        if (std::optional<bool> wasDefined{
+                DefinedFormattedIo(io, descriptor, *type, special)}) {
+          return *wasDefined;
+        }
+      } else {
+        return DefaultComponentwiseIO<DIR>(io, descriptor, *type, table);
+      }
+    }
+  }
   if (const typeInfo::SpecialBinding *
       special{type->FindSpecialBinding(DIR == Direction::Input
               ? typeInfo::SpecialBinding::Which::ReadFormatted
               : typeInfo::SpecialBinding::Which::WriteFormatted)}) {
+    if (!table || !table->ignoreNonTbpEntries || special->isTypeBound()) {
       if (std::optional<bool> wasDefined{
               DefinedFormattedIo(io, descriptor, *type, *special)}) {
-      return *wasDefined; // user-defined I/O was applied
+        return *wasDefined; // defined I/O was applied
+      }
     }
   }
-  return DefaultComponentwiseIO<DIR>(io, descriptor, *type);
+  return DefaultComponentwiseIO<DIR>(io, descriptor, *type, table);
 }
 
 bool DefinedUnformattedIo(IoStatementState &, const Descriptor &,
     const typeInfo::DerivedType &, const typeInfo::SpecialBinding &);
 
 // Unformatted I/O
 template <Direction DIR>
-static bool UnformattedDescriptorIO(
-    IoStatementState &io, const Descriptor &descriptor) {
+static bool UnformattedDescriptorIO(IoStatementState &io,
+    const Descriptor &descriptor, const NonTbpDefinedIoTable *table = nullptr) {
   IoErrorHandler &handler{io.GetIoErrorHandler()};
   const DescriptorAddendum *addendum{descriptor.Addendum()};
   if (const typeInfo::DerivedType *
       type{addendum ? addendum->derivedType() : nullptr}) {
     // derived type unformatted I/O
+    if (table) {
+      if (const auto *definedIo{table->Find(*type,
+              DIR == Direction::Input ? common::DefinedIo::ReadUnformatted
+                                      : common::DefinedIo::WriteUnformatted)}) {
+        if (definedIo->subroutine) {
+          typeInfo::SpecialBinding special{DIR == Direction::Input
+                  ? typeInfo::SpecialBinding::Which::ReadUnformatted
+                  : typeInfo::SpecialBinding::Which::WriteUnformatted,
+              definedIo->subroutine, definedIo->isDtvArgPolymorphic, false};
+          if (std::optional<bool> wasDefined{
+                  DefinedUnformattedIo(io, descriptor, *type, special)}) {
+            return *wasDefined;
+          }
+        } else {
+          return DefaultComponentwiseIO<DIR>(io, descriptor, *type, table);
+        }
+      }
+    }
     if (const typeInfo::SpecialBinding *
         special{type->FindSpecialBinding(DIR == Direction::Input
                 ? typeInfo::SpecialBinding::Which::ReadUnformatted
                 : typeInfo::SpecialBinding::Which::WriteUnformatted)}) {
-      // User-defined derived type unformatted I/O
+      if (!table || !table->ignoreNonTbpEntries || special->isTypeBound()) {
+        // defined derived type unformatted I/O
         return DefinedUnformattedIo(io, descriptor, *type, *special);
-    } else {
-      // Default derived type unformatted I/O
-      // TODO: If no component at any level has user defined READ or WRITE
-      // (as appropriate), the elements are contiguous, and no byte swapping
-      // is active, do a block transfer via the code below.
-      return DefaultComponentwiseIO<DIR>(io, descriptor, *type);
-    }
+      }
+    }
+    // TODO: If no component at any level has defined READ or WRITE
+    return DefaultComponentwiseIO<DIR>(io, descriptor, *type, table);
   } else {
     // intrinsic type unformatted I/O
     auto *externalUnf{io.get_if<ExternalUnformattedIoStatementState<DIR>>()};
     auto *childUnf{io.get_if<ChildUnformattedIoStatementState<DIR>>()};
     auto *inq{
         DIR == Direction::Output ? io.get_if<InquireIOLengthState>() : nullptr};
     RUNTIME_CHECK(handler, externalUnf || childUnf || inq);
     std::size_t elementBytes{descriptor.ElementBytes()};
if (!swapEndianness &&
         }
       }
       return true;
     }
   }
 }
 
 template <Direction DIR>
-static bool DescriptorIO(IoStatementState &io, const Descriptor &descriptor) {
+static bool DescriptorIO(IoStatementState &io, const Descriptor &descriptor,
+    const NonTbpDefinedIoTable *table) {
   IoErrorHandler &handler{io.GetIoErrorHandler()};
   if (handler.InError()) {
     return false;
   }
   if (!io.get_if<IoDirectionState<DIR>>()) {
     io.GetIoErrorHandler().Crash(
         "DescriptorIO() called for wrong I/O direction");
     return false;
   }
   if constexpr (DIR == Direction::Input) {
     if (!io.BeginReadingRecord()) {
       return false;
     }
   }
   if (!io.get_if<FormattedIoStatementState<DIR>>()) {
-    return UnformattedDescriptorIO<DIR>(io, descriptor);
+    return UnformattedDescriptorIO<DIR>(io, descriptor, table);
   }
   if (auto catAndKind{descriptor.type().GetCategoryAndKind()}) {
     TypeCategory cat{catAndKind->first};
     int kind{catAndKind->second};
     switch (cat) {
     case TypeCategory::Integer:
       switch (kind) {
       case 1:
case TypeCategory::Logical:
         return FormattedLogicalIO<8, DIR>(io, descriptor);
       default:
         handler.Crash(
             "DescriptorIO: Unimplemented LOGICAL kind (%d) in descriptor",
             kind);
         return false;
       }
     case TypeCategory::Derived:
-      return FormattedDerivedTypeIO<DIR>(io, descriptor);
+      return FormattedDerivedTypeIO<DIR>(io, descriptor, table);
     }
   }
   handler.Crash("DescriptorIO: bad type code (%d) in descriptor",
       static_cast<int>(descriptor.type().raw()));
   return false;
 }
 } // namespace Fortran::runtime::io::descr
 #endif // FORTRAN_RUNTIME_DESCRIPTOR_IO_H_

flang/runtime/descriptor-io.cpp

 //===-- runtime/descriptor-io.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 "descriptor-io.h"
 #include "flang/Common/restorer.h"
 
 namespace Fortran::runtime::io::descr {
 
-// User-defined derived type formatted I/O (maybe)
+// Defined formatted I/O (maybe)
 std::optional<bool> DefinedFormattedIo(IoStatementState &io,
     const Descriptor &descriptor, const typeInfo::DerivedType &derived,
     const typeInfo::SpecialBinding &special) {
   std::optional<DataEdit> peek{io.GetNextDataEdit(0 /*to peek at it*/)};
   if (peek &&
       (peek->descriptor == DataEdit::DefinedDerivedType ||
           peek->descriptor == DataEdit::ListDirected)) {
-    // User-defined derived type formatting
+    // Defined formatting
     IoErrorHandler &handler{io.GetIoErrorHandler()};
     DataEdit edit{*io.GetNextDataEdit(1)}; // now consume it; no repeats
     RUNTIME_CHECK(handler, edit.descriptor == peek->descriptor);
     char ioType[2 + edit.maxIoTypeChars];
     auto ioTypeLen{std::size_t{2} /*"DT"*/ + edit.ioTypeChars};
     if (edit.descriptor == DataEdit::DefinedDerivedType) {
       ioType[0] = 'D';
       ioType[1] = 'T';
if (!actualExternal) {
       RUNTIME_CHECK(handler, external == closing);
       external->DestroyClosed();
     }
     if (startPos) {
       io.GotChar(io.InquirePos() - *startPos);
     }
     return handler.GetIoStat() == IostatOk;
   } else {
-    // There's a user-defined I/O subroutine, but there's a FORMAT present and
+    // There's a defined I/O subroutine, but there's a FORMAT present and
     // it does not have a DT data edit descriptor, so apply default formatting
     // to the components of the derived type as usual.
     return std::nullopt;
   }
 }
 
-// User-defined derived type unformatted I/O
+// Defined unformatted I/O
 bool DefinedUnformattedIo(IoStatementState &io, const Descriptor &descriptor,
     const typeInfo::DerivedType &derived,
     const typeInfo::SpecialBinding &special) {
   // Unformatted I/O must have an external unit (or child thereof).
   IoErrorHandler &handler{io.GetIoErrorHandler()};
   ExternalFileUnit *external{io.GetExternalFileUnit()};
   RUNTIME_CHECK(handler, external != nullptr);
   ChildIo &child{external->PushChildIo(io)};

flang/runtime/format-implementation.h

std::optional<DataEdit> FormatControl<CONTEXT>::GetNextDataEdit(
   edit.descriptor = static_cast<char>(Capitalize(GetNextChar(context)));
   if (edit.descriptor == 'E') {
     if (auto next{static_cast<char>(Capitalize(PeekNext()))};
         next == 'N' || next == 'S' || next == 'X') {
       edit.variation = next;
       ++offset_;
     }
   } else if (edit.descriptor == 'D' && Capitalize(PeekNext()) == 'T') {
-    // DT['iotype'][(v_list)] user-defined derived type I/O
+    // DT['iotype'][(v_list)] defined I/O
     edit.descriptor = DataEdit::DefinedDerivedType;
     ++offset_;
     if (auto quote{static_cast<char>(PeekNext())};
         quote == '\'' || quote == '"') {
       // Capture the quoted 'iotype'
       bool ok{false};
       for (++offset_; offset_ < formatLength_;) {
         auto ch{static_cast<char>(format_[offset_++])};

flang/runtime/format.h

struct DataEdit {
   constexpr bool IsListDirected() const {
     return descriptor == ListDirected || descriptor == ListDirectedRealPart ||
         descriptor == ListDirectedImaginaryPart;
   }
   constexpr bool IsNamelist() const {
     return IsListDirected() && modes.inNamelist;
   }
 
-  static constexpr char DefinedDerivedType{'d'}; // DT user-defined derived type
+  static constexpr char DefinedDerivedType{'d'}; // DT defined I/O
 
   char variation{'\0'}; // N, S, or X for EN, ES, EX
   std::optional<int> width; // the 'w' field; optional for A
   std::optional<int> digits; // the 'm' or 'd' field
   std::optional<int> expoDigits; // 'Ee' field
   MutableModes modes;
   int repeat{1};
 
   // "iotype" &/or "v_list" values for a DT'iotype'(v_list)
-  // user-defined derived type data edit descriptor
+  // defined I/O data edit descriptor
   static constexpr std::size_t maxIoTypeChars{32};
   static constexpr std::size_t maxVListEntries{4};
   std::uint8_t ioTypeChars{0};
   std::uint8_t vListEntries{0};
   char ioType[maxIoTypeChars];
   int vList[maxVListEntries];
 };
 

flang/runtime/io-api.cpp

bool IONAME(InputLogical)(Cookie cookie, bool &truth) {
   }
   StaticDescriptor staticDescriptor;
   Descriptor &descriptor{staticDescriptor.descriptor()};
   descriptor.Establish(
       TypeCategory::Logical, sizeof truth, reinterpret_cast<void *>(&truth), 0);
   return descr::DescriptorIO<Direction::Input>(*cookie, descriptor);
 }
 
-template <Direction DIR>
-static bool DoDerivedTypeIo(Cookie cookie, const Descriptor &descriptor,
-    void (*procedure)(), bool isPolymorphic, const char *which) {
-  IoStatementState &io{*cookie};
-  IoErrorHandler &handler{io.GetIoErrorHandler()};
-  if (handler.InError()) {
-    return false;
-  }
-  const DescriptorAddendum *addendum{descriptor.Addendum()};
-  const typeInfo::DerivedType *type{
-      addendum ? addendum->derivedType() : nullptr};
-  RUNTIME_CHECK(handler, type != nullptr);
-  if (!procedure) {
-    if constexpr (DIR == Direction::Output) {
-      return IONAME(OutputDescriptor)(cookie, descriptor);
-    } else {
-      return IONAME(InputDescriptor)(cookie, descriptor);
-    }
-  }
-  if (!io.get_if<IoDirectionState<DIR>>()) {
-    handler.Crash("%s called for I/O statement that is not %s", which,
-        DIR == Direction::Output ? "output" : "input");
-  }
-  std::uint8_t isArgDesc{isPolymorphic};
-  if (io.get_if<FormattedIoStatementState<DIR>>()) {
-    if (std::optional<bool> wasDefined{
-            descr::DefinedFormattedIo(io, descriptor, *type,
-                typeInfo::SpecialBinding{DIR == Direction::Output
-                        ? typeInfo::SpecialBinding::Which::WriteFormatted
-                        : typeInfo::SpecialBinding::Which::ReadFormatted,
-                    procedure, isArgDesc})}) {
-      return *wasDefined;
-    }
-    return descr::DefaultComponentwiseIO<DIR>(io, descriptor, *type);
-  } else { // unformatted
-    return descr::DefinedUnformattedIo(io, descriptor, *type,
-        typeInfo::SpecialBinding{DIR == Direction::Output
-                ? typeInfo::SpecialBinding::Which::WriteUnformatted
-                : typeInfo::SpecialBinding::Which::ReadUnformatted,
-            procedure, isArgDesc});
-  }
-}
-
 bool IONAME(OutputDerivedType)(Cookie cookie, const Descriptor &descriptor,
-    void (*procedure)(), bool isPolymorphic) {
-  return DoDerivedTypeIo<Direction::Output>(
-      cookie, descriptor, procedure, isPolymorphic, "OutputDerivedType");
+    const NonTbpDefinedIoTable *table) {
+  return descr::DescriptorIO<Direction::Output>(*cookie, descriptor, table);
 }
 
 bool IONAME(InputDerivedType)(Cookie cookie, const Descriptor &descriptor,
-    void (*procedure)(), bool isPolymorphic) {
-  return DoDerivedTypeIo<Direction::Output>(
-      cookie, descriptor, procedure, isPolymorphic, "InputDerivedType");
+    const NonTbpDefinedIoTable *table) {
+  return descr::DescriptorIO<Direction::Input>(*cookie, descriptor, table);
 }
 
 std::size_t IONAME(GetSize)(Cookie cookie) {
   IoStatementState &io{*cookie};
   IoErrorHandler &handler{io.GetIoErrorHandler()};
   if (!handler.InError()) {
     io.CompleteOperation();
   }

flang/runtime/namelist.h

 //===-- runtime/namelist.h --------------------------------------*- C++ -*-===//
 //
 // 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
 //
 //===----------------------------------------------------------------------===//
 
 // Defines the data structure used for NAMELIST I/O
 
 #ifndef FORTRAN_RUNTIME_NAMELIST_H_
 #define FORTRAN_RUNTIME_NAMELIST_H_
 
+#include "non-tbp-dio.h"
+
 #include <cstddef>
 
 namespace Fortran::runtime {
 class Descriptor;
 class IoStatementState;
 } // namespace Fortran::runtime
 
 namespace Fortran::runtime::io {
 
 // A NAMELIST group is a named ordered collection of distinct variable names.
 // It is packaged by lowering into an instance of this class.
 // If all the items are variables with fixed addresses, the NAMELIST group
 // description can be in a read-only section.
 class NamelistGroup {
 public:
   struct Item {
     const char *name; // NUL-terminated lower-case
     const Descriptor &descriptor;
   };
-  const char *groupName; // NUL-terminated lower-case
-  std::size_t items;
-  const Item *item; // in original declaration order
+  const char *groupName{nullptr}; // NUL-terminated lower-case
+  std::size_t items{0};
+  const Item *item{nullptr}; // in original declaration order
+
+  // When the uses of a namelist group appear in scopes with distinct sets
+  // of non-type-bound defined formatted I/O interfaces, they require the
+  // use of distinct NamelistGroups pointing to distinct NonTbpDefinedIoTables.
+  // Multiple NamelistGroup instances may share a NonTbpDefinedIoTable..
+  const NonTbpDefinedIoTable *nonTbpDefinedIo{nullptr};
 };
 
 // Look ahead on input for a '/' or an identifier followed by a '=', '(', or '%'
 // character; for use in disambiguating a name-like value (e.g. F or T) from a
 // NAMELIST group item name and for coping with short arrays.  Always false
 // when not reading a NAMELIST.
 bool IsNamelistNameOrSlash(IoStatementState &);
 
 } // namespace Fortran::runtime::io
 #endif // FORTRAN_RUNTIME_NAMELIST_H_

flang/runtime/namelist.cpp

 //===-- runtime/namelist.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
 //
 //===----------------------------------------------------------------------===//
 
+// TODO: When lowering has been updated to used the new pointer data member in
+// the NamelistGroup structure, delete this definition and the two #ifndef
+// directives below that test it.
+#define DISABLE_NON_TBP_DIO 1
+
 #include "namelist.h"
 #include "descriptor-io.h"
 #include "emit-encoded.h"
 #include "io-stmt.h"
 #include "flang/Runtime/io-api.h"
 #include <algorithm>
 #include <cstring>
 #include <limits>
bool IONAME(OutputNamelist)(Cookie cookie, const NamelistGroup &group) {
   }
   auto *listOutput{io.get_if<ListDirectedStatementState<Direction::Output>>()};
   for (std::size_t j{0}; j < group.items; ++j) {
     // [,]ITEM=...
     const NamelistGroup::Item &item{group.item[j]};
     if (listOutput) {
       listOutput->set_lastWasUndelimitedCharacter(false);
     }
-    if (!(EmitWithAdvance(j == 0 ? ' ' : comma) && EmitUpperCase(item.name) &&
-            EmitWithAdvance('=') &&
-            descr::DescriptorIO<Direction::Output>(io, item.descriptor))) {
+    if (!EmitWithAdvance(j == 0 ? ' ' : comma) || !EmitUpperCase(item.name) ||
+        !EmitWithAdvance('=')) {
+      return false;
+    }
+    if (const auto *addendum{item.descriptor.Addendum()};
+        addendum && addendum->derivedType()) {
+      NonTbpDefinedIoTable *table{nullptr};
+#ifndef DISABLE_NON_TBP_DIO
+      table = group.nonTbpDefinedIo;
+#endif
+      if (!IONAME(OutputDerivedType)(cookie, item.descriptor, table)) {
+        return false;
+      }
+    } else if (!descr::DescriptorIO<Direction::Output>(io, item.descriptor)) {
       return false;
     }
   }
   // terminal /
   return EmitWithAdvance('/');
 }
 
 static constexpr bool IsLegalIdStart(char32_t ch) {
while (true) {
     if (!next || *next != '=') {
       handler.SignalError("No '=' found after item '%s' in NAMELIST group '%s'",
           name, group.groupName);
       return false;
     }
     io.HandleRelativePosition(byteCount);
     // Read the values into the descriptor.  An array can be short.
     listInput->ResetForNextNamelistItem(useDescriptor->rank() > 0);
-    if (!descr::DescriptorIO<Direction::Input>(io, *useDescriptor)) {
+    if (const auto *addendum{useDescriptor->Addendum()};
+        addendum && addendum->derivedType()) {
+      NonTbpDefinedIoTable *table{nullptr};
+#ifndef DISABLE_NON_TBP_DIO
+      table = group.nonTbpDefinedIo;
+#endif
+      if (!IONAME(InputDerivedType)(cookie, *useDescriptor, table)) {
+        return false;
+      }
+    } else if (!descr::DescriptorIO<Direction::Input>(io, *useDescriptor)) {
       return false;
     }
     next = io.GetNextNonBlank(byteCount);
     if (next && *next == comma) {
       io.HandleRelativePosition(byteCount);
     }
   }
   if (!next || *next != '/') {

flang/runtime/non-tbp-dio.h

+//===-- flang/runtime/non-tbp-dio.h -----------------------------*- C++ -*-===//
+//
+// 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
+//
+//===----------------------------------------------------------------------===//
+
+// Defines a structure used to identify the non-type-bound defined I/O
+// generic interfaces that are accessible in a particular scope.  This
+// table is used by some I/O APIs and is also part of the NAMELIST
+// group table.
+//
+// A specific procedure for a particular derived type must appear in
+// this table if it (a) is a dummy procedure or procedure pointer,
+// (b) is part of the defined I/O generic definition in a scope other
+// than the one that contains the derived type definition, or (c)
+// is a null pointer signifying that some specific procedure from
+// a containing scope has become inaccessible in a nested scope due
+// to the use of "IMPORT, NONE" or "IMPORT, ONLY:".
+
+#ifndef FORTRAN_RUNTIME_NON_TBP_DIO_H_
+#define FORTRAN_RUNTIME_NON_TBP_DIO_H_
+
+#include "flang/Common/Fortran.h"
+#include <cstddef>
+
+namespace Fortran::runtime::typeInfo {
+class DerivedType;
+} // namespace Fortran::runtime::typeInfo
+
+namespace Fortran::runtime::io {
+
+struct NonTbpDefinedIo {
+  const typeInfo::DerivedType &derivedType;
+  void (*subroutine)(); // null means no non-TBP defined I/O here
+  common::DefinedIo definedIo;
+  bool isDtvArgPolymorphic; // first dummy arg is CLASS(T)
+};
+
+struct NonTbpDefinedIoTable {
+  const NonTbpDefinedIo *Find(
+      const typeInfo::DerivedType &, common::DefinedIo) const;
+  std::size_t items{0};
+  const NonTbpDefinedIo *item{nullptr};
+  // True when the only procedures to be used are the type-bound special
+  // procedures in the type information tables and any non-null procedures
+  // in this table.  When false, the entries in this table override whatever
+  // non-type-bound specific procedures might be in the type inforamtion,
+  // but the remaining specifics remain visible.
+  bool ignoreNonTbpEntries{false};
+};
+
+} // namespace Fortran::runtime::io
+#endif // FORTRAN_RUNTIME_NON_TBP_DIO_H_

flang/runtime/non-tbp-dio.cpp

+//===-- flang/runtime/non-tbp-dio.cpp ---------------------------*- C++ -*-===//
+//
+// 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 "non-tbp-dio.h"
+#include "type-info.h"
+
+namespace Fortran::runtime::io {
+
+const NonTbpDefinedIo *NonTbpDefinedIoTable::Find(
+    const typeInfo::DerivedType &type, common::DefinedIo definedIo) const {
+  std::size_t j{items};
+  for (const auto *p{item}; j-- > 0; ++p) {
+    if (&p->derivedType == &type && p->definedIo == definedIo) {
+      return p;
+    } else if (p->isDtvArgPolymorphic) {
+      for (const typeInfo::DerivedType *t{type.GetParentType()}; t;
+           t = t->GetParentType()) {
+        if (&p->derivedType == t && p->definedIo == definedIo) {
+          return p;
+        }
+      }
+    }
+  }
+  return nullptr;
+}
+
+} // namespace Fortran::runtime::io

flang/runtime/type-info.h

enum class Which : std::uint8_t {
     WriteFormatted = 5,
     WriteUnformatted = 6,
     ElementalFinal = 7,
     AssumedRankFinal = 8,
     ScalarFinal = 9,
     // higher-ranked final procedures follow
   };
 
-  // Special bindings can be created during execution to handle user-defined
-  // derived type I/O procedures that are not type-bound.
-  SpecialBinding(Which which, ProcedurePointer proc, std::uint8_t isArgDescSet)
-      : which_{which}, isArgDescriptorSet_{isArgDescSet}, proc_{proc} {}
+  // Special bindings can be created during execution to handle defined
+  // I/O procedures that are not type-bound.
+  SpecialBinding(Which which, ProcedurePointer proc, std::uint8_t isArgDescSet,
+      std::uint8_t isTypeBound)
+      : which_{which}, isArgDescriptorSet_{isArgDescSet},
+        isTypeBound_{isTypeBound}, proc_{proc} {}
 
   static constexpr Which RankFinal(int rank) {
     return static_cast<Which>(static_cast<int>(Which::ScalarFinal) + rank);
   }
 
   Which which() const { return which_; }
   bool IsArgDescriptor(int zeroBasedArg) const {
     return (isArgDescriptorSet_ >> zeroBasedArg) & 1;
   }
+  bool isTypeBound() const { return isTypeBound_; }
   template <typename PROC> PROC GetProc() const {
     return reinterpret_cast<PROC>(proc_);
   }
 
   FILE *Dump(FILE *) const;
 
 private:
   Which which_{Which::None};
private:
   //   Which::Final and Which::ElementalFinal:
   //     Set to 1 when dummy argument is assumed-shape; otherwise, the
   //     argument can be passed by address.  (Fortran guarantees that
   //     any finalized object must be whole and contiguous by restricting
   //     the use of DEALLOCATE on pointers.  The dummy argument of an
   //     elemental final subroutine must be scalar and monomorphic, but
   //     use a descriptors when the type has LEN parameters.)
   //   Which::AssumedRankFinal: flag must necessarily be set
-  //   User derived type I/O:
+  //   Defined I/O:
   //     Set to 1 when "dtv" initial dummy argument is polymorphic, which is
   //     the case when and only when the derived type is extensible.
-  //     When false, the user derived type I/O subroutine must have been
+  //     When false, the defined I/O subroutine must have been
   //     called via a generic interface, not a generic TBP.
   std::uint8_t isArgDescriptorSet_{0};
+  std::uint8_t isTypeBound_{0};
 
   ProcedurePointer proc_{nullptr};
 };
 
 class DerivedType {
 public:
   ~DerivedType(); // never defined
 

flang/runtime/unit.h

std::variant<std::monostate, OpenStatementState, CloseStatementState,
       ExternalUnformattedIoStatementState<Direction::Output>,
       ExternalUnformattedIoStatementState<Direction::Input>, InquireUnitState,
       ExternalMiscIoStatementState, ErroneousIoStatementState>
       u_;
 
   // Points to the active alternative (if any) in u_ for use as a Cookie
   std::optional<IoStatementState> io_;
 
-  // A stack of child I/O pseudo-units for user-defined derived type
-  // I/O that have this unit number.
+  // A stack of child I/O pseudo-units for defined I/O that have this
+  // unit number.
   OwningPtr<ChildIo> child_;
 };
 
-// A pseudo-unit for child I/O statements in user-defined derived type
-// I/O subroutines; it forwards operations to the parent I/O statement,
-// which can also be a child I/O statement.
+// A pseudo-unit for child I/O statements in defined I/O subroutines;
+// it forwards operations to the parent I/O statement, which might also
+// be a child I/O statement.
 class ChildIo {
 public:
   ChildIo(IoStatementState &parent, OwningPtr<ChildIo> &&previous)
       : parent_{parent}, previous_{std::move(previous)} {}
 
   IoStatementState &parent() const { return parent_; }
 
   void EndIoStatement();

flang/test/Semantics/typeinfo01.f90

contains
   end subroutine
   subroutine s2(x, y)
     class(t2), intent(out) :: x
     class(t), intent(in) :: y
   end subroutine
 !CHECK: .c.t2, SAVE, TARGET (CompilerCreated, ReadOnly): 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 (CompilerCreated, ReadOnly): 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 (CompilerCreated, ReadOnly): 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 (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(specialbinding) shape: 0_8:0_8 init:[specialbinding::specialbinding(which=1_1,isargdescriptorset=3_1,proc=s1)]
+!CHECK: .s.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(specialbinding) shape: 0_8:0_8 init:[specialbinding::specialbinding(which=1_1,isargdescriptorset=3_1,istypebound=1_1,proc=s1)]
 !CHECK: .v.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(binding) shape: 0_8:0_8 init:[binding::binding(proc=s1,name=.n.s1)]
 !CHECK: .v.t2, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(binding) shape: 0_8:0_8 init:[binding::binding(proc=s2,name=.n.s1)]
 end module
 
 module m07
   type :: t
    contains
     procedure :: s1
     generic :: assignment(=) => s1
   end type
  contains
   impure elemental subroutine s1(x, y)
     class(t), intent(out) :: x
     class(t), intent(in) :: y
   end subroutine
 !CHECK: .dt.t, SAVE, TARGET (CompilerCreated, ReadOnly): 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 (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(specialbinding) shape: 0_8:0_8 init:[specialbinding::specialbinding(which=2_1,isargdescriptorset=3_1,proc=s1)]
+!CHECK: .s.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(specialbinding) shape: 0_8:0_8 init:[specialbinding::specialbinding(which=2_1,isargdescriptorset=3_1,istypebound=1_1,proc=s1)]
 !CHECK: .v.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(binding) shape: 0_8:0_8 init:[binding::binding(proc=s1,name=.n.s1)]
 end module
 
 module m08
   type :: t
    contains
     final :: s1, s2, s3
   end type
  contains
   subroutine s1(x)
     type(t) :: x(:)
   end subroutine
   subroutine s2(x)
     type(t) :: x(3,3)
   end subroutine
   impure elemental subroutine s3(x)
     type(t), intent(in) :: x
   end subroutine
 !CHECK: .dt.t, SAVE, TARGET (CompilerCreated, ReadOnly): 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 (CompilerCreated, ReadOnly): 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)]
+!CHECK: .s.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(specialbinding) shape: 0_8:2_8 init:[specialbinding::specialbinding(which=7_1,isargdescriptorset=0_1,istypebound=1_1,proc=s3),specialbinding(which=10_1,isargdescriptorset=1_1,istypebound=1_1,proc=s1),specialbinding(which=11_1,isargdescriptorset=0_1,istypebound=1_1,proc=s2)]
 end module
 
 module m09
   type :: t
    contains
     procedure :: rf, ru, wf, wu
     generic :: read(formatted) => rf
     generic :: read(unformatted) => ru
contains
   end subroutine
   subroutine wu(x,u,iostat,iomsg)
     class(t), intent(in) :: x
     integer, intent(in) :: u
     integer, intent(out) :: iostat
     character(len=*), intent(inout) :: iomsg
   end subroutine
 !CHECK: .dt.t, SAVE, TARGET (CompilerCreated, ReadOnly): 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 (CompilerCreated, ReadOnly): 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: .s.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(specialbinding) shape: 0_8:3_8 init:[specialbinding::specialbinding(which=3_1,isargdescriptorset=1_1,istypebound=1_1,proc=rf),specialbinding(which=4_1,isargdescriptorset=1_1,istypebound=1_1,proc=ru),specialbinding(which=5_1,isargdescriptorset=1_1,istypebound=1_1,proc=wf),specialbinding(which=6_1,isargdescriptorset=1_1,istypebound=1_1,proc=wu)]
 !CHECK: .v.t, SAVE, TARGET (CompilerCreated, ReadOnly): 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
 
 module m10
   type, bind(c) :: t ! non-extensible
   end type
   interface read(formatted)
     procedure :: rf
contains
   end subroutine
   subroutine wu(x,u,iostat,iomsg)
     type(t), intent(in) :: x
     integer, intent(in) :: u
     integer, intent(out) :: iostat
     character(len=*), intent(inout) :: iomsg
   end subroutine
 !CHECK: .dt.t, SAVE, TARGET (CompilerCreated, ReadOnly): 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 (CompilerCreated, ReadOnly): 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)]
+!CHECK: .s.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(specialbinding) shape: 0_8:3_8 init:[specialbinding::specialbinding(which=3_1,isargdescriptorset=0_1,istypebound=0_1,proc=rf),specialbinding(which=4_1,isargdescriptorset=0_1,istypebound=0_1,proc=ru),specialbinding(which=5_1,isargdescriptorset=0_1,istypebound=0_1,proc=wf),specialbinding(which=6_1,isargdescriptorset=0_1,istypebound=0_1,proc=wu)]
 end module
 
 module m11
   real, target :: target
   type :: t(len)
     integer(kind=8), len :: len
     real, allocatable :: allocatable(:)
     real, pointer :: pointer => target

 end module
 
 module m13
   type :: t1
     integer :: n
    contains
     procedure :: assign1, assign2
     generic :: assignment(=) => assign1, assign2
-    ! CHECK: .s.t1, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(specialbinding) shape: 0_8:0_8 init:[specialbinding::specialbinding(which=2_1,isargdescriptorset=3_1,proc=assign1)]
+    ! CHECK: .s.t1, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(specialbinding) shape: 0_8:0_8 init:[specialbinding::specialbinding(which=2_1,isargdescriptorset=3_1,istypebound=1_1,proc=assign1)]
   end type
  contains
   impure elemental subroutine assign1(to, from)
     class(t1), intent(out) :: to
     class(t1), intent(in) :: from
   end subroutine
   impure elemental subroutine assign2(to, from)
     class(t1), intent(out) :: to
     integer, intent(in) :: from
   end subroutine
 end module

flang/test/Semantics/typeinfo02.f90

subroutine wf2(x,u,iot,v,iostat,iomsg)
     class(extended), intent(in) :: x
     integer, intent(in) :: u
     character(len=*), intent(in) :: iot
     integer, intent(in) :: v(:)
     integer, intent(out) :: iostat
     character(len=*), intent(inout) :: iomsg
   end subroutine
 end module
-!CHECK: .s.base, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(specialbinding) shape: 0_8:0_8 init:[specialbinding::specialbinding(which=5_1,isargdescriptorset=1_1,proc=wf1)]
-!CHECK: .s.extended, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(specialbinding) shape: 0_8:0_8 init:[specialbinding::specialbinding(which=5_1,isargdescriptorset=1_1,proc=wf2)]
+!CHECK: .s.base, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(specialbinding) shape: 0_8:0_8 init:[specialbinding::specialbinding(which=5_1,isargdescriptorset=1_1,istypebound=1_1,proc=wf1)]
+!CHECK: .s.extended, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(specialbinding) shape: 0_8:0_8 init:[specialbinding::specialbinding(which=5_1,isargdescriptorset=1_1,istypebound=1_1,proc=wf2)]