[flang] Allow data transfer stmt control list errors to be caught

[klausler]

Summary

The runtime crashes on several fundamental I/O data transfer statement
control list errors, like list I/O on a direct-access unit, or
input from a write-only unit, &c. These errors should not be fatal
when ERR= or IOSTAT= are present.

This patch creates a new ErroneousIoStatementState class and
uses it for the state of an I/O statement that is doomed to fail
from these errors. If there is no ERR= label or IOSTAT= variable,
the error will be raised at the end of the statement. Data transfer
operations along the way will be no-op failures.

flang/include/flang/Runtime/iostat.h

enum Iostat {
   IostatOpenUnknownSize,
   IostatOpenBadAppend,
   IostatWriteToReadOnly,
   IostatReadFromWriteOnly,
   IostatBackspaceNonSequential,
   IostatBackspaceAtFirstRecord,
   IostatRewindNonSequential,
   IostatWriteAfterEndfile,
+  IostatFormattedIoOnUnformattedUnit,
+  IostatUnformattedIoOnFormattedUnit,
+  IostatListIoOnDirectAccessUnit,
+  IostatUnformattedChildOnFormattedParent,
+  IostatFormattedChildOnUnformattedParent,
+  IostatChildInputFromOutputParent,
+  IostatChildOutputToInputParent,
 };
 
 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);
 }
 
 template <Direction DIR, template <Direction> class STATE, typename... A>
-Cookie BeginExternalListIO(const char *what, int unitNumber,
-    const char *sourceFile, int sourceLine, A &&...xs) {
+Cookie BeginExternalListIO(
+    int unitNumber, const char *sourceFile, int sourceLine, A &&...xs) {
   Terminator terminator{sourceFile, sourceLine};
   if (unitNumber == DefaultUnit) {
     unitNumber = DIR == Direction::Input ? 5 : 6;
   }
   ExternalFileUnit &unit{ExternalFileUnit::LookUpOrCreateAnonymous(
       unitNumber, DIR, false /*!unformatted*/, terminator)};
   if (!unit.isUnformatted.has_value()) {
     unit.isUnformatted = false;
   }
+  Iostat iostat{IostatOk};
   if (*unit.isUnformatted) {
-    terminator.Crash("%s attempted on unformatted file", what);
-    return nullptr;
+    iostat = IostatFormattedIoOnUnformattedUnit;
   }
   if (ChildIo * child{unit.GetChildIo()}) {
-    return child->CheckFormattingAndDirection(terminator, what, false, DIR)
-        ? &child->BeginIoStatement<ChildListIoStatementState<DIR>>(
-              *child, sourceFile, sourceLine)
-        : nullptr;
+    if (iostat == IostatOk) {
+      iostat = child->CheckFormattingAndDirection(false, DIR);
+    }
+    if (iostat == IostatOk) {
+      return &child->BeginIoStatement<ChildListIoStatementState<DIR>>(
+          *child, sourceFile, sourceLine);
     } else {
-    if (unit.access == Access::Direct) {
-      terminator.Crash("%s attempted on direct access file", what);
-      return nullptr;
+      return &child->BeginIoStatement<ErroneousIoStatementState>(
+          iostat, sourceFile, sourceLine);
+    }
+  } else {
+    if (iostat == IostatOk && unit.access == Access::Direct) {
+      iostat = IostatListIoOnDirectAccessUnit;
+    }
+    if (iostat == IostatOk) {
+      iostat = unit.SetDirection(DIR);
+    }
+    if (iostat == IostatOk) {
+      return &unit.BeginIoStatement<STATE<DIR>>(
+          std::forward<A>(xs)..., unit, sourceFile, sourceLine);
+    } else {
+      return &unit.BeginIoStatement<ErroneousIoStatementState>(
+          iostat, sourceFile, sourceLine);
     }
-    IoErrorHandler handler{terminator};
-    unit.SetDirection(DIR, handler);
-    IoStatementState &io{unit.BeginIoStatement<STATE<DIR>>(
-        std::forward<A>(xs)..., unit, sourceFile, sourceLine)};
-    return &io;
   }
 }
 
 Cookie IONAME(BeginExternalListOutput)(
     ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
   return BeginExternalListIO<Direction::Output, ExternalListIoStatementState>(
-      "List-directed output", unitNumber, sourceFile, sourceLine);
+      unitNumber, sourceFile, sourceLine);
 }
 
 Cookie IONAME(BeginExternalListInput)(
     ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
   return BeginExternalListIO<Direction::Input, ExternalListIoStatementState>(
-      "List-directed input", unitNumber, sourceFile, sourceLine);
+      unitNumber, sourceFile, sourceLine);
 }
 
 template <Direction DIR>
 Cookie BeginExternalFormattedIO(const char *format, std::size_t formatLength,
     ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
   Terminator terminator{sourceFile, sourceLine};
   if (unitNumber == DefaultUnit) {
     unitNumber = DIR == Direction::Input ? 5 : 6;
   }
   ExternalFileUnit &unit{ExternalFileUnit::LookUpOrCreateAnonymous(
       unitNumber, DIR, false /*!unformatted*/, terminator)};
+  Iostat iostat{IostatOk};
   if (!unit.isUnformatted.has_value()) {
     unit.isUnformatted = false;
   }
   if (*unit.isUnformatted) {
-    terminator.Crash("Formatted I/O attempted on unformatted file");
-    return nullptr;
+    iostat = IostatFormattedIoOnUnformattedUnit;
   }
   if (ChildIo * child{unit.GetChildIo()}) {
-    return child->CheckFormattingAndDirection(terminator,
-               DIR == Direction::Output ? "formatted output"
-                                        : "formatted input",
-               false, DIR)
-        ? &child->BeginIoStatement<ChildFormattedIoStatementState<DIR>>(
-              *child, format, formatLength, sourceFile, sourceLine)
-        : nullptr;
+    if (iostat == IostatOk) {
+      iostat = child->CheckFormattingAndDirection(false, DIR);
+    }
+    if (iostat == IostatOk) {
+      return &child->BeginIoStatement<ChildFormattedIoStatementState<DIR>>(
+          *child, format, formatLength, sourceFile, sourceLine);
     } else {
-    IoErrorHandler handler{terminator};
-    unit.SetDirection(DIR, handler);
-    IoStatementState &io{
-        unit.BeginIoStatement<ExternalFormattedIoStatementState<DIR>>(
-            unit, format, formatLength, sourceFile, sourceLine)};
-    return &io;
+      return &child->BeginIoStatement<ErroneousIoStatementState>(
+          iostat, sourceFile, sourceLine);
+    }
+  } else {
+    if (iostat == IostatOk) {
+      iostat = unit.SetDirection(DIR);
+    }
+    if (iostat == IostatOk) {
+      return &unit.BeginIoStatement<ExternalFormattedIoStatementState<DIR>>(
+          unit, format, formatLength, sourceFile, sourceLine);
+    } else {
+      return &unit.BeginIoStatement<ErroneousIoStatementState>(
+          iostat, sourceFile, sourceLine);
+    }
   }
 }
 
 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 &unit{ExternalFileUnit::LookUpOrCreateAnonymous(
       unitNumber, DIR, true /*unformatted*/, terminator)};
+  Iostat iostat{IostatOk};
   if (!unit.isUnformatted.has_value()) {
     unit.isUnformatted = true;
   }
   if (!*unit.isUnformatted) {
-    terminator.Crash("Unformatted I/O attempted on formatted file");
+    iostat = IostatUnformattedIoOnFormattedUnit;
   }
   if (ChildIo * child{unit.GetChildIo()}) {
-    return child->CheckFormattingAndDirection(terminator,
-               DIR == Direction::Output ? "unformatted output"
-                                        : "unformatted input",
-               true, DIR)
-        ? &child->BeginIoStatement<ChildUnformattedIoStatementState<DIR>>(
-              *child, sourceFile, sourceLine)
-        : nullptr;
+    if (iostat == IostatOk) {
+      iostat = child->CheckFormattingAndDirection(true, DIR);
+    }
+    if (iostat == IostatOk) {
+      return &child->BeginIoStatement<ChildUnformattedIoStatementState<DIR>>(
+          *child, sourceFile, sourceLine);
+    } else {
+      return &child->BeginIoStatement<ErroneousIoStatementState>(
+          iostat, sourceFile, sourceLine);
+    }
   } else {
+    if (iostat == IostatOk) {
+      iostat = unit.SetDirection(DIR);
+    }
+    if (iostat == IostatOk) {
       IoStatementState &io{
           unit.BeginIoStatement<ExternalUnformattedIoStatementState<DIR>>(
               unit, sourceFile, sourceLine)};
-    IoErrorHandler handler{terminator};
-    unit.SetDirection(DIR, handler);
       if constexpr (DIR == Direction::Output) {
         if (unit.access == Access::Sequential) {
           // Create space for (sub)record header to be completed by
           // ExternalFileUnit::AdvanceRecord()
           unit.recordLength.reset(); // in case of prior BACKSPACE
           io.Emit("\0\0\0\0", 4); // placeholder for record length header
         }
       }
       return &io;
+    } else {
+      return &unit.BeginIoStatement<ErroneousIoStatementState>(
+          iostat, sourceFile, sourceLine);
+    }
   }
 }
 
 Cookie IONAME(BeginUnformattedOutput)(
     ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
   return BeginUnformattedIO<Direction::Output>(
       unitNumber, sourceFile, sourceLine);
 }

