Skip to content

[flang] Stricter checking of v_list DIO arguments #139329

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 1 commit into from
May 12, 2025
Merged

[flang] Stricter checking of v_list DIO arguments #139329

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
15 changes: 11 additions & 4 deletions flang/lib/Semantics/check-declarations.cpp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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);
}
}
Expand Down Expand Up @@ -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<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(),
Expand Down Expand Up @@ -3592,9 +3598,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());
}
}
Expand Down
49 changes: 46 additions & 3 deletions flang/test/Semantics/io11.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down