[flang][runtime] FLUSH(bad or unconnected unit number) is an error

[klausler]

Summary

Some I/O control statements are no-ops when attempted on a bad or
unconnected UNIT=, but the standard says that FLUSH is an error
in that case.

flang/include/flang/Runtime/iostat.h

enum Iostat {
   IostatIntegerInputOverflow,
   IostatRealInputOverflow,
   IostatOpenAlreadyConnected,
   IostatCannotReposition,
   IostatBadWaitId,
   IostatTooManyAsyncOps,
   IostatBadBackspaceUnit,
   IostatBadUnitNumber,
+  IostatBadFlushUnit,
 };
 
 const char *IostatErrorString(int);
 
 } // namespace Fortran::runtime::io
 #endif // FORTRAN_RUNTIME_IOSTAT_H_

flang/runtime/io-api.cpp

 Cookie IONAME(BeginInternalFormattedInput)(const char *internal,
     std::size_t internalLength, const char *format, std::size_t formatLength,
     void **scratchArea, std::size_t scratchBytes, const char *sourceFile,
     int sourceLine) {
   return BeginInternalFormattedIO<Direction::Input>(internal, internalLength,
       format, formatLength, scratchArea, scratchBytes, sourceFile, sourceLine);
 }
 
+static Cookie NoopUnit(const Terminator &terminator, int unitNumber,
+    enum Iostat iostat = IostatOk) {
+  Cookie cookie{&New<NoopStatementState>{terminator}(
+      terminator.sourceFileName(), terminator.sourceLine(), unitNumber)
+                     .release()
+                     ->ioStatementState()};
+  if (iostat != IostatOk) {
+    cookie->GetIoErrorHandler().SetPendingError(iostat);
+  }
+  return cookie;
+}
+
 static ExternalFileUnit *GetOrCreateUnit(int unitNumber, Direction direction,
     std::optional<bool> isUnformatted, const Terminator &terminator,
     Cookie &errorCookie) {
   if (ExternalFileUnit *
       unit{ExternalFileUnit::LookUpOrCreateAnonymous(
           unitNumber, direction, isUnformatted, terminator)}) {
     errorCookie = nullptr;
     return unit;
   } else {
-    errorCookie = &New<NoopStatementState>{terminator}(
-        terminator.sourceFileName(), terminator.sourceLine(), unitNumber)
-                       .release()
-                       ->ioStatementState();
-    errorCookie->GetIoErrorHandler().SetPendingError(IostatBadUnitNumber);
+    errorCookie = NoopUnit(terminator, unitNumber, IostatBadUnitNumber);
     return nullptr;
   }
 }
 
 template <Direction DIR, template <Direction> class STATE, typename... A>
 Cookie BeginExternalListIO(
     int unitNumber, const char *sourceFile, int sourceLine, A &&...xs) {
   Terminator terminator{sourceFile, sourceLine};
Cookie IONAME(BeginOpenUnit)( // OPEN(without NEWUNIT=)
   Terminator terminator{sourceFile, sourceLine};
   bool wasExtant{false};
   if (ExternalFileUnit *
       unit{ExternalFileUnit::LookUpOrCreate(
           unitNumber, terminator, wasExtant)}) {
     return &unit->BeginIoStatement<OpenStatementState>(
         *unit, wasExtant, sourceFile, sourceLine);
   } else {
-    auto &io{
-        New<NoopStatementState>{terminator}(sourceFile, sourceLine, unitNumber)
-            .release()
-            ->ioStatementState()};
-    io.GetIoErrorHandler().SetPendingError(IostatBadUnitNumber);
-    return &io;
+    return NoopUnit(terminator, unitNumber, IostatBadUnitNumber);
   }
 }
 
 Cookie IONAME(BeginOpenNewUnit)( // OPEN(NEWUNIT=j)
     const char *sourceFile, int sourceLine) {
   Terminator terminator{sourceFile, sourceLine};
   ExternalFileUnit &unit{
       ExternalFileUnit::NewUnit(terminator, false /*not child I/O*/)};
   return &unit.BeginIoStatement<OpenStatementState>(
       unit, false /*was an existing file*/, sourceFile, sourceLine);
 }
 
 Cookie IONAME(BeginWait)(ExternalUnit unitNumber, AsynchronousId id,
     const char *sourceFile, int sourceLine) {
-  Terminator terminator{sourceFile, sourceLine};
   if (ExternalFileUnit * unit{ExternalFileUnit::LookUp(unitNumber)}) {
     if (unit->Wait(id)) {
       return &unit->BeginIoStatement<ExternalMiscIoStatementState>(
           *unit, ExternalMiscIoStatementState::Wait, sourceFile, sourceLine);
     } else {
       return &unit->BeginIoStatement<ErroneousIoStatementState>(
           IostatBadWaitId, unit, sourceFile, sourceLine);
     }
   } else {
-    auto &io{
-        New<NoopStatementState>{terminator}(sourceFile, sourceLine, unitNumber)
-            .release()
-            ->ioStatementState()};
-    if (id != 0) {
-      io.GetIoErrorHandler().SetPendingError(IostatBadWaitUnit);
-    }
-    return &io;
+    Terminator terminator{sourceFile, sourceLine};
+    return NoopUnit(
+        terminator, unitNumber, id == 0 ? IostatOk : IostatBadWaitUnit);
   }
 }
 Cookie IONAME(BeginWaitAll)(
     ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
   return IONAME(BeginWait)(unitNumber, 0 /*no ID=*/, sourceFile, sourceLine);
 }
 
 Cookie IONAME(BeginClose)(
     ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
   if (ExternalFileUnit * unit{ExternalFileUnit::LookUpForClose(unitNumber)}) {
     return &unit->BeginIoStatement<CloseStatementState>(
         *unit, sourceFile, sourceLine);
   } else {
     // CLOSE(UNIT=bad unit) is just a no-op
-    Terminator oom{sourceFile, sourceLine};
-    return &New<NoopStatementState>{oom}(sourceFile, sourceLine, unitNumber)
-                .release()
-                ->ioStatementState();
+    Terminator terminator{sourceFile, sourceLine};
+    return NoopUnit(terminator, unitNumber);
   }
 }
 
 Cookie IONAME(BeginFlush)(
     ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
   if (ExternalFileUnit * unit{ExternalFileUnit::LookUp(unitNumber)}) {
     return &unit->BeginIoStatement<ExternalMiscIoStatementState>(
         *unit, ExternalMiscIoStatementState::Flush, sourceFile, sourceLine);
   } else {
-    // FLUSH(UNIT=unknown) is a no-op
-    Terminator oom{sourceFile, sourceLine};
-    return &New<NoopStatementState>{oom}(sourceFile, sourceLine, unitNumber)
-                .release()
-                ->ioStatementState();
+    // FLUSH(UNIT=bad unit) is an error; an unconnected unit is a no-op
+    Terminator terminator{sourceFile, sourceLine};
+    return NoopUnit(terminator, unitNumber,
+        unitNumber >= 0 ? IostatOk : IostatBadFlushUnit);
   }
 }
 
 Cookie IONAME(BeginBackspace)(
     ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
   Terminator terminator{sourceFile, sourceLine};
   if (ExternalFileUnit * unit{ExternalFileUnit::LookUp(unitNumber)}) {
     return &unit->BeginIoStatement<ExternalMiscIoStatementState>(
         *unit, ExternalMiscIoStatementState::Backspace, sourceFile, sourceLine);
   } else {
-    auto &io{
-        New<NoopStatementState>{terminator}(sourceFile, sourceLine, unitNumber)
-            .release()
-            ->ioStatementState()};
-    io.GetIoErrorHandler().SetPendingError(IostatBadBackspaceUnit);
-    return &io;
+    return NoopUnit(terminator, unitNumber, IostatBadBackspaceUnit);
   }
 }
 
 Cookie IONAME(BeginEndfile)(
     ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
   Terminator terminator{sourceFile, sourceLine};
   Cookie errorCookie{nullptr};
   if (ExternalFileUnit *

flang/runtime/iostat.cpp

const char *IostatErrorString(int iostat) {
   case IostatBadRealInput:
     return "Bad REAL input value";
   case IostatBadScaleFactor:
     return "Bad REAL output scale factor (kP)";
   case IostatBadAsynchronous:
     return "READ/WRITE(ASYNCHRONOUS='YES') on unit without "
            "OPEN(ASYNCHRONOUS='YES')";
   case IostatBadWaitUnit:
-    return "WAIT(UNIT=) for a bad unit number";
+    return "WAIT(UNIT=) for a bad or unconnected unit number";
   case IostatBOZInputOverflow:
     return "B/O/Z input value overflows variable";
   case IostatIntegerInputOverflow:
     return "Integer input value overflows variable";
   case IostatRealInputOverflow:
     return "Real or complex input value overflows type";
   case IostatCannotReposition:
     return "Attempt to reposition a unit which is connected to a file that can "
            "only be processed sequentially";
   case IostatOpenAlreadyConnected:
     return "OPEN of file already connected to another unit";
   case IostatBadWaitId:
     return "WAIT(ID=nonzero) for an ID value that is not a pending operation";
   case IostatTooManyAsyncOps:
     return "Too many asynchronous operations pending on unit";
   case IostatBadBackspaceUnit:
     return "BACKSPACE on unconnected unit";
   case IostatBadUnitNumber:
     return "Negative unit number is not allowed";
+  case IostatBadFlushUnit:
+    return "FLUSH attempted on a bad or unconnected unit number";
   default:
     return nullptr;
   }
 }
 
 } // namespace Fortran::runtime::io