[flang][runtime] Corrections to formatted child I/O

[klausler]

Summary

A handful of I/O statements (OPEN, CLOSE, positioning) are not allowed
on units during child I/O; catch violations and report errors.
Also finesse error handling during FORMAT runtime parsing of DT
derived type edit descriptors, and ensure that formatted child
I/O is nonadvancing.

[clementval]

LGTM

flang/include/flang/Runtime/iostat.h

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

flang/runtime/descriptor-io.cpp

 //===-- runtime/descriptor-io.cpp -----------------------------------------===//
 //
 // 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 "descriptor-io.h"
+#include "flang/Common/restorer.h"
 
 namespace Fortran::runtime::io::descr {
 
 // User-defined derived type formatted I/O (maybe)
 std::optional<bool> DefinedFormattedIo(IoStatementState &io,
     const Descriptor &descriptor, const typeInfo::SpecialBinding &special) {
   std::optional<DataEdit> peek{io.GetNextDataEdit(0 /*to peek at it*/)};
   if (peek &&
if (peek &&
     ExternalFileUnit *actualExternal{io.GetExternalFileUnit()};
     ExternalFileUnit *external{actualExternal};
     if (!external) {
       // Create a new unit to service defined I/O for an
       // internal I/O parent.
       external = &ExternalFileUnit::NewUnit(handler, true);
     }
     ChildIo &child{external->PushChildIo(io)};
+    // Child formatted I/O is nonadvancing by definition (F'2018 12.6.2.4).
+    auto restorer{common::ScopedSet(io.mutableModes().nonAdvancing, true)};
     int unit{external->unitNumber()};
     int ioStat{IostatOk};
     char ioMsg[100];
     std::optional<std::int64_t> startPos;
     if (edit.descriptor == DataEdit::DefinedDerivedType &&
         special.which() == typeInfo::SpecialBinding::Which::ReadFormatted) {
       // DT is an edit descriptor so everything that the child
       // I/O subroutine reads counts towards READ(SIZE=).

flang/runtime/format-implementation.h

FormatControl<CONTEXT>::FormatControl(const Terminator &terminator,
   RUNTIME_CHECK(
       terminator, formatLength == static_cast<std::size_t>(formatLength_));
   stack_[0].start = offset_;
   stack_[0].remaining = Iteration::unlimited; // 13.4(8)
 }
 
 template <typename CONTEXT>
 int FormatControl<CONTEXT>::GetIntField(
-    IoErrorHandler &handler, CharType firstCh) {
+    IoErrorHandler &handler, CharType firstCh, bool *hadError) {
   CharType ch{firstCh ? firstCh : PeekNext()};
   if (ch != '-' && ch != '+' && (ch < '0' || ch > '9')) {
     handler.SignalError(IostatErrorInFormat,
         "Invalid FORMAT: integer expected at '%c'", static_cast<char>(ch));
+    if (hadError) {
+      *hadError = true;
+    }
     return 0;
   }
   int result{0};
   bool negate{ch == '-'};
   if (negate || ch == '+') {
     if (firstCh) {
       firstCh = '\0';
     } else {
       ++offset_;
     }
     ch = PeekNext();
   }
   while (ch >= '0' && ch <= '9') {
     if (result >
         std::numeric_limits<int>::max() / 10 - (static_cast<int>(ch) - '0')) {
       handler.SignalError(
           IostatErrorInFormat, "FORMAT integer field out of range");
+      if (hadError) {
+        *hadError = true;
+      }
       return result;
     }
     result = 10 * result + ch - '0';
     if (firstCh) {
       firstCh = '\0';
     } else {
       ++offset_;
     }
     ch = PeekNext();
   }
   if (negate && (result *= -1) > 0) {
     handler.SignalError(
         IostatErrorInFormat, "FORMAT integer field out of range");
+    if (hadError) {
+      *hadError = true;
+    }
   }
   return result;
 }
 
 template <typename CONTEXT>
 static void HandleControl(CONTEXT &context, char ch, char next, int n) {
   MutableModes &modes{context.mutableModes()};
   switch (ch) {
if (ch == '(') {
           context, "Invalid character in FORMAT", maybeReversionPoint);
       return 0;
     }
   }
 }
 
 // Returns the next data edit descriptor
 template <typename CONTEXT>
-DataEdit FormatControl<CONTEXT>::GetNextDataEdit(
+std::optional<DataEdit> FormatControl<CONTEXT>::GetNextDataEdit(
     Context &context, int maxRepeat) {
   int repeat{CueUpNextDataEdit(context)};
   auto start{offset_};
   DataEdit edit;
   edit.descriptor = static_cast<char>(Capitalize(GetNextChar(context)));
   if (edit.descriptor == 'E') {
     if (auto next{static_cast<char>(Capitalize(PeekNext()))};
         next == 'N' || next == 'S' || next == 'X') {
       edit.variation = next;
       ++offset_;
     }
   } else if (edit.descriptor == 'D' && Capitalize(PeekNext()) == 'T') {
     // DT['iotype'][(v_list)] user-defined derived type I/O
     edit.descriptor = DataEdit::DefinedDerivedType;
     ++offset_;
     if (auto quote{static_cast<char>(PeekNext())};
         quote == '\'' || quote == '"') {
       // Capture the quoted 'iotype'
-      bool ok{false}, tooLong{false};
+      bool ok{false};
       for (++offset_; offset_ < formatLength_;) {
         auto ch{static_cast<char>(format_[offset_++])};
         if (ch == quote &&
             (offset_ == formatLength_ ||
                 static_cast<char>(format_[offset_]) != quote)) {
           ok = true;
           break; // that was terminating quote
-        } else if (edit.ioTypeChars >= edit.maxIoTypeChars) {
-          tooLong = true;
-        } else {
-          edit.ioType[edit.ioTypeChars++] = ch;
-          if (ch == quote) {
-            ++offset_;
-          }
-        }
-      }
+        }
+        if (edit.ioTypeChars >= edit.maxIoTypeChars) {
+          ReportBadFormat(context, "Excessive DT'iotype' in FORMAT", start);
+          return std::nullopt;
+        }
       if (!ok) {
         ReportBadFormat(context, "Unclosed DT'iotype' in FORMAT", start);
-      } else if (tooLong) {
-        ReportBadFormat(context, "Excessive DT'iotype' in FORMAT", start);
+        return std::nullopt;
       }
     }
     if (PeekNext() == '(') {
       // Capture the v_list arguments
-      bool ok{false}, tooLong{false};
+      bool ok{false};
       for (++offset_; offset_ < formatLength_;) {
-        int n{GetIntField(context)};
+        bool hadError{false};
+        int n{GetIntField(context, '\0', &hadError)};
+        if (hadError) {
+          ok = false;
+          break;
+        }
         if (edit.vListEntries >= edit.maxVListEntries) {
-          tooLong = true;
-        } else {
-          edit.vList[edit.vListEntries++] = n;
+          ReportBadFormat(context, "Excessive DT(v_list) in FORMAT", start);
+          return std::nullopt;
         }
+        edit.vList[edit.vListEntries++] = n;
         auto ch{static_cast<char>(GetNextChar(context))};
         if (ch != ',') {
           ok = ch == ')';
           break;
         }
       }
       if (!ok) {
         ReportBadFormat(context, "Unclosed DT(v_list) in FORMAT", start);
-      } else if (tooLong) {
-        ReportBadFormat(context, "Excessive DT(v_list) in FORMAT", start);
+        return std::nullopt;
       }
     }
   }
   if (edit.descriptor == 'A') { // width is optional for A[w]
     auto ch{PeekNext()};
     if (ch >= '0' && ch <= '9') {
       edit.width = GetIntField(context);
     }

flang/runtime/format.h

public:
   static std::size_t GetNeededSize(int maxHeight) {
     return sizeof(FormatControl) -
         sizeof(Iteration) * (maxMaxHeight - maxHeight);
   }
 
   // Extracts the next data edit descriptor, handling control edit descriptors
   // along the way.  If maxRepeat==0, this is a peek at the next data edit
   // descriptor.
-  DataEdit GetNextDataEdit(Context &, int maxRepeat = 1);
+  std::optional<DataEdit> GetNextDataEdit(Context &, int maxRepeat = 1);
 
   // Emit any remaining character literals after the last data item (on output)
   // and perform remaining record positioning actions.
   void Finish(Context &);
 
 private:
   static constexpr std::uint8_t maxMaxHeight{100};
 
if (offset_ >= formatLength_) {
       } else {
         handler.SignalError(
             IostatErrorInFormat, "FORMAT missing at least one ')'");
       }
       return '\n';
     }
     return format_[offset_++];
   }
-  int GetIntField(IoErrorHandler &, CharType firstCh = '\0');
+  int GetIntField(
+      IoErrorHandler &, CharType firstCh = '\0', bool *hadError = nullptr);
 
   // Advances through the FORMAT until the next data edit
   // descriptor has been found; handles control edit descriptors
   // along the way.  Returns the repeat count that appeared
   // before the descriptor (defaulting to 1) and leaves offset_
   // pointing to the data edit.
   int CueUpNextDataEdit(Context &, bool stop = false);
 

flang/runtime/io-api.cpp

 
 Cookie IONAME(BeginOpenUnit)( // OPEN(without NEWUNIT=)
     ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
   Terminator terminator{sourceFile, sourceLine};
   bool wasExtant{false};
   if (ExternalFileUnit *
       unit{ExternalFileUnit::LookUpOrCreate(
           unitNumber, terminator, wasExtant)}) {
+    if (ChildIo * child{unit->GetChildIo()}) {
+      return &child->BeginIoStatement<ErroneousIoStatementState>(
+          IostatBadOpOnChildUnit, nullptr /* no unit */, sourceFile,
+          sourceLine);
+    } else {
       return &unit->BeginIoStatement<OpenStatementState>(
           terminator, *unit, wasExtant, sourceFile, sourceLine);
+    }
   } else {
     return NoopUnit(terminator, unitNumber, IostatBadUnitNumber);
   }
 }
 
 Cookie IONAME(BeginOpenNewUnit)( // OPEN(NEWUNIT=j)
     const char *sourceFile, int sourceLine) {
   Terminator terminator{sourceFile, sourceLine};

 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) {
   Terminator terminator{sourceFile, sourceLine};
+  if (ExternalFileUnit * unit{ExternalFileUnit::LookUp(unitNumber)}) {
+    if (ChildIo * child{unit->GetChildIo()}) {
+      return &child->BeginIoStatement<ErroneousIoStatementState>(
+          IostatBadOpOnChildUnit, nullptr /* no unit */, sourceFile,
+          sourceLine);
+    }
+  }
   if (ExternalFileUnit * unit{ExternalFileUnit::LookUpForClose(unitNumber)}) {
     return &unit->BeginIoStatement<CloseStatementState>(
         terminator, *unit, sourceFile, sourceLine);
   } else {
     // CLOSE(UNIT=bad unit) is just a no-op
     return NoopUnit(terminator, unitNumber);
   }
 }
 
 Cookie IONAME(BeginFlush)(
     ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
   Terminator terminator{sourceFile, sourceLine};
   if (ExternalFileUnit * unit{ExternalFileUnit::LookUp(unitNumber)}) {
+    if (ChildIo * child{unit->GetChildIo()}) {
+      return &child->BeginIoStatement<ExternalMiscIoStatementState>(
+          *unit, ExternalMiscIoStatementState::Flush, sourceFile, sourceLine);
+    } else {
       return &unit->BeginIoStatement<ExternalMiscIoStatementState>(terminator,
           *unit, ExternalMiscIoStatementState::Flush, sourceFile, sourceLine);
+    }
   } else {
     // FLUSH(UNIT=bad unit) is an error; an unconnected unit is a no-op
     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)}) {
+    if (ChildIo * child{unit->GetChildIo()}) {
+      return &child->BeginIoStatement<ErroneousIoStatementState>(
+          IostatBadOpOnChildUnit, nullptr /* no unit */, sourceFile,
+          sourceLine);
+    } else {
       return &unit->BeginIoStatement<ExternalMiscIoStatementState>(terminator,
-        *unit, ExternalMiscIoStatementState::Backspace, sourceFile, sourceLine);
+          *unit, ExternalMiscIoStatementState::Backspace, sourceFile,
+          sourceLine);
+    }
   } else {
     return NoopUnit(terminator, unitNumber, IostatBadBackspaceUnit);
   }
 }
 
 Cookie IONAME(BeginEndfile)(
     ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
   Terminator terminator{sourceFile, sourceLine};
   Cookie errorCookie{nullptr};
   if (ExternalFileUnit *
       unit{GetOrCreateUnit(unitNumber, Direction::Output, std::nullopt,
           terminator, errorCookie)}) {
+    if (ChildIo * child{unit->GetChildIo()}) {
+      return &child->BeginIoStatement<ErroneousIoStatementState>(
+          IostatBadOpOnChildUnit, nullptr /* no unit */, sourceFile,
+          sourceLine);
+    } else {
       return &unit->BeginIoStatement<ExternalMiscIoStatementState>(terminator,
           *unit, ExternalMiscIoStatementState::Endfile, sourceFile, sourceLine);
+    }
   } else {
     return errorCookie;
   }
 }
 
 Cookie IONAME(BeginRewind)(
     ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
   Terminator terminator{sourceFile, sourceLine};
   Cookie errorCookie{nullptr};
   if (ExternalFileUnit *
       unit{GetOrCreateUnit(unitNumber, Direction::Input, std::nullopt,
           terminator, errorCookie)}) {
+    if (ChildIo * child{unit->GetChildIo()}) {
+      return &child->BeginIoStatement<ErroneousIoStatementState>(
+          IostatBadOpOnChildUnit, nullptr /* no unit */, sourceFile,
+          sourceLine);
+    } else {
       return &unit->BeginIoStatement<ExternalMiscIoStatementState>(terminator,
           *unit, ExternalMiscIoStatementState::Rewind, sourceFile, sourceLine);
+    }
   } else {
     return errorCookie;
   }
 }
 
 Cookie IONAME(BeginInquireUnit)(
     ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
   Terminator terminator{sourceFile, sourceLine};
Cookie IONAME(BeginInquireFile)(const char *path, std::size_t pathLength,
     const char *sourceFile, int sourceLine) {
   Terminator terminator{sourceFile, sourceLine};
   auto trimmed{SaveDefaultCharacter(
       path, TrimTrailingSpaces(path, pathLength), terminator)};
   if (ExternalFileUnit *
       unit{ExternalFileUnit::LookUp(
           trimmed.get(), std::strlen(trimmed.get()))}) {
     // INQUIRE(FILE=) to a connected unit
+    if (ChildIo * child{unit->GetChildIo()}) {
+      return &child->BeginIoStatement<InquireUnitState>(
+          *unit, sourceFile, sourceLine);
+    } else {
       return &unit->BeginIoStatement<InquireUnitState>(
           terminator, *unit, sourceFile, sourceLine);
+    }
   } else {
     return &New<InquireUnconnectedFileState>{terminator}(
         std::move(trimmed), sourceFile, sourceLine)
                 .release()
                 ->ioStatementState();
   }
 }
 

 bool IONAME(SetAdvance)(
     Cookie cookie, const char *keyword, std::size_t length) {
   IoStatementState &io{*cookie};
   IoErrorHandler &handler{io.GetIoErrorHandler()};
   bool nonAdvancing{!YesOrNo(keyword, length, "ADVANCE", handler)};
   if (nonAdvancing && io.GetConnectionState().access == Access::Direct) {
     handler.SignalError("Non-advancing I/O attempted on direct access file");
   } else {
+    auto *unit{io.GetExternalFileUnit()};
+    if (unit && unit->GetChildIo()) {
+      // ADVANCE= is ignored for child I/O (12.6.4.8.3 p3)
+    } else {
       io.mutableModes().nonAdvancing = nonAdvancing;
     }
+  }
   return !handler.InError();
 }
 
 bool IONAME(SetBlank)(Cookie cookie, const char *keyword, std::size_t length) {
   IoStatementState &io{*cookie};
   static const char *keywords[]{"NULL", "ZERO", nullptr};
   switch (IdentifyValue(keyword, length, keywords)) {
   case 0:
bool IONAME(SetPos)(Cookie cookie, std::int64_t pos) {
   }
   return false;
 }
 
 bool IONAME(SetRec)(Cookie cookie, std::int64_t rec) {
   IoStatementState &io{*cookie};
   IoErrorHandler &handler{io.GetIoErrorHandler()};
   if (auto *unit{io.GetExternalFileUnit()}) {
+    if (unit->GetChildIo()) {
+      handler.SignalError(
+          IostatBadOpOnChildUnit, "REC= specifier on child I/O");
+    } else {
       unit->SetDirectRec(rec, handler);
+    }
   } else if (!io.get_if<ErroneousIoStatementState>()) {
     handler.Crash("SetRec() called on internal unit");
   }
   return true;
 }
 
 bool IONAME(SetRound)(Cookie cookie, const char *keyword, std::size_t length) {
   IoStatementState &io{*cookie};

flang/runtime/io-error.cpp

 }
 
 void IoErrorHandler::SignalError(int iostatOrErrno) {
   SignalError(iostatOrErrno, nullptr);
 }
 
 void IoErrorHandler::Forward(
     int ioStatOrErrno, const char *msg, std::size_t length) {
-  if (ioStat_ != IostatOk && msg && (flags_ & hasIoMsg)) {
-    ioMsg_ = SaveDefaultCharacter(msg, length, *this);
-  }
-  if (ioStatOrErrno != IostatOk && msg) {
+  if (ioStatOrErrno != IostatOk) {
+    if (msg) {
       SignalError(ioStatOrErrno, "%.*s", static_cast<int>(length), msg);
     } else {
       SignalError(ioStatOrErrno);
     }
   }
+}
 
 void IoErrorHandler::SignalErrno() { SignalError(errno); }
 
 void IoErrorHandler::SignalEnd() { SignalError(IostatEnd); }
 
 void IoErrorHandler::SignalEor() { SignalError(IostatEor); }
 
 void IoErrorHandler::SignalPendingError() {

flang/runtime/iostat.cpp

const char *IostatErrorString(int iostat) {
   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";
+  case IostatBadOpOnChildUnit:
+    return "Impermissible I/O statement on child I/O unit";
   default:
     return nullptr;
   }
 }
 
 } // namespace Fortran::runtime::io

flang/runtime/unit.h

private:
   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,
-      ErroneousIoStatementState>
+      ErroneousIoStatementState, ExternalMiscIoStatementState>
       u_;
   std::optional<IoStatementState> io_;
 };
 
 } // namespace Fortran::runtime::io
 #endif // FORTRAN_RUNTIME_IO_UNIT_H_

flang/unittests/Runtime/Format.cpp

 //===-- flang/unittests/Runtime/Format.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 "CrashHandlerFixture.h"
 #include "../runtime/connection.h"
 #include "../runtime/format-implementation.h"
 #include "../runtime/io-error.h"
+#include <optional>
 #include <string>
 #include <tuple>
 #include <vector>
 
 using namespace Fortran::runtime;
 using namespace Fortran::runtime::io;
 using namespace std::literals::string_literals;
 
 using ResultsTy = std::vector<std::string>;
 
 // A test harness context for testing FormatControl
 class TestFormatContext : public IoErrorHandler {
 public:
   using CharType = char;
   TestFormatContext() : IoErrorHandler{"format.cpp", 1} {}
   bool Emit(const char *, std::size_t, std::size_t = 0);
   bool AdvanceRecord(int = 1);
   void HandleRelativePosition(std::int64_t);
   void HandleAbsolutePosition(std::int64_t);
-  void Report(const DataEdit &);
+  void Report(const std::optional<DataEdit> &);
   ResultsTy results;
   MutableModes &mutableModes() { return mutableModes_; }
   ConnectionState &GetConnectionState() { return connectionState_; }
 
 private:
   MutableModes mutableModes_;
   ConnectionState connectionState_;
 };

 void TestFormatContext::HandleRelativePosition(std::int64_t n) {
   if (n < 0) {
     results.push_back("TL"s + std::to_string(-n));
   } else {
     results.push_back(std::to_string(n) + 'X');
   }
 }
 
-void TestFormatContext::Report(const DataEdit &edit) {
-  std::string str{edit.descriptor};
-  if (edit.repeat != 1) {
-    str = std::to_string(edit.repeat) + '*' + str;
-  }
-  if (edit.variation) {
-    str += edit.variation;
+void TestFormatContext::Report(const std::optional<DataEdit> &edit) {
+  if (edit) {
+    std::string str{edit->descriptor};
+    if (edit->repeat != 1) {
+      str = std::to_string(edit->repeat) + '*' + str;
+    }
+    if (edit->variation) {
+      str += edit->variation;
     }
-  if (edit.width) {
-    str += std::to_string(*edit.width);
+    if (edit->width) {
+      str += std::to_string(*edit->width);
     }
-  if (edit.digits) {
-    str += "."s + std::to_string(*edit.digits);
+    if (edit->digits) {
+      str += "."s + std::to_string(*edit->digits);
     }
-  if (edit.expoDigits) {
-    str += "E"s + std::to_string(*edit.expoDigits);
+    if (edit->expoDigits) {
+      str += "E"s + std::to_string(*edit->expoDigits);
     }
     // modes?
     results.push_back(str);
+  } else {
+    results.push_back("(nullopt)"s);
+  }
 }
 
 struct FormatTests : public CrashHandlerFixture {};
 
 TEST(FormatTests, FormatStringTraversal) {
 
   using ParamsTy = std::tuple<int, const char *, ResultsTy, int>;