flang/runtime/io-stmt.h

 class OpenStatementState;
 class InquireUnitState;
 class InquireNoUnitState;
 class InquireUnconnectedFileState;
 class InquireIOLengthState;
 class ExternalMiscIoStatementState;
 class CloseStatementState;
 class NoopStatementState; // CLOSE or FLUSH on unknown unit
+class ErroneousIoStatementState;
 
 template <Direction, typename CHAR = char>
 class InternalFormattedIoStatementState;
 template <Direction, typename CHAR = char> class InternalListIoStatementState;
 template <Direction, typename CHAR = char>
 class ExternalFormattedIoStatementState;
 template <Direction> class ExternalListIoStatementState;
 template <Direction> class ExternalUnformattedIoStatementState;
std::variant<std::reference_wrapper<OpenStatementState>,
       std::reference_wrapper<
           ChildUnformattedIoStatementState<Direction::Output>>,
       std::reference_wrapper<
           ChildUnformattedIoStatementState<Direction::Input>>,
       std::reference_wrapper<InquireUnitState>,
       std::reference_wrapper<InquireNoUnitState>,
       std::reference_wrapper<InquireUnconnectedFileState>,
       std::reference_wrapper<InquireIOLengthState>,
-      std::reference_wrapper<ExternalMiscIoStatementState>>
+      std::reference_wrapper<ExternalMiscIoStatementState>,
+      std::reference_wrapper<ErroneousIoStatementState>>
       u_;
 };
 
 // Base class for all per-I/O statement state classes.
 struct IoStatementBase : public IoErrorHandler {
   using IoErrorHandler::IoErrorHandler;
 
   // These are default no-op backstops that can be overridden by descendants.
ExternalMiscIoStatementState(ExternalFileUnit &unit, Which which,
       const char *sourceFile = nullptr, int sourceLine = 0)
       : ExternalIoStatementBase{unit, sourceFile, sourceLine}, which_{which} {}
   int EndIoStatement();
 
 private:
   Which which_;
 };
 
+class ErroneousIoStatementState : public IoStatementBase {
+public:
+  explicit ErroneousIoStatementState(
+      Iostat iostat, const char *sourceFile = nullptr, int sourceLine = 0)
+      : IoStatementBase{sourceFile, sourceLine}, iostat_{iostat} {}
+  int EndIoStatement();
+  ConnectionState &GetConnectionState() { return connection_; }
+  MutableModes &mutableModes() { return connection_.modes; }
+
+private:
+  Iostat iostat_;
+  ConnectionState connection_;
+};
+
 } // namespace Fortran::runtime::io
 #endif // FORTRAN_RUNTIME_IO_STMT_H_

flang/runtime/io-stmt.cpp

bool InquireUnitState::Inquire(
   case HashInquiryKeyword("RECL"):
     if (!unit().IsConnected()) {
       result = -1;
     } else if (unit().access == Access::Stream) {
       result = -2;
     } else if (unit().openRecl) {
       result = *unit().openRecl;
     } else {
-      result = std::numeric_limits<std::uint32_t>::max();
+      result = std::numeric_limits<std::int32_t>::max();
     }
     return true;
   case HashInquiryKeyword("SIZE"):
     result = -1;
     if (unit().IsConnected()) {
       if (auto size{unit().knownSize()}) {
         result = *size;
       }
bool InquireIOLengthState::Emit(const char16_t *p, std::size_t n) {
   return true;
 }
 
 bool InquireIOLengthState::Emit(const char32_t *p, std::size_t n) {
   bytes_ += sizeof *p * n;
   return true;
 }
 
+int ErroneousIoStatementState::EndIoStatement() {
+  SignalError(iostat_);
+  return IoStatementBase::EndIoStatement();
+}
+
 } // namespace Fortran::runtime::io

flang/runtime/iostat.cpp

const char *IostatErrorString(int iostat) {
   case IostatBackspaceNonSequential:
     return "BACKSPACE on non-sequential file";
   case IostatBackspaceAtFirstRecord:
     return "BACKSPACE at first record";
   case IostatRewindNonSequential:
     return "REWIND on non-sequential file";
   case IostatWriteAfterEndfile:
     return "WRITE after ENDFILE";
+  case IostatFormattedIoOnUnformattedUnit:
+    return "Formatted I/O on unformatted file";
+  case IostatUnformattedIoOnFormattedUnit:
+    return "Unformatted I/O on formatted file";
+  case IostatListIoOnDirectAccessUnit:
+    return "List-directed or NAMELIST I/O on direct-access file";
+  case IostatUnformattedChildOnFormattedParent:
+    return "Unformatted child I/O on formatted parent unit";
+  case IostatFormattedChildOnUnformattedParent:
+    return "Formatted child I/O on unformatted parent unit";
+  case IostatChildInputFromOutputParent:
+    return "Child input from output parent unit";
+  case IostatChildOutputToInputParent:
+    return "Child output to input parent unit";
   default:
     return nullptr;
   }
 }
 
 } // namespace Fortran::runtime::io

