[flang] Check that various variables referenced in I/O statements may be defined
A number of I/O syntax rules involve variables that will be written to, and must therefore be definable. This includes internal file variables, IOSTAT= and IOMSG= specifiers, most INQUIRE statement specifiers, a few other specifiers, and input variables. This patch checks for these violations, and implements several additional I/O TODO constraint checks. Differential Revision: https://reviews.llvm.org/D86557
This commit is contained in:
peter klausler
parent
e713b0ecbc
commit
bce7a7edf3
|
|
@ -155,7 +155,8 @@ void IoChecker::Enter(const parser::ConnectSpec::CharExpr &spec) {
|
|||
}
|
||||
}
|
||||
|
||||
void IoChecker::Enter(const parser::ConnectSpec::Newunit &) {
|
||||
void IoChecker::Enter(const parser::ConnectSpec::Newunit &var) {
|
||||
CheckForDefinableVariable(var, "NEWUNIT");
|
||||
SetSpecifier(IoSpecKind::Newunit);
|
||||
}
|
||||
|
||||
|
|
@ -266,10 +267,11 @@ void IoChecker::Enter(const parser::IdExpr &) { SetSpecifier(IoSpecKind::Id); }
|
|||
|
||||
void IoChecker::Enter(const parser::IdVariable &spec) {
|
||||
SetSpecifier(IoSpecKind::Id);
|
||||
auto expr{GetExpr(spec)};
|
||||
const auto *expr{GetExpr(spec)};
|
||||
if (!expr || !expr->GetType()) {
|
||||
return;
|
||||
}
|
||||
CheckForDefinableVariable(spec, "ID");
|
||||
int kind{expr->GetType()->kind()};
|
||||
int defaultKind{context_.GetDefaultKind(TypeCategory::Integer)};
|
||||
if (kind < defaultKind) {
|
||||
|
|
@ -281,21 +283,18 @@ void IoChecker::Enter(const parser::IdVariable &spec) {
|
|||
|
||||
void IoChecker::Enter(const parser::InputItem &spec) {
|
||||
flags_.set(Flag::DataList);
|
||||
if (const parser::Variable * var{std::get_if<parser::Variable>(&spec.u)}) {
|
||||
const parser::Name &name{GetLastName(*var)};
|
||||
if (name.symbol) {
|
||||
if (auto *details{name.symbol->detailsIf<ObjectEntityDetails>()}) {
|
||||
// TODO: Determine if this check is needed at all, and if so, replace
|
||||
// the false subcondition with a check for a whole array. Otherwise,
|
||||
// the check incorrectly flags array element and section references.
|
||||
if (details->IsAssumedSize() && false) {
|
||||
// This check may be superseded by C928 or C1002.
|
||||
context_.Say(name.source,
|
||||
"'%s' must not be a whole assumed size array"_err_en_US,
|
||||
name.source); // C1231
|
||||
}
|
||||
}
|
||||
}
|
||||
const parser::Variable *var{std::get_if<parser::Variable>(&spec.u)};
|
||||
if (!var) {
|
||||
return;
|
||||
}
|
||||
CheckForDefinableVariable(*var, "Input");
|
||||
const auto &name{GetLastName(*var)};
|
||||
const auto *expr{GetExpr(*var)};
|
||||
if (name.symbol && IsAssumedSizeArray(*name.symbol) && expr &&
|
||||
!evaluate::IsArrayElement(*GetExpr(*var))) {
|
||||
context_.Say(name.source,
|
||||
"Whole assumed size array '%s' may not be an input item"_err_en_US,
|
||||
name.source); // C1231
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -386,6 +385,8 @@ void IoChecker::Enter(const parser::InquireSpec::CharVar &spec) {
|
|||
specKind = IoSpecKind::Dispose;
|
||||
break;
|
||||
}
|
||||
CheckForDefinableVariable(std::get<parser::ScalarDefaultCharVariable>(spec.t),
|
||||
parser::ToUpperCaseLetters(common::EnumToString(specKind)));
|
||||
SetSpecifier(specKind);
|
||||
}
|
||||
|
||||
|
|
@ -412,6 +413,8 @@ void IoChecker::Enter(const parser::InquireSpec::IntVar &spec) {
|
|||
specKind = IoSpecKind::Size;
|
||||
break;
|
||||
}
|
||||
CheckForDefinableVariable(std::get<parser::ScalarIntVariable>(spec.t),
|
||||
parser::ToUpperCaseLetters(common::EnumToString(specKind)));
|
||||
SetSpecifier(specKind);
|
||||
}
|
||||
|
||||
|
|
@ -500,17 +503,23 @@ void IoChecker::Enter(const parser::IoControlSpec::Rec &) {
|
|||
SetSpecifier(IoSpecKind::Rec);
|
||||
}
|
||||
|
||||
void IoChecker::Enter(const parser::IoControlSpec::Size &) {
|
||||
void IoChecker::Enter(const parser::IoControlSpec::Size &var) {
|
||||
CheckForDefinableVariable(var, "SIZE");
|
||||
SetSpecifier(IoSpecKind::Size);
|
||||
}
|
||||
|
||||
void IoChecker::Enter(const parser::IoUnit &spec) {
|
||||
if (const parser::Variable * var{std::get_if<parser::Variable>(&spec.u)}) {
|
||||
// TODO: C1201 - internal file variable must not be an array section ...
|
||||
if (auto expr{GetExpr(*var)}) {
|
||||
if (!ExprTypeKindIsDefault(*expr, context_)) {
|
||||
if (stmt_ == IoStmtKind::Write) {
|
||||
CheckForDefinableVariable(*var, "Internal file");
|
||||
}
|
||||
if (const auto *expr{GetExpr(*var)}) {
|
||||
if (HasVectorSubscript(*expr)) {
|
||||
context_.Say(parser::FindSourceLocation(*var), // C1201
|
||||
"Internal file must not have a vector subscript"_err_en_US);
|
||||
} else if (!ExprTypeKindIsDefault(*expr, context_)) {
|
||||
// This may be too restrictive; other kinds may be valid.
|
||||
context_.Say( // C1202
|
||||
context_.Say(parser::FindSourceLocation(*var), // C1202
|
||||
"Invalid character kind for an internal file variable"_err_en_US);
|
||||
}
|
||||
}
|
||||
|
|
@ -522,13 +531,26 @@ void IoChecker::Enter(const parser::IoUnit &spec) {
|
|||
}
|
||||
}
|
||||
|
||||
void IoChecker::Enter(const parser::MsgVariable &) {
|
||||
void IoChecker::Enter(const parser::MsgVariable &var) {
|
||||
if (stmt_ == IoStmtKind::None) {
|
||||
// allocate, deallocate, image control
|
||||
CheckForDefinableVariable(var, "ERRMSG");
|
||||
return;
|
||||
}
|
||||
CheckForDefinableVariable(var, "IOMSG");
|
||||
SetSpecifier(IoSpecKind::Iomsg);
|
||||
}
|
||||
|
||||
void IoChecker::Enter(const parser::OutputItem &) {
|
||||
void IoChecker::Enter(const parser::OutputItem &item) {
|
||||
flags_.set(Flag::DataList);
|
||||
// TODO: C1233 - output item must not be a procedure pointer
|
||||
if (const auto *x{std::get_if<parser::Expr>(&item.u)}) {
|
||||
if (const auto *expr{GetExpr(*x)}) {
|
||||
if (IsProcedurePointer(*expr)) {
|
||||
context_.Say(parser::FindSourceLocation(*x),
|
||||
"Output item must not be a procedure pointer"_err_en_US); // C1233
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
void IoChecker::Enter(const parser::StatusExpr &spec) {
|
||||
|
|
@ -555,12 +577,14 @@ void IoChecker::Enter(const parser::StatusExpr &spec) {
|
|||
}
|
||||
}
|
||||
|
||||
void IoChecker::Enter(const parser::StatVariable &) {
|
||||
void IoChecker::Enter(const parser::StatVariable &var) {
|
||||
if (stmt_ == IoStmtKind::None) {
|
||||
// ALLOCATE & DEALLOCATE
|
||||
} else {
|
||||
SetSpecifier(IoSpecKind::Iostat);
|
||||
// allocate, deallocate, image control
|
||||
CheckForDefinableVariable(var, "STAT");
|
||||
return;
|
||||
}
|
||||
CheckForDefinableVariable(var, "IOSTAT");
|
||||
SetSpecifier(IoSpecKind::Iostat);
|
||||
}
|
||||
|
||||
void IoChecker::Leave(const parser::BackspaceStmt &) {
|
||||
|
|
@ -808,7 +832,7 @@ void IoChecker::CheckStringValue(IoSpecKind specKind, const std::string &value,
|
|||
|
||||
// CheckForRequiredSpecifier and CheckForProhibitedSpecifier functions
|
||||
// need conditions to check, and string arguments to insert into a message.
|
||||
// A IoSpecKind provides both an absence/presence condition and a string
|
||||
// An IoSpecKind provides both an absence/presence condition and a string
|
||||
// argument (its name). A (condition, string) pair provides an arbitrary
|
||||
// condition and an arbitrary string.
|
||||
|
||||
|
|
@ -893,6 +917,17 @@ void IoChecker::CheckForProhibitedSpecifier(
|
|||
}
|
||||
}
|
||||
|
||||
template <typename A>
|
||||
void IoChecker::CheckForDefinableVariable(
|
||||
const A &var, const std::string &s) const {
|
||||
const Symbol *sym{
|
||||
GetFirstName(*parser::Unwrap<parser::Variable>(var)).symbol};
|
||||
if (WhyNotModifiable(*sym, context_.FindScope(*context_.location()))) {
|
||||
context_.Say(parser::FindSourceLocation(var),
|
||||
"%s variable '%s' must be definable"_err_en_US, s, sym->name());
|
||||
}
|
||||
}
|
||||
|
||||
void IoChecker::CheckForPureSubprogram() const { // C1597
|
||||
CHECK(context_.location());
|
||||
if (FindPureProcedureContaining(context_.FindScope(*context_.location()))) {
|
||||
|
|
|
|||
|
|
@ -122,6 +122,11 @@ private:
|
|||
void CheckForProhibitedSpecifier(IoSpecKind, bool, const std::string &) const;
|
||||
void CheckForProhibitedSpecifier(bool, const std::string &, IoSpecKind) const;
|
||||
|
||||
template <typename A>
|
||||
void CheckForDefinableVariable(const A &var, const std::string &s) const;
|
||||
|
||||
void CheckForPureSubprogram() const;
|
||||
|
||||
void Init(IoStmtKind s) {
|
||||
stmt_ = s;
|
||||
specifierSet_.reset();
|
||||
|
|
@ -130,8 +135,6 @@ private:
|
|||
|
||||
void Done() { stmt_ = IoStmtKind::None; }
|
||||
|
||||
void CheckForPureSubprogram() const;
|
||||
|
||||
SemanticsContext &context_;
|
||||
IoStmtKind stmt_{IoStmtKind::None};
|
||||
common::EnumSet<IoSpecKind, common::IoSpecKind_enumSize> specifierSet_;
|
||||
|
|
|
|||
|
|
@ -21,6 +21,7 @@ Type(t),Allocatable :: x(:)
|
|||
|
||||
Real :: r
|
||||
Integer :: s
|
||||
Integer, Parameter :: const_s = 13
|
||||
Integer :: e
|
||||
Integer :: pi
|
||||
Character(256) :: ee
|
||||
|
|
@ -56,6 +57,8 @@ Deallocate(x%p)
|
|||
|
||||
!ERROR: STAT may not be duplicated in a DEALLOCATE statement
|
||||
Deallocate(x, stat=s, stat=s)
|
||||
!ERROR: STAT variable 'const_s' must be definable
|
||||
Deallocate(x, stat=const_s)
|
||||
!ERROR: ERRMSG may not be duplicated in a DEALLOCATE statement
|
||||
Deallocate(x, errmsg=ee, errmsg=ee)
|
||||
!ERROR: STAT may not be duplicated in a DEALLOCATE statement
|
||||
|
|
|
|||
|
|
@ -21,6 +21,7 @@
|
|||
integer :: unit10 = 10
|
||||
integer :: unit11 = 11
|
||||
integer :: n = 40
|
||||
integer, parameter :: const_new_unit = 66
|
||||
|
||||
integer(kind=1) :: stat1
|
||||
integer(kind=2) :: stat2
|
||||
|
|
@ -73,6 +74,9 @@
|
|||
!ERROR: If NEWUNIT appears, FILE or STATUS must also appear
|
||||
open(newunit=n, newunit=nn, iostat=stat4)
|
||||
|
||||
!ERROR: NEWUNIT variable 'const_new_unit' must be definable
|
||||
open(newunit=const_new_unit, status=cc)
|
||||
|
||||
!ERROR: Duplicate UNIT specifier
|
||||
open(unit=100, unit=100)
|
||||
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
! RUN: %S/test_errors.sh %s %t %f18
|
||||
integer :: unit10 = 10
|
||||
integer :: unit11 = 11
|
||||
integer, parameter :: const_stat = 6666
|
||||
|
||||
integer(kind=1) :: stat1
|
||||
integer(kind=8) :: stat8
|
||||
|
|
@ -28,5 +29,8 @@
|
|||
!ERROR: Invalid STATUS value 'old'
|
||||
close(status='old', unit=17)
|
||||
|
||||
!ERROR: IOSTAT variable 'const_stat' must be definable
|
||||
close(14, iostat=const_stat)
|
||||
|
||||
9 continue
|
||||
end
|
||||
|
|
|
|||
|
|
@ -2,13 +2,18 @@
|
|||
character(kind=1,len=50) internal_file
|
||||
character(kind=2,len=50) internal_file2
|
||||
character(kind=4,len=50) internal_file4
|
||||
character(kind=1,len=50) internal_fileA(20)
|
||||
character(kind=1,len=111) msg
|
||||
character(20) advance
|
||||
character(20) :: cvar;
|
||||
character, parameter :: const_internal_file = "(I6)"
|
||||
character, parameter :: const_cvar = "Ceci n'est pas une pipe."
|
||||
integer*1 stat1
|
||||
integer*2 stat2, id2
|
||||
integer*8 stat8
|
||||
integer :: iunit = 10
|
||||
integer, parameter :: junit = 11
|
||||
integer, parameter :: junit = 11, const_size = 13, const_int = 15
|
||||
integer :: vv(10) = 7
|
||||
|
||||
namelist /mmm/ mm1, mm2
|
||||
namelist /nnn/ nn1, nn2
|
||||
|
|
@ -29,11 +34,14 @@
|
|||
read(fmt='(I4)', unit=*) jj
|
||||
read(iunit, *) jj
|
||||
read(junit, *) jj
|
||||
read(10, *) jj
|
||||
read(10, *) jj, cvar, cvar(7:17)
|
||||
read(internal_file, *) jj
|
||||
read(internal_fileA(3), *) jj
|
||||
read(internal_fileA(4:9), *) jj
|
||||
read(10, nnn)
|
||||
read(internal_file, nnn)
|
||||
read(internal_file, nml=nnn)
|
||||
read(const_internal_file, *)
|
||||
read(fmt=*, unit=internal_file)
|
||||
read(nml=nnn, unit=internal_file)
|
||||
read(iunit, nnn)
|
||||
|
|
@ -53,6 +61,21 @@
|
|||
!ERROR: Invalid character kind for an internal file variable
|
||||
read(internal_file4, *) jj
|
||||
|
||||
!ERROR: Internal file must not have a vector subscript
|
||||
read(internal_fileA(vv), *) jj
|
||||
|
||||
!ERROR: Input variable 'const_int' must be definable
|
||||
read(11, *) const_int
|
||||
|
||||
!ERROR: SIZE variable 'const_size' must be definable
|
||||
read(11, pos=ipos, size=const_size, end=9)
|
||||
|
||||
!ERROR: Input variable 'const_cvar' must be definable
|
||||
read(11, *) const_cvar
|
||||
|
||||
!ERROR: Input variable 'const_cvar' must be definable
|
||||
read(11, *) const_cvar(3:13)
|
||||
|
||||
!ERROR: Duplicate IOSTAT specifier
|
||||
read(11, pos=ipos, iostat=stat1, iostat=stat2)
|
||||
|
||||
|
|
@ -136,3 +159,25 @@
|
|||
|
||||
9 continue
|
||||
end
|
||||
|
||||
subroutine s(aa, n)
|
||||
integer :: aa(5,*)
|
||||
integer, intent(in) :: n
|
||||
integer :: bb(10), vv(10)
|
||||
type tt
|
||||
real :: x, y, z
|
||||
end type tt
|
||||
type(tt) :: qq(20)
|
||||
|
||||
vv = 1
|
||||
|
||||
read(*, *) aa(n,1)
|
||||
read(*, *) aa(n:n+2,2)
|
||||
read(*, *) qq(2:5)%y
|
||||
|
||||
!ERROR: Input variable 'n' must be definable
|
||||
read(*, *) n
|
||||
|
||||
!ERROR: Whole assumed size array 'aa' may not be an input item
|
||||
read(*, *) aa
|
||||
end
|
||||
|
|
|
|||
|
|
@ -2,6 +2,7 @@
|
|||
character(kind=1,len=50) internal_file
|
||||
character(kind=1,len=100) msg
|
||||
character(20) sign
|
||||
character, parameter :: const_internal_file = "(I6)"
|
||||
integer*1 stat1, id1
|
||||
integer*2 stat2
|
||||
integer*4 stat4
|
||||
|
|
@ -9,6 +10,8 @@
|
|||
integer :: iunit = 10
|
||||
integer, parameter :: junit = 11
|
||||
integer, pointer :: a(:)
|
||||
integer, parameter :: const_id = 66666
|
||||
procedure(), pointer :: procptr
|
||||
|
||||
namelist /nnn/ nn1, nn2
|
||||
|
||||
|
|
@ -66,6 +69,9 @@
|
|||
!ERROR: If NML appears, a data list must not appear
|
||||
write(10, nnn, rec=40, fmt=1) 'Ok'
|
||||
|
||||
!ERROR: Internal file variable 'const_internal_file' must be definable
|
||||
write(const_internal_file, fmt=*)
|
||||
|
||||
!ERROR: If UNIT=* appears, POS must not appear
|
||||
write(*, pos=n, nml=nnn)
|
||||
|
||||
|
|
@ -118,8 +124,14 @@
|
|||
!ERROR: ID kind (1) is smaller than default INTEGER kind (4)
|
||||
write(id=id1, unit=10, asynchronous='Yes') 'Ok'
|
||||
|
||||
!ERROR: ID variable 'const_id' must be definable
|
||||
write(10, *, asynchronous='yes', id=const_id, iostat=stat2) 'Ok'
|
||||
|
||||
write(*, '(X)')
|
||||
|
||||
!ERROR: Output item must not be a procedure pointer
|
||||
print*, n1, procptr, n2
|
||||
|
||||
1 format (A)
|
||||
9 continue
|
||||
end
|
||||
|
|
|
|||
|
|
@ -1,10 +1,12 @@
|
|||
! RUN: %S/test_errors.sh %s %t %f18
|
||||
character*20 c(25), cv
|
||||
character(kind=1,len=59) msg
|
||||
character, parameter :: const_round = "c'est quoi?"
|
||||
logical*2 v(5), lv
|
||||
integer*1 stat1
|
||||
integer*2 stat4
|
||||
integer*8 stat8, iv
|
||||
integer, parameter :: const_id = 1
|
||||
|
||||
inquire(10)
|
||||
inquire(file='abc')
|
||||
|
|
@ -22,6 +24,7 @@
|
|||
exist=v(1), named=v(2), opened=v(3), pending=v(4))
|
||||
inquire(pending=v(5), file='abc')
|
||||
inquire(10, id=id, pending=v(5))
|
||||
inquire(10, id=const_id, pending=v(5))
|
||||
|
||||
! using variable 'cv' multiple times seems to be allowed
|
||||
inquire(file='abc', &
|
||||
|
|
@ -56,5 +59,8 @@
|
|||
!ERROR: If ID appears, PENDING must also appear
|
||||
inquire(file='abc', id=id)
|
||||
|
||||
!ERROR: ROUND variable 'const_round' must be definable
|
||||
inquire(file='abc', round=const_round)
|
||||
|
||||
9 continue
|
||||
end
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
! RUN: %S/test_errors.sh %s %t %f18
|
||||
character(kind=1,len=100) msg1
|
||||
character(kind=2,len=200) msg2
|
||||
character, parameter :: const_msg = 'doof'
|
||||
integer(1) stat1
|
||||
integer(2) stat2
|
||||
integer(8) stat8
|
||||
|
|
@ -28,6 +29,9 @@
|
|||
!ERROR: Duplicate IOSTAT specifier
|
||||
endfile(iostat=stat2, err=9, unit=10, iostat=stat8, iomsg=msg1)
|
||||
|
||||
!ERROR: IOMSG variable 'const_msg' must be definable
|
||||
flush(iomsg=const_msg, unit=10, iostat=stat8, err=9)
|
||||
|
||||
!ERROR: REWIND statement must have a UNIT number specifier
|
||||
rewind(iostat=stat2)
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue