[flang] Delay parse tree rewriting for I/O UNIT=func()

[klausler]

Summary

When an I/O statement's UNIT= specifier is a variable that is a
function reference, parse tree rewriting may determine the wrong type
of the result because generic resolution has not yet been performed.
So move this bit of parse tree rewriting into I/O semantic
checking so that the right handling (integer -> external file unit
number, character pointer -> internal I/O) applies.

[PeteSteinfeld]

All builds and tests correctly and looks good.

flang/lib/Semantics/check-io.cpp

 
 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)}) {
+    // Only now after generic resolution can it be known whether a function
+    // call appearing as UNIT=f() is an integer scalar external unit number
+    // or a character pointer for internal I/O.
+    const auto *expr{GetExpr(context_, *var)};
+    std::optional<evaluate::DynamicType> dyType;
+    if (expr) {
+      dyType = expr->GetType();
+    }
+    if (dyType && dyType->category() == TypeCategory::Integer) {
+      if (expr->Rank() != 0) {
+        context_.Say(parser::FindSourceLocation(*var),
+            "I/O unit number must be scalar"_err_en_US);
+      }
+      // In the case of an integer unit number variable, rewrite the parse
+      // tree as if the unit had been parsed as a FileUnitNumber in order
+      // to ease lowering.
+      auto &mutableSpec{const_cast<parser::IoUnit &>(spec)};
+      auto &mutableVar{std::get<parser::Variable>(mutableSpec.u)};
+      auto source{mutableVar.GetSource()};
+      auto typedExpr{std::move(mutableVar.typedExpr)};
+      auto newExpr{common::visit(
+          [](auto &&indirection) {
+            return parser::Expr{std::move(indirection)};
+          },
+          std::move(mutableVar.u))};
+      newExpr.source = source;
+      newExpr.typedExpr = std::move(typedExpr);
+      mutableSpec.u = parser::FileUnitNumber{
+          parser::ScalarIntExpr{parser::IntExpr{std::move(newExpr)}}};
+    } else if (!dyType || dyType->category() != TypeCategory::Character) {
+      SetSpecifier(IoSpecKind::Unit);
+      context_.Say(parser::FindSourceLocation(*var),
+          "I/O unit must be a character variable or a scalar integer expression"_err_en_US);
+    } else { // CHARACTER variable (internal I/O)
       if (stmt_ == IoStmtKind::Write) {
         CheckForDefinableVariable(*var, "Internal file");
       }
-    if (const auto *expr{GetExpr(context_, *var)}) {
       if (HasVectorSubscript(*expr)) {
         context_.Say(parser::FindSourceLocation(*var), // C1201
             "Internal file must not have a vector subscript"_err_en_US);
       }
-    }
       SetSpecifier(IoSpecKind::Unit);
       flags_.set(Flag::InternalUnit);
+    }
   } else if (std::get_if<parser::Star>(&spec.u)) {
     SetSpecifier(IoSpecKind::Unit);
     flags_.set(Flag::StarUnit);
   }
 }
 
 void IoChecker::Enter(const parser::MsgVariable &var) {
   if (stmt_ == IoStmtKind::None) {

flang/lib/Semantics/rewrite-parse-tree.cpp

public:
 
   // Default action for a parse tree node is to visit children.
   template <typename T> bool Pre(T &) { return true; }
   template <typename T> void Post(T &) {}
 
   void Post(parser::Name &);
   void Post(parser::SpecificationPart &);
   bool Pre(parser::ExecutionPart &);
-  void Post(parser::IoUnit &);
   void Post(parser::ReadStmt &);
   void Post(parser::WriteStmt &);
 
   // Name resolution yet implemented:
   // TODO: Can some/all of these now be enabled?
   bool Pre(parser::EquivalenceStmt &) { return false; }
   bool Pre(parser::Keyword &) { return false; }
   bool Pre(parser::EntryStmt &) { return false; }
for (stmtFuncType &sf : stmtFuncsToConvert_) {
     x.v.insert(origFirst,
         parser::ExecutionPartConstruct{
             parser::ExecutableConstruct{std::move(stmt)}});
   }
   stmtFuncsToConvert_.clear();
   return true;
 }
 
-// Convert a syntactically ambiguous io-unit internal-file-variable to a
-// file-unit-number.
-void RewriteMutator::Post(parser::IoUnit &x) {
-  if (auto *var{std::get_if<parser::Variable>(&x.u)}) {
-    const parser::Name &last{parser::GetLastName(*var)};
-    DeclTypeSpec *type{last.symbol ? last.symbol->GetType() : nullptr};
-    if (!type || type->category() != DeclTypeSpec::Character) {
-      // If the Variable is not known to be character (any kind), transform
-      // the I/O unit in situ to a FileUnitNumber so that automatic expression
-      // constraint checking will be applied.
-      auto source{var->GetSource()};
-      auto expr{common::visit(
-          [](auto &&indirection) {
-            return parser::Expr{std::move(indirection)};
-          },
-          std::move(var->u))};
-      expr.source = source;
-      x.u = parser::FileUnitNumber{
-          parser::ScalarIntExpr{parser::IntExpr{std::move(expr)}}};
-    }
-  }
-}
-
 // When a namelist group name appears (without NML=) in a READ or WRITE
 // statement in such a way that it can be misparsed as a format expression,
 // rewrite the I/O statement's parse tree node as if the namelist group
 // name had appeared with NML=.
 template <typename READ_OR_WRITE>
 void FixMisparsedUntaggedNamelistName(READ_OR_WRITE &x) {
   if (x.iounit && x.format &&
       std::holds_alternative<parser::Expr>(x.format->u)) {

flang/test/Semantics/io04.f90

! RUN: %python %S/test_errors.py %s %flang_fc1
   write(internal_file, err=9, pos=n, nml=nnn)
 
   !ERROR: If UNIT=internal-file appears, REC must not appear
   write(internal_file, rec=n, err=9)
 
   !ERROR: If UNIT=* appears, REC must not appear
   write(*, rec=13) 'Ok'
 
-  !ERROR: Must have INTEGER type, but is REAL(4)
+  !ERROR: I/O unit must be a character variable or a scalar integer expression
   write(unit, *) 'Ok'
 
   !ERROR: If ADVANCE appears, UNIT=internal-file must not appear
   write(internal_file, advance='yes', fmt=1) 'Ok'
 
   !ERROR: If ADVANCE appears, an explicit format must also appear
   write(10, advance='yes') 'Ok'
 

flang/test/Semantics/io13.f90

+! RUN: %python %S/test_errors.py %s %flang_fc1
+! Tests for UNIT=function()
+module m1
+  integer, target :: itarget
+  character(20), target :: ctarget
+  logical, target :: ltarget
+  interface gf
+    module procedure :: intf, pintf, pchf, logf, plogf
+  end interface
+ contains
+  integer function intf(n)
+    integer(1), intent(in) :: n
+    intf = n
+  end function
+  function pintf(n)
+    integer(2), intent(in) :: n
+    integer, pointer :: pintf
+    pintf => itarget
+    pintf = n
+  end function
+  function pchf(n)
+    integer(4), intent(in) :: n
+    character(:), pointer :: pchf
+    pchf => ctarget
+  end function
+  logical function logf(n)
+    integer(8), intent(in) :: n
+    logf = .true.
+  end function
+  function plogf(n)
+    integer(16), intent(in) :: n
+    logical, pointer :: plf
+    plf => ltarget
+  end function
+  subroutine test
+    write(intf(6_1),"('hi')")
+    write(pintf(6_2),"('hi')")
+    write(pchf(123_4),"('hi')")
+    write(gf(6_1),"('hi')")
+    write(gf(6_2),"('hi')")
+    write(gf(666_4),"('hi')")
+    !ERROR: I/O unit must be a character variable or a scalar integer expression
+    write(logf(666_8),"('hi')")
+    !ERROR: I/O unit must be a character variable or a scalar integer expression
+    write(plogf(666_16),"('hi')")
+    !ERROR: I/O unit must be a character variable or a scalar integer expression
+    write(gf(666_8),"('hi')")
+    !ERROR: I/O unit must be a character variable or a scalar integer expression
+    write(gf(666_16),"('hi')")
+    !ERROR: I/O unit must be a character variable or a scalar integer expression
+    write(null(),"('hi')")
+  end subroutine
+end module