flang/runtime/unit.h

public:
   void OpenUnit(std::optional<OpenStatus>, std::optional<Action>, Position,
       OwningPtr<char> &&path, std::size_t pathLength, Convert,
       IoErrorHandler &);
   void OpenAnonymousUnit(std::optional<OpenStatus>, std::optional<Action>,
       Position, Convert, IoErrorHandler &);
   void CloseUnit(CloseStatus, IoErrorHandler &);
   void DestroyClosed();
 
-  bool SetDirection(Direction, IoErrorHandler &);
+  Iostat SetDirection(Direction);
 
   template <typename A, typename... X>
   IoStatementState &BeginIoStatement(X &&...xs) {
     lock_.Take(); // dropped in EndIoStatement()
     A &state{u_.emplace<A>(std::forward<X>(xs)...)};
     if constexpr (!std::is_same_v<A, OpenStatementState>) {
       state.mutableModes() = ConnectionState::modes;
     }
private:
   // When an I/O statement is in progress on this unit, holds its state.
   std::variant<std::monostate, OpenStatementState, CloseStatementState,
       ExternalFormattedIoStatementState<Direction::Output>,
       ExternalFormattedIoStatementState<Direction::Input>,
       ExternalListIoStatementState<Direction::Output>,
       ExternalListIoStatementState<Direction::Input>,
       ExternalUnformattedIoStatementState<Direction::Output>,
       ExternalUnformattedIoStatementState<Direction::Input>, InquireUnitState,
-      ExternalMiscIoStatementState>
+      ExternalMiscIoStatementState, ErroneousIoStatementState>
       u_;
 
   // Points to the active alternative (if any) in u_ for use as a Cookie
   std::optional<IoStatementState> io_;
 
   // Subtle: The beginning of the frame can't be allowed to advance
   // during a single list-directed READ due to the possibility of a
   // multi-record CHARACTER value with a "r*" repeat count.  So we
public:
   IoStatementState &BeginIoStatement(X &&...xs) {
     A &state{u_.emplace<A>(std::forward<X>(xs)...)};
     io_.emplace(state);
     return *io_;
   }
 
   OwningPtr<ChildIo> AcquirePrevious() { return std::move(previous_); }
 
-  bool CheckFormattingAndDirection(
-      Terminator &, const char *what, bool unformatted, Direction);
+  Iostat CheckFormattingAndDirection(bool unformatted, Direction);
 
 private:
   IoStatementState &parent_;
   OwningPtr<ChildIo> previous_;
   std::variant<std::monostate,
       ChildFormattedIoStatementState<Direction::Output>,
       ChildFormattedIoStatementState<Direction::Input>,
       ChildListIoStatementState<Direction::Output>,
       ChildListIoStatementState<Direction::Input>,
       ChildUnformattedIoStatementState<Direction::Output>,
-      ChildUnformattedIoStatementState<Direction::Input>, InquireUnitState>
+      ChildUnformattedIoStatementState<Direction::Input>, InquireUnitState,
+      ErroneousIoStatementState>
       u_;
   std::optional<IoStatementState> io_;
 };
 
 } // namespace Fortran::runtime::io
 #endif // FORTRAN_RUNTIME_IO_UNIT_H_

flang/runtime/unit.cpp

