[flang] Fix false error for multiple defined I/O subroutines

[klausler]

Summary

User-defined derived type I/O subroutines need to be unique for
a given type and operation in any scope, but it is acceptable
to have more than one defined I/O subroutine so long as only one
of them is visible.

flang/lib/Semantics/check-declarations.cpp

void SayWithDeclaration(const Symbol &symbol, A &&...x) {
     }
   }
   bool IsResultOkToDiffer(const FunctionResult &);
   void CheckBindCName(const Symbol &);
   // Check functions for defined I/O procedures
   void CheckDefinedIoProc(
       const Symbol &, const GenericDetails &, GenericKind::DefinedIo);
   bool CheckDioDummyIsData(const Symbol &, const Symbol *, std::size_t);
-  void CheckDioDummyIsDerived(
-      const Symbol &, const Symbol &, GenericKind::DefinedIo ioKind);
+  void CheckDioDummyIsDerived(const Symbol &, const Symbol &,
+      GenericKind::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);
+  void CheckDioDtvArg(
+      const Symbol &, const Symbol *, GenericKind::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);
   struct TypeWithDefinedIo {
-    const DerivedTypeSpec *type;
+    const DerivedTypeSpec &type;
     GenericKind::DefinedIo ioKind;
     const Symbol &proc;
+    const Symbol &generic;
   };
-  void CheckAlreadySeenDefinedIo(
-      const DerivedTypeSpec *, GenericKind::DefinedIo, const Symbol &);
+  void CheckAlreadySeenDefinedIo(const DerivedTypeSpec &,
+      GenericKind::DefinedIo, const Symbol &, const Symbol &generic);
 
   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
   // that has a symbol.
