diff --git a/flang/lib/Semantics/check-io.h b/flang/lib/Semantics/check-io.h --- a/flang/lib/Semantics/check-io.h +++ b/flang/lib/Semantics/check-io.h @@ -122,6 +122,11 @@ void CheckForProhibitedSpecifier(IoSpecKind, bool, const std::string &) const; void CheckForProhibitedSpecifier(bool, const std::string &, IoSpecKind) const; + template + 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 @@ void Done() { stmt_ = IoStmtKind::None; } - void CheckForPureSubprogram() const; - SemanticsContext &context_; IoStmtKind stmt_{IoStmtKind::None}; common::EnumSet specifierSet_; diff --git a/flang/lib/Semantics/check-io.cpp b/flang/lib/Semantics/check-io.cpp --- a/flang/lib/Semantics/check-io.cpp +++ b/flang/lib/Semantics/check-io.cpp @@ -155,7 +155,8 @@ } } -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::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::InputItem &spec) { flags_.set(Flag::DataList); - if (const parser::Variable * var{std::get_if(&spec.u)}) { - const parser::Name &name{GetLastName(*var)}; - if (name.symbol) { - if (auto *details{name.symbol->detailsIf()}) { - // 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(&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 @@ specKind = IoSpecKind::Dispose; break; } + CheckForDefinableVariable(std::get(spec.t), + parser::ToUpperCaseLetters(common::EnumToString(specKind))); SetSpecifier(specKind); } @@ -412,6 +413,8 @@ specKind = IoSpecKind::Size; break; } + CheckForDefinableVariable(std::get(spec.t), + parser::ToUpperCaseLetters(common::EnumToString(specKind))); SetSpecifier(specKind); } @@ -500,17 +503,23 @@ 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(&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::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(&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::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 @@ // 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 @@ } } +template +void IoChecker::CheckForDefinableVariable( + const A &var, const std::string &s) const { + const Symbol *sym{ + GetFirstName(*parser::Unwrap(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/test/Semantics/deallocate05.f90 b/flang/test/Semantics/deallocate05.f90 --- a/flang/test/Semantics/deallocate05.f90 +++ b/flang/test/Semantics/deallocate05.f90 @@ -21,6 +21,7 @@ Real :: r Integer :: s +Integer, Parameter :: const_s = 13 Integer :: e Integer :: pi Character(256) :: ee @@ -56,6 +57,8 @@ !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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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)