void ExternalFileUnit::CloseUnit(CloseStatus status, IoErrorHandler &handler) {
   FlushOutput(handler);
   Close(status, handler);
 }
 
 void ExternalFileUnit::DestroyClosed() {
   GetUnitMap().DestroyClosed(*this); // destroys *this
 }
 
-bool ExternalFileUnit::SetDirection(
-    Direction direction, IoErrorHandler &handler) {
+Iostat ExternalFileUnit::SetDirection(Direction direction) {
   if (direction == Direction::Input) {
     if (mayRead()) {
       direction_ = Direction::Input;
-      return true;
+      return IostatOk;
     } else {
-      handler.SignalError(IostatReadFromWriteOnly,
-          "READ(UNIT=%d) with ACTION='WRITE'", unitNumber());
-      return false;
+      return IostatReadFromWriteOnly;
     }
   } else {
     if (mayWrite()) {
       direction_ = Direction::Output;
-      return true;
+      return IostatOk;
     } else {
-      handler.SignalError(IostatWriteToReadOnly,
-          "WRITE(UNIT=%d) with ACTION='READ'", unitNumber());
-      return false;
+      return IostatWriteToReadOnly;
     }
   }
 }
 
 UnitMap &ExternalFileUnit::GetUnitMap() {
   if (unitMap) {
     return *unitMap;
   }
   CriticalSection critical{unitMapLock};
   if (unitMap) {
     return *unitMap;
   }
   Terminator terminator{__FILE__, __LINE__};
   IoErrorHandler handler{terminator};
   UnitMap *newUnitMap{New<UnitMap>{terminator}().release()};
 
   bool wasExtant{false};
   ExternalFileUnit &out{newUnitMap->LookUpOrCreate(6, terminator, wasExtant)};
   RUNTIME_CHECK(terminator, !wasExtant);
   out.Predefine(1);
-  out.SetDirection(Direction::Output, handler);
+  handler.SignalError(out.SetDirection(Direction::Output));
   out.isUnformatted = false;
   defaultOutput = &out;
 
   ExternalFileUnit &in{newUnitMap->LookUpOrCreate(5, terminator, wasExtant)};
   RUNTIME_CHECK(terminator, !wasExtant);
   in.Predefine(0);
-  in.SetDirection(Direction::Input, handler);
+  handler.SignalError(in.SetDirection(Direction::Input));
   in.isUnformatted = false;
   defaultInput = &in;
 
   ExternalFileUnit &error{newUnitMap->LookUpOrCreate(0, terminator, wasExtant)};
   RUNTIME_CHECK(terminator, !wasExtant);
   error.Predefine(2);
-  error.SetDirection(Direction::Output, handler);
+  handler.SignalError(error.SetDirection(Direction::Output));
   error.isUnformatted = false;
   errorOutput = &error;
 
   // TODO: Set UTF-8 mode from the environment
   unitMap = newUnitMap;
   return *unitMap;
 }
 
void ExternalFileUnit::PopChildIo(ChildIo &child) {
   child_.reset(child.AcquirePrevious().release()); // deletes top child
 }
 
 void ChildIo::EndIoStatement() {
   io_.reset();
   u_.emplace<std::monostate>();
 }
 
-bool ChildIo::CheckFormattingAndDirection(Terminator &terminator,
-    const char *what, bool unformatted, Direction direction) {
+Iostat ChildIo::CheckFormattingAndDirection(
+    bool unformatted, Direction direction) {
   bool parentIsInput{!parent_.get_if<IoDirectionState<Direction::Output>>()};
   bool parentIsFormatted{parentIsInput
           ? parent_.get_if<FormattedIoStatementState<Direction::Input>>() !=
               nullptr
           : parent_.get_if<FormattedIoStatementState<Direction::Output>>() !=
               nullptr};
   bool parentIsUnformatted{!parentIsFormatted};
   if (unformatted != parentIsUnformatted) {
-    terminator.Crash("Child %s attempted on %s parent I/O unit", what,
-        parentIsUnformatted ? "unformatted" : "formatted");
-    return false;
+    return unformatted ? IostatUnformattedChildOnFormattedParent
+                       : IostatFormattedChildOnUnformattedParent;
   } else if (parentIsInput != (direction == Direction::Input)) {
-    terminator.Crash("Child %s attempted on %s parent I/O unit", what,
-        parentIsInput ? "input" : "output");
-    return false;
+    return parentIsInput ? IostatChildOutputToInputParent
+                         : IostatChildInputFromOutputParent;
   } else {
-    return true;
+    return IostatOk;
   }
 }
 
 } // namespace Fortran::runtime::io