[flang] Check that various variables referenced in I/O statements may be defined

[klausler]

Summary

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.

[PeteSteinfeld]

All builds, tests, and looks good.

flang/lib/Semantics/check-io.h

   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();

 
   void Done() { stmt_ = IoStmtKind::None; }
 
-  void CheckForPureSubprogram() const;
-
   SemanticsContext &context_;
   IoStmtKind stmt_{IoStmtKind::None};
   common::EnumSet<IoSpecKind, common::IoSpecKind_enumSize> specifierSet_;

flang/lib/Semantics/check-io.cpp

   }
 }
 
-void IoChecker::Enter(const parser::ConnectSpec::Newunit &) {
+void IoChecker::Enter(const parser::ConnectSpec::Newunit &var) {
+  CheckForDefinableVariable(var, "NEWUNIT");
   SetSpecifier(IoSpecKind::Newunit);
 }
 

 
 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) {

 
 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))) {
+        "Whole assumed size array '%s' may not be an input item"_err_en_US,
   }
 }
 

     specKind = IoSpecKind::Dispose;
     break;
   }
+  CheckForDefinableVariable(std::get<parser::ScalarDefaultCharVariable>(spec.t),
+      parser::ToUpperCaseLetters(common::EnumToString(specKind)));
   SetSpecifier(specKind);
 }
 

     specKind = IoSpecKind::Size;
     break;
   }
+  CheckForDefinableVariable(std::get<parser::ScalarIntVariable>(spec.t),
+      parser::ToUpperCaseLetters(common::EnumToString(specKind)));
   SetSpecifier(specKind);
 }
 

   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);
       }
     }

   }
 }
 
-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) {

   }
 }
 
-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 &) {

 
 // 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.
 

   }
 }
 
+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()))) {

flang/test/Semantics/deallocate05.f90

 
 Real :: r
 Integer :: s
+Integer, Parameter :: const_s = 13
 Integer :: e
 Integer :: pi
 Character(256) :: ee

 
 !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

flang/test/Semantics/io01.f90

   integer :: unit10 = 10
   integer :: unit11 = 11
   integer :: n = 40
+  integer, parameter :: const_new_unit = 66
 
   integer(kind=1) :: stat1
   integer(kind=2) :: stat2

   !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)
 

flang/test/Semantics/io02.f90

 ! 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

   !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

flang/test/Semantics/io03.f90

   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

   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)

   !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)
 

 
 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

flang/test/Semantics/io04.f90

   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

   integer :: iunit = 10
   integer, parameter :: junit = 11
   integer, pointer :: a(:)
+  integer, parameter :: const_id = 66666
+  procedure(), pointer :: procptr
 
   namelist /nnn/ nn1, nn2
 

   !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)
 

   !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

flang/test/Semantics/io05.f90

 ! 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')

       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', &

   !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

flang/test/Semantics/io06.f90

 ! 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

   !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)