[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:
@@ -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());
|
||||
}
|
||||
}
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user