[flang] Fix checks for USE-associated UDDTIO & their character argument kinds

[klausler]

Summary

Call GetUltimate() before checking a user-defined derived type I/O specific
procedure so that the checks work on a USE-associated procedure. And
require their character arguments to have the default CHARACTER kind.

flang/lib/Semantics/check-declarations.cpp

void CheckHelper::CheckDefaultIntegerArg(
   }
 }
 
 void CheckHelper::CheckDioAssumedLenCharacterArg(const Symbol &subp,
     const Symbol *arg, std::size_t argPosition, Attr intent) {
   // Argument looks like: CHARACTER (LEN=*), INTENT(intent) :: (iotype OR iomsg)
   if (CheckDioDummyIsData(subp, arg, argPosition)) {
     CheckDioDummyAttrs(subp, *arg, intent);
-    if (!IsAssumedLengthCharacter(*arg)) {
+    const DeclTypeSpec *type{arg ? arg->GetType() : nullptr};
+    const IntrinsicTypeSpec *intrinsic{type ? type->AsIntrinsic() : nullptr};
+    const auto kind{
+        intrinsic ? evaluate::ToInt64(intrinsic->kind()) : std::nullopt};
+    if (!IsAssumedLengthCharacter(*arg) ||
+        (!kind ||
+            *kind !=
+                context_.defaultKinds().GetDefaultKind(
+                    TypeCategory::Character))) {
       messages_.Say(arg->name(),
           "Dummy argument '%s' of a defined input/output procedure"
-          " must be assumed-length CHARACTER"_err_en_US,
+          " must be assumed-length CHARACTER of default kind"_err_en_US,
           arg->name());
     }
   }
 }
 
 void CheckHelper::CheckDioVlistArg(
     const Symbol &subp, const Symbol *arg, std::size_t argPosition) {
   // Vlist argument looks like: INTEGER, INTENT(IN) :: v_list(:)
messages_.Say(arg.name(),
         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) {
   for (auto ref : details.specificProcs()) {
-    const auto *binding{ref->detailsIf<ProcBindingDetails>()};
-    const Symbol &specific{*(binding ? &binding->symbol() : &*ref)};
-    if (ref->attrs().test(Attr::NOPASS)) { // C774
+    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,
-          ref->name());
-      context_.SetError(*ref);
+          ultimate.name());
+      context_.SetError(ultimate);
     }
     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:

flang/test/Semantics/io11.f90

contains
     procedure, pass :: tbp=>formattedReadProc
     generic :: read(formatted) => tbp
   end type
   private
 contains
   subroutine formattedReadProc(dtv, unit, iotype, vlist, iostat, iomsg)
     class(t), intent(inout) :: dtv
     integer, intent(in) :: unit
-    !ERROR: Dummy argument 'iotype' of a defined input/output procedure must be assumed-length CHARACTER
+    !ERROR: Dummy argument 'iotype' of a defined input/output procedure must be assumed-length CHARACTER of default kind
     character(len=5), intent(in) :: iotype ! Error, must be assumed length
     integer, intent(in) :: vlist(:)
     integer, intent(out) :: iostat
-    character(len=*), intent(inout) :: iomsg
-
+    !ERROR: Dummy argument 'iomsg' of a defined input/output procedure must be assumed-length CHARACTER of default kind
+    character(len=5), intent(inout) :: iomsg
     iostat = 343
     stop 'fail'
   end subroutine
 end module m15
 
 module m16
   type,public :: t
     integer c
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
+
+module m26a
+  type t
+    integer n
+  end type
+ contains
+  subroutine unformattedRead(dtv,unit,iostat,iomsg)
+    class(t),intent(inout) :: dtv
+    integer,intent(in) :: unit
+    integer,intent(out) :: iostat
+    !ERROR: Dummy argument 'iomsg' of a defined input/output procedure must be assumed-length CHARACTER of default kind
+    character(kind=4,len=*),intent(inout) :: iomsg
+    !ERROR: Must have default kind(1) of CHARACTER type, but is CHARACTER(KIND=4,LEN=*)
+    read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%n
+  end subroutine
+end
+module m26b
+  use m26a
+  interface read(unformatted)
+    procedure unformattedRead
+  end interface
+end