if (arg) {
       messages_.Say(subp.name(),
           "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) {
+void CheckHelper::CheckAlreadySeenDefinedIo(const DerivedTypeSpec &derivedType,
+    GenericKind::DefinedIo ioKind, const Symbol &proc, const Symbol &generic) {
   for (TypeWithDefinedIo definedIoType : seenDefinedIoTypes_) {
-    if (*derivedType == *definedIoType.type && ioKind == definedIoType.ioKind &&
-        proc != definedIoType.proc) {
+    // 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 if both were visible in the same scope.)
+    if (derivedType == definedIoType.type && ioKind == definedIoType.ioKind &&
+        proc != definedIoType.proc &&
+        (generic.owner().IsDerivedType() ||
+            definedIoType.generic.owner().IsDerivedType())) {
       SayWithDeclaration(proc, definedIoType.proc.name(),
           "Derived type '%s' already has defined input/output procedure"
           " '%s'"_err_en_US,
-          derivedType->name(),
+          derivedType.name(),
           parser::ToUpperCaseLetters(GenericKind::EnumToString(ioKind)));
       return;
     }
   }
   seenDefinedIoTypes_.emplace_back(
-      TypeWithDefinedIo{derivedType, ioKind, proc});
+      TypeWithDefinedIo{derivedType, ioKind, proc, generic});
 }
 
-void CheckHelper::CheckDioDummyIsDerived(
-    const Symbol &subp, const Symbol &arg, GenericKind::DefinedIo ioKind) {
+void CheckHelper::CheckDioDummyIsDerived(const Symbol &subp, const Symbol &arg,
+    GenericKind::DefinedIo ioKind, const Symbol &generic) {
   if (const DeclTypeSpec * type{arg.GetType()}) {
     if (const DerivedTypeSpec * derivedType{type->AsDerived()}) {
-      CheckAlreadySeenDefinedIo(derivedType, ioKind, subp);
+      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()",
             isPolymorphic ? "not extensible" : "extensible");
       }
     } else {
void CheckHelper::CheckDioDummyIsScalar(const Symbol &subp, const Symbol &arg) {
   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) {
+void CheckHelper::CheckDioDtvArg(const Symbol &subp, const Symbol *arg,
+    GenericKind::DefinedIo ioKind, const Symbol &generic) {
   // Dtv argument looks like: dtv-type-spec, INTENT(INOUT) :: dtv
   if (CheckDioDummyIsData(subp, arg, 0)) {
-    CheckDioDummyIsDerived(subp, *arg, ioKind);
+    CheckDioDummyIsDerived(subp, *arg, ioKind, generic);
     CheckDioDummyAttrs(subp, *arg,
         ioKind == GenericKind::DefinedIo::ReadFormatted ||
                 ioKind == GenericKind::DefinedIo::ReadUnformatted
             ? Attr::INTENT_INOUT
             : Attr::INTENT_IN);
   }
 }
 
for (auto ref : details.specificProcs()) {
     if (const auto *subpDetails{specific.detailsIf<SubprogramDetails>()}) {
       const std::vector<Symbol *> &dummyArgs{subpDetails->dummyArgs()};
       CheckDioArgCount(specific, ioKind, dummyArgs.size());
       int argCount{0};
       for (auto *arg : dummyArgs) {
         switch (argCount++) {
         case 0:
           // dtv-type-spec, INTENT(INOUT) :: dtv
-          CheckDioDtvArg(specific, arg, ioKind);
+          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) {

flang/test/Semantics/io11.f90

module m19
   end interface
 contains
   subroutine unformattedReadProc1(dtv,unit,iostat,iomsg)
     class(t),intent(inout) :: dtv
     integer,intent(in) :: unit
     integer,intent(out) :: iostat
     character(*),intent(inout) :: iomsg
     read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
-    print *,v_list
   end subroutine
   !ERROR: Derived type 't' already has defined input/output procedure 'READUNFORMATTED'
   subroutine unformattedReadProc(dtv,unit,iostat,iomsg)
     class(t),intent(inout) :: dtv
     integer,intent(in) :: unit
     integer,intent(out) :: iostat
     character(*),intent(inout) :: iomsg
     read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
-    print *,v_list
   end subroutine
 end module
 
 module m20
   ! Test read and write defined input/output procedures specified as a 
   ! type-bound procedure and as a generic for the same derived type
   type t
     integer c
module m20
   end interface
 contains
   subroutine unformattedReadProc(dtv,unit,iostat,iomsg)
     class(t),intent(inout) :: dtv
     integer,intent(in) :: unit
     integer,intent(out) :: iostat
     character(*),intent(inout) :: iomsg
     read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
-    print *,v_list
   end subroutine
   subroutine unformattedWriteProc(dtv,unit,iostat,iomsg)
     class(t),intent(in) :: dtv
     integer,intent(in) :: unit
     integer,intent(out) :: iostat
     character(*),intent(inout) :: iomsg
     write(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
-    print *,v_list
   end subroutine
 end module
 
 module m21
   ! Test read and write defined input/output procedures specified as a 
   ! type-bound procedure and as a generic for the same derived type with a
   ! KIND type parameter where they both have the same value
   type t(typeParam)
     integer, kind :: typeParam = 4
     integer c
   contains
     procedure :: unformattedReadProc
     generic :: read(unformatted) => unformattedReadProc
   end type
   interface read(unformatted)
     module procedure unformattedReadProc1
   end interface
 contains
   subroutine unformattedReadProc(dtv,unit,iostat,iomsg)
     class(t),intent(inout) :: dtv
     integer,intent(in) :: unit
     integer,intent(out) :: iostat
     character(*),intent(inout) :: iomsg
     read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
-    print *,v_list
   end subroutine
   !ERROR: Derived type 't' already has defined input/output procedure 'READUNFORMATTED'
   subroutine unformattedReadProc1(dtv,unit,iostat,iomsg)
     class(t(4)),intent(inout) :: dtv
     integer,intent(in) :: unit
     integer,intent(out) :: iostat
     character(*),intent(inout) :: iomsg
     read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
-    print *,v_list
   end subroutine
 end module
 
 module m22
   ! Test read and write defined input/output procedures specified as a 
   ! type-bound procedure and as a generic for the same derived type with a
   ! KIND type parameter where they have different values
   type t(typeParam)
     integer, kind :: typeParam = 4
     integer c
   contains
     procedure :: unformattedReadProc
     generic :: read(unformatted) => unformattedReadProc
   end type
   interface read(unformatted)
     module procedure unformattedReadProc1
   end interface
 contains
   subroutine unformattedReadProc(dtv,unit,iostat,iomsg)
     class(t),intent(inout) :: dtv
     integer,intent(in) :: unit
     integer,intent(out) :: iostat
     character(*),intent(inout) :: iomsg
     read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
-    print *,v_list
   end subroutine
   subroutine unformattedReadProc1(dtv,unit,iostat,iomsg)
     class(t(3)),intent(inout) :: dtv
     integer,intent(in) :: unit
     integer,intent(out) :: iostat
     character(*),intent(inout) :: iomsg
     read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
-    print *,v_list
   end subroutine
 end module
 
 module m23
   type t(typeParam)
   ! Test read and write defined input/output procedures specified as a 
   ! type-bound procedure and as a generic for the same derived type with a
   ! LEN type parameter where they have different values
     integer, len :: typeParam = 4
     integer c
   contains
     procedure :: unformattedReadProc
     generic :: read(unformatted) => unformattedReadProc
   end type
   interface read(unformatted)
     module procedure unformattedReadProc1
   end interface
 contains
   subroutine unformattedReadProc(dtv,unit,iostat,iomsg)
     class(t(*)),intent(inout) :: dtv
     integer,intent(in) :: unit
     integer,intent(out) :: iostat
     character(*),intent(inout) :: iomsg
     read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
-    print *,v_list
   end subroutine
   subroutine unformattedReadProc1(dtv,unit,iostat,iomsg)
     class(t(3)),intent(inout) :: dtv
     integer,intent(in) :: unit
     integer,intent(out) :: iostat
     character(*),intent(inout) :: iomsg
     read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
-    print *,v_list
   end subroutine
 end module
 
 module m24
   ! Test read and write defined input/output procedures specified as a 
   ! type-bound procedure and as a generic for the same derived type with a
   ! LEN type parameter where they have the same value
   type t(typeParam)
     integer, len :: typeParam = 4
     integer c
   contains
     procedure :: unformattedReadProc
     generic :: read(unformatted) => unformattedReadProc
   end type
   interface read(unformatted)
     module procedure unformattedReadProc1
   end interface
 contains
   subroutine unformattedReadProc(dtv,unit,iostat,iomsg)
     class(t(*)),intent(inout) :: dtv
     integer,intent(in) :: unit
     integer,intent(out) :: iostat
     character(*),intent(inout) :: iomsg
     read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
-    print *,v_list
   end subroutine
   !ERROR: Derived type 't' already has defined input/output procedure 'READUNFORMATTED'
   subroutine unformattedReadProc1(dtv,unit,iostat,iomsg)
     class(t(*)),intent(inout) :: dtv
     integer,intent(in) :: unit
     integer,intent(out) :: iostat
     character(*),intent(inout) :: iomsg
     read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
-    print *,v_list
   end subroutine
 end module
+
+module m25a
+  ! Test against false error when two defined I/O procedures exist
+  ! for the same type but are not both visible in the same scope.
+  type t
+    integer c
+  end type
+  interface read(unformatted)
+    module procedure unformattedReadProc1
+  end interface
+ contains
+  subroutine unformattedReadProc1(dtv,unit,iostat,iomsg)
+    class(t),intent(inout) :: dtv
+    integer,intent(in) :: unit
+    integer,intent(out) :: iostat
+    character(*),intent(inout) :: iomsg
+    read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
+  end subroutine
+end module
+subroutine m25b
+  use m25a, only: t
+  interface read(unformatted)
+    procedure unformattedReadProc2
+  end interface
+ contains
+  subroutine unformattedReadProc2(dtv,unit,iostat,iomsg)
+    class(t),intent(inout) :: dtv
+    integer,intent(in) :: unit
+    integer,intent(out) :: iostat
+    character(*),intent(inout) :: iomsg
+    read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
+  end subroutine
+end subroutine