diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp index 318085518cc57..25117964e078f 100644 --- a/flang/lib/Semantics/check-declarations.cpp +++ b/flang/lib/Semantics/check-declarations.cpp @@ -1192,7 +1192,7 @@ void CheckHelper::CheckObjectEntity( typeName); } else if (evaluate::IsAssumedRank(symbol)) { SayWithDeclaration(symbol, - "Assumed Rank entity of %s type is not supported"_err_en_US, + "Assumed rank entity of %s type is not supported"_err_en_US, typeName); } } @@ -3414,7 +3414,13 @@ void CheckHelper::CheckBindC(const Symbol &symbol) { bool CheckHelper::CheckDioDummyIsData( const Symbol &subp, const Symbol *arg, std::size_t position) { if (arg && arg->detailsIf()) { - return true; + if (evaluate::IsAssumedRank(*arg)) { + messages_.Say(arg->name(), + "Dummy argument '%s' may not be assumed-rank"_err_en_US, arg->name()); + return false; + } else { + return true; + } } else { if (arg) { messages_.Say(arg->name(), @@ -3592,9 +3598,10 @@ void CheckHelper::CheckDioVlistArg( CheckDioDummyIsDefaultInteger(subp, *arg); CheckDioDummyAttrs(subp, *arg, Attr::INTENT_IN); const auto *objectDetails{arg->detailsIf()}; - if (!objectDetails || !objectDetails->shape().CanBeAssumedShape()) { + if (!objectDetails || !objectDetails->shape().CanBeAssumedShape() || + objectDetails->shape().Rank() != 1) { messages_.Say(arg->name(), - "Dummy argument '%s' of a defined input/output procedure must be assumed shape"_err_en_US, + "Dummy argument '%s' of a defined input/output procedure must be assumed shape vector"_err_en_US, arg->name()); } } diff --git a/flang/test/Semantics/io11.f90 b/flang/test/Semantics/io11.f90 index 3529929003b01..c00deede6b516 100644 --- a/flang/test/Semantics/io11.f90 +++ b/flang/test/Semantics/io11.f90 @@ -342,7 +342,7 @@ subroutine formattedReadProc(dtv, unit, iotype, vlist, iostat, iomsg) end subroutine end module m15 -module m16 +module m16a type,public :: t integer c contains @@ -355,15 +355,58 @@ subroutine formattedReadProc(dtv, unit, iotype, vlist, iostat, iomsg) class(t), intent(inout) :: dtv integer, intent(in) :: unit character(len=*), intent(in) :: iotype - !ERROR: Dummy argument 'vlist' of a defined input/output procedure must be assumed shape + !ERROR: Dummy argument 'vlist' of a defined input/output procedure must be assumed shape vector integer, intent(in) :: vlist(5) integer, intent(out) :: iostat character(len=*), intent(inout) :: iomsg + iostat = 343 + stop 'fail' + end subroutine +end module m16a +module m16b + type,public :: t + integer c + 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 + character(len=*), intent(in) :: iotype + !ERROR: Dummy argument 'vlist' of a defined input/output procedure must be assumed shape vector + integer, intent(in) :: vlist(:,:) + integer, intent(out) :: iostat + character(len=*), intent(inout) :: iomsg + iostat = 343 + stop 'fail' + end subroutine +end module m16b + +module m16c + type,public :: t + integer c + 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 + character(len=*), intent(in) :: iotype + !ERROR: Dummy argument 'vlist' may not be assumed-rank + integer, intent(in) :: vlist(..) + integer, intent(out) :: iostat + character(len=*), intent(inout) :: iomsg iostat = 343 stop 'fail' end subroutine -end module m16 +end module m16c module m17 ! Test the same defined input/output procedure specified as a generic