[flang] Stricter checking of v_list DIO arguments (#139329)

Catch assumed-rank arguments to defined I/O subroutines, and ensure that
v_list dummy arguments are vectors.

Fixes https://github.com/llvm/llvm-project/issues/138933.
This commit is contained in:
Peter Klausler
2025-05-12 12:27:56 -07:00
committed by GitHub
parent 8fc1a6496a
commit d90bbf147b
2 changed files with 58 additions and 8 deletions

View File

@@ -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);
}
}
@@ -3420,7 +3420,13 @@ void CheckHelper::CheckBindC(const Symbol &symbol) {
bool CheckHelper::CheckDioDummyIsData(
const Symbol &subp, const Symbol *arg, std::size_t position) {
if (arg && arg->detailsIf<ObjectEntityDetails>()) {
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(),
@@ -3598,9 +3604,10 @@ void CheckHelper::CheckDioVlistArg(
CheckDioDummyIsDefaultInteger(subp, *arg);
CheckDioDummyAttrs(subp, *arg, Attr::INTENT_IN);
const auto *objectDetails{arg->detailsIf<ObjectEntityDetails>()};
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());
}
}

View File

@@ -342,7 +342,7 @@ contains
end subroutine
end module m15
module m16
module m16a
type,public :: t
integer c
contains
@@ -355,15 +355,58 @@ contains
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 m16
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 m16c
module m17
! Test the same defined input/output procedure specified as a generic