diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp --- a/flang/lib/Semantics/check-declarations.cpp +++ b/flang/lib/Semantics/check-declarations.cpp @@ -2624,10 +2624,18 @@ // 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()); } } @@ -2688,13 +2696,14 @@ void CheckHelper::CheckDefinedIoProc(const Symbol &symbol, const GenericDetails &details, GenericKind::DefinedIo ioKind) { for (auto ref : details.specificProcs()) { - const auto *binding{ref->detailsIf()}; - const Symbol &specific{*(binding ? &binding->symbol() : &*ref)}; - if (ref->attrs().test(Attr::NOPASS)) { // C774 + const Symbol &ultimate{ref->GetUltimate()}; + const auto *binding{ultimate.detailsIf()}; + 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()}) { const std::vector &dummyArgs{subpDetails->dummyArgs()}; diff --git a/flang/test/Semantics/io11.f90 b/flang/test/Semantics/io11.f90 --- a/flang/test/Semantics/io11.f90 +++ b/flang/test/Semantics/io11.f90 @@ -331,12 +331,12 @@ 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 @@ -667,3 +667,25 @@ 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