[flang-commits] [flang] bce7a7e - [flang] Check that various variables referenced in I/O statements may be defined
peter klausler via flang-commits
flang-commits at lists.llvm.org
Tue Aug 25 12:06:34 PDT 2020
Author: peter klausler
Date: 2020-08-25T12:06:18-07:00
New Revision: bce7a7edf32d5094b37d65c9198b048c86645f99
URL: https://github.com/llvm/llvm-project/commit/bce7a7edf32d5094b37d65c9198b048c86645f99
DIFF: https://github.com/llvm/llvm-project/commit/bce7a7edf32d5094b37d65c9198b048c86645f99.diff
LOG: [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
Added:
Modified:
flang/lib/Semantics/check-io.cpp
flang/lib/Semantics/check-io.h
flang/test/Semantics/deallocate05.f90
flang/test/Semantics/io01.f90
flang/test/Semantics/io02.f90
flang/test/Semantics/io03.f90
flang/test/Semantics/io04.f90
flang/test/Semantics/io05.f90
flang/test/Semantics/io06.f90
Removed:
################################################################################
diff --git a/flang/lib/Semantics/check-io.cpp b/flang/lib/Semantics/check-io.cpp
index 250ad492ebc9..d00f56c38042 100644
--- a/flang/lib/Semantics/check-io.cpp
+++ b/flang/lib/Semantics/check-io.cpp
@@ -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()))) {
diff --git a/flang/lib/Semantics/check-io.h b/flang/lib/Semantics/check-io.h
index b5e8f12b5ee6..01bbcd9ba24f 100644
--- a/flang/lib/Semantics/check-io.h
+++ b/flang/lib/Semantics/check-io.h
@@ -122,6 +122,11 @@ class IoChecker : public virtual BaseChecker {
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 @@ class IoChecker : public virtual BaseChecker {
void Done() { stmt_ = IoStmtKind::None; }
- void CheckForPureSubprogram() const;
-
SemanticsContext &context_;
IoStmtKind stmt_{IoStmtKind::None};
common::EnumSet<IoSpecKind, common::IoSpecKind_enumSize> specifierSet_;
diff --git a/flang/test/Semantics/deallocate05.f90 b/flang/test/Semantics/deallocate05.f90
index 7524cc88fe0b..4a54469e5ab6 100644
--- a/flang/test/Semantics/deallocate05.f90
+++ b/flang/test/Semantics/deallocate05.f90
@@ -21,6 +21,7 @@ Program deallocatetest
Real :: r
Integer :: s
+Integer, Parameter :: const_s = 13
Integer :: e
Integer :: pi
Character(256) :: ee
@@ -56,6 +57,8 @@ Program deallocatetest
!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
diff --git a/flang/test/Semantics/io01.f90 b/flang/test/Semantics/io01.f90
index 4238df89f5d0..9828d4afe892 100644
--- a/flang/test/Semantics/io01.f90
+++ b/flang/test/Semantics/io01.f90
@@ -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)
diff --git a/flang/test/Semantics/io02.f90 b/flang/test/Semantics/io02.f90
index 5fd5fca4bc0c..9f5235d353cb 100644
--- a/flang/test/Semantics/io02.f90
+++ b/flang/test/Semantics/io02.f90
@@ -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
diff --git a/flang/test/Semantics/io03.f90 b/flang/test/Semantics/io03.f90
index 0041e6cd0f5c..5eb3420d1aea 100644
--- a/flang/test/Semantics/io03.f90
+++ b/flang/test/Semantics/io03.f90
@@ -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
diff --git a/flang/test/Semantics/io04.f90 b/flang/test/Semantics/io04.f90
index 0a37d685d3ee..6be26047fd5b 100644
--- a/flang/test/Semantics/io04.f90
+++ b/flang/test/Semantics/io04.f90
@@ -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
diff --git a/flang/test/Semantics/io05.f90 b/flang/test/Semantics/io05.f90
index 1501fbf587f5..ed6b77f7d4ad 100644
--- a/flang/test/Semantics/io05.f90
+++ b/flang/test/Semantics/io05.f90
@@ -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
diff --git a/flang/test/Semantics/io06.f90 b/flang/test/Semantics/io06.f90
index 157d831dc333..fe3b97f0e67e 100644
--- a/flang/test/Semantics/io06.f90
+++ b/flang/test/Semantics/io06.f90
@@ -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)
More information about the flang-commits
mailing list