[flang] Add fixes and missing stmts to I/O runtime API handlers (ext. I/O part 8)

[klausler]

Summary

Complete the rework of the initial implementation of external I/O
to fix problems found in testing (tests to follow); add handlers
for hitherto unimplemented PAUSE, FLUSH, ENDFILE, BACKSPACE, and
REWIND statements.

flang/runtime/io-api.cpp

Cookie BeginExternalListIO(
   if (unit.access == Access::Direct) {
     terminator.Crash("List-directed I/O attempted on direct access file");
     return nullptr;
   }
   if (unit.isUnformatted) {
     terminator.Crash("List-directed I/O attempted on unformatted file");
     return nullptr;
   }
+  IoErrorHandler handler{terminator};
+  unit.SetDirection(DIR, handler);
   IoStatementState &io{unit.BeginIoStatement<ExternalListIoStatementState<DIR>>(
       unit, sourceFile, sourceLine)};
   if constexpr (DIR == Direction::Input) {
-    io.AdvanceRecord();
+    unit.BeginReadingRecord(handler);
   }
   return &io;
 }
 
 Cookie IONAME(BeginExternalListOutput)(
     ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
   return BeginExternalListIO<Direction::Output>(
       unitNumber, sourceFile, sourceLine);
if (unitNumber == DefaultUnit) {
     unitNumber = DIR == Direction::Input ? 5 : 6;
   }
   ExternalFileUnit &unit{
       ExternalFileUnit::LookUpOrCrash(unitNumber, terminator)};
   if (unit.isUnformatted) {
     terminator.Crash("Formatted I/O attempted on unformatted file");
     return nullptr;
   }
+  IoErrorHandler handler{terminator};
+  unit.SetDirection(DIR, handler);
   IoStatementState &io{
       unit.BeginIoStatement<ExternalFormattedIoStatementState<DIR>>(
           unit, format, formatLength, sourceFile, sourceLine)};
   if constexpr (DIR == Direction::Input) {
-    io.AdvanceRecord();
+    unit.BeginReadingRecord(handler);
   }
   return &io;
 }
 
 Cookie IONAME(BeginExternalFormattedOutput)(const char *format,
     std::size_t formatLength, ExternalUnit unitNumber, const char *sourceFile,
     int sourceLine) {
   return BeginExternalFormattedIO<Direction::Output>(
       format, formatLength, unitNumber, sourceFile, sourceLine);
 }
 
 Cookie IONAME(BeginExternalFormattedInput)(const char *format,
     std::size_t formatLength, ExternalUnit unitNumber, const char *sourceFile,
     int sourceLine) {
   return BeginExternalFormattedIO<Direction::Input>(
       format, formatLength, unitNumber, sourceFile, sourceLine);
 }
 
 template <Direction DIR>
 Cookie BeginUnformattedIO(
     ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
   Terminator terminator{sourceFile, sourceLine};
-  ExternalFileUnit &file{
+  ExternalFileUnit &unit{
       ExternalFileUnit::LookUpOrCrash(unitNumber, terminator)};
-  if (!file.isUnformatted) {
+  if (!unit.isUnformatted) {
     terminator.Crash("Unformatted output attempted on formatted file");
   }
-  IoStatementState &io{file.BeginIoStatement<UnformattedIoStatementState<DIR>>(
-      file, sourceFile, sourceLine)};
+  IoStatementState &io{unit.BeginIoStatement<UnformattedIoStatementState<DIR>>(
+      unit, sourceFile, sourceLine)};
+  IoErrorHandler handler{terminator};
+  unit.SetDirection(DIR, handler);
   if constexpr (DIR == Direction::Input) {
-    io.AdvanceRecord();
+    unit.BeginReadingRecord(handler);
   } else {
-    if (file.access == Access::Sequential && !file.recordLength.has_value()) {
+    if (unit.access == Access::Sequential && !unit.isFixedRecordLength) {
       // Create space for (sub)record header to be completed by
       // UnformattedIoStatementState<Direction::Output>::EndIoStatement()
       io.Emit("\0\0\0\0", 4); // placeholder for record length header
     }
   }
   return &io;
 }
 
ExternalFileUnit &unit{
       ExternalFileUnit::LookUpOrCreate(unitNumber, terminator, &wasExtant)};
   return &unit.BeginIoStatement<OpenStatementState>(
       unit, wasExtant, sourceFile, sourceLine);
 }
 
 Cookie IONAME(BeginOpenNewUnit)( // OPEN(NEWUNIT=j)
     const char *sourceFile, int sourceLine) {
   Terminator terminator{sourceFile, sourceLine};
-  return IONAME(BeginOpenUnit)(
-      ExternalFileUnit::NewUnit(terminator), sourceFile, sourceLine);
+  ExternalFileUnit &unit{ExternalFileUnit::LookUpOrCreate(
+      ExternalFileUnit::NewUnit(terminator), terminator)};
+  return &unit.BeginIoStatement<OpenStatementState>(
+      unit, false /*wasExtant*/, 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<NoopCloseStatementState>{oom}(sourceFile, sourceLine)
                 .release()
                 ->ioStatementState();
   }
 }
 
+Cookie IONAME(BeginFlush)(
+    ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
+  Terminator terminator{sourceFile, sourceLine};
+  ExternalFileUnit &unit{
+      ExternalFileUnit::LookUpOrCrash(unitNumber, terminator)};
+  return &unit.BeginIoStatement<ExternalMiscIoStatementState>(
+      unit, ExternalMiscIoStatementState::Flush, sourceFile, sourceLine);
+}
+
+Cookie IONAME(BeginBackspace)(
+    ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
+  Terminator terminator{sourceFile, sourceLine};
+  ExternalFileUnit &unit{
+      ExternalFileUnit::LookUpOrCrash(unitNumber, terminator)};
+  return &unit.BeginIoStatement<ExternalMiscIoStatementState>(
+      unit, ExternalMiscIoStatementState::Backspace, sourceFile, sourceLine);
+}
+
+Cookie IONAME(BeginEndfile)(
+    ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
+  Terminator terminator{sourceFile, sourceLine};
+  ExternalFileUnit &unit{
+      ExternalFileUnit::LookUpOrCrash(unitNumber, terminator)};
+  return &unit.BeginIoStatement<ExternalMiscIoStatementState>(
+      unit, ExternalMiscIoStatementState::Endfile, sourceFile, sourceLine);
+}
+
+Cookie IONAME(BeginRewind)(
+    ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
+  Terminator terminator{sourceFile, sourceLine};
+  ExternalFileUnit &unit{
+      ExternalFileUnit::LookUpOrCrash(unitNumber, terminator)};
+  return &unit.BeginIoStatement<ExternalMiscIoStatementState>(
+      unit, ExternalMiscIoStatementState::Rewind, sourceFile, sourceLine);
+}
+
 // Control list items
 
 void IONAME(EnableHandlers)(Cookie cookie, bool hasIoStat, bool hasErr,
     bool hasEnd, bool hasEor, bool hasIoMsg) {
   IoErrorHandler &handler{cookie->GetIoErrorHandler()};
   if (hasIoStat) {
     handler.HasIoStat();
   }

 bool IONAME(SetRec)(Cookie cookie, std::int64_t rec) {
   IoStatementState &io{*cookie};
   ConnectionState &connection{io.GetConnectionState()};
   if (connection.access != Access::Direct) {
     io.GetIoErrorHandler().SignalError(
         "REC= may not appear unless ACCESS='DIRECT'");
     return false;
   }
-  if (!connection.recordLength) {
+  if (!connection.isFixedRecordLength || !connection.recordLength) {
     io.GetIoErrorHandler().SignalError("RECL= was not specified");
     return false;
   }
   if (rec < 1) {
     io.GetIoErrorHandler().SignalError(
         "REC=%zd is invalid", static_cast<std::intmax_t>(rec));
     return false;
   }
bool IONAME(SetRecl)(Cookie cookie, std::size_t n) {
   auto *open{io.get_if<OpenStatementState>()};
   if (!open) {
     io.GetIoErrorHandler().Crash(
         "SetRecl() called when not in an OPEN statement");
   }
   if (n <= 0) {
     io.GetIoErrorHandler().SignalError("RECL= must be greater than zero");
   }
-  if (open->wasExtant() && open->unit().recordLength.has_value() &&
-      *open->unit().recordLength != static_cast<std::int64_t>(n)) {
+  if (open->wasExtant() && open->unit().isFixedRecordLength &&
+      open->unit().recordLength.value_or(n) != static_cast<std::int64_t>(n)) {
     open->SignalError("RECL= may not be changed for an open unit");
   }
+  open->unit().isFixedRecordLength = true;
   open->unit().recordLength = n;
   return true;
 }
 
 bool IONAME(SetStatus)(Cookie cookie, const char *keyword, std::size_t length) {
   IoStatementState &io{*cookie};
   if (auto *open{io.get_if<OpenStatementState>()}) {
     static const char *statuses[]{

 }
 
 bool IONAME(OutputUnformattedBlock)(
     Cookie cookie, const char *x, std::size_t length) {
   IoStatementState &io{*cookie};
   if (auto *unf{io.get_if<UnformattedIoStatementState<Direction::Output>>()}) {
     return unf->Emit(x, length);
   }
-  io.GetIoErrorHandler().Crash("OutputUnformatted() called for an I/O "
+  io.GetIoErrorHandler().Crash("OutputUnformattedBlock() called for an I/O "
+                               "statement that is not unformatted output");
+  return false;
+}
+
+bool IONAME(InputUnformattedBlock)(Cookie cookie, char *x, std::size_t length) {
+  IoStatementState &io{*cookie};
+  if (auto *unf{io.get_if<UnformattedIoStatementState<Direction::Input>>()}) {
+    return unf->Receive(x, length);
+  }
+  io.GetIoErrorHandler().Crash("InputUnformattedBlock() called for an I/O "
                                "statement that is not unformatted output");
   return false;
 }
 
 bool IONAME(OutputInteger64)(Cookie cookie, std::int64_t n) {
   IoStatementState &io{*cookie};
   if (!io.get_if<OutputStatementState>()) {
     io.GetIoErrorHandler().Crash(

flang/runtime/stop.h

 
 FORTRAN_EXTERN_C_BEGIN
 
 // Program-initiated image stop
 NORETURN void RTNAME(StopStatement)(int code DEFAULT_VALUE(EXIT_SUCCESS),
     bool isErrorStop DEFAULT_VALUE(false), bool quiet DEFAULT_VALUE(false));
 NORETURN void RTNAME(StopStatementText)(const char *,
     bool isErrorStop DEFAULT_VALUE(false), bool quiet DEFAULT_VALUE(false));
+void RTNAME(PauseStatement)(NO_ARGUMENTS);
 NORETURN void RTNAME(FailImageStatement)(NO_ARGUMENTS);
 NORETURN void RTNAME(ProgramEndStatement)(NO_ARGUMENTS);
 
 FORTRAN_EXTERN_C_END
 
 #endif // FORTRAN_RUNTIME_STOP_H_

flang/runtime/stop.cpp

 //===-- runtime/stop.cpp ----------------------------------------*- C++ -*-===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #include "stop.h"
+#include "file.h"
 #include "io-error.h"
 #include "terminator.h"
 #include "unit.h"
 #include <cfenv>
 #include <cstdio>
 #include <cstdlib>
 
 extern "C" {
[[noreturn]] void RTNAME(StopStatementText)(
   if (!quiet) {
     std::fprintf(
         stderr, "Fortran %s: %s\n", isErrorStop ? "ERROR STOP" : "STOP", code);
     DescribeIEEESignaledExceptions();
   }
   std::exit(EXIT_FAILURE);
 }
 
+void RTNAME(PauseStatement)() {
+  if (Fortran::runtime::io::IsATerminal(0)) {
+    Fortran::runtime::io::IoErrorHandler handler{"PAUSE statement"};
+    Fortran::runtime::io::ExternalFileUnit::FlushAll(handler);
+    std::fputs("Fortran PAUSE: hit RETURN to continue:", stderr);
+    std::fflush(nullptr);
+    if (std::fgetc(stdin) == EOF) {
+      CloseAllExternalUnits("PAUSE statement");
+      std::exit(EXIT_SUCCESS);
+    }
+  }
+}
+
 [[noreturn]] void RTNAME(FailImageStatement)() {
   Fortran::runtime::NotifyOtherImagesOfFailImageStatement();
   CloseAllExternalUnits("FAIL IMAGE statement");
   std::exit(EXIT_FAILURE);
 }
 
 [[noreturn]] void RTNAME(ProgramEndStatement)() {
   CloseAllExternalUnits("END statement");
   std::exit(EXIT_SUCCESS);
 }
 }