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

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.

Differential Revision: https://reviews.llvm.org/D148257

Author: klausler

flang/include/flang/Common/Fortran.h

@@ -57,6 +57,11 @@ ENUM_CLASS(IoSpecKind, Access, Action, Advance, Asynchronous, Blank, Decimal,
     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 {
@@ -75,5 +80,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

@@ -23,6 +23,7 @@ class Descriptor;
 
 namespace Fortran::runtime::io {
 
+class NonTbpDefinedIoTable;
 class NamelistGroup;
 class IoStatementState;
 using Cookie = IoStatementState *;
@@ -275,21 +276,19 @@ bool IONAME(InputLogical)(Cookie, bool &);
 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(),

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

@@ -15,6 +15,8 @@
 #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>
@@ -24,12 +26,6 @@ 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};
@@ -52,5 +48,14 @@ 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

@@ -445,8 +445,6 @@ class HostAssocDetails {
 // 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); }
@@ -455,9 +453,9 @@ struct GenericKind {
   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:

flang/include/flang/Semantics/tools.h

@@ -620,30 +620,19 @@ std::optional<ArraySpec> ToArraySpec(
 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

@@ -60,4 +60,18 @@ const char *AsFortran(RelationalOperator opr) {
   }
 }
 
+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

@@ -121,30 +121,29 @@ class CheckHelper {
   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_;
@@ -1426,7 +1425,7 @@ 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) {
@@ -2498,13 +2497,13 @@ bool CheckHelper::CheckDioDummyIsData(
 }
 
 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;
   }
@@ -2528,7 +2527,7 @@ void CheckHelper::CheckAlreadySeenDefinedIo(const DerivedTypeSpec &derivedType,
 }
 
 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);
@@ -2573,13 +2572,13 @@ void CheckHelper::CheckDioDummyIsScalar(const Symbol &subp, const Symbol &arg) {
 }
 
 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);
   }
@@ -2668,10 +2667,10 @@ void CheckHelper::CheckDioVlistArg(
 }
 
 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) {
@@ -2704,7 +2703,7 @@ void CheckHelper::CheckDioDummyAttrs(
 
 // 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>()};
@@ -2730,8 +2729,8 @@ void CheckHelper::CheckDefinedIoProc(const Symbol &symbol,
           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);
@@ -2741,8 +2740,8 @@ void CheckHelper::CheckDefinedIoProc(const Symbol &symbol,
           }
           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 {