[flang] Use hash table for UnitMap, avoid C++ STL binary dependence

Scan FORMAT strings locally to avoid C++ binary runtime dependence when computing deepest parenthesis nesting

Remove a dependency on ostream from runtime

Remove remaining direct external references from runtime to C++ library binaries

Remove runtime dependences on lib/common

SetPos() and SetRec()

Instantiate templates for input

Begin input; rearrange locking, deal with CLOSE races

View()

Update error message in test to agree with compiler change

First cut at real input

More robust I/O runtime error handling

Debugging of REAL input

Add iostat.{h,cpp}

Rename runtime/numeric-* to runtime/edit-*

Move templates around, templatize integer output editing

Move LOGICAL and CHARACTER output from io-api.cpp to edit-output.cpp

Change pointer argument to reference

More list-directed input

Complex list-directed input

Use enum class Direction rather than bool for templates

Catch up with changes to master

Undo reformatting of Lower code

Use record number instead of subscripts for internal unit

Unformatted sequential backspace

Testing and debugging

Dodge bogus GCC warning

Add <cstddef> for std::size_t to fix CI build

Address review comments

Original-commit: flang-compiler/f18@50406b3496
Reviewed-on: https://github.com/flang-compiler/f18/pull/1053

flang/documentation/IORuntimeInternals.md

@@ -273,12 +273,13 @@ A Narrative Overview Of `PRINT *, 'HELLO, WORLD'`
 =================================================
 1. When the compiled Fortran program begins execution at the `main()`
 entry point exported from its main program, it calls `ProgramStart()`
-with its arguments and environment.  `ProgramStart()` calls
-`ExternalFileUnit::InitializePredefinedUnits()` to create and
-initialize Fortran units 5 and 6 and connect them with the
-standard input and output file descriptors (respectively).
+with its arguments and environment.
 1. The generated code calls `BeginExternalListOutput()` to
 start the sequence of calls that implement the `PRINT` statement.
+Since the Fortran runtime I/O library has not yet been used in
+this process, its data structures are initialized on this
+first call, and Fortran I/O units 5 and 6 are connected with
+the stadard input and output file descriptors (respectively).
 The default unit code is converted to 6 and passed to
 `ExternalFileUnit::LookUpOrCrash()`, which returns a reference to
 unit 6's instance.

flang/include/flang/Parser/char-buffer.h

@@ -47,7 +47,7 @@ public:
     lastBlockEmpty_ = false;
   }
 
-  char *FreeSpace(std::size_t *);
+  char *FreeSpace(std::size_t &);
   void Claim(std::size_t);
 
   // The return value is the byte offset of the new data,

flang/include/flang/Semantics/type.h

@@ -327,9 +327,7 @@ public:
   bool IsUnlimitedPolymorphic() const {
     return category_ == TypeStar || category_ == ClassStar;
   }
-  bool IsAssumedType() const {
-    return category_ == TypeStar;
-  }
+  bool IsAssumedType() const { return category_ == TypeStar; }
   bool IsNumeric(TypeCategory) const;
   const NumericTypeSpec &numericTypeSpec() const;
   const LogicalTypeSpec &logicalTypeSpec() const;

flang/lib/Parser/char-buffer.cpp

@@ -14,7 +14,7 @@
 
 namespace Fortran::parser {
 
-char *CharBuffer::FreeSpace(std::size_t *n) {
+char *CharBuffer::FreeSpace(std::size_t &n) {
   int offset{LastBlockOffset()};
   if (blocks_.empty()) {
     blocks_.emplace_front();
@@ -24,7 +24,7 @@ char *CharBuffer::FreeSpace(std::size_t *n) {
     last_ = blocks_.emplace_after(last_);
     lastBlockEmpty_ = true;
   }
-  *n = Block::capacity - offset;
+  n = Block::capacity - offset;
   return last_->data + offset;
 }
 
@@ -38,7 +38,7 @@ void CharBuffer::Claim(std::size_t n) {
 std::size_t CharBuffer::Put(const char *data, std::size_t n) {
   std::size_t chunk;
   for (std::size_t at{0}; at < n; at += chunk) {
-    char *to{FreeSpace(&chunk)};
+    char *to{FreeSpace(chunk)};
     chunk = std::min(n - at, chunk);
     Claim(chunk);
     std::memcpy(to, data + at, chunk);

flang/lib/Parser/source.cpp

@@ -200,7 +200,7 @@ bool SourceFile::ReadFile(std::string errorPath, std::stringstream *error) {
   CharBuffer buffer;
   while (true) {
     std::size_t count;
-    char *to{buffer.FreeSpace(&count)};
+    char *to{buffer.FreeSpace(count)};
     ssize_t got{read(fileDescriptor_, to, count)};
     if (got < 0) {
       *error << "could not read " << errorPath << ": " << std::strerror(errno);

flang/lib/Semantics/check-call.cpp

@@ -613,16 +613,13 @@ static void CheckExplicitInterfaceArg(evaluate::ActualArgument &arg,
               const Symbol &assumed{DEREF(arg.GetAssumedTypeDummy())};
               if (!object.type.type().IsAssumedType()) {
                 messages.Say(
-                    "Assumed-type TYPE(*) '%s' may be associated only with an"
-                    " assumed-TYPE(*) %s"_err_en_US,
+                    "Assumed-type '%s' may be associated only with an assumed-type %s"_err_en_US,
                     assumed.name(), dummyName);
               } else if (const auto *details{
                              assumed.detailsIf<ObjectEntityDetails>()}) {
                 if (!(details->IsAssumedShape() || details->IsAssumedRank())) {
                   messages.Say(  // C711
-                      "Assumed-type TYPE(*) '%s' must be either assumed "
-                      "shape or assumed rank to be associated with TYPE(*) "
-                      "%s"_err_en_US,
+                      "Assumed-type '%s' must be either assumed shape or assumed rank to be associated with assumed-type %s"_err_en_US,
                       assumed.name(), dummyName);
                 }
               }

flang/runtime/CMakeLists.txt

@@ -12,25 +12,27 @@ add_library(FortranRuntime
   connection.cpp
   derived-type.cpp
   descriptor.cpp
+  edit-input.cpp
+  edit-output.cpp
   environment.cpp
   file.cpp
   format.cpp
   internal-unit.cpp
+  iostat.cpp
   io-api.cpp
   io-error.cpp
   io-stmt.cpp
   main.cpp
   memory.cpp
-  numeric-output.cpp
   stop.cpp
   terminator.cpp
   tools.cpp
   transformational.cpp
   type-code.cpp
   unit.cpp
+  unit-map.cpp
 )
 
 target_link_libraries(FortranRuntime
-  FortranCommon
   FortranDecimal
 )

flang/runtime/ISO_Fortran_binding.cpp

@@ -11,6 +11,7 @@
 
 #include "../include/flang/ISO_Fortran_binding.h"
 #include "descriptor.h"
+#include <cstdlib>
 
 namespace Fortran::ISO {
 extern "C" {
@@ -75,7 +76,7 @@ int CFI_allocate(CFI_cdesc_t *descriptor, const CFI_index_t lower_bounds[],
     dim->sm = byteSize;
     byteSize *= extent;
   }
-  void *p{new char[byteSize]};
+  void *p{std::malloc(byteSize)};
   if (!p) {
     return CFI_ERROR_MEM_ALLOCATION;
   }
@@ -99,7 +100,7 @@ int CFI_deallocate(CFI_cdesc_t *descriptor) {
   if (!descriptor->base_addr) {
     return CFI_ERROR_BASE_ADDR_NULL;
   }
-  delete[] static_cast<char *>(descriptor->base_addr);
+  std::free(descriptor->base_addr);
   descriptor->base_addr = nullptr;
   return CFI_SUCCESS;
 }

flang/runtime/buffer.h

@@ -43,6 +43,7 @@ public:
   std::size_t FrameLength() const {
     return std::min<std::size_t>(length_ - frame_, size_ - (start_ + frame_));
   }
+  std::size_t BytesBufferedBeforeFrame() const { return frame_ - start_; }
 
   // Returns a short frame at a non-fatal EOF.  Can return a long frame as well.
   std::size_t ReadFrame(
@@ -52,10 +53,10 @@ public:
     if (at < fileOffset_ || at > fileOffset_ + length_) {
       Reset(at);
     }
-    frame_ = static_cast<std::size_t>(at - fileOffset_);
-    if (start_ + frame_ + bytes > size_) {
+    frame_ = at - fileOffset_;
+    if (static_cast<std::int64_t>(start_ + frame_ + bytes) > size_) {
       DiscardLeadingBytes(frame_, handler);
-      if (start_ + bytes > size_) {
+      if (static_cast<std::int64_t>(start_ + bytes) > size_) {
         // Frame would wrap around; shift current data (if any) to force
         // contiguity.
         RUNTIME_CHECK(handler, length_ < size_);
@@ -90,7 +91,8 @@ public:
 
   void WriteFrame(FileOffset at, std::size_t bytes, IoErrorHandler &handler) {
     if (!dirty_ || at < fileOffset_ || at > fileOffset_ + length_ ||
-        start_ + (at - fileOffset_) + bytes > size_) {
+        start_ + (at - fileOffset_) + static_cast<std::int64_t>(bytes) >
+            size_) {
       Flush(handler);
       fileOffset_ = at;
       Reallocate(bytes, handler);
@@ -120,11 +122,11 @@ public:
 private:
   STORE &Store() { return static_cast<STORE &>(*this); }
 
-  void Reallocate(std::size_t bytes, const Terminator &terminator) {
+  void Reallocate(std::int64_t bytes, const Terminator &terminator) {
     if (bytes > size_) {
       char *old{buffer_};
       auto oldSize{size_};
-      size_ = std::max(bytes, minBuffer);
+      size_ = std::max<std::int64_t>(bytes, minBuffer);
       buffer_ =
           reinterpret_cast<char *>(AllocateMemoryOrCrash(terminator, size_));
       auto chunk{std::min<std::int64_t>(length_, oldSize - start_)};
@@ -141,7 +143,7 @@ private:
     dirty_ = false;
   }
 
-  void DiscardLeadingBytes(std::size_t n, const Terminator &terminator) {
+  void DiscardLeadingBytes(std::int64_t n, const Terminator &terminator) {
     RUNTIME_CHECK(terminator, length_ >= n);
     length_ -= n;
     if (length_ == 0) {
@@ -163,7 +165,7 @@ private:
   static constexpr std::size_t minBuffer{64 << 10};
 
   char *buffer_{nullptr};
-  std::size_t size_{0};  // current allocated buffer size
+  std::int64_t size_{0};  // current allocated buffer size
   FileOffset fileOffset_{0};  // file offset corresponding to buffer valid data
   std::int64_t start_{0};  // buffer_[] offset of valid data
   std::int64_t length_{0};  // valid data length (can wrap)

flang/runtime/connection.cpp

@@ -12,8 +12,20 @@
 namespace Fortran::runtime::io {
 
 std::size_t ConnectionState::RemainingSpaceInRecord() const {
-  return recordLength.value_or(
-             executionEnvironment.listDirectedOutputLineLengthLimit) -
-      positionInRecord;
+  auto recl{recordLength.value_or(
+      executionEnvironment.listDirectedOutputLineLengthLimit)};
+  return positionInRecord >= recl ? 0 : recl - positionInRecord;
+}
+
+bool ConnectionState::IsAtEOF() const {
+  return endfileRecordNumber && currentRecordNumber >= *endfileRecordNumber;
+}
+
+void ConnectionState::HandleAbsolutePosition(std::int64_t n) {
+  positionInRecord = std::max(n, std::int64_t{0}) + leftTabLimit.value_or(0);
+}
+
+void ConnectionState::HandleRelativePosition(std::int64_t n) {
+  positionInRecord = std::max(leftTabLimit.value_or(0), positionInRecord + n);
 }
 }

flang/runtime/connection.h

@@ -6,7 +6,7 @@
 //
 //===----------------------------------------------------------------------===//
 
-// Fortran I/O connection state (internal & external)
+// Fortran I/O connection state (abstracted over internal & external units)
 
 #ifndef FORTRAN_RUNTIME_IO_CONNECTION_H_
 #define FORTRAN_RUNTIME_IO_CONNECTION_H_
@@ -17,6 +17,7 @@
 
 namespace Fortran::runtime::io {
 
+enum class Direction { Output, Input };
 enum class Access { Sequential, Direct, Stream };
 
 inline bool IsRecordFile(Access a) { return a != Access::Stream; }
@@ -25,24 +26,30 @@ inline bool IsRecordFile(Access a) { return a != Access::Stream; }
 // established in an OPEN statement.
 struct ConnectionAttributes {
   Access access{Access::Sequential};  // ACCESS='SEQUENTIAL', 'DIRECT', 'STREAM'
-  std::optional<std::size_t> recordLength;  // RECL= when fixed-length
+  std::optional<std::int64_t> recordLength;  // RECL= when fixed-length
   bool isUnformatted{false};  // FORM='UNFORMATTED'
   bool isUTF8{false};  // ENCODING='UTF-8'
 };
 
 struct ConnectionState : public ConnectionAttributes {
+  bool IsAtEOF() const;  // true when read has hit EOF or endfile record
   std::size_t RemainingSpaceInRecord() const;
-  // Positions in a record file (sequential or direct, but not stream)
-  std::int64_t recordOffsetInFile{0};
+  void HandleAbsolutePosition(std::int64_t);
+  void HandleRelativePosition(std::int64_t);
+
+  // Positions in a record file (sequential or direct, not stream)
   std::int64_t currentRecordNumber{1};  // 1 is first
   std::int64_t positionInRecord{0};  // offset in current record
   std::int64_t furthestPositionInRecord{0};  // max(positionInRecord)
   bool nonAdvancing{false};  // ADVANCE='NO'
+
   // Set at end of non-advancing I/O data transfer
   std::optional<std::int64_t> leftTabLimit;  // offset in current record
+
   // currentRecordNumber value captured after ENDFILE/REWIND/BACKSPACE statement
-  // on a sequential access file
+  // or an end-of-file READ condition on a sequential access file
   std::optional<std::int64_t> endfileRecordNumber;
+
   // Mutable modes set at OPEN() that can be overridden in READ/WRITE & FORMAT
   MutableModes modes;  // BLANK=, DECIMAL=, SIGN=, ROUND=, PAD=, DELIM=, kP
 };

flang/runtime/descriptor.cpp

@@ -7,7 +7,8 @@
 //===----------------------------------------------------------------------===//
 
 #include "descriptor.h"
-#include "flang/Common/idioms.h"
+#include "memory.h"
+#include "terminator.h"
 #include <cassert>
 #include <cstdlib>
 #include <cstring>
@@ -27,11 +28,13 @@ Descriptor::~Descriptor() {
 void Descriptor::Establish(TypeCode t, std::size_t elementBytes, void *p,
     int rank, const SubscriptValue *extent, ISO::CFI_attribute_t attribute,
     bool addendum) {
-  CHECK(ISO::CFI_establish(&raw_, p, attribute, t.raw(), elementBytes, rank,
-            extent) == CFI_SUCCESS);
+  Terminator terminator{__FILE__, __LINE__};
+  RUNTIME_CHECK(terminator,
+      ISO::CFI_establish(&raw_, p, attribute, t.raw(), elementBytes, rank,
+          extent) == CFI_SUCCESS);
   raw_.f18Addendum = addendum;
   DescriptorAddendum *a{Addendum()};
-  CHECK(addendum == (a != nullptr));
+  RUNTIME_CHECK(terminator, addendum == (a != nullptr));
   if (a) {
     new (a) DescriptorAddendum{};
   }
@@ -44,11 +47,13 @@ void Descriptor::Establish(TypeCategory c, int kind, void *p, int rank,
   if (c == TypeCategory::Complex) {
     elementBytes *= 2;
   }
-  CHECK(ISO::CFI_establish(&raw_, p, attribute, TypeCode(c, kind).raw(),
-            elementBytes, rank, extent) == CFI_SUCCESS);
+  Terminator terminator{__FILE__, __LINE__};
+  RUNTIME_CHECK(terminator,
+      ISO::CFI_establish(&raw_, p, attribute, TypeCode(c, kind).raw(),
+          elementBytes, rank, extent) == CFI_SUCCESS);
   raw_.f18Addendum = addendum;
   DescriptorAddendum *a{Addendum()};
-  CHECK(addendum == (a != nullptr));
+  RUNTIME_CHECK(terminator, addendum == (a != nullptr));
   if (a) {
     new (a) DescriptorAddendum{};
   }
@@ -56,41 +61,45 @@ void Descriptor::Establish(TypeCategory c, int kind, void *p, int rank,
 
 void Descriptor::Establish(const DerivedType &dt, void *p, int rank,
     const SubscriptValue *extent, ISO::CFI_attribute_t attribute) {
-  CHECK(ISO::CFI_establish(&raw_, p, attribute, CFI_type_struct,
-            dt.SizeInBytes(), rank, extent) == CFI_SUCCESS);
+  Terminator terminator{__FILE__, __LINE__};
+  RUNTIME_CHECK(terminator,
+      ISO::CFI_establish(&raw_, p, attribute, CFI_type_struct, dt.SizeInBytes(),
+          rank, extent) == CFI_SUCCESS);
   raw_.f18Addendum = true;
   DescriptorAddendum *a{Addendum()};
-  CHECK(a);
+  RUNTIME_CHECK(terminator, a);
   new (a) DescriptorAddendum{&dt};
 }
 
-std::unique_ptr<Descriptor> Descriptor::Create(TypeCode t,
-    std::size_t elementBytes, void *p, int rank, const SubscriptValue *extent,
-    ISO::CFI_attribute_t attribute) {
-  std::size_t bytes{SizeInBytes(rank, true)};
-  Descriptor *result{reinterpret_cast<Descriptor *>(new char[bytes])};
-  CHECK(result);
-  result->Establish(t, elementBytes, p, rank, extent, attribute, true);
-  return std::unique_ptr<Descriptor>{result};
-}
-
-std::unique_ptr<Descriptor> Descriptor::Create(TypeCategory c, int kind,
+OwningPtr<Descriptor> Descriptor::Create(TypeCode t, std::size_t elementBytes,
     void *p, int rank, const SubscriptValue *extent,
     ISO::CFI_attribute_t attribute) {
   std::size_t bytes{SizeInBytes(rank, true)};
-  Descriptor *result{reinterpret_cast<Descriptor *>(new char[bytes])};
-  CHECK(result);
-  result->Establish(c, kind, p, rank, extent, attribute, true);
-  return std::unique_ptr<Descriptor>{result};
+  Terminator terminator{__FILE__, __LINE__};
+  Descriptor *result{
+      reinterpret_cast<Descriptor *>(AllocateMemoryOrCrash(terminator, bytes))};
+  result->Establish(t, elementBytes, p, rank, extent, attribute, true);
+  return OwningPtr<Descriptor>{result};
 }
 
-std::unique_ptr<Descriptor> Descriptor::Create(const DerivedType &dt, void *p,
+OwningPtr<Descriptor> Descriptor::Create(TypeCategory c, int kind, void *p,
+    int rank, const SubscriptValue *extent, ISO::CFI_attribute_t attribute) {
+  std::size_t bytes{SizeInBytes(rank, true)};
+  Terminator terminator{__FILE__, __LINE__};
+  Descriptor *result{
+      reinterpret_cast<Descriptor *>(AllocateMemoryOrCrash(terminator, bytes))};
+  result->Establish(c, kind, p, rank, extent, attribute, true);
+  return OwningPtr<Descriptor>{result};
+}
+
+OwningPtr<Descriptor> Descriptor::Create(const DerivedType &dt, void *p,
     int rank, const SubscriptValue *extent, ISO::CFI_attribute_t attribute) {
   std::size_t bytes{SizeInBytes(rank, true, dt.lenParameters())};
-  Descriptor *result{reinterpret_cast<Descriptor *>(new char[bytes])};
-  CHECK(result);
+  Terminator terminator{__FILE__, __LINE__};
+  Descriptor *result{
+      reinterpret_cast<Descriptor *>(AllocateMemoryOrCrash(terminator, bytes))};
   result->Establish(dt, p, rank, extent, attribute);
-  return std::unique_ptr<Descriptor>{result};
+  return OwningPtr<Descriptor>{result};
 }
 
 std::size_t Descriptor::SizeInBytes() const {
@@ -141,42 +150,103 @@ void Descriptor::Destroy(char *data, bool finalize) const {
   }
 }
 
+bool Descriptor::IncrementSubscripts(
+    SubscriptValue *subscript, const int *permutation) const {
+  for (int j{0}; j < raw_.rank; ++j) {
+    int k{permutation ? permutation[j] : j};
+    const Dimension &dim{GetDimension(k)};
+    if (subscript[k]++ < dim.UpperBound()) {
+      return true;
+    }
+    subscript[k] = dim.LowerBound();
+  }
+  return false;
+}
+
+bool Descriptor::DecrementSubscripts(
+    SubscriptValue *subscript, const int *permutation) const {
+  for (int j{raw_.rank - 1}; j >= 0; --j) {
+    int k{permutation ? permutation[j] : j};
+    const Dimension &dim{GetDimension(k)};
+    if (--subscript[k] >= dim.LowerBound()) {
+      return true;
+    }
+    subscript[k] = dim.UpperBound();
+  }
+  return false;
+}
+
+std::size_t Descriptor::ZeroBasedElementNumber(
+    const SubscriptValue *subscript, const int *permutation) const {
+  std::size_t result{0};
+  std::size_t coefficient{1};
+  for (int j{0}; j < raw_.rank; ++j) {
+    int k{permutation ? permutation[j] : j};
+    const Dimension &dim{GetDimension(k)};
+    result += coefficient * (subscript[k] - dim.LowerBound());
+    coefficient *= dim.Extent();
+  }
+  return result;
+}
+
+bool Descriptor::SubscriptsForZeroBasedElementNumber(SubscriptValue *subscript,
+    std::size_t elementNumber, const int *permutation) const {
+  std::size_t coefficient{1};
+  std::size_t dimCoefficient[maxRank];
+  for (int j{0}; j < raw_.rank; ++j) {
+    int k{permutation ? permutation[j] : j};
+    const Dimension &dim{GetDimension(k)};
+    dimCoefficient[j] = coefficient;
+    coefficient *= dim.Extent();
+  }
+  if (elementNumber >= coefficient) {
+    return false;  // out of range
+  }
+  for (int j{raw_.rank - 1}; j >= 0; --j) {
+    int k{permutation ? permutation[j] : j};
+    const Dimension &dim{GetDimension(k)};
+    std::size_t quotient{j ? elementNumber / dimCoefficient[j] : 0};
+    subscript[k] =
+        dim.LowerBound() + elementNumber - dimCoefficient[j] * quotient;
+    elementNumber = quotient;
+  }
+  return true;
+}
+
 void Descriptor::Check() const {
   // TODO
 }
 
-std::ostream &Descriptor::Dump(std::ostream &o) const {
-  o << "Descriptor @ 0x" << std::hex << reinterpret_cast<std::intptr_t>(this)
-    << std::dec << ":\n";
-  o << "  base_addr 0x" << std::hex
-    << reinterpret_cast<std::intptr_t>(raw_.base_addr) << std::dec << '\n';
-  o << "  elem_len  " << raw_.elem_len << '\n';
-  o << "  version   " << raw_.version
-    << (raw_.version == CFI_VERSION ? "(ok)" : "BAD!") << '\n';
-  o << "  rank      " << static_cast<int>(raw_.rank) << '\n';
-  o << "  type      " << static_cast<int>(raw_.type) << '\n';
-  o << "  attribute " << static_cast<int>(raw_.attribute) << '\n';
-  o << "  addendum? " << static_cast<bool>(raw_.f18Addendum) << '\n';
+void Descriptor::Dump(FILE *f) const {
+  std::fprintf(f, "Descriptor @ %p:\n", reinterpret_cast<const void *>(this));
+  std::fprintf(f, "  base_addr %p\n", raw_.base_addr);
+  std::fprintf(f, "  elem_len  %zd\n", static_cast<std::size_t>(raw_.elem_len));
+  std::fprintf(f, "  version   %d\n", static_cast<int>(raw_.version));
+  std::fprintf(f, "  rank      %d\n", static_cast<int>(raw_.rank));
+  std::fprintf(f, "  type      %d\n", static_cast<int>(raw_.type));
+  std::fprintf(f, "  attribute %d\n", static_cast<int>(raw_.attribute));
+  std::fprintf(f, "  addendum  %d\n", static_cast<int>(raw_.f18Addendum));
   for (int j{0}; j < raw_.rank; ++j) {
-    o << "  dim[" << j << "] lower_bound " << raw_.dim[j].lower_bound << '\n';
-    o << "         extent      " << raw_.dim[j].extent << '\n';
-    o << "         sm          " << raw_.dim[j].sm << '\n';
+    std::fprintf(f, "  dim[%d] lower_bound %jd\n", j,
+        static_cast<std::intmax_t>(raw_.dim[j].lower_bound));
+    std::fprintf(f, "         extent      %jd\n",
+        static_cast<std::intmax_t>(raw_.dim[j].extent));
+    std::fprintf(f, "         sm          %jd\n",
+        static_cast<std::intmax_t>(raw_.dim[j].sm));
   }
   if (const DescriptorAddendum * addendum{Addendum()}) {
-    addendum->Dump(o);
+    addendum->Dump(f);
   }
-  return o;
 }
 
 std::size_t DescriptorAddendum::SizeInBytes() const {
   return SizeInBytes(LenParameters());
 }
 
-std::ostream &DescriptorAddendum::Dump(std::ostream &o) const {
-  o << "  derivedType @ 0x" << std::hex
-    << reinterpret_cast<std::intptr_t>(derivedType_) << std::dec << '\n';
-  o << "  flags         " << flags_ << '\n';
+void DescriptorAddendum::Dump(FILE *f) const {
+  std::fprintf(
+      f, "  derivedType @ %p\n", reinterpret_cast<const void *>(derivedType_));
+  std::fprintf(f, "  flags 0x%jx\n", static_cast<std::intmax_t>(flags_));
   // TODO: LEN parameter values
-  return o;
 }
 }

flang/runtime/descriptor.h

@@ -19,14 +19,14 @@
 // but should never reference this internal header.
 
 #include "derived-type.h"
+#include "memory.h"
 #include "type-code.h"
 #include "flang/ISO_Fortran_binding.h"
 #include <cassert>
 #include <cinttypes>
 #include <cstddef>
+#include <cstdio>
 #include <cstring>
-#include <memory>
-#include <ostream>
 
 namespace Fortran::runtime {
 
@@ -93,7 +93,7 @@ public:
     len_[which] = x;
   }
 
-  std::ostream &Dump(std::ostream &) const;
+  void Dump(FILE * = stdout) const;
 
 private:
   const DerivedType *derivedType_{nullptr};
@@ -141,17 +141,15 @@ public:
       const SubscriptValue *extent = nullptr,
       ISO::CFI_attribute_t attribute = CFI_attribute_other);
 
-  static std::unique_ptr<Descriptor> Create(TypeCode t,
-      std::size_t elementBytes, void *p = nullptr, int rank = maxRank,
-      const SubscriptValue *extent = nullptr,
-      ISO::CFI_attribute_t attribute = CFI_attribute_other);
-  static std::unique_ptr<Descriptor> Create(TypeCategory, int kind,
+  static OwningPtr<Descriptor> Create(TypeCode t, std::size_t elementBytes,
       void *p = nullptr, int rank = maxRank,
       const SubscriptValue *extent = nullptr,
       ISO::CFI_attribute_t attribute = CFI_attribute_other);
-  static std::unique_ptr<Descriptor> Create(const DerivedType &dt,
-      void *p = nullptr, int rank = maxRank,
-      const SubscriptValue *extent = nullptr,
+  static OwningPtr<Descriptor> Create(TypeCategory, int kind, void *p = nullptr,
+      int rank = maxRank, const SubscriptValue *extent = nullptr,
+      ISO::CFI_attribute_t attribute = CFI_attribute_other);
+  static OwningPtr<Descriptor> Create(const DerivedType &dt, void *p = nullptr,
+      int rank = maxRank, const SubscriptValue *extent = nullptr,
       ISO::CFI_attribute_t attribute = CFI_attribute_other);
 
   ISO::CFI_cdesc_t &raw() { return raw_; }
@@ -192,13 +190,21 @@ public:
     return offset;
   }
 
-  template<typename A> A *Element(std::size_t offset) const {
+  template<typename A> A *OffsetElement(std::size_t offset) const {
     return reinterpret_cast<A *>(
         reinterpret_cast<char *>(raw_.base_addr) + offset);
   }
 
   template<typename A> A *Element(const SubscriptValue *subscript) const {
-    return Element<A>(SubscriptsToByteOffset(subscript));
+    return OffsetElement<A>(SubscriptsToByteOffset(subscript));
+  }
+
+  template<typename A> A *ZeroBasedIndexedElement(std::size_t n) const {
+    SubscriptValue at[maxRank];
+    if (SubscriptsForZeroBasedElementNumber(at, n)) {
+      return Element<A>(at);
+    }
+    return nullptr;
   }
 
   void GetLowerBounds(SubscriptValue *subscript) const {
@@ -207,17 +213,18 @@ public:
     }
   }
 
-  void IncrementSubscripts(
-      SubscriptValue *subscript, const int *permutation = nullptr) const {
-    for (int j{0}; j < raw_.rank; ++j) {
-      int k{permutation ? permutation[j] : j};
-      const Dimension &dim{GetDimension(k)};
-      if (subscript[k]++ < dim.UpperBound()) {
-        break;
-      }
-      subscript[k] = dim.LowerBound();
-    }
-  }
+  // When the passed subscript vector contains the last (or first)
+  // subscripts of the array, these wrap the subscripts around to
+  // their first (or last) values and return false.
+  bool IncrementSubscripts(
+      SubscriptValue *, const int *permutation = nullptr) const;
+  bool DecrementSubscripts(
+      SubscriptValue *, const int *permutation = nullptr) const;
+  // False when out of range.
+  bool SubscriptsForZeroBasedElementNumber(SubscriptValue *,
+      std::size_t elementNumber, const int *permutation = nullptr) const;
+  std::size_t ZeroBasedElementNumber(
+      const SubscriptValue *, const int *permutation = nullptr) const;
 
   DescriptorAddendum *Addendum() {
     if (raw_.f18Addendum != 0) {
@@ -270,7 +277,7 @@ public:
 
   // TODO: creation of array sections
 
-  std::ostream &Dump(std::ostream &) const;
+  void Dump(FILE * = stdout) const;
 
 private:
   ISO::CFI_cdesc_t raw_;

flang/runtime/edit-input.cpp

@@ -0,0 +1,428 @@
+//===-- runtime/edit-input.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 "edit-input.h"
+#include "flang/Common/real.h"
+#include "flang/Common/uint128.h"
+
+namespace Fortran::runtime::io {
+
+static bool EditBOZInput(IoStatementState &io, const DataEdit &edit, void *n,
+    int base, int totalBitSize) {
+  std::optional<int> remaining;
+  if (edit.width) {
+    remaining = std::max(0, *edit.width);
+  }
+  io.SkipSpaces(remaining);
+  std::optional<char32_t> next{io.NextInField(remaining)};
+  common::UnsignedInt128 value{0};
+  for (; next; next = io.NextInField(remaining)) {
+    char32_t ch{*next};
+    if (ch == ' ') {
+      continue;
+    }
+    int digit{0};
+    if (ch >= '0' && ch <= '1') {
+      digit = ch - '0';
+    } else if (base >= 8 && ch >= '2' && ch <= '7') {
+      digit = ch - '0';
+    } else if (base >= 10 && ch >= '8' && ch <= '9') {
+      digit = ch - '0';
+    } else if (base == 16 && ch >= 'A' && ch <= 'Z') {
+      digit = ch + 10 - 'A';
+    } else if (base == 16 && ch >= 'a' && ch <= 'z') {
+      digit = ch + 10 - 'a';
+    } else {
+      io.GetIoErrorHandler().SignalError(
+          "Bad character '%lc' in B/O/Z input field", ch);
+      return false;
+    }
+    value *= base;
+    value += digit;
+  }
+  // TODO: check for overflow
+  std::memcpy(n, &value, totalBitSize >> 3);
+  return true;
+}
+
+// Returns false if there's a '-' sign
+static bool ScanNumericPrefix(IoStatementState &io, const DataEdit &edit,
+    std::optional<char32_t> &next, std::optional<int> &remaining) {
+  if (edit.descriptor != DataEdit::ListDirected && edit.width) {
+    remaining = std::max(0, *edit.width);
+  } else {
+    // list-directed, namelist, or (nonstandard) 0-width input editing
+    remaining.reset();
+  }
+  io.SkipSpaces(remaining);
+  next = io.NextInField(remaining);
+  bool negative{false};
+  if (next) {
+    negative = *next == '-';
+    if (negative || *next == '+') {
+      next = io.NextInField(remaining);
+    }
+  }
+  return negative;
+}
+
+bool EditIntegerInput(
+    IoStatementState &io, const DataEdit &edit, void *n, int kind) {
+  RUNTIME_CHECK(io.GetIoErrorHandler(), kind >= 1 && !(kind & (kind - 1)));
+  switch (edit.descriptor) {
+  case DataEdit::ListDirected:
+  case 'G':
+  case 'I': break;
+  case 'B': return EditBOZInput(io, edit, n, 2, kind << 3);
+  case 'O': return EditBOZInput(io, edit, n, 8, kind << 3);
+  case 'Z': return EditBOZInput(io, edit, n, 16, kind << 3);
+  default:
+    io.GetIoErrorHandler().SignalError(IostatErrorInFormat,
+        "Data edit descriptor '%c' may not be used with an INTEGER data item",
+        edit.descriptor);
+    return false;
+  }
+  std::optional<int> remaining;
+  std::optional<char32_t> next;
+  bool negate{ScanNumericPrefix(io, edit, next, remaining)};
+  common::UnsignedInt128 value;
+  for (; next; next = io.NextInField(remaining)) {
+    char32_t ch{*next};
+    if (ch == ' ') {
+      if (edit.modes.editingFlags & blankZero) {
+        ch = '0';  // BZ mode - treat blank as if it were zero
+      } else {
+        continue;
+      }
+    }
+    int digit{0};
+    if (ch >= '0' && ch <= '9') {
+      digit = ch - '0';
+    } else {
+      io.GetIoErrorHandler().SignalError(
+          "Bad character '%lc' in INTEGER input field", ch);
+      return false;
+    }
+    value *= 10;
+    value += digit;
+  }
+  if (negate) {
+    value = -value;
+  }
+  std::memcpy(n, &value, kind);
+  return true;
+}
+
+static int ScanRealInput(char *buffer, int bufferSize, IoStatementState &io,
+    const DataEdit &edit, int &exponent) {
+  std::optional<int> remaining;
+  std::optional<char32_t> next;
+  int got{0};
+  std::optional<int> decimalPoint;
+  if (ScanNumericPrefix(io, edit, next, remaining) && next) {
+    if (got < bufferSize) {
+      buffer[got++] = '-';
+    }
+  }
+  if (!next) {  // empty field means zero
+    if (got < bufferSize) {
+      buffer[got++] = '0';
+    }
+    return got;
+  }
+  if (got < bufferSize) {
+    buffer[got++] = '.';  // input field is normalized to a fraction
+  }
+  char32_t decimal = edit.modes.editingFlags & decimalComma ? ',' : '.';
+  auto start{got};
+  if ((*next >= 'a' && *next <= 'z') || (*next >= 'A' && *next <= 'Z')) {
+    // NaN or infinity - convert to upper case
+    for (; next &&
+         ((*next >= 'a' && *next <= 'z') || (*next >= 'A' && *next <= 'Z'));
+         next = io.NextInField(remaining)) {
+      if (got < bufferSize) {
+        if (*next >= 'a' && *next <= 'z') {
+          buffer[got++] = *next - 'a' + 'A';
+        } else {
+          buffer[got++] = *next;
+        }
+      }
+    }
+    if (next && *next == '(') {  // NaN(...)
+      while (next && *next != ')') {
+        next = io.NextInField(remaining);
+      }
+    }
+    exponent = 0;
+  } else if (*next == decimal || (*next >= '0' && *next <= '9')) {
+    for (; next; next = io.NextInField(remaining)) {
+      char32_t ch{*next};
+      if (ch == ' ') {
+        if (edit.modes.editingFlags & blankZero) {
+          ch = '0';  // BZ mode - treat blank as if it were zero
+        } else {
+          continue;
+        }
+      }
+      if (ch == '0' && got == start) {
+        // omit leading zeroes
+      } else if (ch >= '0' && ch <= '9') {
+        if (got < bufferSize) {
+          buffer[got++] = ch;
+        }
+      } else if (ch == decimal && !decimalPoint) {
+        // the decimal point is *not* copied to the buffer
+        decimalPoint = got - start;  // # of digits before the decimal point
+      } else {
+        break;
+      }
+    }
+    if (got == start && got < bufferSize) {
+      buffer[got++] = '0';  // all digits were zeroes
+    }
+    if (next &&
+        (*next == 'e' || *next == 'E' || *next == 'd' || *next == 'D' ||
+            *next == 'q' || *next == 'Q')) {
+      io.SkipSpaces(remaining);
+      next = io.NextInField(remaining);
+    }
+    exponent = -edit.modes.scale;  // default exponent is -kP
+    if (next &&
+        (*next == '-' || *next == '+' || (*next >= '0' && *next <= '9'))) {
+      bool negExpo{*next == '-'};
+      if (negExpo || *next == '+') {
+        next = io.NextInField(remaining);
+      }
+      for (exponent = 0; next && (*next >= '0' && *next <= '9');
+           next = io.NextInField(remaining)) {
+        exponent = 10 * exponent + *next - '0';
+      }
+      if (negExpo) {
+        exponent = -exponent;
+      }
+    }
+    if (decimalPoint) {
+      exponent += *decimalPoint;
+    } else {
+      // When no decimal point (or comma) appears in the value, the 'd'
+      // part of the edit descriptor must be interpreted as the number of
+      // digits in the value to be interpreted as being to the *right* of
+      // the assumed decimal point (13.7.2.3.2)
+      exponent += got - start - edit.digits.value_or(0);
+    }
+  } else {
+    // TODO: hex FP input
+    exponent = 0;
+    return 0;
+  }
+  if (remaining) {
+    while (next && *next == ' ') {
+      next = io.NextInField(remaining);
+    }
+    if (next) {
+      return 0;  // error: unused nonblank character in fixed-width field
+    }
+  }
+  return got;
+}
+
+template<int binaryPrecision>
+bool EditCommonRealInput(IoStatementState &io, const DataEdit &edit, void *n) {
+  static constexpr int maxDigits{
+      common::MaxDecimalConversionDigits(binaryPrecision)};
+  static constexpr int bufferSize{maxDigits + 18};
+  char buffer[bufferSize];
+  int exponent{0};
+  int got{ScanRealInput(buffer, maxDigits + 2, io, edit, exponent)};
+  if (got >= maxDigits + 2) {
+    io.GetIoErrorHandler().Crash("EditRealInput: buffer was too small");
+    return false;
+  }
+  if (got == 0) {
+    io.GetIoErrorHandler().SignalError("Bad REAL input value");
+    return false;
+  }
+  bool hadExtra{got > maxDigits};
+  if (exponent != 0) {
+    got += std::snprintf(&buffer[got], bufferSize - got, "e%d", exponent);
+  }
+  buffer[got] = '\0';
+  const char *p{buffer};
+  decimal::ConversionToBinaryResult<binaryPrecision> converted{
+      decimal::ConvertToBinary<binaryPrecision>(p, edit.modes.round)};
+  if (hadExtra) {
+    converted.flags = static_cast<enum decimal::ConversionResultFlags>(
+        converted.flags | decimal::Inexact);
+  }
+  // TODO: raise converted.flags as exceptions?
+  *reinterpret_cast<decimal::BinaryFloatingPointNumber<binaryPrecision> *>(n) =
+      converted.binary;
+  return true;
+}
+
+template<int binaryPrecision>
+bool EditRealInput(IoStatementState &io, const DataEdit &edit, void *n) {
+  switch (edit.descriptor) {
+  case DataEdit::ListDirected:
+  case 'F':
+  case 'E':  // incl. EN, ES, & EX
+  case 'D':
+  case 'G': return EditCommonRealInput<binaryPrecision>(io, edit, n);
+  case 'B':
+    return EditBOZInput(
+        io, edit, n, 2, common::BitsForBinaryPrecision(binaryPrecision));
+  case 'O':
+    return EditBOZInput(
+        io, edit, n, 8, common::BitsForBinaryPrecision(binaryPrecision));
+  case 'Z':
+    return EditBOZInput(
+        io, edit, n, 16, common::BitsForBinaryPrecision(binaryPrecision));
+  default:
+    io.GetIoErrorHandler().SignalError(IostatErrorInFormat,
+        "Data edit descriptor '%c' may not be used for REAL input",
+        edit.descriptor);
+    return false;
+  }
+}
+
+// 13.7.3 in Fortran 2018
+bool EditLogicalInput(IoStatementState &io, const DataEdit &edit, bool &x) {
+  switch (edit.descriptor) {
+  case DataEdit::ListDirected:
+  case 'L':
+  case 'G': break;
+  default:
+    io.GetIoErrorHandler().SignalError(IostatErrorInFormat,
+        "Data edit descriptor '%c' may not be used for LOGICAL input",
+        edit.descriptor);
+    return false;
+  }
+  std::optional<int> remaining;
+  if (edit.width) {
+    remaining = std::max(0, *edit.width);
+  }
+  io.SkipSpaces(remaining);
+  std::optional<char32_t> next{io.NextInField(remaining)};
+  if (next && *next == '.') {  // skip optional period
+    next = io.NextInField(remaining);
+  }
+  if (!next) {
+    io.GetIoErrorHandler().SignalError("Empty LOGICAL input field");
+    return false;
+  }
+  switch (*next) {
+  case 'T':
+  case 't': x = true; break;
+  case 'F':
+  case 'f': x = false; break;
+  default:
+    io.GetIoErrorHandler().SignalError(
+        "Bad character '%lc' in LOGICAL input field", *next);
+    return false;
+  }
+  if (remaining) {  // ignore the rest of the field
+    io.HandleRelativePosition(*remaining);
+  }
+  return true;
+}
+
+// See 13.10.3.1 paragraphs 7-9 in Fortran 2018
+static bool EditDelimitedCharacterInput(
+    IoStatementState &io, char *x, std::size_t length, char32_t delimiter) {
+  while (true) {
+    if (auto ch{io.GetCurrentChar()}) {
+      io.HandleRelativePosition(1);
+      if (*ch == delimiter) {
+        ch = io.GetCurrentChar();
+        if (ch && *ch == delimiter) {
+          // Repeated delimiter: use as character value.  Can't straddle a
+          // record boundary.
+          io.HandleRelativePosition(1);
+        } else {
+          std::fill_n(x, length, ' ');
+          return true;
+        }
+      }
+      if (length > 0) {
+        *x++ = *ch;
+        --length;
+      }
+    } else if (!io.AdvanceRecord()) {  // EOF
+      std::fill_n(x, length, ' ');
+      return false;
+    }
+  }
+}
+
+static bool EditListDirectedDefaultCharacterInput(
+    IoStatementState &io, char *x, std::size_t length) {
+  auto ch{io.GetCurrentChar()};
+  if (ch && (*ch == '\'' || *ch == '"')) {
+    io.HandleRelativePosition(1);
+    return EditDelimitedCharacterInput(io, x, length, *ch);
+  }
+  // Undelimited list-directed character input: stop at a value separator
+  // or the end of the current record.
+  std::optional<int> remaining{length};
+  for (std::optional<char32_t> next{io.NextInField(remaining)}; next;
+       next = io.NextInField(remaining)) {
+    switch (*next) {
+    case ' ':
+    case ',':
+    case ';':
+    case '/':
+      remaining = 0;  // value separator: stop
+      break;
+    default: *x++ = *next; --length;
+    }
+  }
+  std::fill_n(x, length, ' ');
+  return true;
+}
+
+bool EditDefaultCharacterInput(
+    IoStatementState &io, const DataEdit &edit, char *x, std::size_t length) {
+  switch (edit.descriptor) {
+  case DataEdit::ListDirected:
+    return EditListDirectedDefaultCharacterInput(io, x, length);
+  case 'A':
+  case 'G': break;
+  default:
+    io.GetIoErrorHandler().SignalError(IostatErrorInFormat,
+        "Data edit descriptor '%c' may not be used with a CHARACTER data item",
+        edit.descriptor);
+    return false;
+  }
+  std::optional<int> remaining{length};
+  if (edit.width && *edit.width > 0) {
+    remaining = *edit.width;
+  }
+  // When the field is wider than the variable, we drop the leading
+  // characters.  When the variable is wider than the field, there's
+  // trailing padding.
+  std::int64_t skip{*remaining - static_cast<std::int64_t>(length)};
+  for (std::optional<char32_t> next{io.NextInField(remaining)}; next;
+       next = io.NextInField(remaining)) {
+    if (skip > 0) {
+      --skip;
+    } else {
+      *x++ = *next;
+      --length;
+    }
+  }
+  std::fill_n(x, length, ' ');
+  return true;
+}
+
+template bool EditRealInput<8>(IoStatementState &, const DataEdit &, void *);
+template bool EditRealInput<11>(IoStatementState &, const DataEdit &, void *);
+template bool EditRealInput<24>(IoStatementState &, const DataEdit &, void *);
+template bool EditRealInput<53>(IoStatementState &, const DataEdit &, void *);
+template bool EditRealInput<64>(IoStatementState &, const DataEdit &, void *);
+template bool EditRealInput<113>(IoStatementState &, const DataEdit &, void *);
+}

flang/runtime/edit-input.h

@@ -0,0 +1,40 @@
+//===-- runtime/edit-input.h ------------------------------------*- 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
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_RUNTIME_EDIT_INPUT_H_
+#define FORTRAN_RUNTIME_EDIT_INPUT_H_
+
+#include "format.h"
+#include "io-stmt.h"
+#include "flang/Decimal/decimal.h"
+
+namespace Fortran::runtime::io {
+
+bool EditIntegerInput(IoStatementState &, const DataEdit &, void *, int kind);
+
+template<int binaryPrecision>
+bool EditRealInput(IoStatementState &, const DataEdit &, void *);
+
+bool EditLogicalInput(IoStatementState &, const DataEdit &, bool &);
+bool EditDefaultCharacterInput(
+    IoStatementState &, const DataEdit &, char *, std::size_t);
+
+extern template bool EditRealInput<8>(
+    IoStatementState &, const DataEdit &, void *);
+extern template bool EditRealInput<11>(
+    IoStatementState &, const DataEdit &, void *);
+extern template bool EditRealInput<24>(
+    IoStatementState &, const DataEdit &, void *);
+extern template bool EditRealInput<53>(
+    IoStatementState &, const DataEdit &, void *);
+extern template bool EditRealInput<64>(
+    IoStatementState &, const DataEdit &, void *);
+extern template bool EditRealInput<113>(
+    IoStatementState &, const DataEdit &, void *);
+}
+#endif  // FORTRAN_RUNTIME_EDIT_INPUT_H_

flang/runtime/edit-output.cpp

@@ -1,4 +1,4 @@
-//===-- runtime/numeric-output.h --------------------------------*- C++ -*-===//
+//===-- runtime/edit-output.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.
@@ -6,86 +6,155 @@
 //
 //===----------------------------------------------------------------------===//
 
-#ifndef FORTRAN_RUNTIME_NUMERIC_OUTPUT_H_
-#define FORTRAN_RUNTIME_NUMERIC_OUTPUT_H_
-
-// Output data editing templates implementing the FORMAT data editing
-// descriptors E, EN, ES, EX, D, F, and G for REAL data (and COMPLEX
-// components, I and G for INTEGER, and B/O/Z for both.
-// See subclauses in 13.7.2.3 of Fortran 2018 for the
-// detailed specifications of these descriptors.
-// List-directed output (13.10.4) for numeric types is also done here.
-// Drives the same fast binary-to-decimal formatting templates used
-// in the f18 front-end.
-
-#include "format.h"
-#include "io-stmt.h"
-#include "flang/Decimal/decimal.h"
+#include "edit-output.h"
+#include "flang/Common/uint128.h"
+#include "flang/Common/unsigned-const-division.h"
 
 namespace Fortran::runtime::io {
 
-class IoStatementState;
-
-// I, B, O, Z, and G output editing for INTEGER.
-// edit is const here (and elsewhere in this header) so that one
-// edit descriptor with a repeat factor may safely serve to edit
-// multiple elements of an array.
-bool EditIntegerOutput(IoStatementState &, const DataEdit &, std::int64_t);
-
-// Encapsulates the state of a REAL output conversion.
-class RealOutputEditingBase {
-protected:
-  explicit RealOutputEditingBase(IoStatementState &io) : io_{io} {}
-
-  static bool IsDecimalNumber(const char *p) {
-    if (!p) {
-      return false;
+template<typename INT, typename UINT>
+bool EditIntegerOutput(IoStatementState &io, const DataEdit &edit, INT n) {
+  char buffer[130], *end = &buffer[sizeof buffer], *p = end;
+  bool isNegative{false};
+  if constexpr (std::is_same_v<INT, UINT>) {
+    isNegative = (n >> (8 * sizeof(INT) - 1)) != 0;
+  } else {
+    isNegative = n < 0;
+  }
+  UINT un{static_cast<UINT>(isNegative ? -n : n)};
+  int signChars{0};
+  switch (edit.descriptor) {
+  case DataEdit::ListDirected:
+  case 'G':
+  case 'I':
+    if (isNegative || (edit.modes.editingFlags & signPlus)) {
+      signChars = 1;  // '-' or '+'
     }
-    if (*p == '-' || *p == '+') {
-      ++p;
+    while (un > 0) {
+      auto quotient{common::DivideUnsignedBy<UINT, 10>(un)};
+      *--p = '0' + static_cast<int>(un - UINT{10} * quotient);
+      un = quotient;
     }
-    return *p >= '0' && *p <= '9';
+    break;
+  case 'B':
+    for (; un > 0; un >>= 1) {
+      *--p = '0' + (static_cast<int>(un) & 1);
+    }
+    break;
+  case 'O':
+    for (; un > 0; un >>= 3) {
+      *--p = '0' + (static_cast<int>(un) & 7);
+    }
+    break;
+  case 'Z':
+    for (; un > 0; un >>= 4) {
+      int digit = static_cast<int>(un) & 0xf;
+      *--p = digit >= 10 ? 'A' + (digit - 10) : '0' + digit;
+    }
+    break;
+  default:
+    io.GetIoErrorHandler().Crash(
+        "Data edit descriptor '%c' may not be used with an INTEGER data item",
+        edit.descriptor);
+    return false;
   }
 
-  const char *FormatExponent(int, const DataEdit &edit, int &length);
-  bool EmitPrefix(const DataEdit &, std::size_t length, std::size_t width);
-  bool EmitSuffix(const DataEdit &);
+  int digits = end - p;
+  int leadingZeroes{0};
+  int editWidth{edit.width.value_or(0)};
+  if (edit.digits && digits <= *edit.digits) {  // Iw.m
+    if (*edit.digits == 0 && n == 0) {
+      // Iw.0 with zero value: output field must be blank.  For I0.0
+      // and a zero value, emit one blank character.
+      signChars = 0;  // in case of SP
+      editWidth = std::max(1, editWidth);
+    } else {
+      leadingZeroes = *edit.digits - digits;
+    }
+  } else if (n == 0) {
+    leadingZeroes = 1;
+  }
+  int total{signChars + leadingZeroes + digits};
+  if (editWidth > 0 && total > editWidth) {
+    return io.EmitRepeated('*', editWidth);
+  }
+  int leadingSpaces{std::max(0, editWidth - total)};
+  if (edit.IsListDirected()) {
+    if (static_cast<std::size_t>(total) >
+            io.GetConnectionState().RemainingSpaceInRecord() &&
+        !io.AdvanceRecord()) {
+      return false;
+    }
+    leadingSpaces = 1;
+  }
+  return io.EmitRepeated(' ', leadingSpaces) &&
+      io.Emit(n < 0 ? "-" : "+", signChars) &&
+      io.EmitRepeated('0', leadingZeroes) && io.Emit(p, digits);
+}
 
-  IoStatementState &io_;
-  int trailingBlanks_{0};  // created when Gw editing maps to Fw
-  char exponent_[16];
-};
+// Formats the exponent (see table 13.1 for all the cases)
+const char *RealOutputEditingBase::FormatExponent(
+    int expo, const DataEdit &edit, int &length) {
+  char *eEnd{&exponent_[sizeof exponent_]};
+  char *exponent{eEnd};
+  for (unsigned e{static_cast<unsigned>(std::abs(expo))}; e > 0;) {
+    unsigned quotient{common::DivideUnsignedBy<unsigned, 10>(e)};
+    *--exponent = '0' + e - 10 * quotient;
+    e = quotient;
+  }
+  if (edit.expoDigits) {
+    if (int ed{*edit.expoDigits}) {  // Ew.dEe with e > 0
+      while (exponent > exponent_ + 2 /*E+*/ && exponent + ed > eEnd) {
+        *--exponent = '0';
+      }
+    } else if (exponent == eEnd) {
+      *--exponent = '0';  // Ew.dE0 with zero-valued exponent
+    }
+  } else {  // ensure at least two exponent digits
+    while (exponent + 2 > eEnd) {
+      *--exponent = '0';
+    }
+  }
+  *--exponent = expo < 0 ? '-' : '+';
+  if (edit.expoDigits || exponent + 3 == eEnd) {
+    *--exponent = edit.descriptor == 'D' ? 'D' : 'E';  // not 'G'
+  }
+  length = eEnd - exponent;
+  return exponent;
+}
 
-template<int binaryPrecision = 53>
-class RealOutputEditing : public RealOutputEditingBase {
-public:
-  template<typename A>
-  RealOutputEditing(IoStatementState &io, A x)
-    : RealOutputEditingBase{io}, x_{x} {}
-  bool Edit(const DataEdit &);
+bool RealOutputEditingBase::EmitPrefix(
+    const DataEdit &edit, std::size_t length, std::size_t width) {
+  if (edit.IsListDirected()) {
+    int prefixLength{edit.descriptor == DataEdit::ListDirectedRealPart
+            ? 2
+            : edit.descriptor == DataEdit::ListDirectedImaginaryPart ? 0 : 1};
+    int suffixLength{edit.descriptor == DataEdit::ListDirectedRealPart ||
+                edit.descriptor == DataEdit::ListDirectedImaginaryPart
+            ? 1
+            : 0};
+    length += prefixLength + suffixLength;
+    ConnectionState &connection{io_.GetConnectionState()};
+    return (connection.positionInRecord == 0 ||
+               length <= connection.RemainingSpaceInRecord() ||
+               io_.AdvanceRecord()) &&
+        io_.Emit(" (", prefixLength);
+  } else if (width > length) {
+    return io_.EmitRepeated(' ', width - length);
+  } else {
+    return true;
+  }
+}
 
-private:
-  using BinaryFloatingPoint =
-      decimal::BinaryFloatingPointNumber<binaryPrecision>;
-
-  // The DataEdit arguments here are const references or copies so that
-  // the original DataEdit can safely serve multiple array elements when
-  // it has a repeat count.
-  bool EditEorDOutput(const DataEdit &);
-  bool EditFOutput(const DataEdit &);
-  DataEdit EditForGOutput(DataEdit);  // returns an E or F edit
-  bool EditEXOutput(const DataEdit &);
-  bool EditListDirectedOutput(const DataEdit &);
-
-  bool IsZero() const { return x_.IsZero(); }
-
-  decimal::ConversionToDecimalResult Convert(
-      int significantDigits, const DataEdit &, int flags = 0);
-
-  BinaryFloatingPoint x_;
-  char buffer_[BinaryFloatingPoint::maxDecimalConversionDigits +
-      EXTRA_DECIMAL_CONVERSION_SPACE];
-};
+bool RealOutputEditingBase::EmitSuffix(const DataEdit &edit) {
+  if (edit.descriptor == DataEdit::ListDirectedRealPart) {
+    return io_.Emit(edit.modes.editingFlags & decimalComma ? ";" : ",", 1);
+  } else if (edit.descriptor == DataEdit::ListDirectedImaginaryPart) {
+    return io_.Emit(")", 1);
+  } else {
+    return true;
+  }
+}
 
 template<int binaryPrecision>
 decimal::ConversionToDecimalResult RealOutputEditing<binaryPrecision>::Convert(
@@ -331,7 +400,7 @@ bool RealOutputEditing<binaryPrecision>::Edit(const DataEdit &edit) {
     if (edit.IsListDirected()) {
       return EditListDirectedOutput(edit);
     }
-    io_.GetIoErrorHandler().Crash(
+    io_.GetIoErrorHandler().SignalError(IostatErrorInFormat,
         "Data edit descriptor '%c' may not be used with a REAL data item",
         edit.descriptor);
     return false;
@@ -339,5 +408,88 @@ bool RealOutputEditing<binaryPrecision>::Edit(const DataEdit &edit) {
   return false;
 }
 
+bool ListDirectedLogicalOutput(IoStatementState &io,
+    ListDirectedStatementState<Direction::Output> &list, bool truth) {
+  return list.EmitLeadingSpaceOrAdvance(io, 1) && io.Emit(truth ? "T" : "F", 1);
+}
+
+bool EditLogicalOutput(IoStatementState &io, const DataEdit &edit, bool truth) {
+  switch (edit.descriptor) {
+  case 'L':
+  case 'G': return io.Emit(truth ? "T" : "F", 1);
+  default:
+    io.GetIoErrorHandler().SignalError(IostatErrorInFormat,
+        "Data edit descriptor '%c' may not be used with a LOGICAL data item",
+        edit.descriptor);
+    return false;
+  }
+}
+
+bool ListDirectedDefaultCharacterOutput(IoStatementState &io,
+    ListDirectedStatementState<Direction::Output> &list, const char *x,
+    std::size_t length) {
+  bool ok{list.EmitLeadingSpaceOrAdvance(io, length, true)};
+  MutableModes &modes{io.mutableModes()};
+  ConnectionState &connection{io.GetConnectionState()};
+  if (modes.delim) {
+    // Value is delimited with ' or " marks, and interior
+    // instances of that character are doubled.  When split
+    // over multiple lines, delimit each lines' part.
+    ok &= io.Emit(&modes.delim, 1);
+    for (std::size_t j{0}; j < length; ++j) {
+      if (list.NeedAdvance(connection, 2)) {
+        ok &= io.Emit(&modes.delim, 1) && io.AdvanceRecord() &&
+            io.Emit(&modes.delim, 1);
+      }
+      if (x[j] == modes.delim) {
+        ok &= io.EmitRepeated(modes.delim, 2);
+      } else {
+        ok &= io.Emit(&x[j], 1);
+      }
+    }
+    ok &= io.Emit(&modes.delim, 1);
+  } else {
+    // Undelimited list-directed output
+    std::size_t put{0};
+    while (put < length) {
+      auto chunk{std::min(length - put, connection.RemainingSpaceInRecord())};
+      ok &= io.Emit(x + put, chunk);
+      put += chunk;
+      if (put < length) {
+        ok &= io.AdvanceRecord() && io.Emit(" ", 1);
+      }
+    }
+    list.lastWasUndelimitedCharacter = true;
+  }
+  return ok;
+}
+
+bool EditDefaultCharacterOutput(IoStatementState &io, const DataEdit &edit,
+    const char *x, std::size_t length) {
+  switch (edit.descriptor) {
+  case 'A':
+  case 'G': break;
+  default:
+    io.GetIoErrorHandler().SignalError(IostatErrorInFormat,
+        "Data edit descriptor '%c' may not be used with a CHARACTER data item",
+        edit.descriptor);
+    return false;
+  }
+  int len{static_cast<int>(length)};
+  int width{edit.width.value_or(len)};
+  return io.EmitRepeated(' ', std::max(0, width - len)) &&
+      io.Emit(x, std::min(width, len));
+}
+
+template bool EditIntegerOutput<std::int64_t, std::uint64_t>(
+    IoStatementState &, const DataEdit &, std::int64_t);
+template bool EditIntegerOutput<common::uint128_t, common::uint128_t>(
+    IoStatementState &, const DataEdit &, common::uint128_t);
+
+template class RealOutputEditing<8>;
+template class RealOutputEditing<11>;
+template class RealOutputEditing<24>;
+template class RealOutputEditing<53>;
+template class RealOutputEditing<64>;
+template class RealOutputEditing<113>;
 }
-#endif  // FORTRAN_RUNTIME_NUMERIC_OUTPUT_H_

flang/runtime/edit-output.h

@@ -0,0 +1,111 @@
+//===-- runtime/edit-output.h -----------------------------------*- 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
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_RUNTIME_EDIT_OUTPUT_H_
+#define FORTRAN_RUNTIME_EDIT_OUTPUT_H_
+
+// Output data editing templates implementing the FORMAT data editing
+// descriptors E, EN, ES, EX, D, F, and G for REAL data (and COMPLEX
+// components, I and G for INTEGER, and B/O/Z for both.
+// See subclauses in 13.7.2.3 of Fortran 2018 for the
+// detailed specifications of these descriptors.
+// List-directed output (13.10.4) for numeric types is also done here.
+// Drives the same fast binary-to-decimal formatting templates used
+// in the f18 front-end.
+
+#include "format.h"
+#include "io-stmt.h"
+#include "flang/Common/uint128.h"
+#include "flang/Decimal/decimal.h"
+
+namespace Fortran::runtime::io {
+
+// I, B, O, Z, and G output editing for INTEGER.
+// The DataEdit reference is const here (and elsewhere in this header) so that
+// one edit descriptor with a repeat factor may safely serve to edit
+// multiple elements of an array.
+template<typename INT = std::int64_t, typename UINT = std::uint64_t>
+bool EditIntegerOutput(IoStatementState &, const DataEdit &, INT);
+
+// Encapsulates the state of a REAL output conversion.
+class RealOutputEditingBase {
+protected:
+  explicit RealOutputEditingBase(IoStatementState &io) : io_{io} {}
+
+  static bool IsDecimalNumber(const char *p) {
+    if (!p) {
+      return false;
+    }
+    if (*p == '-' || *p == '+') {
+      ++p;
+    }
+    return *p >= '0' && *p <= '9';
+  }
+
+  const char *FormatExponent(int, const DataEdit &edit, int &length);
+  bool EmitPrefix(const DataEdit &, std::size_t length, std::size_t width);
+  bool EmitSuffix(const DataEdit &);
+
+  IoStatementState &io_;
+  int trailingBlanks_{0};  // created when Gw editing maps to Fw
+  char exponent_[16];
+};
+
+template<int binaryPrecision = 53>
+class RealOutputEditing : public RealOutputEditingBase {
+public:
+  template<typename A>
+  RealOutputEditing(IoStatementState &io, A x)
+    : RealOutputEditingBase{io}, x_{x} {}
+  bool Edit(const DataEdit &);
+
+private:
+  using BinaryFloatingPoint =
+      decimal::BinaryFloatingPointNumber<binaryPrecision>;
+
+  // The DataEdit arguments here are const references or copies so that
+  // the original DataEdit can safely serve multiple array elements when
+  // it has a repeat count.
+  bool EditEorDOutput(const DataEdit &);
+  bool EditFOutput(const DataEdit &);
+  DataEdit EditForGOutput(DataEdit);  // returns an E or F edit
+  bool EditEXOutput(const DataEdit &);
+  bool EditListDirectedOutput(const DataEdit &);
+
+  bool IsZero() const { return x_.IsZero(); }
+
+  decimal::ConversionToDecimalResult Convert(
+      int significantDigits, const DataEdit &, int flags = 0);
+
+  BinaryFloatingPoint x_;
+  char buffer_[BinaryFloatingPoint::maxDecimalConversionDigits +
+      EXTRA_DECIMAL_CONVERSION_SPACE];
+};
+
+bool ListDirectedLogicalOutput(
+    IoStatementState &, ListDirectedStatementState<Direction::Output> &, bool);
+bool EditLogicalOutput(IoStatementState &, const DataEdit &, bool);
+bool ListDirectedDefaultCharacterOutput(IoStatementState &,
+    ListDirectedStatementState<Direction::Output> &, const char *, std::size_t);
+bool EditDefaultCharacterOutput(
+    IoStatementState &, const DataEdit &, const char *, std::size_t);
+
+extern template bool EditIntegerOutput<std::int64_t, std::uint64_t>(
+    IoStatementState &, const DataEdit &, std::int64_t);
+extern template bool EditIntegerOutput<common::uint128_t, common::uint128_t>(
+    IoStatementState &, const DataEdit &, common::uint128_t);
+
+extern template class RealOutputEditing<8>;
+extern template class RealOutputEditing<11>;
+extern template class RealOutputEditing<24>;
+extern template class RealOutputEditing<53>;
+extern template class RealOutputEditing<64>;
+extern template class RealOutputEditing<113>;
+
+}
+#endif  // FORTRAN_RUNTIME_EDIT_OUTPUT_H_

flang/runtime/file.cpp

@@ -34,7 +34,7 @@ void OpenFile::Open(
   case OpenStatus::New: flags |= O_CREAT | O_EXCL; break;
   case OpenStatus::Scratch:
     if (path_.get()) {
-      handler.Crash("FILE= must not appear with STATUS='SCRATCH'");
+      handler.SignalError("FILE= must not appear with STATUS='SCRATCH'");
       path_.reset();
     }
     {
@@ -54,7 +54,8 @@ void OpenFile::Open(
     flags |= O_CREAT;
     break;
   }
-  // If we reach this point, we're opening a new file
+  // If we reach this point, we're opening a new file.
+  // TODO: Fortran shouldn't create a new file until the first WRITE.
   if (fd_ >= 0) {
     if (fd_ <= 2) {
       // don't actually close a standard file descriptor, we might need it
@@ -63,8 +64,9 @@ void OpenFile::Open(
     }
   }
   if (!path_.get()) {
-    handler.Crash(
+    handler.SignalError(
         "FILE= is required unless STATUS='OLD' and unit is connected");
+    return;
   }
   fd_ = ::open(path_.get(), flags, 0600);
   if (fd_ < 0) {
@@ -79,7 +81,6 @@ void OpenFile::Open(
 }
 
 void OpenFile::Predefine(int fd) {
-  CriticalSection criticalSection{lock_};
   fd_ = fd;
   path_.reset();
   pathLength_ = 0;
@@ -90,7 +91,6 @@ void OpenFile::Predefine(int fd) {
 }
 
 void OpenFile::Close(CloseStatus status, IoErrorHandler &handler) {
-  CriticalSection criticalSection{lock_};
   CheckOpen(handler);
   pending_.reset();
   knownSize_.reset();
@@ -116,7 +116,6 @@ std::size_t OpenFile::Read(FileOffset at, char *buffer, std::size_t minBytes,
   if (maxBytes == 0) {
     return 0;
   }
-  CriticalSection criticalSection{lock_};
   CheckOpen(handler);
   if (!Seek(at, handler)) {
     return 0;
@@ -150,7 +149,6 @@ std::size_t OpenFile::Write(FileOffset at, const char *buffer,
   if (bytes == 0) {
     return 0;
   }
-  CriticalSection criticalSection{lock_};
   CheckOpen(handler);
   if (!Seek(at, handler)) {
     return 0;
@@ -176,7 +174,6 @@ std::size_t OpenFile::Write(FileOffset at, const char *buffer,
 }
 
 void OpenFile::Truncate(FileOffset at, IoErrorHandler &handler) {
-  CriticalSection criticalSection{lock_};
   CheckOpen(handler);
   if (!knownSize_ || *knownSize_ != at) {
     if (::ftruncate(fd_, at) != 0) {
@@ -191,7 +188,6 @@ void OpenFile::Truncate(FileOffset at, IoErrorHandler &handler) {
 // TODO: True asynchronicity
 int OpenFile::ReadAsynchronously(
     FileOffset at, char *buffer, std::size_t bytes, IoErrorHandler &handler) {
-  CriticalSection criticalSection{lock_};
   CheckOpen(handler);
   int iostat{0};
   for (std::size_t got{0}; got < bytes;) {
@@ -221,7 +217,6 @@ int OpenFile::ReadAsynchronously(
 // TODO: True asynchronicity
 int OpenFile::WriteAsynchronously(FileOffset at, const char *buffer,
     std::size_t bytes, IoErrorHandler &handler) {
-  CriticalSection criticalSection{lock_};
   CheckOpen(handler);
   int iostat{0};
   for (std::size_t put{0}; put < bytes;) {
@@ -247,19 +242,16 @@ int OpenFile::WriteAsynchronously(FileOffset at, const char *buffer,
 
 void OpenFile::Wait(int id, IoErrorHandler &handler) {
   std::optional<int> ioStat;
-  {
-    CriticalSection criticalSection{lock_};
-    Pending *prev{nullptr};
-    for (Pending *p{pending_.get()}; p; p = (prev = p)->next.get()) {
-      if (p->id == id) {
-        ioStat = p->ioStat;
-        if (prev) {
-          prev->next.reset(p->next.release());
-        } else {
-          pending_.reset(p->next.release());
-        }
-        break;
+  Pending *prev{nullptr};
+  for (Pending *p{pending_.get()}; p; p = (prev = p)->next.get()) {
+    if (p->id == id) {
+      ioStat = p->ioStat;
+      if (prev) {
+        prev->next.reset(p->next.release());
+      } else {
+        pending_.reset(p->next.release());
       }
+      break;
     }
   }
   if (ioStat) {
@@ -270,14 +262,11 @@ void OpenFile::Wait(int id, IoErrorHandler &handler) {
 void OpenFile::WaitAll(IoErrorHandler &handler) {
   while (true) {
     int ioStat;
-    {
-      CriticalSection criticalSection{lock_};
-      if (pending_) {
-        ioStat = pending_->ioStat;
-        pending_.reset(pending_->next.release());
-      } else {
-        return;
-      }
+    if (pending_) {
+      ioStat = pending_->ioStat;
+      pending_.reset(pending_->next.release());
+    } else {
+      return;
     }
     handler.SignalError(ioStat);
   }

flang/runtime/file.h

@@ -12,7 +12,6 @@
 #define FORTRAN_RUNTIME_FILE_H_
 
 #include "io-error.h"
-#include "lock.h"
 #include "memory.h"
 #include <cinttypes>
 #include <optional>
@@ -27,7 +26,6 @@ class OpenFile {
 public:
   using FileOffset = std::int64_t;
 
-  Lock &lock() { return lock_; }
   const char *path() const { return path_.get(); }
   void set_path(OwningPtr<char> &&, std::size_t bytes);
   std::size_t pathLength() const { return pathLength_; }
@@ -76,14 +74,12 @@ private:
     OwningPtr<Pending> next;
   };
 
-  // lock_ must be held for these
   void CheckOpen(const Terminator &);
   bool Seek(FileOffset, IoErrorHandler &);
   bool RawSeek(FileOffset);
   bool RawSeekToEnd();
   int PendingResult(const Terminator &, int);
 
-  Lock lock_;
   int fd_{-1};
   OwningPtr<char> path_;
   std::size_t pathLength_;

flang/runtime/format-implementation.h

@@ -25,39 +25,69 @@ FormatControl<CONTEXT>::FormatControl(const Terminator &terminator,
     const CharType *format, std::size_t formatLength, int maxHeight)
   : maxHeight_{static_cast<std::uint8_t>(maxHeight)}, format_{format},
     formatLength_{static_cast<int>(formatLength)} {
-  if (maxHeight != maxHeight_) {
-    terminator.Crash("internal Fortran runtime error: maxHeight %d", maxHeight);
-  }
-  if (formatLength != static_cast<std::size_t>(formatLength_)) {
-    terminator.Crash(
-        "internal Fortran runtime error: formatLength %zd", formatLength);
-  }
+  RUNTIME_CHECK(terminator, maxHeight == maxHeight_);
+  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>::GetMaxParenthesisNesting(
-    const Terminator &terminator, const CharType *format,
-    std::size_t formatLength) {
-  using Validator = common::FormatValidator<CharType>;
-  typename Validator::Reporter reporter{
-      [&](const common::FormatMessage &message) {
-        terminator.Crash(message.text, message.arg);
-        return false;  // crashes on error above
-      }};
-  Validator validator{format, formatLength, reporter};
-  validator.Check();
-  return validator.maxNesting();
+    IoErrorHandler &handler, const CharType *format, std::size_t formatLength) {
+  int maxNesting{0};
+  int nesting{0};
+  const CharType *end{format + formatLength};
+  std::optional<CharType> quote;
+  int repeat{0};
+  for (const CharType *p{format}; p < end; ++p) {
+    if (quote) {
+      if (*p == *quote) {
+        quote.reset();
+      }
+    } else if (*p >= '0' && *p <= '9') {
+      repeat = 10 * repeat + *p - '0';
+    } else if (*p != ' ') {
+      switch (*p) {
+      case '\'':
+      case '"': quote = *p; break;
+      case 'h':
+      case 'H':  // 9HHOLLERITH
+        p += repeat;
+        if (p >= end) {
+          handler.SignalError(IostatErrorInFormat,
+              "Hollerith (%dH) too long in FORMAT", repeat);
+          return maxNesting;
+        }
+        break;
+      case ' ': break;
+      case '(':
+        ++nesting;
+        maxNesting = std::max(nesting, maxNesting);
+        break;
+      case ')': nesting = std::max(nesting - 1, 0); break;
+      }
+      repeat = 0;
+    }
+  }
+  if (quote) {
+    handler.SignalError(
+        IostatErrorInFormat, "Unbalanced quotation marks in FORMAT string");
+  } else if (nesting) {
+    handler.SignalError(
+        IostatErrorInFormat, "Unbalanced parentheses in FORMAT string");
+  }
+  return maxNesting;
 }
 
 template<typename CONTEXT>
 int FormatControl<CONTEXT>::GetIntField(
-    const Terminator &terminator, CharType firstCh) {
+    IoErrorHandler &handler, CharType firstCh) {
   CharType ch{firstCh ? firstCh : PeekNext()};
   if (ch != '-' && ch != '+' && (ch < '0' || ch > '9')) {
-    terminator.Crash(
+    handler.SignalError(IostatErrorInFormat,
         "Invalid FORMAT: integer expected at '%c'", static_cast<char>(ch));
+    return 0;
   }
   int result{0};
   bool negate{ch == '-'};
@@ -68,7 +98,9 @@ int FormatControl<CONTEXT>::GetIntField(
   while (ch >= '0' && ch <= '9') {
     if (result >
         std::numeric_limits<int>::max() / 10 - (static_cast<int>(ch) - '0')) {
-      terminator.Crash("FORMAT integer field out of range");
+      handler.SignalError(
+          IostatErrorInFormat, "FORMAT integer field out of range");
+      return result;
     }
     result = 10 * result + ch - '0';
     if (firstCh) {
@@ -79,7 +111,8 @@ int FormatControl<CONTEXT>::GetIntField(
     ch = PeekNext();
   }
   if (negate && (result *= -1) > 0) {
-    terminator.Crash("FORMAT integer field out of range");
+    handler.SignalError(
+        IostatErrorInFormat, "FORMAT integer field out of range");
   }
   return result;
 }
@@ -156,9 +189,11 @@ static void HandleControl(CONTEXT &context, char ch, char next, int n) {
   default: break;
   }
   if (next) {
-    context.Crash("Unknown '%c%c' edit descriptor in FORMAT", ch, next);
+    context.SignalError(IostatErrorInFormat,
+        "Unknown '%c%c' edit descriptor in FORMAT", ch, next);
   } else {
-    context.Crash("Unknown '%c' edit descriptor in FORMAT", ch);
+    context.SignalError(
+        IostatErrorInFormat, "Unknown '%c' edit descriptor in FORMAT", ch);
   }
 }
 
@@ -188,12 +223,16 @@ int FormatControl<CONTEXT>::CueUpNextDataEdit(Context &context, bool stop) {
       unlimited = true;
       ch = GetNextChar(context);
       if (ch != '(') {
-        context.Crash("Invalid FORMAT: '*' may appear only before '('");
+        context.SignalError(IostatErrorInFormat,
+            "Invalid FORMAT: '*' may appear only before '('");
+        return 0;
       }
     }
     if (ch == '(') {
       if (height_ >= maxHeight_) {
-        context.Crash("FORMAT stack overflow: too many nested parentheses");
+        context.SignalError(IostatErrorInFormat,
+            "FORMAT stack overflow: too many nested parentheses");
+        return 0;
       }
       stack_[height_].start = offset_ - 1;  // the '('
       if (unlimited || height_ == 0) {
@@ -209,7 +248,8 @@ int FormatControl<CONTEXT>::CueUpNextDataEdit(Context &context, bool stop) {
       }
       ++height_;
     } else if (height_ == 0) {
-      context.Crash("FORMAT lacks initial '('");
+      context.SignalError(IostatErrorInFormat, "FORMAT lacks initial '('");
+      return 0;
     } else if (ch == ')') {
       if (height_ == 1) {
         if (stop) {
@@ -220,7 +260,7 @@ int FormatControl<CONTEXT>::CueUpNextDataEdit(Context &context, bool stop) {
       if (stack_[height_ - 1].remaining == Iteration::unlimited) {
         offset_ = stack_[height_ - 1].start + 1;
         if (offset_ == unlimitedLoopCheck) {
-          context.Crash(
+          context.SignalError(IostatErrorInFormat,
               "Unlimited repetition in FORMAT lacks data edit descriptors");
         }
       } else if (stack_[height_ - 1].remaining-- > 0) {
@@ -236,7 +276,9 @@ int FormatControl<CONTEXT>::CueUpNextDataEdit(Context &context, bool stop) {
         ++offset_;
       }
       if (offset_ >= formatLength_) {
-        context.Crash("FORMAT missing closing quote on character literal");
+        context.SignalError(IostatErrorInFormat,
+            "FORMAT missing closing quote on character literal");
+        return 0;
       }
       ++offset_;
       std::size_t chars{
@@ -252,7 +294,9 @@ int FormatControl<CONTEXT>::CueUpNextDataEdit(Context &context, bool stop) {
     } else if (ch == 'H') {
       // 9HHOLLERITH
       if (!repeat || *repeat < 1 || offset_ + *repeat > formatLength_) {
-        context.Crash("Invalid width on Hollerith in FORMAT");
+        context.SignalError(
+            IostatErrorInFormat, "Invalid width on Hollerith in FORMAT");
+        return 0;
       }
       context.Emit(format_ + offset_, static_cast<std::size_t>(*repeat));
       offset_ += *repeat;
@@ -282,7 +326,9 @@ int FormatControl<CONTEXT>::CueUpNextDataEdit(Context &context, bool stop) {
     } else if (ch == '/') {
       context.AdvanceRecord(repeat && *repeat > 0 ? *repeat : 1);
     } else {
-      context.Crash("Invalid character '%c' in FORMAT", static_cast<char>(ch));
+      context.SignalError(IostatErrorInFormat,
+          "Invalid character '%c' in FORMAT", static_cast<char>(ch));
+      return 0;
     }
   }
 }
@@ -348,7 +394,7 @@ DataEdit FormatControl<CONTEXT>::GetNextDataEdit(
 }
 
 template<typename CONTEXT>
-void FormatControl<CONTEXT>::FinishOutput(Context &context) {
+void FormatControl<CONTEXT>::Finish(Context &context) {
   CueUpNextDataEdit(context, true /* stop at colon or end of FORMAT */);
 }
 }

flang/runtime/format.cpp

@@ -30,24 +30,34 @@ bool DefaultFormatControlCallbacks::Emit(const char32_t *, std::size_t) {
         "I/O statement");
   return {};
 }
+std::optional<char32_t> DefaultFormatControlCallbacks::GetCurrentChar() {
+  Crash("DefaultFormatControlCallbacks::GetCurrentChar() called for non-input "
+        "I/O "
+        "statement");
+  return {};
+}
 bool DefaultFormatControlCallbacks::AdvanceRecord(int) {
   Crash("DefaultFormatControlCallbacks::AdvanceRecord() called unexpectedly");
   return {};
 }
-bool DefaultFormatControlCallbacks::HandleAbsolutePosition(std::int64_t) {
-  Crash("DefaultFormatControlCallbacks::HandleAbsolutePosition() called for "
-        "non-formatted "
-        "I/O statement");
-  return {};
+void DefaultFormatControlCallbacks::BackspaceRecord() {
+  Crash("DefaultFormatControlCallbacks::BackspaceRecord() called unexpectedly");
 }
-bool DefaultFormatControlCallbacks::HandleRelativePosition(std::int64_t) {
+void DefaultFormatControlCallbacks::HandleAbsolutePosition(std::int64_t) {
+  Crash("DefaultFormatControlCallbacks::HandleAbsolutePosition() called for "
+        "non-formatted I/O statement");
+}
+void DefaultFormatControlCallbacks::HandleRelativePosition(std::int64_t) {
   Crash("DefaultFormatControlCallbacks::HandleRelativePosition() called for "
-        "non-formatted "
-        "I/O statement");
-  return {};
+        "non-formatted I/O statement");
 }
 
-template class FormatControl<InternalFormattedIoStatementState<false>>;
-template class FormatControl<InternalFormattedIoStatementState<true>>;
-template class FormatControl<ExternalFormattedIoStatementState<false>>;
+template class FormatControl<
+    InternalFormattedIoStatementState<Direction::Output>>;
+template class FormatControl<
+    InternalFormattedIoStatementState<Direction::Input>>;
+template class FormatControl<
+    ExternalFormattedIoStatementState<Direction::Output>>;
+template class FormatControl<
+    ExternalFormattedIoStatementState<Direction::Input>>;
 }

flang/runtime/format.h

@@ -13,7 +13,6 @@
 
 #include "environment.h"
 #include "io-error.h"
-#include "terminator.h"
 #include "flang/Common/Fortran.h"
 #include "flang/Decimal/decimal.h"
 #include <cinttypes>
@@ -41,10 +40,11 @@ struct MutableModes {
 struct DataEdit {
   char descriptor;  // capitalized: one of A, I, B, O, Z, F, E(N/S/X), D, G
 
-  // Special internal data edit descriptors to distinguish list-directed I/O
+  // Special internal data edit descriptors for list-directed I/O
   static constexpr char ListDirected{'g'};  // non-COMPLEX list-directed
   static constexpr char ListDirectedRealPart{'r'};  // emit "(r," or "(r;"
   static constexpr char ListDirectedImaginaryPart{'z'};  // emit "z)"
+  static constexpr char ListDirectedNullValue{'n'};  // see 13.10.3.2
   constexpr bool IsListDirected() const {
     return descriptor == ListDirected || descriptor == ListDirectedRealPart ||
         descriptor == ListDirectedImaginaryPart;
@@ -66,9 +66,11 @@ struct DefaultFormatControlCallbacks : public IoErrorHandler {
   bool Emit(const char *, std::size_t);
   bool Emit(const char16_t *, std::size_t);
   bool Emit(const char32_t *, std::size_t);
+  std::optional<char32_t> GetCurrentChar();
   bool AdvanceRecord(int = 1);
-  bool HandleAbsolutePosition(std::int64_t);
-  bool HandleRelativePosition(std::int64_t);
+  void BackspaceRecord();
+  void HandleAbsolutePosition(std::int64_t);
+  void HandleRelativePosition(std::int64_t);
 };
 
 // Generates a sequence of DataEdits from a FORMAT statement or
@@ -86,7 +88,7 @@ public:
   // Determines the max parenthesis nesting level by scanning and validating
   // the FORMAT string.
   static int GetMaxParenthesisNesting(
-      const Terminator &, const CharType *format, std::size_t formatLength);
+      IoErrorHandler &, const CharType *format, std::size_t formatLength);
 
   // For attempting to allocate in a user-supplied stack area
   static std::size_t GetNeededSize(int maxHeight) {
@@ -98,8 +100,9 @@ public:
   // along the way.
   DataEdit GetNextDataEdit(Context &, int maxRepeat = 1);
 
-  // Emit any remaining character literals after the last data item.
-  void FinishOutput(Context &);
+  // 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};
@@ -119,14 +122,16 @@ private:
     SkipBlanks();
     return offset_ < formatLength_ ? format_[offset_] : '\0';
   }
-  CharType GetNextChar(const Terminator &terminator) {
+  CharType GetNextChar(IoErrorHandler &handler) {
     SkipBlanks();
     if (offset_ >= formatLength_) {
-      terminator.Crash("FORMAT missing at least one ')'");
+      handler.SignalError(
+          IostatErrorInFormat, "FORMAT missing at least one ')'");
+      return '\n';
     }
     return format_[offset_++];
   }
-  int GetIntField(const Terminator &, CharType firstCh = '\0');
+  int GetIntField(IoErrorHandler &, CharType firstCh = '\0');
 
   // Advances through the FORMAT until the next data edit
   // descriptor has been found; handles control edit descriptors

flang/runtime/internal-unit.cpp

@@ -14,8 +14,8 @@
 
 namespace Fortran::runtime::io {
 
-template<bool isInput>
-InternalDescriptorUnit<isInput>::InternalDescriptorUnit(
+template<Direction DIR>
+InternalDescriptorUnit<DIR>::InternalDescriptorUnit(
     Scalar scalar, std::size_t length) {
   recordLength = length;
   endfileRecordNumber = 2;
@@ -24,8 +24,8 @@ InternalDescriptorUnit<isInput>::InternalDescriptorUnit(
       CFI_attribute_pointer);
 }
 
-template<bool isInput>
-InternalDescriptorUnit<isInput>::InternalDescriptorUnit(
+template<Direction DIR>
+InternalDescriptorUnit<DIR>::InternalDescriptorUnit(
     const Descriptor &that, const Terminator &terminator) {
   RUNTIME_CHECK(terminator, that.type().IsCharacter());
   Descriptor &d{descriptor()};
@@ -35,95 +35,107 @@ InternalDescriptorUnit<isInput>::InternalDescriptorUnit(
   d.Check();
   recordLength = d.ElementBytes();
   endfileRecordNumber = d.Elements() + 1;
-  d.GetLowerBounds(at_);
 }
 
-template<bool isInput> void InternalDescriptorUnit<isInput>::EndIoStatement() {
-  if constexpr (!isInput) {
-    // blank fill
-    while (currentRecordNumber < endfileRecordNumber.value_or(0)) {
-      char *record{descriptor().template Element<char>(at_)};
-      std::fill_n(record + furthestPositionInRecord,
-          recordLength.value_or(0) - furthestPositionInRecord, ' ');
+template<Direction DIR> void InternalDescriptorUnit<DIR>::EndIoStatement() {
+  if constexpr (DIR == Direction::Output) {  // blank fill
+    while (char *record{CurrentRecord()}) {
+      if (furthestPositionInRecord <
+          recordLength.value_or(furthestPositionInRecord)) {
+        std::fill_n(record + furthestPositionInRecord,
+            *recordLength - furthestPositionInRecord, ' ');
+      }
       furthestPositionInRecord = 0;
       ++currentRecordNumber;
-      descriptor().IncrementSubscripts(at_);
     }
   }
 }
 
-template<bool isInput>
-bool InternalDescriptorUnit<isInput>::Emit(
+template<Direction DIR>
+bool InternalDescriptorUnit<DIR>::Emit(
     const char *data, std::size_t bytes, IoErrorHandler &handler) {
-  if constexpr (isInput) {
-    handler.Crash(
-        "InternalDescriptorUnit<true>::Emit() called for an input statement");
-    return false;
+  if constexpr (DIR == Direction::Input) {
+    handler.Crash("InternalDescriptorUnit<Direction::Input>::Emit() called");
+    return false && data[bytes] != 0;  // bogus compare silences GCC warning
+  } else {
+    if (bytes <= 0) {
+      return true;
+    }
+    char *record{CurrentRecord()};
+    if (!record) {
+      handler.SignalError(IostatInternalWriteOverrun);
+      return false;
+    }
+    auto furthestAfter{std::max(furthestPositionInRecord,
+        positionInRecord + static_cast<std::int64_t>(bytes))};
+    bool ok{true};
+    if (furthestAfter > static_cast<std::int64_t>(recordLength.value_or(0))) {
+      handler.SignalError(IostatRecordWriteOverrun);
+      furthestAfter = recordLength.value_or(0);
+      bytes = std::max(std::int64_t{0}, furthestAfter - positionInRecord);
+      ok = false;
+    } else if (positionInRecord > furthestPositionInRecord) {
+      std::fill_n(record + furthestPositionInRecord,
+          positionInRecord - furthestPositionInRecord, ' ');
+    }
+    std::memcpy(record + positionInRecord, data, bytes);
+    positionInRecord += bytes;
+    furthestPositionInRecord = furthestAfter;
+    return ok;
   }
-  if (currentRecordNumber >= endfileRecordNumber.value_or(0)) {
-    handler.SignalEnd();
-    return false;
-  }
-  char *record{descriptor().template Element<char>(at_)};
-  auto furthestAfter{std::max(furthestPositionInRecord,
-      positionInRecord + static_cast<std::int64_t>(bytes))};
-  bool ok{true};
-  if (furthestAfter > static_cast<std::int64_t>(recordLength.value_or(0))) {
-    handler.SignalEor();
-    furthestAfter = recordLength.value_or(0);
-    bytes = std::max(std::int64_t{0}, furthestAfter - positionInRecord);
-    ok = false;
-  }
-  std::memcpy(record + positionInRecord, data, bytes);
-  positionInRecord += bytes;
-  furthestPositionInRecord = furthestAfter;
-  return ok;
 }
 
-template<bool isInput>
-bool InternalDescriptorUnit<isInput>::AdvanceRecord(IoErrorHandler &handler) {
+template<Direction DIR>
+std::optional<char32_t> InternalDescriptorUnit<DIR>::GetCurrentChar(
+    IoErrorHandler &handler) {
+  if constexpr (DIR == Direction::Output) {
+    handler.Crash(
+        "InternalDescriptorUnit<Direction::Output>::GetCurrentChar() called");
+    return std::nullopt;
+  }
+  const char *record{CurrentRecord()};
+  if (!record) {
+    handler.SignalEnd();
+    return std::nullopt;
+  }
+  if (positionInRecord >= recordLength.value_or(positionInRecord)) {
+    return std::nullopt;
+  }
+  if (isUTF8) {
+    // TODO: UTF-8 decoding
+  }
+  return record[positionInRecord];
+}
+
+template<Direction DIR>
+bool InternalDescriptorUnit<DIR>::AdvanceRecord(IoErrorHandler &handler) {
   if (currentRecordNumber >= endfileRecordNumber.value_or(0)) {
     handler.SignalEnd();
     return false;
   }
-  if (!HandleAbsolutePosition(recordLength.value_or(0), handler)) {
-    return false;
+  if constexpr (DIR == Direction::Output) {  // blank fill
+    if (furthestPositionInRecord <
+        recordLength.value_or(furthestPositionInRecord)) {
+      char *record{CurrentRecord()};
+      RUNTIME_CHECK(handler, record != nullptr);
+      std::fill_n(record + furthestPositionInRecord,
+          *recordLength - furthestPositionInRecord, ' ');
+    }
   }
   ++currentRecordNumber;
-  descriptor().IncrementSubscripts(at_);
   positionInRecord = 0;
   furthestPositionInRecord = 0;
   return true;
 }
 
-template<bool isInput>
-bool InternalDescriptorUnit<isInput>::HandleAbsolutePosition(
-    std::int64_t n, IoErrorHandler &handler) {
-  n = std::max<std::int64_t>(0, n);
-  bool ok{true};
-  if (n > static_cast<std::int64_t>(recordLength.value_or(n))) {
-    handler.SignalEor();
-    n = *recordLength;
-    ok = false;
-  }
-  if (n > furthestPositionInRecord && ok) {
-    if constexpr (!isInput) {
-      char *record{descriptor().template Element<char>(at_)};
-      std::fill_n(
-          record + furthestPositionInRecord, n - furthestPositionInRecord, ' ');
-    }
-    furthestPositionInRecord = n;
-  }
-  positionInRecord = n;
-  return ok;
+template<Direction DIR>
+void InternalDescriptorUnit<DIR>::BackspaceRecord(IoErrorHandler &handler) {
+  RUNTIME_CHECK(handler, currentRecordNumber > 1);
+  --currentRecordNumber;
+  positionInRecord = 0;
+  furthestPositionInRecord = 0;
 }
 
-template<bool isInput>
-bool InternalDescriptorUnit<isInput>::HandleRelativePosition(
-    std::int64_t n, IoErrorHandler &handler) {
-  return HandleAbsolutePosition(positionInRecord + n, handler);
-}
-
-template class InternalDescriptorUnit<false>;
-template class InternalDescriptorUnit<true>;
+template class InternalDescriptorUnit<Direction::Output>;
+template class InternalDescriptorUnit<Direction::Input>;
 }

flang/runtime/internal-unit.h

@@ -22,25 +22,32 @@ class IoErrorHandler;
 
 // Points to (but does not own) a CHARACTER scalar or array for internal I/O.
 // Does not buffer.
-template<bool isInput> class InternalDescriptorUnit : public ConnectionState {
+template<Direction DIR> class InternalDescriptorUnit : public ConnectionState {
 public:
-  using Scalar = std::conditional_t<isInput, const char *, char *>;
+  using Scalar =
+      std::conditional_t<DIR == Direction::Input, const char *, char *>;
   InternalDescriptorUnit(Scalar, std::size_t);
   InternalDescriptorUnit(const Descriptor &, const Terminator &);
   void EndIoStatement();
 
-  bool Emit(const char *, std::size_t bytes, IoErrorHandler &);
+  bool Emit(const char *, std::size_t, IoErrorHandler &);
+  std::optional<char32_t> GetCurrentChar(IoErrorHandler &);
   bool AdvanceRecord(IoErrorHandler &);
-  bool HandleAbsolutePosition(std::int64_t, IoErrorHandler &);
-  bool HandleRelativePosition(std::int64_t, IoErrorHandler &);
+  void BackspaceRecord(IoErrorHandler &);
 
 private:
   Descriptor &descriptor() { return staticDescriptor_.descriptor(); }
+  const Descriptor &descriptor() const {
+    return staticDescriptor_.descriptor();
+  }
+  Scalar CurrentRecord() const {
+    return descriptor().template ZeroBasedIndexedElement<char>(
+        currentRecordNumber - 1);
+  }
   StaticDescriptor<maxRank, true /*addendum*/> staticDescriptor_;
-  SubscriptValue at_[maxRank];
 };
 
-extern template class InternalDescriptorUnit<false>;
-extern template class InternalDescriptorUnit<true>;
+extern template class InternalDescriptorUnit<Direction::Output>;
+extern template class InternalDescriptorUnit<Direction::Input>;
 }
 #endif  // FORTRAN_RUNTIME_IO_INTERNAL_UNIT_H_

flang/runtime/io-api.cpp

@@ -9,11 +9,12 @@
 // Implements the I/O statement API
 
 #include "io-api.h"
+#include "edit-input.h"
+#include "edit-output.h"
 #include "environment.h"
 #include "format.h"
 #include "io-stmt.h"
 #include "memory.h"
-#include "numeric-output.h"
 #include "terminator.h"
 #include "tools.h"
 #include "unit.h"
@@ -22,116 +23,212 @@
 
 namespace Fortran::runtime::io {
 
-Cookie IONAME(BeginInternalArrayListOutput)(const Descriptor &descriptor,
+template<Direction DIR>
+Cookie BeginInternalArrayListIO(const Descriptor &descriptor,
     void ** /*scratchArea*/, std::size_t /*scratchBytes*/,
     const char *sourceFile, int sourceLine) {
   Terminator oom{sourceFile, sourceLine};
-  return &New<InternalListIoStatementState<false>>{}(
+  return &New<InternalListIoStatementState<DIR>>{}(
       oom, descriptor, sourceFile, sourceLine)
               .ioStatementState();
 }
 
-Cookie IONAME(BeginInternalArrayFormattedOutput)(const Descriptor &descriptor,
+Cookie IONAME(BeginInternalArrayListOutput)(const Descriptor &descriptor,
+    void **scratchArea, std::size_t scratchBytes, const char *sourceFile,
+    int sourceLine) {
+  return BeginInternalArrayListIO<Direction::Output>(
+      descriptor, scratchArea, scratchBytes, sourceFile, sourceLine);
+}
+
+Cookie IONAME(BeginInternalArrayListInput)(const Descriptor &descriptor,
+    void **scratchArea, std::size_t scratchBytes, const char *sourceFile,
+    int sourceLine) {
+  return BeginInternalArrayListIO<Direction::Input>(
+      descriptor, scratchArea, scratchBytes, sourceFile, sourceLine);
+}
+
+template<Direction DIR>
+Cookie BeginInternalArrayFormattedIO(const Descriptor &descriptor,
     const char *format, std::size_t formatLength, void ** /*scratchArea*/,
     std::size_t /*scratchBytes*/, const char *sourceFile, int sourceLine) {
   Terminator oom{sourceFile, sourceLine};
-  return &New<InternalFormattedIoStatementState<false>>{}(
+  return &New<InternalFormattedIoStatementState<DIR>>{}(
       oom, descriptor, format, formatLength, sourceFile, sourceLine)
               .ioStatementState();
 }
 
-Cookie IONAME(BeginInternalListOutput)(char *internal,
-    std::size_t internalLength, void ** /*scratchArea*/,
-    std::size_t /*scratchBytes*/, const char *sourceFile, int sourceLine) {
+Cookie IONAME(BeginInternalArrayFormattedOutput)(const Descriptor &descriptor,
+    const char *format, std::size_t formatLength, void **scratchArea,
+    std::size_t scratchBytes, const char *sourceFile, int sourceLine) {
+  return BeginInternalArrayFormattedIO<Direction::Output>(descriptor, format,
+      formatLength, scratchArea, scratchBytes, sourceFile, sourceLine);
+}
+
+Cookie IONAME(BeginInternalArrayFormattedInput)(const Descriptor &descriptor,
+    const char *format, std::size_t formatLength, void **scratchArea,
+    std::size_t scratchBytes, const char *sourceFile, int sourceLine) {
+  return BeginInternalArrayFormattedIO<Direction::Input>(descriptor, format,
+      formatLength, scratchArea, scratchBytes, sourceFile, sourceLine);
+}
+
+template<Direction DIR>
+Cookie BeginInternalFormattedIO(
+    std::conditional_t<DIR == Direction::Input, const char, char> *internal,
+    std::size_t internalLength, const char *format, std::size_t formatLength,
+    void ** /*scratchArea*/, std::size_t /*scratchBytes*/,
+    const char *sourceFile, int sourceLine) {
   Terminator oom{sourceFile, sourceLine};
-  return &New<InternalListIoStatementState<false>>{}(
-      oom, internal, internalLength, sourceFile, sourceLine)
+  return &New<InternalFormattedIoStatementState<DIR>>{}(oom, internal,
+      internalLength, format, formatLength, sourceFile, sourceLine)
               .ioStatementState();
 }
 
 Cookie IONAME(BeginInternalFormattedOutput)(char *internal,
     std::size_t internalLength, const char *format, std::size_t formatLength,
-    void ** /*scratchArea*/, std::size_t /*scratchBytes*/,
-    const char *sourceFile, int sourceLine) {
+    void **scratchArea, std::size_t scratchBytes, const char *sourceFile,
+    int sourceLine) {
   Terminator oom{sourceFile, sourceLine};
-  return &New<InternalFormattedIoStatementState<false>>{}(oom, internal,
-      internalLength, format, formatLength, sourceFile, sourceLine)
-              .ioStatementState();
+  return BeginInternalFormattedIO<Direction::Output>(internal, internalLength,
+      format, formatLength, scratchArea, scratchBytes, sourceFile, sourceLine);
 }
 
-Cookie IONAME(BeginInternalFormattedInput)(char *internal,
+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) {
+    void **scratchArea, std::size_t scratchBytes, const char *sourceFile,
+    int sourceLine) {
   Terminator oom{sourceFile, sourceLine};
-  return &New<InternalFormattedIoStatementState<true>>{}(oom, internal,
-      internalLength, format, formatLength, sourceFile, sourceLine)
-              .ioStatementState();
+  return BeginInternalFormattedIO<Direction::Input>(internal, internalLength,
+      format, formatLength, scratchArea, scratchBytes, sourceFile, sourceLine);
+}
+
+template<Direction DIR>
+Cookie BeginExternalListIO(
+    ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
+  Terminator terminator{sourceFile, sourceLine};
+  if (unitNumber == DefaultUnit) {
+    unitNumber = DIR == Direction::Input ? 5 : 6;
+  }
+  ExternalFileUnit &unit{
+      ExternalFileUnit::LookUpOrCrash(unitNumber, terminator)};
+  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;
+  }
+  IoStatementState &io{unit.BeginIoStatement<ExternalListIoStatementState<DIR>>(
+      unit, sourceFile, sourceLine)};
+  if constexpr (DIR == Direction::Input) {
+    io.AdvanceRecord();
+  }
+  return &io;
 }
 
 Cookie IONAME(BeginExternalListOutput)(
     ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
+  return BeginExternalListIO<Direction::Output>(
+      unitNumber, sourceFile, sourceLine);
+}
+
+Cookie IONAME(BeginExternalListInput)(
+    ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
+  return BeginExternalListIO<Direction::Input>(
+      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};
-  int unit{unitNumber == DefaultUnit ? 6 : unitNumber};
-  ExternalFileUnit &file{ExternalFileUnit::LookUpOrCrash(unit, terminator)};
-  if (file.isUnformatted) {
-    terminator.Crash("List-directed output attempted to unformatted file");
+  if (unitNumber == DefaultUnit) {
+    unitNumber = DIR == Direction::Input ? 5 : 6;
   }
-  return &file.BeginIoStatement<ExternalListIoStatementState<false>>(
-      file, sourceFile, sourceLine);
+  ExternalFileUnit &unit{
+      ExternalFileUnit::LookUpOrCrash(unitNumber, terminator)};
+  if (unit.isUnformatted) {
+    terminator.Crash("Formatted I/O attempted on unformatted file");
+    return nullptr;
+  }
+  IoStatementState &io{
+      unit.BeginIoStatement<ExternalFormattedIoStatementState<DIR>>(
+          unit, format, formatLength, sourceFile, sourceLine)};
+  if constexpr (DIR == Direction::Input) {
+    io.AdvanceRecord();
+  }
+  return &io;
 }
 
 Cookie IONAME(BeginExternalFormattedOutput)(const char *format,
     std::size_t formatLength, ExternalUnit unitNumber, const char *sourceFile,
     int sourceLine) {
-  Terminator terminator{sourceFile, sourceLine};
-  int unit{unitNumber == DefaultUnit ? 6 : unitNumber};
-  ExternalFileUnit &file{ExternalFileUnit::LookUpOrCrash(unit, terminator)};
-  if (file.isUnformatted) {
-    terminator.Crash("Formatted output attempted to unformatted file");
-  }
-  IoStatementState &io{
-      file.BeginIoStatement<ExternalFormattedIoStatementState<false>>(
-          file, format, formatLength, sourceFile, sourceLine)};
-  return &io;
+  return BeginExternalFormattedIO<Direction::Output>(
+      format, formatLength, unitNumber, sourceFile, sourceLine);
 }
 
-Cookie IONAME(BeginUnformattedOutput)(
+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::LookUpOrCrash(unitNumber, terminator)};
   if (!file.isUnformatted) {
-    terminator.Crash("Unformatted output attempted to formatted file");
+    terminator.Crash("Unformatted output attempted on formatted file");
   }
-  IoStatementState &io{
-      file.BeginIoStatement<UnformattedIoStatementState<false>>(
-          file, sourceFile, sourceLine)};
-  if (file.access == Access::Sequential && !file.recordLength.has_value()) {
-    // Filled in by UnformattedIoStatementState<false>::EndIoStatement()
-    io.Emit("\0\0\0\0", 4);  // placeholder for record length header
+  IoStatementState &io{file.BeginIoStatement<UnformattedIoStatementState<DIR>>(
+      file, sourceFile, sourceLine)};
+  if constexpr (DIR == Direction::Input) {
+    io.AdvanceRecord();
+  } else {
+    if (file.access == Access::Sequential && !file.recordLength.has_value()) {
+      // 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;
 }
 
+Cookie IONAME(BeginUnformattedOutput)(
+    ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
+  return BeginUnformattedIO<Direction::Output>(
+      unitNumber, sourceFile, sourceLine);
+}
+
+Cookie IONAME(BeginUnformattedInput)(
+    ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
+  return BeginUnformattedIO<Direction::Input>(
+      unitNumber, sourceFile, sourceLine);
+}
+
 Cookie IONAME(BeginOpenUnit)(  // OPEN(without NEWUNIT=)
     ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
   bool wasExtant{false};
+  Terminator terminator{sourceFile, sourceLine};
   ExternalFileUnit &unit{
-      ExternalFileUnit::LookUpOrCreate(unitNumber, &wasExtant)};
+      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(), sourceFile, sourceLine);
+      ExternalFileUnit::NewUnit(terminator), sourceFile, sourceLine);
 }
 
 Cookie IONAME(BeginClose)(
     ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
-  if (ExternalFileUnit * unit{ExternalFileUnit::LookUp(unitNumber)}) {
+  if (ExternalFileUnit * unit{ExternalFileUnit::LookUpForClose(unitNumber)}) {
     return &unit->BeginIoStatement<CloseStatementState>(
         *unit, sourceFile, sourceLine);
   } else {
@@ -144,8 +241,8 @@ Cookie IONAME(BeginClose)(
 
 // Control list items
 
-void IONAME(EnableHandlers)(
-    Cookie cookie, bool hasIoStat, bool hasErr, bool hasEnd, bool hasEor) {
+void IONAME(EnableHandlers)(Cookie cookie, bool hasIoStat, bool hasErr,
+    bool hasEnd, bool hasEor, bool hasIoMsg) {
   IoErrorHandler &handler{cookie->GetIoErrorHandler()};
   if (hasIoStat) {
     handler.HasIoStat();
@@ -159,17 +256,20 @@ void IONAME(EnableHandlers)(
   if (hasEor) {
     handler.HasEorLabel();
   }
+  if (hasIoMsg) {
+    handler.HasIoMsg();
+  }
 }
 
 static bool YesOrNo(const char *keyword, std::size_t length, const char *what,
-    const Terminator &terminator) {
+    IoErrorHandler &handler) {
   static const char *keywords[]{"YES", "NO", nullptr};
   switch (IdentifyValue(keyword, length, keywords)) {
   case 0: return true;
   case 1: return false;
   default:
-    terminator.Crash(
-        "Invalid %s='%.*s'", what, static_cast<int>(length), keyword);
+    handler.SignalError(IostatErrorInKeyword, "Invalid %s='%.*s'", what,
+        static_cast<int>(length), keyword);
     return false;
   }
 }
@@ -180,6 +280,10 @@ bool IONAME(SetAdvance)(
   ConnectionState &connection{io.GetConnectionState()};
   connection.nonAdvancing =
       !YesOrNo(keyword, length, "ADVANCE", io.GetIoErrorHandler());
+  if (connection.nonAdvancing && connection.access == Access::Direct) {
+    io.GetIoErrorHandler().SignalError(
+        "Non-advancing I/O attempted on direct access file");
+  }
   return true;
 }
 
@@ -191,7 +295,7 @@ bool IONAME(SetBlank)(Cookie cookie, const char *keyword, std::size_t length) {
   case 0: connection.modes.editingFlags &= ~blankZero; return true;
   case 1: connection.modes.editingFlags |= blankZero; return true;
   default:
-    io.GetIoErrorHandler().Crash(
+    io.GetIoErrorHandler().SignalError(IostatErrorInKeyword,
         "Invalid BLANK='%.*s'", static_cast<int>(length), keyword);
     return false;
   }
@@ -206,7 +310,7 @@ bool IONAME(SetDecimal)(
   case 0: connection.modes.editingFlags |= decimalComma; return true;
   case 1: connection.modes.editingFlags &= ~decimalComma; return true;
   default:
-    io.GetIoErrorHandler().Crash(
+    io.GetIoErrorHandler().SignalError(IostatErrorInKeyword,
         "Invalid DECIMAL='%.*s'", static_cast<int>(length), keyword);
     return false;
   }
@@ -221,7 +325,7 @@ bool IONAME(SetDelim)(Cookie cookie, const char *keyword, std::size_t length) {
   case 1: connection.modes.delim = '"'; return true;
   case 2: connection.modes.delim = '\0'; return true;
   default:
-    io.GetIoErrorHandler().Crash(
+    io.GetIoErrorHandler().SignalError(IostatErrorInKeyword,
         "Invalid DELIM='%.*s'", static_cast<int>(length), keyword);
     return false;
   }
@@ -235,8 +339,50 @@ bool IONAME(SetPad)(Cookie cookie, const char *keyword, std::size_t length) {
   return true;
 }
 
-// TODO: SetPos (stream I/O)
-// TODO: SetRec (direct I/O)
+bool IONAME(SetPos)(Cookie cookie, std::int64_t pos) {
+  IoStatementState &io{*cookie};
+  ConnectionState &connection{io.GetConnectionState()};
+  if (connection.access != Access::Stream) {
+    io.GetIoErrorHandler().SignalError(
+        "REC= may not appear unless ACCESS='STREAM'");
+    return false;
+  }
+  if (pos < 1) {
+    io.GetIoErrorHandler().SignalError(
+        "POS=%zd is invalid", static_cast<std::intmax_t>(pos));
+    return false;
+  }
+  if (auto *unit{io.GetExternalFileUnit()}) {
+    unit->SetPosition(pos);
+    return true;
+  }
+  io.GetIoErrorHandler().Crash("SetPos() on internal unit");
+  return false;
+}
+
+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) {
+    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;
+  }
+  connection.currentRecordNumber = rec;
+  if (auto *unit{io.GetExternalFileUnit()}) {
+    unit->SetPosition(rec * *connection.recordLength);
+  }
+  return true;
+}
 
 bool IONAME(SetRound)(Cookie cookie, const char *keyword, std::size_t length) {
   IoStatementState &io{*cookie};
@@ -253,7 +399,7 @@ bool IONAME(SetRound)(Cookie cookie, const char *keyword, std::size_t length) {
     connection.modes.round = executionEnvironment.defaultOutputRoundingMode;
     return true;
   default:
-    io.GetIoErrorHandler().Crash(
+    io.GetIoErrorHandler().SignalError(IostatErrorInKeyword,
         "Invalid ROUND='%.*s'", static_cast<int>(length), keyword);
     return false;
   }
@@ -270,7 +416,7 @@ bool IONAME(SetSign)(Cookie cookie, const char *keyword, std::size_t length) {
     connection.modes.editingFlags &= ~signPlus;
     return true;
   default:
-    io.GetIoErrorHandler().Crash(
+    io.GetIoErrorHandler().SignalError(IostatErrorInKeyword,
         "Invalid SIGN='%.*s'", static_cast<int>(length), keyword);
     return false;
   }
@@ -291,11 +437,12 @@ bool IONAME(SetAccess)(Cookie cookie, const char *keyword, std::size_t length) {
   case 1: access = Access::Direct; break;
   case 2: access = Access::Stream; break;
   default:
-    open->Crash("Invalid ACCESS='%.*s'", static_cast<int>(length), keyword);
+    open->SignalError(IostatErrorInKeyword, "Invalid ACCESS='%.*s'",
+        static_cast<int>(length), keyword);
   }
   if (access != connection.access) {
     if (open->wasExtant()) {
-      open->Crash("ACCESS= may not be changed on an open unit");
+      open->SignalError("ACCESS= may not be changed on an open unit");
     }
     connection.access = access;
   }
@@ -317,13 +464,14 @@ bool IONAME(SetAction)(Cookie cookie, const char *keyword, std::size_t length) {
   case 1: mayRead = false; break;
   case 2: break;
   default:
-    open->Crash("Invalid ACTION='%.*s'", static_cast<int>(length), keyword);
+    open->SignalError(IostatErrorInKeyword, "Invalid ACTION='%.*s'",
+        static_cast<int>(length), keyword);
     return false;
   }
   if (mayRead != open->unit().mayRead() ||
       mayWrite != open->unit().mayWrite()) {
     if (open->wasExtant()) {
-      open->Crash("ACTION= may not be changed on an open unit");
+      open->SignalError("ACTION= may not be changed on an open unit");
     }
     open->unit().set_mayRead(mayRead);
     open->unit().set_mayWrite(mayWrite);
@@ -344,8 +492,8 @@ bool IONAME(SetAsynchronous)(
   case 0: open->unit().set_mayAsynchronous(true); return true;
   case 1: open->unit().set_mayAsynchronous(false); return true;
   default:
-    open->Crash(
-        "Invalid ASYNCHRONOUS='%.*s'", static_cast<int>(length), keyword);
+    open->SignalError(IostatErrorInKeyword, "Invalid ASYNCHRONOUS='%.*s'",
+        static_cast<int>(length), keyword);
     return false;
   }
 }
@@ -364,11 +512,12 @@ bool IONAME(SetEncoding)(
   case 0: isUTF8 = true; break;
   case 1: isUTF8 = false; break;
   default:
-    open->Crash("Invalid ENCODING='%.*s'", static_cast<int>(length), keyword);
+    open->SignalError(IostatErrorInKeyword, "Invalid ENCODING='%.*s'",
+        static_cast<int>(length), keyword);
   }
   if (isUTF8 != open->unit().isUTF8) {
     if (open->wasExtant()) {
-      open->Crash("ENCODING= may not be changed on an open unit");
+      open->SignalError("ENCODING= may not be changed on an open unit");
     }
     open->unit().isUTF8 = isUTF8;
   }
@@ -388,11 +537,12 @@ bool IONAME(SetForm)(Cookie cookie, const char *keyword, std::size_t length) {
   case 0: isUnformatted = false; break;
   case 1: isUnformatted = true; break;
   default:
-    open->Crash("Invalid FORM='%.*s'", static_cast<int>(length), keyword);
+    open->SignalError(IostatErrorInKeyword, "Invalid FORM='%.*s'",
+        static_cast<int>(length), keyword);
   }
   if (isUnformatted != open->unit().isUnformatted) {
     if (open->wasExtant()) {
-      open->Crash("FORM= may not be changed on an open unit");
+      open->SignalError("FORM= may not be changed on an open unit");
     }
     open->unit().isUnformatted = isUnformatted;
   }
@@ -413,7 +563,7 @@ bool IONAME(SetPosition)(
   case 1: open->set_position(Position::Rewind); return true;
   case 2: open->set_position(Position::Append); return true;
   default:
-    io.GetIoErrorHandler().Crash(
+    io.GetIoErrorHandler().SignalError(IostatErrorInKeyword,
         "Invalid POSITION='%.*s'", static_cast<int>(length), keyword);
   }
   return true;
@@ -426,9 +576,12 @@ bool IONAME(SetRecl)(Cookie cookie, std::size_t n) {
     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 != n) {
-    open->Crash("RECL= may not be changed for an open unit");
+      *open->unit().recordLength != static_cast<std::int64_t>(n)) {
+    open->SignalError("RECL= may not be changed for an open unit");
   }
   open->unit().recordLength = n;
   return true;
@@ -446,7 +599,7 @@ bool IONAME(SetStatus)(Cookie cookie, const char *keyword, std::size_t length) {
     case 3: open->set_status(OpenStatus::Replace); return true;
     case 4: open->set_status(OpenStatus::Unknown); return true;
     default:
-      io.GetIoErrorHandler().Crash(
+      io.GetIoErrorHandler().SignalError(IostatErrorInKeyword,
           "Invalid STATUS='%.*s'", static_cast<int>(length), keyword);
     }
     return false;
@@ -457,7 +610,7 @@ bool IONAME(SetStatus)(Cookie cookie, const char *keyword, std::size_t length) {
     case 0: close->set_status(CloseStatus::Keep); return true;
     case 1: close->set_status(CloseStatus::Delete); return true;
     default:
-      io.GetIoErrorHandler().Crash(
+      io.GetIoErrorHandler().SignalError(IostatErrorInKeyword,
           "Invalid STATUS='%.*s'", static_cast<int>(length), keyword);
     }
     return false;
@@ -499,13 +652,12 @@ bool IONAME(GetNewUnit)(Cookie cookie, int &unit, int kind) {
         "GetNewUnit() called when not in an OPEN statement");
   }
   if (!SetInteger(unit, kind, open->unit().unitNumber())) {
-    open->Crash("GetNewUnit(): Bad INTEGER kind(%d) for result");
+    open->SignalError("GetNewUnit(): Bad INTEGER kind(%d) for result");
   }
   return true;
 }
 
 // Data transfers
-// TODO: Input
 
 bool IONAME(OutputDescriptor)(Cookie cookie, const Descriptor &) {
   IoStatementState &io{*cookie};
@@ -516,7 +668,7 @@ bool IONAME(OutputDescriptor)(Cookie cookie, const Descriptor &) {
 bool IONAME(OutputUnformattedBlock)(
     Cookie cookie, const char *x, std::size_t length) {
   IoStatementState &io{*cookie};
-  if (auto *unf{io.get_if<UnformattedIoStatementState<false>>()}) {
+  if (auto *unf{io.get_if<UnformattedIoStatementState<Direction::Output>>()}) {
     return unf->Emit(x, length);
   }
   io.GetIoErrorHandler().Crash("OutputUnformatted() called for an I/O "
@@ -531,7 +683,26 @@ bool IONAME(OutputInteger64)(Cookie cookie, std::int64_t n) {
         "OutputInteger64() called for a non-output I/O statement");
     return false;
   }
-  return EditIntegerOutput(io, io.GetNextDataEdit(), n);
+  if (auto edit{io.GetNextDataEdit()}) {
+    return EditIntegerOutput(io, *edit, n);
+  }
+  return false;
+}
+
+bool IONAME(InputInteger)(Cookie cookie, std::int64_t &n, int kind) {
+  IoStatementState &io{*cookie};
+  if (!io.get_if<InputStatementState>()) {
+    io.GetIoErrorHandler().Crash(
+        "InputInteger64() called for a non-input I/O statement");
+    return false;
+  }
+  if (auto edit{io.GetNextDataEdit()}) {
+    if (edit->descriptor == DataEdit::ListDirectedNullValue) {
+      return true;
+    }
+    return EditIntegerInput(io, *edit, reinterpret_cast<void *>(&n), kind);
+  }
+  return false;
 }
 
 bool IONAME(OutputReal64)(Cookie cookie, double x) {
@@ -541,12 +712,31 @@ bool IONAME(OutputReal64)(Cookie cookie, double x) {
         "OutputReal64() called for a non-output I/O statement");
     return false;
   }
-  return RealOutputEditing<53>{io, x}.Edit(io.GetNextDataEdit());
+  if (auto edit{io.GetNextDataEdit()}) {
+    return RealOutputEditing<53>{io, x}.Edit(*edit);
+  }
+  return false;
+}
+
+bool IONAME(InputReal64)(Cookie cookie, double &x) {
+  IoStatementState &io{*cookie};
+  if (!io.get_if<InputStatementState>()) {
+    io.GetIoErrorHandler().Crash(
+        "InputReal64() called for a non-input I/O statement");
+    return false;
+  }
+  if (auto edit{io.GetNextDataEdit()}) {
+    if (edit->descriptor == DataEdit::ListDirectedNullValue) {
+      return true;
+    }
+    return EditRealInput<53>(io, *edit, reinterpret_cast<void *>(&x));
+  }
+  return false;
 }
 
 bool IONAME(OutputComplex64)(Cookie cookie, double r, double z) {
   IoStatementState &io{*cookie};
-  if (io.get_if<ListDirectedStatementState<false>>()) {
+  if (io.get_if<ListDirectedStatementState<Direction::Output>>()) {
     DataEdit real, imaginary;
     real.descriptor = DataEdit::ListDirectedRealPart;
     imaginary.descriptor = DataEdit::ListDirectedImaginaryPart;
@@ -563,53 +753,29 @@ bool IONAME(OutputAscii)(Cookie cookie, const char *x, std::size_t length) {
         "OutputAscii() called for a non-output I/O statement");
     return false;
   }
-  bool ok{true};
-  if (auto *list{io.get_if<ListDirectedStatementState<false>>()}) {
-    // List-directed default CHARACTER output
-    ok &= list->EmitLeadingSpaceOrAdvance(io, length, true);
-    MutableModes &modes{io.mutableModes()};
-    ConnectionState &connection{io.GetConnectionState()};
-    if (modes.delim) {
-      ok &= io.Emit(&modes.delim, 1);
-      for (std::size_t j{0}; j < length; ++j) {
-        if (list->NeedAdvance(connection, 2)) {
-          ok &= io.Emit(&modes.delim, 1) && io.AdvanceRecord() &&
-              io.Emit(&modes.delim, 1);
-        }
-        if (x[j] == modes.delim) {
-          ok &= io.EmitRepeated(modes.delim, 2);
-        } else {
-          ok &= io.Emit(&x[j], 1);
-        }
-      }
-      ok &= io.Emit(&modes.delim, 1);
-    } else {
-      std::size_t put{0};
-      while (put < length) {
-        auto chunk{std::min(length - put, connection.RemainingSpaceInRecord())};
-        ok &= io.Emit(x + put, chunk);
-        put += chunk;
-        if (put < length) {
-          ok &= io.AdvanceRecord() && io.Emit(" ", 1);
-        }
-      }
-      list->lastWasUndelimitedCharacter = true;
-    }
+  if (auto *list{io.get_if<ListDirectedStatementState<Direction::Output>>()}) {
+    return ListDirectedDefaultCharacterOutput(io, *list, x, length);
+  } else if (auto edit{io.GetNextDataEdit()}) {
+    return EditDefaultCharacterOutput(io, *edit, x, length);
   } else {
-    // Formatted default CHARACTER output
-    DataEdit edit{io.GetNextDataEdit()};
-    if (edit.descriptor != 'A' && edit.descriptor != 'G') {
-      io.GetIoErrorHandler().Crash("Data edit descriptor '%c' may not be used "
-                                   "with a CHARACTER data item",
-          edit.descriptor);
-      return false;
-    }
-    int len{static_cast<int>(length)};
-    int width{edit.width.value_or(len)};
-    ok &= io.EmitRepeated(' ', std::max(0, width - len)) &&
-        io.Emit(x, std::min(width, len));
+    return false;
   }
-  return ok;
+}
+
+bool IONAME(InputAscii)(Cookie cookie, char *x, std::size_t length) {
+  IoStatementState &io{*cookie};
+  if (!io.get_if<InputStatementState>()) {
+    io.GetIoErrorHandler().Crash(
+        "InputAscii() called for a non-input I/O statement");
+    return false;
+  }
+  if (auto edit{io.GetNextDataEdit()}) {
+    if (edit->descriptor == DataEdit::ListDirectedNullValue) {
+      return true;
+    }
+    return EditDefaultCharacterInput(io, *edit, x, length);
+  }
+  return false;
 }
 
 bool IONAME(OutputLogical)(Cookie cookie, bool truth) {
@@ -619,24 +785,36 @@ bool IONAME(OutputLogical)(Cookie cookie, bool truth) {
         "OutputLogical() called for a non-output I/O statement");
     return false;
   }
-  if (auto *unf{io.get_if<UnformattedIoStatementState<false>>()}) {
-    char x = truth;
-    return unf->Emit(&x, 1);
-  }
-  bool ok{true};
-  if (auto *list{io.get_if<ListDirectedStatementState<false>>()}) {
-    ok &= list->EmitLeadingSpaceOrAdvance(io, 1);
+  if (auto *list{io.get_if<ListDirectedStatementState<Direction::Output>>()}) {
+    return ListDirectedLogicalOutput(io, *list, truth);
+  } else if (auto edit{io.GetNextDataEdit()}) {
+    return EditLogicalOutput(io, *edit, truth);
   } else {
-    DataEdit edit{io.GetNextDataEdit()};
-    if (edit.descriptor != 'L' && edit.descriptor != 'G') {
-      io.GetIoErrorHandler().Crash(
-          "Data edit descriptor '%c' may not be used with a LOGICAL data item",
-          edit.descriptor);
-      return false;
-    }
-    ok &= io.EmitRepeated(' ', std::max(0, edit.width.value_or(1) - 1));
+    return false;
+  }
+}
+
+bool IONAME(InputLogical)(Cookie cookie, bool &truth) {
+  IoStatementState &io{*cookie};
+  if (!io.get_if<InputStatementState>()) {
+    io.GetIoErrorHandler().Crash(
+        "InputLogical() called for a non-input I/O statement");
+    return false;
+  }
+  if (auto edit{io.GetNextDataEdit()}) {
+    if (edit->descriptor == DataEdit::ListDirectedNullValue) {
+      return true;
+    }
+    return EditLogicalInput(io, *edit, truth);
+  }
+  return false;
+}
+
+void IONAME(GetIoMsg)(Cookie cookie, char *msg, std::size_t length) {
+  IoErrorHandler &handler{cookie->GetIoErrorHandler()};
+  if (handler.GetIoStat()) {  // leave "msg" alone when no error
+    handler.GetIoMsg(msg, length);
   }
-  return ok && io.Emit(truth ? "T" : "F", 1);
 }
 
 enum Iostat IONAME(EndIoStatement)(Cookie cookie) {

flang/runtime/io-api.h

@@ -12,7 +12,7 @@
 #define FORTRAN_RUNTIME_IO_API_H_
 
 #include "entry-names.h"
-#include "magic-numbers.h"
+#include "iostat.h"
 #include <cinttypes>
 #include <cstddef>
 
@@ -73,7 +73,7 @@ Cookie IONAME(BeginInternalListOutput)(char *internal,
     std::size_t internalLength, void **scratchArea = nullptr,
     std::size_t scratchBytes = 0, const char *sourceFile = nullptr,
     int sourceLine = 0);
-Cookie IONAME(BeginInternalListInput)(char *internal,
+Cookie IONAME(BeginInternalListInput)(const char *internal,
     std::size_t internalLength, void **scratchArea = nullptr,
     std::size_t scratchBytes = 0, const char *sourceFile = nullptr,
     int sourceLine = 0);
@@ -81,7 +81,7 @@ Cookie IONAME(BeginInternalFormattedOutput)(char *internal,
     std::size_t internalLength, const char *format, std::size_t formatLength,
     void **scratchArea = nullptr, std::size_t scratchBytes = 0,
     const char *sourceFile = nullptr, int sourceLine = 0);
-Cookie IONAME(BeginInternalFormattedInput)(char *internal,
+Cookie IONAME(BeginInternalFormattedInput)(const char *internal,
     std::size_t internalLength, const char *format, std::size_t formatLength,
     void **scratchArea = nullptr, std::size_t scratchBytes = 0,
     const char *sourceFile = nullptr, int sourceLine = 0);
@@ -172,7 +172,7 @@ Cookie IONAME(BeginInquireIoLength)(
 //   }
 //   if (EndIoStatement(cookie) == FORTRAN_RUTIME_IOSTAT_END) goto label666;
 void IONAME(EnableHandlers)(Cookie, bool hasIoStat = false, bool hasErr = false,
-    bool hasEnd = false, bool hasEor = false);
+    bool hasEnd = false, bool hasEor = false, bool hasIoMsg = false);
 
 // Control list options.  These return false on a error that the
 // Begin...() call has specified will be handled by the caller.
@@ -214,7 +214,7 @@ bool IONAME(InputDescriptor)(Cookie, const Descriptor &);
 bool IONAME(OutputUnformattedBlock)(Cookie, const char *, std::size_t);
 bool IONAME(InputUnformattedBlock)(Cookie, char *, std::size_t);
 bool IONAME(OutputInteger64)(Cookie, std::int64_t);
-bool IONAME(InputInteger64)(Cookie, std::int64_t &, int kind = 8);
+bool IONAME(InputInteger)(Cookie, std::int64_t &, int kind = 8);
 bool IONAME(OutputReal32)(Cookie, float);
 bool IONAME(InputReal32)(Cookie, float &);
 bool IONAME(OutputReal64)(Cookie, double);
@@ -282,23 +282,6 @@ bool IONAME(InquirePendingId)(Cookie, std::int64_t, bool &);
 bool IONAME(InquireInteger64)(
     Cookie, const char *specifier, std::int64_t &, int kind = 8);
 
-// The value of IOSTAT= is zero when no error, end-of-record,
-// or end-of-file condition has arisen; errors are positive values.
-// (See 12.11.5 in Fortran 2018 for the complete requirements;
-// these constants must match the values of their corresponding
-// named constants in the predefined module ISO_FORTRAN_ENV, so
-// they're actually defined in another magic-numbers.h header file
-// so that they can be included both here and there.)
-enum Iostat {
-  // Other errors have values >1
-  IostatInquireInternalUnit = FORTRAN_RUNTIME_IOSTAT_INQUIRE_INTERNAL_UNIT,
-  IostatOk = 0,
-  IostatEnd = FORTRAN_RUNTIME_IOSTAT_END,  // end-of-file & no error
-  IostatEor = FORTRAN_RUNTIME_IOSTAT_EOR,  // end-of-record & no error or EOF
-  IostatFlush =
-      FORTRAN_RUNTIME_IOSTAT_FLUSH,  // attempt to FLUSH an unflushable unit
-};
-
 // This function must be called to end an I/O statement, and its
 // cookie value may not be used afterwards unless it is recycled
 // by the runtime library to serve a later I/O statement.

flang/runtime/io-error.cpp

@@ -8,7 +8,9 @@
 
 #include "io-error.h"
 #include "magic-numbers.h"
+#include "tools.h"
 #include <cerrno>
+#include <cstdarg>
 #include <cstdio>
 #include <cstring>
 
@@ -17,46 +19,63 @@ namespace Fortran::runtime::io {
 void IoErrorHandler::Begin(const char *sourceFileName, int sourceLine) {
   flags_ = 0;
   ioStat_ = 0;
+  ioMsg_.reset();
   SetLocation(sourceFileName, sourceLine);
 }
 
-void IoErrorHandler::SignalError(int iostatOrErrno) {
-  if (iostatOrErrno == FORTRAN_RUNTIME_IOSTAT_END) {
-    SignalEnd();
-  } else if (iostatOrErrno == FORTRAN_RUNTIME_IOSTAT_EOR) {
-    SignalEor();
-  } else if (iostatOrErrno != 0) {
-    if (flags_ & hasIoStat) {
+void IoErrorHandler::SignalError(int iostatOrErrno, const char *msg, ...) {
+  if (iostatOrErrno == IostatEnd && (flags_ & hasEnd)) {
+    if (!ioStat_ || ioStat_ < IostatEnd) {
+      ioStat_ = IostatEnd;
+    }
+  } else if (iostatOrErrno == IostatEor && (flags_ & hasEor)) {
+    if (!ioStat_ || ioStat_ < IostatEor) {
+      ioStat_ = IostatEor;  // least priority
+    }
+  } else if (iostatOrErrno != IostatOk) {
+    if (flags_ & (hasIoStat | hasErr)) {
       if (ioStat_ <= 0) {
         ioStat_ = iostatOrErrno;  // priority over END=/EOR=
+        if (msg && (flags_ & hasIoMsg)) {
+          char buffer[256];
+          va_list ap;
+          va_start(ap, msg);
+          std::vsnprintf(buffer, sizeof buffer, msg, ap);
+          ioMsg_ = SaveDefaultCharacter(buffer, std::strlen(buffer) + 1, *this);
+        }
       }
-    } else if (iostatOrErrno == FORTRAN_RUNTIME_IOSTAT_INQUIRE_INTERNAL_UNIT) {
-      Crash("INQUIRE on internal unit");
+    } else if (msg) {
+      va_list ap;
+      va_start(ap, msg);
+      CrashArgs(msg, ap);
+    } else if (const char *errstr{IostatErrorString(iostatOrErrno)}) {
+      Crash(errstr);
     } else {
-      Crash("I/O error %d: %s", iostatOrErrno, std::strerror(iostatOrErrno));
+      Crash("I/O error (errno=%d): %s", iostatOrErrno,
+          std::strerror(iostatOrErrno));
     }
   }
 }
 
+void IoErrorHandler::SignalError(int iostatOrErrno) {
+  SignalError(iostatOrErrno, nullptr);
+}
+
 void IoErrorHandler::SignalErrno() { SignalError(errno); }
 
-void IoErrorHandler::SignalEnd() {
-  if (flags_ & hasEnd) {
-    if (!ioStat_ || ioStat_ < FORTRAN_RUNTIME_IOSTAT_END) {
-      ioStat_ = FORTRAN_RUNTIME_IOSTAT_END;
-    }
-  } else {
-    Crash("End of file");
-  }
-}
+void IoErrorHandler::SignalEnd() { SignalError(IostatEnd); }
 
-void IoErrorHandler::SignalEor() {
-  if (flags_ & hasEor) {
-    if (!ioStat_ || ioStat_ < FORTRAN_RUNTIME_IOSTAT_EOR) {
-      ioStat_ = FORTRAN_RUNTIME_IOSTAT_EOR;  // least priority
-    }
-  } else {
-    Crash("End of record");
+void IoErrorHandler::SignalEor() { SignalError(IostatEor); }
+
+bool IoErrorHandler::GetIoMsg(char *buffer, std::size_t bufferLength) {
+  const char *msg{ioMsg_.get()};
+  if (!msg) {
+    msg = IostatErrorString(ioStat_);
   }
+  if (msg) {
+    ToFortranDefaultCharacter(buffer, bufferLength, msg);
+    return true;
+  }
+  return ::strerror_r(ioStat_, buffer, bufferLength) == 0;
 }
 }

flang/runtime/io-error.h

@@ -9,15 +9,20 @@
 // Distinguishes I/O error conditions; fatal ones lead to termination,
 // and those that the user program has chosen to handle are recorded
 // so that the highest-priority one can be returned as IOSTAT=.
+// IOSTAT error codes are raw errno values augmented with values for
+// Fortran-specific errors.
 
 #ifndef FORTRAN_RUNTIME_IO_ERROR_H_
 #define FORTRAN_RUNTIME_IO_ERROR_H_
 
+#include "iostat.h"
+#include "memory.h"
 #include "terminator.h"
 #include <cinttypes>
 
 namespace Fortran::runtime::io {
 
+// See 12.11 in Fortran 2018
 class IoErrorHandler : public Terminator {
 public:
   using Terminator::Terminator;
@@ -27,13 +32,22 @@ public:
   void HasErrLabel() { flags_ |= hasErr; }
   void HasEndLabel() { flags_ |= hasEnd; }
   void HasEorLabel() { flags_ |= hasEor; }
+  void HasIoMsg() { flags_ |= hasIoMsg; }
 
+  bool InError() const { return ioStat_ != 0; }
+
+  void SignalError(int iostatOrErrno, const char *msg, ...);
   void SignalError(int iostatOrErrno);
-  void SignalErrno();
-  void SignalEnd();
-  void SignalEor();
+  template<typename... X> void SignalError(const char *msg, X &&... xs) {
+    SignalError(IostatGenericError, msg, std::forward<X>(xs)...);
+  }
+
+  void SignalErrno();  // SignalError(errno)
+  void SignalEnd();  // input only; EOF on internal write is an error
+  void SignalEor();  // non-advancing input only; EOR on write is an error
 
   int GetIoStat() const { return ioStat_; }
+  bool GetIoMsg(char *, std::size_t);
 
 private:
   enum Flag : std::uint8_t {
@@ -41,9 +55,11 @@ private:
     hasErr = 2,  // ERR=
     hasEnd = 4,  // END=
     hasEor = 8,  // EOR=
+    hasIoMsg = 16,  // IOMSG=
   };
   std::uint8_t flags_{0};
   int ioStat_{0};
+  OwningPtr<char> ioMsg_;
 };
 
 }

flang/runtime/io-stmt.cpp

@@ -20,33 +20,43 @@ namespace Fortran::runtime::io {
 
 int IoStatementBase::EndIoStatement() { return GetIoStat(); }
 
-DataEdit IoStatementBase::GetNextDataEdit(int) {
-  Crash("IoStatementBase::GetNextDataEdit() called for non-formatted I/O "
-        "statement");
+std::optional<DataEdit> IoStatementBase::GetNextDataEdit(
+    IoStatementState &, int) {
+  return std::nullopt;
 }
 
-template<bool isInput, typename CHAR>
-InternalIoStatementState<isInput, CHAR>::InternalIoStatementState(
+template<Direction DIR, typename CHAR>
+InternalIoStatementState<DIR, CHAR>::InternalIoStatementState(
     Buffer scalar, std::size_t length, const char *sourceFile, int sourceLine)
   : IoStatementBase{sourceFile, sourceLine}, unit_{scalar, length} {}
 
-template<bool isInput, typename CHAR>
-InternalIoStatementState<isInput, CHAR>::InternalIoStatementState(
+template<Direction DIR, typename CHAR>
+InternalIoStatementState<DIR, CHAR>::InternalIoStatementState(
     const Descriptor &d, const char *sourceFile, int sourceLine)
   : IoStatementBase{sourceFile, sourceLine}, unit_{d, *this} {}
 
-template<bool isInput, typename CHAR>
-bool InternalIoStatementState<isInput, CHAR>::Emit(
+template<Direction DIR, typename CHAR>
+bool InternalIoStatementState<DIR, CHAR>::Emit(
     const CharType *data, std::size_t chars) {
-  if constexpr (isInput) {
-    Crash("InternalIoStatementState<true>::Emit() called for input statement");
+  if constexpr (DIR == Direction::Input) {
+    Crash("InternalIoStatementState<Direction::Input>::Emit() called");
     return false;
   }
   return unit_.Emit(data, chars, *this);
 }
 
-template<bool isInput, typename CHAR>
-bool InternalIoStatementState<isInput, CHAR>::AdvanceRecord(int n) {
+template<Direction DIR, typename CHAR>
+std::optional<char32_t> InternalIoStatementState<DIR, CHAR>::GetCurrentChar() {
+  if constexpr (DIR == Direction::Output) {
+    Crash(
+        "InternalIoStatementState<Direction::Output>::GetCurrentChar() called");
+    return std::nullopt;
+  }
+  return unit_.GetCurrentChar(*this);
+}
+
+template<Direction DIR, typename CHAR>
+bool InternalIoStatementState<DIR, CHAR>::AdvanceRecord(int n) {
   while (n-- > 0) {
     if (!unit_.AdvanceRecord(*this)) {
       return false;
@@ -55,9 +65,14 @@ bool InternalIoStatementState<isInput, CHAR>::AdvanceRecord(int n) {
   return true;
 }
 
-template<bool isInput, typename CHAR>
-int InternalIoStatementState<isInput, CHAR>::EndIoStatement() {
-  if constexpr (!isInput) {
+template<Direction DIR, typename CHAR>
+void InternalIoStatementState<DIR, CHAR>::BackspaceRecord() {
+  unit_.BackspaceRecord(*this);
+}
+
+template<Direction DIR, typename CHAR>
+int InternalIoStatementState<DIR, CHAR>::EndIoStatement() {
+  if constexpr (DIR == Direction::Output) {
     unit_.EndIoStatement();  // fill
   }
   auto result{IoStatementBase::EndIoStatement()};
@@ -67,54 +82,51 @@ int InternalIoStatementState<isInput, CHAR>::EndIoStatement() {
   return result;
 }
 
-template<bool isInput, typename CHAR>
-InternalFormattedIoStatementState<isInput,
-    CHAR>::InternalFormattedIoStatementState(Buffer buffer, std::size_t length,
-    const CHAR *format, std::size_t formatLength, const char *sourceFile,
-    int sourceLine)
-  : InternalIoStatementState<isInput, CHAR>{buffer, length, sourceFile,
-        sourceLine},
+template<Direction DIR, typename CHAR>
+void InternalIoStatementState<DIR, CHAR>::HandleAbsolutePosition(
+    std::int64_t n) {
+  return unit_.HandleAbsolutePosition(n);
+}
+
+template<Direction DIR, typename CHAR>
+void InternalIoStatementState<DIR, CHAR>::HandleRelativePosition(
+    std::int64_t n) {
+  return unit_.HandleRelativePosition(n);
+}
+
+template<Direction DIR, typename CHAR>
+InternalFormattedIoStatementState<DIR, CHAR>::InternalFormattedIoStatementState(
+    Buffer buffer, std::size_t length, const CHAR *format,
+    std::size_t formatLength, const char *sourceFile, int sourceLine)
+  : InternalIoStatementState<DIR, CHAR>{buffer, length, sourceFile, sourceLine},
     ioStatementState_{*this}, format_{*this, format, formatLength} {}
 
-template<bool isInput, typename CHAR>
-InternalFormattedIoStatementState<isInput,
-    CHAR>::InternalFormattedIoStatementState(const Descriptor &d,
-    const CHAR *format, std::size_t formatLength, const char *sourceFile,
-    int sourceLine)
-  : InternalIoStatementState<isInput, CHAR>{d, sourceFile, sourceLine},
+template<Direction DIR, typename CHAR>
+InternalFormattedIoStatementState<DIR, CHAR>::InternalFormattedIoStatementState(
+    const Descriptor &d, const CHAR *format, std::size_t formatLength,
+    const char *sourceFile, int sourceLine)
+  : InternalIoStatementState<DIR, CHAR>{d, sourceFile, sourceLine},
     ioStatementState_{*this}, format_{*this, format, formatLength} {}
 
-template<bool isInput, typename CHAR>
-int InternalFormattedIoStatementState<isInput, CHAR>::EndIoStatement() {
-  if constexpr (!isInput) {
-    format_.FinishOutput(*this);
+template<Direction DIR, typename CHAR>
+int InternalFormattedIoStatementState<DIR, CHAR>::EndIoStatement() {
+  if constexpr (DIR == Direction::Output) {
+    format_.Finish(*this);  // ignore any remaining input positioning actions
   }
-  return InternalIoStatementState<isInput, CHAR>::EndIoStatement();
+  return InternalIoStatementState<DIR, CHAR>::EndIoStatement();
 }
 
-template<bool isInput, typename CHAR>
-bool InternalFormattedIoStatementState<isInput, CHAR>::HandleAbsolutePosition(
-    std::int64_t n) {
-  return unit_.HandleAbsolutePosition(n, *this);
-}
-
-template<bool isInput, typename CHAR>
-bool InternalFormattedIoStatementState<isInput, CHAR>::HandleRelativePosition(
-    std::int64_t n) {
-  return unit_.HandleRelativePosition(n, *this);
-}
-
-template<bool isInput, typename CHAR>
-InternalListIoStatementState<isInput, CHAR>::InternalListIoStatementState(
+template<Direction DIR, typename CHAR>
+InternalListIoStatementState<DIR, CHAR>::InternalListIoStatementState(
     Buffer buffer, std::size_t length, const char *sourceFile, int sourceLine)
-  : InternalIoStatementState<isInput, CharType>{buffer, length, sourceFile,
+  : InternalIoStatementState<DIR, CharType>{buffer, length, sourceFile,
         sourceLine},
     ioStatementState_{*this} {}
 
-template<bool isInput, typename CHAR>
-InternalListIoStatementState<isInput, CHAR>::InternalListIoStatementState(
+template<Direction DIR, typename CHAR>
+InternalListIoStatementState<DIR, CHAR>::InternalListIoStatementState(
     const Descriptor &d, const char *sourceFile, int sourceLine)
-  : InternalIoStatementState<isInput, CharType>{d, sourceFile, sourceLine},
+  : InternalIoStatementState<DIR, CharType>{d, sourceFile, sourceLine},
     ioStatementState_{*this} {}
 
 ExternalIoStatementBase::ExternalIoStatementBase(
@@ -149,15 +161,17 @@ void OpenStatementState::set_path(
 
 int OpenStatementState::EndIoStatement() {
   if (wasExtant_ && status_ != OpenStatus::Old) {
-    Crash("OPEN statement for connected unit must have STATUS='OLD'");
+    SignalError("OPEN statement for connected unit must have STATUS='OLD'");
   }
   unit().OpenUnit(status_, position_, std::move(path_), pathLength_, *this);
-  return IoStatementBase::EndIoStatement();
+  return ExternalIoStatementBase::EndIoStatement();
 }
 
 int CloseStatementState::EndIoStatement() {
+  int result{ExternalIoStatementBase::EndIoStatement()};
   unit().CloseUnit(status_, *this);
-  return IoStatementBase::EndIoStatement();
+  unit().DestroyClosed();
+  return result;
 }
 
 int NoopCloseStatementState::EndIoStatement() {
@@ -166,8 +180,8 @@ int NoopCloseStatementState::EndIoStatement() {
   return result;
 }
 
-template<bool isInput> int ExternalIoStatementState<isInput>::EndIoStatement() {
-  if constexpr (!isInput) {
+template<Direction DIR> int ExternalIoStatementState<DIR>::EndIoStatement() {
+  if constexpr (DIR == Direction::Output) {
     if (!unit().nonAdvancing) {
       unit().AdvanceRecord(*this);
     }
@@ -176,39 +190,49 @@ template<bool isInput> int ExternalIoStatementState<isInput>::EndIoStatement() {
   return ExternalIoStatementBase::EndIoStatement();
 }
 
-template<bool isInput>
-bool ExternalIoStatementState<isInput>::Emit(
-    const char *data, std::size_t chars) {
-  if (isInput) {
-    Crash("ExternalIoStatementState::Emit called for input statement");
+template<Direction DIR>
+bool ExternalIoStatementState<DIR>::Emit(const char *data, std::size_t chars) {
+  if constexpr (DIR == Direction::Input) {
+    Crash("ExternalIoStatementState::Emit(char) called for input statement");
   }
   return unit().Emit(data, chars * sizeof(*data), *this);
 }
 
-template<bool isInput>
-bool ExternalIoStatementState<isInput>::Emit(
+template<Direction DIR>
+bool ExternalIoStatementState<DIR>::Emit(
     const char16_t *data, std::size_t chars) {
-  if (isInput) {
-    Crash("ExternalIoStatementState::Emit called for input statement");
+  if constexpr (DIR == Direction::Input) {
+    Crash(
+        "ExternalIoStatementState::Emit(char16_t) called for input statement");
   }
   // TODO: UTF-8 encoding
   return unit().Emit(
       reinterpret_cast<const char *>(data), chars * sizeof(*data), *this);
 }
 
-template<bool isInput>
-bool ExternalIoStatementState<isInput>::Emit(
+template<Direction DIR>
+bool ExternalIoStatementState<DIR>::Emit(
     const char32_t *data, std::size_t chars) {
-  if (isInput) {
-    Crash("ExternalIoStatementState::Emit called for input statement");
+  if constexpr (DIR == Direction::Input) {
+    Crash(
+        "ExternalIoStatementState::Emit(char32_t) called for input statement");
   }
   // TODO: UTF-8 encoding
   return unit().Emit(
       reinterpret_cast<const char *>(data), chars * sizeof(*data), *this);
 }
 
-template<bool isInput>
-bool ExternalIoStatementState<isInput>::AdvanceRecord(int n) {
+template<Direction DIR>
+std::optional<char32_t> ExternalIoStatementState<DIR>::GetCurrentChar() {
+  if constexpr (DIR == Direction::Output) {
+    Crash(
+        "ExternalIoStatementState<Direction::Output>::GetCurrentChar() called");
+  }
+  return unit().GetCurrentChar(*this);
+}
+
+template<Direction DIR>
+bool ExternalIoStatementState<DIR>::AdvanceRecord(int n) {
   while (n-- > 0) {
     if (!unit().AdvanceRecord(*this)) {
       return false;
@@ -217,42 +241,58 @@ bool ExternalIoStatementState<isInput>::AdvanceRecord(int n) {
   return true;
 }
 
-template<bool isInput>
-bool ExternalIoStatementState<isInput>::HandleAbsolutePosition(std::int64_t n) {
-  return unit().HandleAbsolutePosition(n, *this);
+template<Direction DIR> void ExternalIoStatementState<DIR>::BackspaceRecord() {
+  unit().BackspaceRecord(*this);
 }
 
-template<bool isInput>
-bool ExternalIoStatementState<isInput>::HandleRelativePosition(std::int64_t n) {
-  return unit().HandleRelativePosition(n, *this);
+template<Direction DIR>
+void ExternalIoStatementState<DIR>::HandleAbsolutePosition(std::int64_t n) {
+  return unit().HandleAbsolutePosition(n);
 }
 
-template<bool isInput, typename CHAR>
-ExternalFormattedIoStatementState<isInput,
-    CHAR>::ExternalFormattedIoStatementState(ExternalFileUnit &unit,
-    const CHAR *format, std::size_t formatLength, const char *sourceFile,
-    int sourceLine)
-  : ExternalIoStatementState<isInput>{unit, sourceFile, sourceLine},
+template<Direction DIR>
+void ExternalIoStatementState<DIR>::HandleRelativePosition(std::int64_t n) {
+  return unit().HandleRelativePosition(n);
+}
+
+template<Direction DIR, typename CHAR>
+ExternalFormattedIoStatementState<DIR, CHAR>::ExternalFormattedIoStatementState(
+    ExternalFileUnit &unit, const CHAR *format, std::size_t formatLength,
+    const char *sourceFile, int sourceLine)
+  : ExternalIoStatementState<DIR>{unit, sourceFile, sourceLine},
     mutableModes_{unit.modes}, format_{*this, format, formatLength} {}
 
-template<bool isInput, typename CHAR>
-int ExternalFormattedIoStatementState<isInput, CHAR>::EndIoStatement() {
-  format_.FinishOutput(*this);
-  return ExternalIoStatementState<isInput>::EndIoStatement();
+template<Direction DIR, typename CHAR>
+int ExternalFormattedIoStatementState<DIR, CHAR>::EndIoStatement() {
+  format_.Finish(*this);
+  return ExternalIoStatementState<DIR>::EndIoStatement();
 }
 
-DataEdit IoStatementState::GetNextDataEdit(int n) {
-  return std::visit([&](auto &x) { return x.get().GetNextDataEdit(n); }, u_);
+std::optional<DataEdit> IoStatementState::GetNextDataEdit(int n) {
+  return std::visit(
+      [&](auto &x) { return x.get().GetNextDataEdit(*this, n); }, u_);
 }
 
 bool IoStatementState::Emit(const char *data, std::size_t n) {
   return std::visit([=](auto &x) { return x.get().Emit(data, n); }, u_);
 }
 
+std::optional<char32_t> IoStatementState::GetCurrentChar() {
+  return std::visit([&](auto &x) { return x.get().GetCurrentChar(); }, u_);
+}
+
 bool IoStatementState::AdvanceRecord(int n) {
   return std::visit([=](auto &x) { return x.get().AdvanceRecord(n); }, u_);
 }
 
+void IoStatementState::BackspaceRecord() {
+  std::visit([](auto &x) { x.get().BackspaceRecord(); }, u_);
+}
+
+void IoStatementState::HandleRelativePosition(std::int64_t n) {
+  return std::visit([=](auto &x) { x.get().HandleRelativePosition(n); }, u_);
+}
+
 int IoStatementState::EndIoStatement() {
   return std::visit([](auto &x) { return x.get().EndIoStatement(); }, u_);
 }
@@ -276,6 +316,10 @@ IoErrorHandler &IoStatementState::GetIoErrorHandler() const {
       u_);
 }
 
+ExternalFileUnit *IoStatementState::GetExternalFileUnit() const {
+  return std::visit([](auto &x) { return x.get().GetExternalFileUnit(); }, u_);
+}
+
 bool IoStatementState::EmitRepeated(char ch, std::size_t n) {
   return std::visit(
       [=](auto &x) {
@@ -302,13 +346,78 @@ bool IoStatementState::EmitField(
   }
 }
 
-bool ListDirectedStatementState<false>::NeedAdvance(
+void IoStatementState::SkipSpaces(std::optional<int> &remaining) {
+  if (!remaining || *remaining > 0) {
+    for (auto ch{GetCurrentChar()}; ch && ch == ' '; ch = GetCurrentChar()) {
+      HandleRelativePosition(1);
+      if (remaining && !--*remaining) {
+        break;
+      }
+    }
+  }
+}
+
+std::optional<char32_t> IoStatementState::NextInField(
+    std::optional<int> &remaining) {
+  if (!remaining) {  // list-directed or namelist: check for separators
+    if (auto next{GetCurrentChar()}) {
+      switch (*next) {
+      case ' ':
+      case ',':
+      case ';':
+      case '/':
+      case '(':
+      case ')':
+      case '\'':
+      case '"':
+      case '*': break;
+      default: HandleRelativePosition(1); return next;
+      }
+    }
+  } else if (*remaining > 0) {
+    if (auto next{GetCurrentChar()}) {
+      --*remaining;
+      HandleRelativePosition(1);
+      return next;
+    }
+    const ConnectionState &connection{GetConnectionState()};
+    if (!connection.IsAtEOF() && connection.recordLength &&
+        connection.positionInRecord >= *connection.recordLength) {
+      if (connection.modes.pad) {  // PAD='YES'
+        --*remaining;
+        return std::optional<char32_t>{' '};
+      }
+      IoErrorHandler &handler{GetIoErrorHandler()};
+      if (connection.nonAdvancing) {
+        handler.SignalEor();
+      } else {
+        handler.SignalError(IostatRecordReadOverrun);
+      }
+    }
+  }
+  return std::nullopt;
+}
+
+std::optional<char32_t> IoStatementState::GetNextNonBlank() {
+  auto ch{GetCurrentChar()};
+  while (ch.value_or(' ') == ' ') {
+    if (ch) {
+      HandleRelativePosition(1);
+    } else if (!AdvanceRecord()) {
+      return std::nullopt;
+    }
+    ch = GetCurrentChar();
+  }
+  return ch;
+}
+
+bool ListDirectedStatementState<Direction::Output>::NeedAdvance(
     const ConnectionState &connection, std::size_t width) const {
   return connection.positionInRecord > 0 &&
       width > connection.RemainingSpaceInRecord();
 }
 
-bool ListDirectedStatementState<false>::EmitLeadingSpaceOrAdvance(
+bool ListDirectedStatementState<Direction::Output>::EmitLeadingSpaceOrAdvance(
     IoStatementState &io, std::size_t length, bool isCharacter) {
   if (length == 0) {
     return true;
@@ -326,9 +435,122 @@ bool ListDirectedStatementState<false>::EmitLeadingSpaceOrAdvance(
   return true;
 }
 
-template<bool isInput>
-int UnformattedIoStatementState<isInput>::EndIoStatement() {
-  auto &ext{static_cast<ExternalIoStatementState<isInput> &>(*this)};
+std::optional<DataEdit>
+ListDirectedStatementState<Direction::Output>::GetNextDataEdit(
+    IoStatementState &io, int maxRepeat) {
+  DataEdit edit;
+  edit.descriptor = DataEdit::ListDirected;
+  edit.repeat = maxRepeat;
+  edit.modes = io.mutableModes();
+  return edit;
+}
+
+std::optional<DataEdit>
+ListDirectedStatementState<Direction::Input>::GetNextDataEdit(
+    IoStatementState &io, int maxRepeat) {
+  // N.B. list-directed transfers cannot be nonadvancing (C1221)
+  ConnectionState &connection{io.GetConnectionState()};
+  DataEdit edit;
+  edit.descriptor = DataEdit::ListDirected;
+  edit.repeat = 1;  // may be overridden below
+  edit.modes = connection.modes;
+  if (hitSlash_) {  // everything after '/' is nullified
+    edit.descriptor = DataEdit::ListDirectedNullValue;
+    return edit;
+  }
+  if (remaining_ > 0 && !realPart_) {  // "r*c" repetition in progress
+    while (connection.currentRecordNumber > initialRecordNumber_) {
+      io.BackspaceRecord();
+    }
+    connection.HandleAbsolutePosition(initialPositionInRecord_);
+    if (!imaginaryPart_) {
+      edit.repeat = std::min<int>(remaining_, maxRepeat);
+    }
+    remaining_ -= edit.repeat;
+    return edit;
+  }
+  // Skip separators, handle a "r*c" repeat count; see 13.10.2 in Fortran 2018
+  auto ch{io.GetNextNonBlank()};
+  if (imaginaryPart_) {
+    imaginaryPart_ = false;
+    if (ch && *ch == ')') {
+      io.HandleRelativePosition(1);
+      ch = io.GetNextNonBlank();
+    }
+  } else if (realPart_) {
+    realPart_ = false;
+    imaginaryPart_ = true;
+  }
+  if (!ch) {
+    return std::nullopt;
+  }
+  if (*ch == '/') {
+    hitSlash_ = true;
+    edit.descriptor = DataEdit::ListDirectedNullValue;
+    return edit;
+  }
+  char32_t comma{','};
+  if (io.mutableModes().editingFlags & decimalComma) {
+    comma = ';';
+  }
+  bool isFirstItem{isFirstItem_};
+  isFirstItem_ = false;
+  if (*ch == comma) {
+    if (isFirstItem) {
+      edit.descriptor = DataEdit::ListDirectedNullValue;
+      return edit;
+    }
+    // Consume comma & whitespace after previous item.
+    io.HandleRelativePosition(1);
+    ch = io.GetNextNonBlank();
+    if (!ch) {
+      return std::nullopt;
+    }
+    if (*ch == comma || *ch == '/') {
+      edit.descriptor = DataEdit::ListDirectedNullValue;
+      return edit;
+    }
+  }
+  if (imaginaryPart_) {  // can't repeat components
+    return edit;
+  }
+  if (*ch >= '0' && *ch <= '9') {  // look for "r*" repetition count
+    auto start{connection.positionInRecord};
+    int r{0};
+    do {
+      static auto constexpr clamp{(std::numeric_limits<int>::max() - '9') / 10};
+      if (r >= clamp) {
+        r = 0;
+        break;
+      }
+      r = 10 * r + (*ch - '0');
+      io.HandleRelativePosition(1);
+      ch = io.GetCurrentChar();
+    } while (ch && *ch >= '0' && *ch <= '9');
+    if (r > 0 && ch && *ch == '*') {  // subtle: r must be nonzero
+      io.HandleRelativePosition(1);
+      ch = io.GetCurrentChar();
+      if (!ch || *ch == ' ' || *ch == comma || *ch == '/') {  // "r*" null
+        edit.descriptor = DataEdit::ListDirectedNullValue;
+        return edit;
+      }
+      edit.repeat = std::min<int>(r, maxRepeat);
+      remaining_ = r - edit.repeat;
+      initialRecordNumber_ = connection.currentRecordNumber;
+      initialPositionInRecord_ = connection.positionInRecord;
+    } else {  // not a repetition count, just an integer value; rewind
+      connection.positionInRecord = start;
+    }
+  }
+  if (!imaginaryPart_ && ch && *ch == '(') {
+    realPart_ = true;
+    io.HandleRelativePosition(1);
+  }
+  return edit;
+}
+
+template<Direction DIR> int UnformattedIoStatementState<DIR>::EndIoStatement() {
+  auto &ext{static_cast<ExternalIoStatementState<DIR> &>(*this)};
   ExternalFileUnit &unit{ext.unit()};
   if (unit.access == Access::Sequential && !unit.recordLength.has_value()) {
     // Overwrite the first four bytes of the record with its length,
@@ -342,21 +564,27 @@ int UnformattedIoStatementState<isInput>::EndIoStatement() {
     } u;
     u.u = unit.furthestPositionInRecord - sizeof u.c;
     // TODO: Convert record length to little-endian on big-endian host?
-    if (!(ext.Emit(u.c, sizeof u.c) && ext.HandleAbsolutePosition(0) &&
-            ext.Emit(u.c, sizeof u.c) && ext.AdvanceRecord())) {
+    if (!(ext.Emit(u.c, sizeof u.c) &&
+            (ext.HandleAbsolutePosition(0), ext.Emit(u.c, sizeof u.c)) &&
+            ext.AdvanceRecord())) {
       return false;
     }
   }
   return ext.EndIoStatement();
 }
 
-template class InternalIoStatementState<false>;
-template class InternalIoStatementState<true>;
-template class InternalFormattedIoStatementState<false>;
-template class InternalFormattedIoStatementState<true>;
-template class InternalListIoStatementState<false>;
-template class ExternalIoStatementState<false>;
-template class ExternalFormattedIoStatementState<false>;
-template class ExternalListIoStatementState<false>;
-template class UnformattedIoStatementState<false>;
+template class InternalIoStatementState<Direction::Output>;
+template class InternalIoStatementState<Direction::Input>;
+template class InternalFormattedIoStatementState<Direction::Output>;
+template class InternalFormattedIoStatementState<Direction::Input>;
+template class InternalListIoStatementState<Direction::Output>;
+template class InternalListIoStatementState<Direction::Input>;
+template class ExternalIoStatementState<Direction::Output>;
+template class ExternalIoStatementState<Direction::Input>;
+template class ExternalFormattedIoStatementState<Direction::Output>;
+template class ExternalFormattedIoStatementState<Direction::Input>;
+template class ExternalListIoStatementState<Direction::Output>;
+template class ExternalListIoStatementState<Direction::Input>;
+template class UnformattedIoStatementState<Direction::Output>;
+template class UnformattedIoStatementState<Direction::Input>;
 }

flang/runtime/io-stmt.h

@@ -11,6 +11,7 @@
 #ifndef FORTRAN_RUNTIME_IO_STMT_H_
 #define FORTRAN_RUNTIME_IO_STMT_H_
 
+#include "connection.h"
 #include "descriptor.h"
 #include "file.h"
 #include "format.h"
@@ -22,19 +23,19 @@
 
 namespace Fortran::runtime::io {
 
-struct ConnectionState;
 class ExternalFileUnit;
 
 class OpenStatementState;
 class CloseStatementState;
 class NoopCloseStatementState;
-template<bool isInput, typename CHAR = char>
+
+template<Direction, typename CHAR = char>
 class InternalFormattedIoStatementState;
-template<bool isInput, typename CHAR = char> class InternalListIoStatementState;
-template<bool isInput, typename CHAR = char>
+template<Direction, typename CHAR = char> class InternalListIoStatementState;
+template<Direction, typename CHAR = char>
 class ExternalFormattedIoStatementState;
-template<bool isInput> class ExternalListIoStatementState;
-template<bool isInput> class UnformattedIoStatementState;
+template<Direction> class ExternalListIoStatementState;
+template<Direction> class UnformattedIoStatementState;
 
 // The Cookie type in the I/O API is a pointer (for C) to this class.
 class IoStatementState {
@@ -42,15 +43,20 @@ public:
   template<typename A> explicit IoStatementState(A &x) : u_{x} {}
 
   // These member functions each project themselves into the active alternative.
-  // They're used by per-data-item routines in the I/O API(e.g., OutputReal64)
+  // They're used by per-data-item routines in the I/O API (e.g., OutputReal64)
   // to interact with the state of the I/O statement in progress.
   // This design avoids virtual member functions and function pointers,
-  // which may not have good support in some use cases.
-  DataEdit GetNextDataEdit(int = 1);
+  // which may not have good support in some runtime environments.
+  std::optional<DataEdit> GetNextDataEdit(int = 1);
   bool Emit(const char *, std::size_t);
+  std::optional<char32_t> GetCurrentChar();  // vacant after end of record
   bool AdvanceRecord(int = 1);
+  void BackspaceRecord();
+  void HandleRelativePosition(std::int64_t);
   int EndIoStatement();
   ConnectionState &GetConnectionState();
+  IoErrorHandler &GetIoErrorHandler() const;
+  ExternalFileUnit *GetExternalFileUnit() const;  // null if internal unit
   MutableModes &mutableModes();
 
   // N.B.: this also works with base classes
@@ -64,21 +70,31 @@ public:
         },
         u_);
   }
-  IoErrorHandler &GetIoErrorHandler() const;
 
   bool EmitRepeated(char, std::size_t);
   bool EmitField(const char *, std::size_t length, std::size_t width);
+  void SkipSpaces(std::optional<int> &remaining);
+  std::optional<char32_t> NextInField(std::optional<int> &remaining);
+  std::optional<char32_t> GetNextNonBlank();  // can advance record
 
 private:
   std::variant<std::reference_wrapper<OpenStatementState>,
       std::reference_wrapper<CloseStatementState>,
       std::reference_wrapper<NoopCloseStatementState>,
-      std::reference_wrapper<InternalFormattedIoStatementState<false>>,
-      std::reference_wrapper<InternalFormattedIoStatementState<true>>,
-      std::reference_wrapper<InternalListIoStatementState<false>>,
-      std::reference_wrapper<ExternalFormattedIoStatementState<false>>,
-      std::reference_wrapper<ExternalListIoStatementState<false>>,
-      std::reference_wrapper<UnformattedIoStatementState<false>>>
+      std::reference_wrapper<
+          InternalFormattedIoStatementState<Direction::Output>>,
+      std::reference_wrapper<
+          InternalFormattedIoStatementState<Direction::Input>>,
+      std::reference_wrapper<InternalListIoStatementState<Direction::Output>>,
+      std::reference_wrapper<InternalListIoStatementState<Direction::Input>>,
+      std::reference_wrapper<
+          ExternalFormattedIoStatementState<Direction::Output>>,
+      std::reference_wrapper<
+          ExternalFormattedIoStatementState<Direction::Input>>,
+      std::reference_wrapper<ExternalListIoStatementState<Direction::Output>>,
+      std::reference_wrapper<ExternalListIoStatementState<Direction::Input>>,
+      std::reference_wrapper<UnformattedIoStatementState<Direction::Output>>,
+      std::reference_wrapper<UnformattedIoStatementState<Direction::Input>>>
       u_;
 };
 
@@ -87,54 +103,80 @@ private:
 struct IoStatementBase : public DefaultFormatControlCallbacks {
   using DefaultFormatControlCallbacks::DefaultFormatControlCallbacks;
   int EndIoStatement();
-  DataEdit GetNextDataEdit(int = 1);  // crashing default
+  std::optional<DataEdit> GetNextDataEdit(IoStatementState &, int = 1);
+  ExternalFileUnit *GetExternalFileUnit() const { return nullptr; }
 };
 
 struct InputStatementState {};
 struct OutputStatementState {};
-template<bool isInput>
-using IoDirectionState =
-    std::conditional_t<isInput, InputStatementState, OutputStatementState>;
+template<Direction D>
+using IoDirectionState = std::conditional_t<D == Direction::Input,
+    InputStatementState, OutputStatementState>;
 
 struct FormattedStatementState {};
 
-template<bool isInput> struct ListDirectedStatementState {};
-template<> struct ListDirectedStatementState<false /*output*/> {
+// Common state for list-directed internal & external I/O
+template<Direction> struct ListDirectedStatementState {};
+template<> struct ListDirectedStatementState<Direction::Output> {
   static std::size_t RemainingSpaceInRecord(const ConnectionState &);
   bool NeedAdvance(const ConnectionState &, std::size_t) const;
   bool EmitLeadingSpaceOrAdvance(
       IoStatementState &, std::size_t, bool isCharacter = false);
+  std::optional<DataEdit> GetNextDataEdit(
+      IoStatementState &, int maxRepeat = 1);
   bool lastWasUndelimitedCharacter{false};
 };
+template<> class ListDirectedStatementState<Direction::Input> {
+public:
+  // Skips value separators, handles repetition and null values.
+  // Vacant when '/' appears; present with descriptor == ListDirectedNullValue
+  // when a null value appears.
+  std::optional<DataEdit> GetNextDataEdit(
+      IoStatementState &, int maxRepeat = 1);
 
-template<bool isInput, typename CHAR = char>
+private:
+  int remaining_{0};  // for "r*" repetition
+  std::int64_t initialRecordNumber_;
+  std::int64_t initialPositionInRecord_;
+  bool isFirstItem_{true};  // leading separator implies null first item
+  bool hitSlash_{false};  // once '/' is seen, nullify further items
+  bool realPart_{false};
+  bool imaginaryPart_{false};
+};
+
+template<Direction DIR, typename CHAR = char>
 class InternalIoStatementState : public IoStatementBase,
-                                 public IoDirectionState<isInput> {
+                                 public IoDirectionState<DIR> {
 public:
   using CharType = CHAR;
-  using Buffer = std::conditional_t<isInput, const CharType *, CharType *>;
+  using Buffer =
+      std::conditional_t<DIR == Direction::Input, const CharType *, CharType *>;
   InternalIoStatementState(Buffer, std::size_t,
       const char *sourceFile = nullptr, int sourceLine = 0);
   InternalIoStatementState(
       const Descriptor &, const char *sourceFile = nullptr, int sourceLine = 0);
   int EndIoStatement();
   bool Emit(const CharType *, std::size_t chars /* not bytes */);
+  std::optional<char32_t> GetCurrentChar();
   bool AdvanceRecord(int = 1);
+  void BackspaceRecord();
   ConnectionState &GetConnectionState() { return unit_; }
   MutableModes &mutableModes() { return unit_.modes; }
+  void HandleRelativePosition(std::int64_t);
+  void HandleAbsolutePosition(std::int64_t);
 
 protected:
   bool free_{true};
-  InternalDescriptorUnit<isInput> unit_;
+  InternalDescriptorUnit<DIR> unit_;
 };
 
-template<bool isInput, typename CHAR>
+template<Direction DIR, typename CHAR>
 class InternalFormattedIoStatementState
-  : public InternalIoStatementState<isInput, CHAR>,
+  : public InternalIoStatementState<DIR, CHAR>,
     public FormattedStatementState {
 public:
   using CharType = CHAR;
-  using typename InternalIoStatementState<isInput, CharType>::Buffer;
+  using typename InternalIoStatementState<DIR, CharType>::Buffer;
   InternalFormattedIoStatementState(Buffer internal, std::size_t internalLength,
       const CharType *format, std::size_t formatLength,
       const char *sourceFile = nullptr, int sourceLine = 0);
@@ -143,42 +185,34 @@ public:
       int sourceLine = 0);
   IoStatementState &ioStatementState() { return ioStatementState_; }
   int EndIoStatement();
-  DataEdit GetNextDataEdit(int maxRepeat = 1) {
+  std::optional<DataEdit> GetNextDataEdit(
+      IoStatementState &, int maxRepeat = 1) {
     return format_.GetNextDataEdit(*this, maxRepeat);
   }
-  bool HandleRelativePosition(std::int64_t);
-  bool HandleAbsolutePosition(std::int64_t);
 
 private:
   IoStatementState ioStatementState_;  // points to *this
-  using InternalIoStatementState<isInput, CharType>::unit_;
+  using InternalIoStatementState<DIR, CharType>::unit_;
   // format_ *must* be last; it may be partial someday
   FormatControl<InternalFormattedIoStatementState> format_;
 };
 
-template<bool isInput, typename CHAR>
-class InternalListIoStatementState
-  : public InternalIoStatementState<isInput, CHAR>,
-    public ListDirectedStatementState<isInput> {
+template<Direction DIR, typename CHAR>
+class InternalListIoStatementState : public InternalIoStatementState<DIR, CHAR>,
+                                     public ListDirectedStatementState<DIR> {
 public:
   using CharType = CHAR;
-  using typename InternalIoStatementState<isInput, CharType>::Buffer;
+  using typename InternalIoStatementState<DIR, CharType>::Buffer;
   InternalListIoStatementState(Buffer internal, std::size_t internalLength,
       const char *sourceFile = nullptr, int sourceLine = 0);
   InternalListIoStatementState(
       const Descriptor &, const char *sourceFile = nullptr, int sourceLine = 0);
   IoStatementState &ioStatementState() { return ioStatementState_; }
-  DataEdit GetNextDataEdit(int maxRepeat = 1) {
-    DataEdit edit;
-    edit.descriptor = DataEdit::ListDirected;
-    edit.repeat = maxRepeat;
-    edit.modes = InternalIoStatementState<isInput, CharType>::mutableModes();
-    return edit;
-  }
+  using ListDirectedStatementState<DIR>::GetNextDataEdit;
 
 private:
-  using InternalIoStatementState<isInput, CharType>::unit_;
   IoStatementState ioStatementState_;  // points to *this
+  using InternalIoStatementState<DIR, CharType>::unit_;
 };
 
 class ExternalIoStatementBase : public IoStatementBase {
@@ -189,29 +223,31 @@ public:
   MutableModes &mutableModes();
   ConnectionState &GetConnectionState();
   int EndIoStatement();
+  ExternalFileUnit *GetExternalFileUnit() { return &unit_; }
 
 private:
   ExternalFileUnit &unit_;
 };
 
-template<bool isInput>
+template<Direction DIR>
 class ExternalIoStatementState : public ExternalIoStatementBase,
-                                 public IoDirectionState<isInput> {
+                                 public IoDirectionState<DIR> {
 public:
   using ExternalIoStatementBase::ExternalIoStatementBase;
   int EndIoStatement();
   bool Emit(const char *, std::size_t chars /* not bytes */);
   bool Emit(const char16_t *, std::size_t chars /* not bytes */);
   bool Emit(const char32_t *, std::size_t chars /* not bytes */);
+  std::optional<char32_t> GetCurrentChar();
   bool AdvanceRecord(int = 1);
-  bool HandleRelativePosition(std::int64_t);
-  bool HandleAbsolutePosition(std::int64_t);
+  void BackspaceRecord();
+  void HandleRelativePosition(std::int64_t);
+  void HandleAbsolutePosition(std::int64_t);
 };
 
-template<bool isInput, typename CHAR>
-class ExternalFormattedIoStatementState
-  : public ExternalIoStatementState<isInput>,
-    public FormattedStatementState {
+template<Direction DIR, typename CHAR>
+class ExternalFormattedIoStatementState : public ExternalIoStatementState<DIR>,
+                                          public FormattedStatementState {
 public:
   using CharType = CHAR;
   ExternalFormattedIoStatementState(ExternalFileUnit &, const CharType *format,
@@ -219,7 +255,8 @@ public:
       int sourceLine = 0);
   MutableModes &mutableModes() { return mutableModes_; }
   int EndIoStatement();
-  DataEdit GetNextDataEdit(int maxRepeat = 1) {
+  std::optional<DataEdit> GetNextDataEdit(
+      IoStatementState &, int maxRepeat = 1) {
     return format_.GetNextDataEdit(*this, maxRepeat);
   }
 
@@ -231,25 +268,18 @@ private:
   FormatControl<ExternalFormattedIoStatementState> format_;
 };
 
-template<bool isInput>
-class ExternalListIoStatementState
-  : public ExternalIoStatementState<isInput>,
-    public ListDirectedStatementState<isInput> {
+template<Direction DIR>
+class ExternalListIoStatementState : public ExternalIoStatementState<DIR>,
+                                     public ListDirectedStatementState<DIR> {
 public:
-  using ExternalIoStatementState<isInput>::ExternalIoStatementState;
-  DataEdit GetNextDataEdit(int maxRepeat = 1) {
-    DataEdit edit;
-    edit.descriptor = DataEdit::ListDirected;
-    edit.repeat = maxRepeat;
-    edit.modes = ExternalIoStatementState<isInput>::mutableModes();
-    return edit;
-  }
+  using ExternalIoStatementState<DIR>::ExternalIoStatementState;
+  using ListDirectedStatementState<DIR>::GetNextDataEdit;
 };
 
-template<bool isInput>
-class UnformattedIoStatementState : public ExternalIoStatementState<isInput> {
+template<Direction DIR>
+class UnformattedIoStatementState : public ExternalIoStatementState<DIR> {
 public:
-  using ExternalIoStatementState<isInput>::ExternalIoStatementState;
+  using ExternalIoStatementState<DIR>::ExternalIoStatementState;
   int EndIoStatement();
 };
 
@@ -300,18 +330,28 @@ private:
   ConnectionState connection_;
 };
 
-extern template class InternalIoStatementState<false>;
-extern template class InternalIoStatementState<true>;
-extern template class InternalFormattedIoStatementState<false>;
-extern template class InternalFormattedIoStatementState<true>;
-extern template class InternalListIoStatementState<false>;
-extern template class ExternalIoStatementState<false>;
-extern template class ExternalFormattedIoStatementState<false>;
-extern template class ExternalListIoStatementState<false>;
-extern template class UnformattedIoStatementState<false>;
-extern template class FormatControl<InternalFormattedIoStatementState<false>>;
-extern template class FormatControl<InternalFormattedIoStatementState<true>>;
-extern template class FormatControl<ExternalFormattedIoStatementState<false>>;
+extern template class InternalIoStatementState<Direction::Output>;
+extern template class InternalIoStatementState<Direction::Input>;
+extern template class InternalFormattedIoStatementState<Direction::Output>;
+extern template class InternalFormattedIoStatementState<Direction::Input>;
+extern template class InternalListIoStatementState<Direction::Output>;
+extern template class InternalListIoStatementState<Direction::Input>;
+extern template class ExternalIoStatementState<Direction::Output>;
+extern template class ExternalIoStatementState<Direction::Input>;
+extern template class ExternalFormattedIoStatementState<Direction::Output>;
+extern template class ExternalFormattedIoStatementState<Direction::Input>;
+extern template class ExternalListIoStatementState<Direction::Output>;
+extern template class ExternalListIoStatementState<Direction::Input>;
+extern template class UnformattedIoStatementState<Direction::Output>;
+extern template class UnformattedIoStatementState<Direction::Input>;
+extern template class FormatControl<
+    InternalFormattedIoStatementState<Direction::Output>>;
+extern template class FormatControl<
+    InternalFormattedIoStatementState<Direction::Input>>;
+extern template class FormatControl<
+    ExternalFormattedIoStatementState<Direction::Output>>;
+extern template class FormatControl<
+    ExternalFormattedIoStatementState<Direction::Input>>;
 
 }
 #endif  // FORTRAN_RUNTIME_IO_STMT_H_

flang/runtime/iostat.cpp

@@ -0,0 +1,31 @@
+//===-- runtime/iostat.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 "iostat.h"
+
+namespace Fortran::runtime::io {
+const char *IostatErrorString(int iostat) {
+  switch (iostat) {
+  case IostatOk: return "No error";
+  case IostatEnd: return "End of file during input";
+  case IostatEor: return "End of record during non-advancing input";
+  case IostatUnflushable: return "FLUSH not possible";
+  case IostatInquireInternalUnit: return "INQUIRE on internal unit";
+  case IostatGenericError:
+    return "I/O error";  // dummy value, there's always a message
+  case IostatRecordWriteOverrun: return "Excessive output to fixed-size record";
+  case IostatRecordReadOverrun: return "Excessive input from fixed-size record";
+  case IostatInternalWriteOverrun:
+    return "Internal write overran available records";
+  case IostatErrorInFormat: return "Invalid FORMAT";
+  case IostatErrorInKeyword: return "Bad keyword argument value";
+  default: return nullptr;
+  }
+}
+
+}

flang/runtime/iostat.h

@@ -0,0 +1,53 @@
+//===-- runtime/iostat.h ----------------------------------------*- 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
+//
+//===----------------------------------------------------------------------===//
+
+// Defines the values returned by the runtime for IOSTAT= specifiers
+// on I/O statements.
+
+#ifndef FORTRAN_RUNTIME_IOSTAT_H_
+#define FORTRAN_RUNTIME_IOSTAT_H_
+#include "magic-numbers.h"
+namespace Fortran::runtime::io {
+
+// The value of IOSTAT= is zero when no error, end-of-record,
+// or end-of-file condition has arisen; errors are positive values.
+// (See 12.11.5 in Fortran 2018 for the complete requirements;
+// these constants must match the values of their corresponding
+// named constants in the predefined module ISO_FORTRAN_ENV, so
+// they're actually defined in another magic-numbers.h header file
+// so that they can be included both here and there.)
+enum Iostat {
+  IostatOk = 0,  // no error, EOF, or EOR condition
+
+  // These error codes are required by Fortran (see 12.10.2.16-17) to be
+  // negative integer values
+  IostatEnd = FORTRAN_RUNTIME_IOSTAT_END,  // end-of-file on input & no error
+  // End-of-record on non-advancing input, no EOF or error
+  IostatEor = FORTRAN_RUNTIME_IOSTAT_EOR,
+
+  // This value is also required to be negative (12.11.5 bullet 6).
+  // It signifies a FLUSH statement on an unflushable unit.
+  IostatUnflushable = FORTRAN_RUNTIME_IOSTAT_FLUSH,
+
+  // Other errors are positive.  We use "errno" values unchanged.
+  // This error is exported in ISO_Fortran_env.
+  IostatInquireInternalUnit = FORTRAN_RUNTIME_IOSTAT_INQUIRE_INTERNAL_UNIT,
+
+  // The remaining error codes are not exported.
+  IostatGenericError = 1001,  // see IOMSG= for details
+  IostatRecordWriteOverrun,
+  IostatRecordReadOverrun,
+  IostatInternalWriteOverrun,
+  IostatErrorInFormat,
+  IostatErrorInKeyword,
+};
+
+const char *IostatErrorString(int);
+
+}
+#endif  // FORTRAN_RUNTIME_IOSTAT_H_

flang/runtime/lock.h

@@ -6,11 +6,12 @@
 //
 //===----------------------------------------------------------------------===//
 
-// Wraps pthread_mutex_t (or whatever)
+// Wraps a mutex
 
 #ifndef FORTRAN_RUNTIME_LOCK_H_
 #define FORTRAN_RUNTIME_LOCK_H_
 
+#include "terminator.h"
 #include <mutex>
 
 namespace Fortran::runtime {

flang/runtime/magic-numbers.h

@@ -26,7 +26,7 @@ and are used "raw" as IOSTAT values.
 #define FORTRAN_RUNTIME_IOSTAT_END (-1)
 #define FORTRAN_RUNTIME_IOSTAT_EOR (-2)
 #define FORTRAN_RUNTIME_IOSTAT_FLUSH (-3)
-#define FORTRAN_RUNTIME_IOSTAT_INQUIRE_INTERNAL_UNIT 255
+#define FORTRAN_RUNTIME_IOSTAT_INQUIRE_INTERNAL_UNIT 256
 
 #define FORTRAN_RUNTIME_STAT_FAILED_IMAGE 10
 #define FORTRAN_RUNTIME_STAT_LOCKED 11

flang/runtime/main.cpp

@@ -9,7 +9,6 @@
 #include "main.h"
 #include "environment.h"
 #include "terminator.h"
-#include "unit.h"
 #include <cfenv>
 #include <cstdio>
 #include <cstdlib>
@@ -28,11 +27,10 @@ static void ConfigureFloatingPoint() {
 }
 
 extern "C" {
-
 void RTNAME(ProgramStart)(int argc, const char *argv[], const char *envp[]) {
   std::atexit(Fortran::runtime::NotifyOtherImagesOfNormalEnd);
   Fortran::runtime::executionEnvironment.Configure(argc, argv, envp);
   ConfigureFloatingPoint();
-  Fortran::runtime::io::ExternalFileUnit::InitializePredefinedUnits();
+  // I/O is initialized on demand so that it works for non-Fortran main().
 }
 }

flang/runtime/numeric-output.cpp

@@ -1,153 +0,0 @@
-//===-- runtime/numeric-output.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 "numeric-output.h"
-#include "flang/Common/unsigned-const-division.h"
-#include <algorithm>
-
-namespace Fortran::runtime::io {
-
-bool EditIntegerOutput(
-    IoStatementState &io, const DataEdit &edit, std::int64_t n) {
-  char buffer[66], *end = &buffer[sizeof buffer], *p = end;
-  std::uint64_t un{static_cast<std::uint64_t>(n < 0 ? -n : n)};
-  int signChars{0};
-  switch (edit.descriptor) {
-  case DataEdit::ListDirected:
-  case 'G':
-  case 'I':
-    if (n < 0 || (edit.modes.editingFlags & signPlus)) {
-      signChars = 1;  // '-' or '+'
-    }
-    while (un > 0) {
-      auto quotient{common::DivideUnsignedBy<std::uint64_t, 10>(un)};
-      *--p = '0' + un - 10 * quotient;
-      un = quotient;
-    }
-    break;
-  case 'B':
-    for (; un > 0; un >>= 1) {
-      *--p = '0' + (un & 1);
-    }
-    break;
-  case 'O':
-    for (; un > 0; un >>= 3) {
-      *--p = '0' + (un & 7);
-    }
-    break;
-  case 'Z':
-    for (; un > 0; un >>= 4) {
-      int digit = un & 0xf;
-      *--p = digit >= 10 ? 'A' + (digit - 10) : '0' + digit;
-    }
-    break;
-  default:
-    io.GetIoErrorHandler().Crash(
-        "Data edit descriptor '%c' may not be used with an INTEGER data item",
-        edit.descriptor);
-    return false;
-  }
-
-  int digits = end - p;
-  int leadingZeroes{0};
-  int editWidth{edit.width.value_or(0)};
-  if (edit.digits && digits <= *edit.digits) {  // Iw.m
-    if (*edit.digits == 0 && n == 0) {
-      // Iw.0 with zero value: output field must be blank.  For I0.0
-      // and a zero value, emit one blank character.
-      signChars = 0;  // in case of SP
-      editWidth = std::max(1, editWidth);
-    } else {
-      leadingZeroes = *edit.digits - digits;
-    }
-  } else if (n == 0) {
-    leadingZeroes = 1;
-  }
-  int total{signChars + leadingZeroes + digits};
-  if (editWidth > 0 && total > editWidth) {
-    return io.EmitRepeated('*', editWidth);
-  }
-  int leadingSpaces{std::max(0, editWidth - total)};
-  if (edit.IsListDirected()) {
-    if (static_cast<std::size_t>(total) >
-            io.GetConnectionState().RemainingSpaceInRecord() &&
-        !io.AdvanceRecord()) {
-      return false;
-    }
-    leadingSpaces = 1;
-  }
-  return io.EmitRepeated(' ', leadingSpaces) &&
-      io.Emit(n < 0 ? "-" : "+", signChars) &&
-      io.EmitRepeated('0', leadingZeroes) && io.Emit(p, digits);
-}
-
-// Formats the exponent (see table 13.1 for all the cases)
-const char *RealOutputEditingBase::FormatExponent(
-    int expo, const DataEdit &edit, int &length) {
-  char *eEnd{&exponent_[sizeof exponent_]};
-  char *exponent{eEnd};
-  for (unsigned e{static_cast<unsigned>(std::abs(expo))}; e > 0;) {
-    unsigned quotient{common::DivideUnsignedBy<unsigned, 10>(e)};
-    *--exponent = '0' + e - 10 * quotient;
-    e = quotient;
-  }
-  if (edit.expoDigits) {
-    if (int ed{*edit.expoDigits}) {  // Ew.dEe with e > 0
-      while (exponent > exponent_ + 2 /*E+*/ && exponent + ed > eEnd) {
-        *--exponent = '0';
-      }
-    } else if (exponent == eEnd) {
-      *--exponent = '0';  // Ew.dE0 with zero-valued exponent
-    }
-  } else {  // ensure at least two exponent digits
-    while (exponent + 2 > eEnd) {
-      *--exponent = '0';
-    }
-  }
-  *--exponent = expo < 0 ? '-' : '+';
-  if (edit.expoDigits || exponent + 3 == eEnd) {
-    *--exponent = edit.descriptor == 'D' ? 'D' : 'E';  // not 'G'
-  }
-  length = eEnd - exponent;
-  return exponent;
-}
-
-bool RealOutputEditingBase::EmitPrefix(
-    const DataEdit &edit, std::size_t length, std::size_t width) {
-  if (edit.IsListDirected()) {
-    int prefixLength{edit.descriptor == DataEdit::ListDirectedRealPart
-            ? 2
-            : edit.descriptor == DataEdit::ListDirectedImaginaryPart ? 0 : 1};
-    int suffixLength{edit.descriptor == DataEdit::ListDirectedRealPart ||
-                edit.descriptor == DataEdit::ListDirectedImaginaryPart
-            ? 1
-            : 0};
-    length += prefixLength + suffixLength;
-    ConnectionState &connection{io_.GetConnectionState()};
-    return (connection.positionInRecord == 0 ||
-               length <= connection.RemainingSpaceInRecord() ||
-               io_.AdvanceRecord()) &&
-        io_.Emit(" (", prefixLength);
-  } else if (width > length) {
-    return io_.EmitRepeated(' ', width - length);
-  } else {
-    return true;
-  }
-}
-
-bool RealOutputEditingBase::EmitSuffix(const DataEdit &edit) {
-  if (edit.descriptor == DataEdit::ListDirectedRealPart) {
-    return io_.Emit(edit.modes.editingFlags & decimalComma ? ";" : ",", 1);
-  } else if (edit.descriptor == DataEdit::ListDirectedImaginaryPart) {
-    return io_.Emit(")", 1);
-  } else {
-    return true;
-  }
-}
-
-}

flang/runtime/terminator.cpp

@@ -18,8 +18,18 @@ namespace Fortran::runtime {
   CrashArgs(message, ap);
 }
 
+static void (*crashHandler)(const char *, va_list &){nullptr};
+
+void Terminator::RegisterCrashHandler(
+    void (*handler)(const char *, va_list &)) {
+  crashHandler = handler;
+}
+
 [[noreturn]] void Terminator::CrashArgs(
     const char *message, va_list &ap) const {
+  if (crashHandler) {
+    crashHandler(message, ap);
+  }
   std::fputs("\nfatal Fortran runtime error", stderr);
   if (sourceFileName_) {
     std::fprintf(stderr, "(%s", sourceFileName_);

flang/runtime/terminator.h

@@ -33,11 +33,15 @@ public:
   [[noreturn]] void CheckFailed(
       const char *predicate, const char *file, int line) const;
 
+  // For test harnessing - overrides CrashArgs().
+  static void RegisterCrashHandler(void (*)(const char *, va_list &));
+
 private:
   const char *sourceFileName_{nullptr};
   int sourceLine_{0};
 };
 
+// RUNTIME_CHECK() guarantees evaluation of its predicate.
 #define RUNTIME_CHECK(terminator, pred) \
   if (pred) \
     ; \

flang/runtime/tools.cpp

@@ -25,13 +25,22 @@ OwningPtr<char> SaveDefaultCharacter(
 
 static bool CaseInsensitiveMatch(
     const char *value, std::size_t length, const char *possibility) {
-  for (; length-- > 0; ++value, ++possibility) {
-    char ch{*value};
+  for (; length-- > 0; ++possibility) {
+    char ch{*value++};
     if (ch >= 'a' && ch <= 'z') {
       ch += 'A' - 'a';
     }
-    if (*possibility == '\0' || ch != *possibility) {
-      return false;
+    if (*possibility != ch) {
+      if (*possibility != '\0' || ch != ' ') {
+        return false;
+      }
+      // Ignore trailing blanks (12.5.6.2 p1)
+      while (length-- > 0) {
+        if (*value++ != ' ') {
+          return false;
+        }
+      }
+      return true;
     }
   }
   return *possibility == '\0';
@@ -48,4 +57,14 @@ int IdentifyValue(
   }
   return -1;
 }
+
+void ToFortranDefaultCharacter(
+    char *to, std::size_t toLength, const char *from) {
+  std::size_t len{std::strlen(from)};
+  std::memcpy(to, from, std::max(toLength, len));
+  if (len < toLength) {
+    std::memset(to + len, ' ', toLength - len);
+  }
+}
+
 }

flang/runtime/tools.h

@@ -28,10 +28,8 @@ OwningPtr<char> SaveDefaultCharacter(
 int IdentifyValue(
     const char *value, std::size_t length, const char *possibilities[]);
 
-// A std::map<> customized to use the runtime's memory allocator
-template<typename KEY, typename VALUE>
-using MapAllocator = Allocator<std::pair<std::add_const_t<KEY>, VALUE>>;
-template<typename KEY, typename VALUE, typename COMPARE = std::less<KEY>>
-using Map = std::map<KEY, VALUE, COMPARE, MapAllocator<KEY, VALUE>>;
+// Truncates or pads as necessary
+void ToFortranDefaultCharacter(
+    char *to, std::size_t toLength, const char *from);
 }
 #endif  // FORTRAN_RUNTIME_TOOLS_H_

flang/runtime/transformational.cpp

@@ -7,12 +7,11 @@
 //===----------------------------------------------------------------------===//
 
 #include "transformational.h"
-#include "flang/Common/idioms.h"
+#include "memory.h"
+#include "terminator.h"
 #include "flang/Evaluate/integer.h"
 #include <algorithm>
-#include <bitset>
 #include <cinttypes>
-#include <memory>
 
 namespace Fortran::runtime {
 
@@ -22,18 +21,22 @@ static inline std::int64_t GetInt64(const char *p, std::size_t bytes) {
   case 2: return *reinterpret_cast<const std::int16_t *>(p);
   case 4: return *reinterpret_cast<const std::int32_t *>(p);
   case 8: return *reinterpret_cast<const std::int64_t *>(p);
-  default: CRASH_NO_CASE;
+  default:
+    Terminator terminator{__FILE__, __LINE__};
+    terminator.Crash("no case for %dz bytes", bytes);
   }
 }
 
 // F2018 16.9.163
-std::unique_ptr<Descriptor> RESHAPE(const Descriptor &source,
-    const Descriptor &shape, const Descriptor *pad, const Descriptor *order) {
+OwningPtr<Descriptor> RESHAPE(const Descriptor &source, const Descriptor &shape,
+    const Descriptor *pad, const Descriptor *order) {
   // Compute and check the rank of the result.
-  CHECK(shape.rank() == 1);
-  CHECK(shape.type().IsInteger());
+  Terminator terminator{__FILE__, __LINE__};
+  RUNTIME_CHECK(terminator, shape.rank() == 1);
+  RUNTIME_CHECK(terminator, shape.type().IsInteger());
   SubscriptValue resultRank{shape.GetDimension(0).Extent()};
-  CHECK(resultRank >= 0 && resultRank <= static_cast<SubscriptValue>(maxRank));
+  RUNTIME_CHECK(terminator,
+      resultRank >= 0 && resultRank <= static_cast<SubscriptValue>(maxRank));
 
   // Extract and check the shape of the result; compute its element count.
   SubscriptValue lowerBound[maxRank];  // all 1's
@@ -45,7 +48,7 @@ std::unique_ptr<Descriptor> RESHAPE(const Descriptor &source,
     lowerBound[j] = 1;
     resultExtent[j] =
         GetInt64(shape.Element<char>(&shapeSubscript), shapeElementBytes);
-    CHECK(resultExtent[j] >= 0);
+    RUNTIME_CHECK(terminator, resultExtent[j] >= 0);
     resultElements *= resultExtent[j];
   }
 
@@ -55,23 +58,25 @@ std::unique_ptr<Descriptor> RESHAPE(const Descriptor &source,
   std::size_t sourceElements{source.Elements()};
   std::size_t padElements{pad ? pad->Elements() : 0};
   if (resultElements < sourceElements) {
-    CHECK(padElements > 0);
-    CHECK(pad->ElementBytes() == elementBytes);
+    RUNTIME_CHECK(terminator, padElements > 0);
+    RUNTIME_CHECK(terminator, pad->ElementBytes() == elementBytes);
   }
 
   // Extract and check the optional ORDER= argument, which must be a
   // permutation of [1..resultRank].
   int dimOrder[maxRank];
   if (order) {
-    CHECK(order->rank() == 1);
-    CHECK(order->type().IsInteger());
-    CHECK(order->GetDimension(0).Extent() == resultRank);
-    std::bitset<maxRank> values;
+    RUNTIME_CHECK(terminator, order->rank() == 1);
+    RUNTIME_CHECK(terminator, order->type().IsInteger());
+    RUNTIME_CHECK(terminator, order->GetDimension(0).Extent() == resultRank);
+    std::uint64_t values{0};
     SubscriptValue orderSubscript{order->GetDimension(0).LowerBound()};
     for (SubscriptValue j{0}; j < resultRank; ++j, ++orderSubscript) {
-      auto k{GetInt64(order->Element<char>(orderSubscript), shapeElementBytes)};
-      CHECK(k >= 1 && k <= resultRank && !values.test(k - 1));
-      values.set(k - 1);
+      auto k{GetInt64(
+          order->OffsetElement<char>(orderSubscript), shapeElementBytes)};
+      RUNTIME_CHECK(
+          terminator, k >= 1 && k <= resultRank && !((values >> k) & 1));
+      values |= std::uint64_t{1} << k;
       dimOrder[k - 1] = j;
     }
   } else {
@@ -84,7 +89,7 @@ std::unique_ptr<Descriptor> RESHAPE(const Descriptor &source,
   const DescriptorAddendum *sourceAddendum{source.Addendum()};
   const DerivedType *sourceDerivedType{
       sourceAddendum ? sourceAddendum->derivedType() : nullptr};
-  std::unique_ptr<Descriptor> result;
+  OwningPtr<Descriptor> result;
   if (sourceDerivedType) {
     result = Descriptor::Create(*sourceDerivedType, nullptr, resultRank,
         resultExtent, CFI_attribute_allocatable);
@@ -94,7 +99,7 @@ std::unique_ptr<Descriptor> RESHAPE(const Descriptor &source,
         CFI_attribute_allocatable);  // TODO rearrange these arguments
   }
   DescriptorAddendum *resultAddendum{result->Addendum()};
-  CHECK(resultAddendum);
+  RUNTIME_CHECK(terminator, resultAddendum);
   resultAddendum->flags() |= DescriptorAddendum::DoNotFinalize;
   if (sourceDerivedType) {
     std::size_t lenParameters{sourceDerivedType->lenParameters()};
@@ -106,7 +111,7 @@ std::unique_ptr<Descriptor> RESHAPE(const Descriptor &source,
   // Allocate storage for the result's data.
   int status{result->Allocate(lowerBound, resultExtent, elementBytes)};
   if (status != CFI_SUCCESS) {
-    common::die("RESHAPE: Allocate failed (error %d)", status);
+    terminator.Crash("RESHAPE: Allocate failed (error %d)", status);
   }
 
   // Populate the result's elements.

flang/runtime/transformational.h

@@ -10,12 +10,11 @@
 #define FORTRAN_RUNTIME_TRANSFORMATIONAL_H_
 
 #include "descriptor.h"
-#include <memory>
+#include "memory.h"
 
 namespace Fortran::runtime {
 
-std::unique_ptr<Descriptor> RESHAPE(const Descriptor &source,
-    const Descriptor &shape, const Descriptor *pad = nullptr,
-    const Descriptor *order = nullptr);
+OwningPtr<Descriptor> RESHAPE(const Descriptor &source, const Descriptor &shape,
+    const Descriptor *pad = nullptr, const Descriptor *order = nullptr);
 }
 #endif  // FORTRAN_RUNTIME_TRANSFORMATIONAL_H_

flang/runtime/type-code.h

@@ -9,8 +9,8 @@
 #ifndef FORTRAN_RUNTIME_TYPE_CODE_H_
 #define FORTRAN_RUNTIME_TYPE_CODE_H_
 
-#include "flang/ISO_Fortran_binding.h"
 #include "flang/Common/Fortran.h"
+#include "flang/ISO_Fortran_binding.h"
 
 namespace Fortran::runtime {
 

flang/runtime/unit-map.cpp

@@ -0,0 +1,72 @@
+//===-- runtime/unit-map.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 "unit-map.h"
+
+namespace Fortran::runtime::io {
+
+ExternalFileUnit *UnitMap::LookUpForClose(int n) {
+  CriticalSection critical{lock_};
+  Chain *previous{nullptr};
+  int hash{Hash(n)};
+  for (Chain *p{bucket_[hash].get()}; p; previous = p, p = p->next.get()) {
+    if (p->unit.unitNumber() == n) {
+      if (previous) {
+        previous->next.swap(p->next);
+      } else {
+        bucket_[hash].swap(p->next);
+      }
+      // p->next.get() == p at this point; the next swap pushes p on closing_
+      closing_.swap(p->next);
+      return &p->unit;
+    }
+  }
+  return nullptr;
+}
+
+void UnitMap::DestroyClosed(ExternalFileUnit &unit) {
+  Chain *p{nullptr};
+  {
+    CriticalSection critical{lock_};
+    Chain *previous{nullptr};
+    for (p = closing_.get(); p; previous = p, p = p->next.get()) {
+      if (&p->unit == &unit) {
+        if (previous) {
+          previous->next.swap(p->next);
+        } else {
+          closing_.swap(p->next);
+        }
+        break;
+      }
+    }
+  }
+  if (p) {
+    p->unit.~ExternalFileUnit();
+    FreeMemory(p);
+  }
+}
+
+void UnitMap::CloseAll(IoErrorHandler &handler) {
+  CriticalSection critical{lock_};
+  for (int j{0}; j < buckets_; ++j) {
+    while (Chain * p{bucket_[j].get()}) {
+      bucket_[j].swap(p->next);  // pops p from head of list
+      p->unit.CloseUnit(CloseStatus::Keep, handler);
+      p->unit.~ExternalFileUnit();
+      FreeMemory(p);
+    }
+  }
+}
+
+ExternalFileUnit &UnitMap::Create(int n, const Terminator &terminator) {
+  Chain &chain{New<Chain>{}(terminator, n)};
+  chain.next.reset(&chain);
+  bucket_[Hash(n)].swap(chain.next);  // pushes new node as list head
+  return chain.unit;
+}
+}

flang/runtime/unit-map.h

@@ -0,0 +1,87 @@
+//===-- runtime/unit-map.h --------------------------------------*- 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
+//
+//===----------------------------------------------------------------------===//
+
+// Maps Fortran unit numbers to their ExternalFileUnit instances.
+// A simple hash table with forward-linked chains per bucket.
+
+#ifndef FORTRAN_RUNTIME_UNIT_MAP_H_
+#define FORTRAN_RUNTIME_UNIT_MAP_H_
+
+#include "lock.h"
+#include "memory.h"
+#include "unit.h"
+
+namespace Fortran::runtime::io {
+
+class UnitMap {
+public:
+  ExternalFileUnit *LookUp(int n) {
+    CriticalSection critical{lock_};
+    return Find(n);
+  }
+
+  ExternalFileUnit &LookUpOrCreate(
+      int n, const Terminator &terminator, bool *wasExtant) {
+    CriticalSection critical{lock_};
+    auto *p{Find(n)};
+    if (wasExtant) {
+      *wasExtant = p != nullptr;
+    }
+    if (p) {
+      return *p;
+    }
+    return Create(n, terminator);
+  }
+
+  ExternalFileUnit &NewUnit(const Terminator &terminator) {
+    CriticalSection critical{lock_};
+    return Create(nextNewUnit_--, terminator);
+  }
+
+  // To prevent races, the unit is removed from the map if it exists,
+  // and put on the closing_ list until DestroyClosed() is called.
+  ExternalFileUnit *LookUpForClose(int);
+
+  void DestroyClosed(ExternalFileUnit &);
+  void CloseAll(IoErrorHandler &);
+
+private:
+  struct Chain {
+    explicit Chain(int n) : unit{n} {}
+    ExternalFileUnit unit;
+    OwningPtr<Chain> next{nullptr};
+  };
+
+  static constexpr int buckets_{1031};  // must be prime
+  int Hash(int n) { return n % buckets_; }
+
+  ExternalFileUnit *Find(int n) {
+    Chain *previous{nullptr};
+    int hash{Hash(n)};
+    for (Chain *p{bucket_[hash].get()}; p; previous = p, p = p->next.get()) {
+      if (p->unit.unitNumber() == n) {
+        if (previous) {
+          // Move found unit to front of chain for quicker lookup next time
+          previous->next.swap(p->next);  // now p->next.get() == p
+          bucket_[hash].swap(p->next);  // now bucket_[hash].get() == p
+        }
+        return &p->unit;
+      }
+    }
+    return nullptr;
+  }
+
+  ExternalFileUnit &Create(int, const Terminator &);
+
+  Lock lock_;
+  OwningPtr<Chain> bucket_[buckets_]{};  // all owned by *this
+  int nextNewUnit_{-1000};  // see 12.5.6.12 in Fortran 2018
+  OwningPtr<Chain> closing_{nullptr};  // units during CLOSE statement
+};
+}
+#endif  // FORTRAN_RUNTIME_UNIT_MAP_H_

flang/runtime/unit.cpp

@@ -7,21 +7,23 @@
 //===----------------------------------------------------------------------===//
 
 #include "unit.h"
+#include "io-error.h"
 #include "lock.h"
-#include "memory.h"
-#include "tools.h"
-#include <algorithm>
-#include <type_traits>
+#include "unit-map.h"
 
 namespace Fortran::runtime::io {
 
-static Lock mapLock;
-static Terminator mapTerminator;
-static Map<int, ExternalFileUnit> unitMap{
-    MapAllocator<int, ExternalFileUnit>{mapTerminator}};
+// The per-unit data structures are created on demand so that Fortran I/O
+// should work without a Fortran main program.
+static Lock unitMapLock;
+static UnitMap *unitMap{nullptr};
 static ExternalFileUnit *defaultOutput{nullptr};
 
 void FlushOutputOnCrash(const Terminator &terminator) {
+  if (!defaultOutput) {
+    return;
+  }
+  CriticalSection critical{unitMapLock};
   if (defaultOutput) {
     IoErrorHandler handler{terminator};
     handler.HasIoStat();  // prevent nested crash if flush has error
@@ -30,14 +32,11 @@ void FlushOutputOnCrash(const Terminator &terminator) {
 }
 
 ExternalFileUnit *ExternalFileUnit::LookUp(int unit) {
-  CriticalSection criticalSection{mapLock};
-  auto iter{unitMap.find(unit)};
-  return iter == unitMap.end() ? nullptr : &iter->second;
+  return GetUnitMap().LookUp(unit);
 }
 
 ExternalFileUnit &ExternalFileUnit::LookUpOrCrash(
     int unit, const Terminator &terminator) {
-  CriticalSection criticalSection{mapLock};
   ExternalFileUnit *file{LookUp(unit)};
   if (!file) {
     terminator.Crash("Not an open I/O unit number: %d", unit);
@@ -45,25 +44,22 @@ ExternalFileUnit &ExternalFileUnit::LookUpOrCrash(
   return *file;
 }
 
-ExternalFileUnit &ExternalFileUnit::LookUpOrCreate(int unit, bool *wasExtant) {
-  CriticalSection criticalSection{mapLock};
-  auto pair{unitMap.emplace(unit, unit)};
-  if (wasExtant) {
-    *wasExtant = !pair.second;
-  }
-  return pair.first->second;
+ExternalFileUnit &ExternalFileUnit::LookUpOrCreate(
+    int unit, const Terminator &terminator, bool *wasExtant) {
+  return GetUnitMap().LookUpOrCreate(unit, terminator, wasExtant);
 }
 
-int ExternalFileUnit::NewUnit() {
-  CriticalSection criticalSection{mapLock};
-  static int nextNewUnit{-1000};  // see 12.5.6.12 in Fortran 2018
-  return --nextNewUnit;
+ExternalFileUnit *ExternalFileUnit::LookUpForClose(int unit) {
+  return GetUnitMap().LookUpForClose(unit);
+}
+
+int ExternalFileUnit::NewUnit(const Terminator &terminator) {
+  return GetUnitMap().NewUnit(terminator).unitNumber();
 }
 
 void ExternalFileUnit::OpenUnit(OpenStatus status, Position position,
     OwningPtr<char> &&newPath, std::size_t newPathLength,
     IoErrorHandler &handler) {
-  CriticalSection criticalSection{lock()};
   if (IsOpen()) {
     if (status == OpenStatus::Old &&
         (!newPath.get() ||
@@ -82,74 +78,93 @@ void ExternalFileUnit::OpenUnit(OpenStatus status, Position position,
 }
 
 void ExternalFileUnit::CloseUnit(CloseStatus status, IoErrorHandler &handler) {
-  {
-    CriticalSection criticalSection{lock()};
-    Flush(handler);
-    Close(status, handler);
-  }
-  CriticalSection criticalSection{mapLock};
-  auto iter{unitMap.find(unitNumber_)};
-  if (iter != unitMap.end()) {
-    unitMap.erase(iter);
-  }
+  Flush(handler);
+  Close(status, handler);
 }
 
-void ExternalFileUnit::InitializePredefinedUnits() {
-  ExternalFileUnit &out{ExternalFileUnit::LookUpOrCreate(6)};
+void ExternalFileUnit::DestroyClosed() {
+  GetUnitMap().DestroyClosed(*this);  // destroys *this
+}
+
+UnitMap &ExternalFileUnit::GetUnitMap() {
+  if (unitMap) {
+    return *unitMap;
+  }
+  CriticalSection critical{unitMapLock};
+  if (unitMap) {
+    return *unitMap;
+  }
+  Terminator terminator{__FILE__, __LINE__};
+  unitMap = &New<UnitMap>{}(terminator);
+  ExternalFileUnit &out{ExternalFileUnit::LookUpOrCreate(6, terminator)};
   out.Predefine(1);
   out.set_mayRead(false);
   out.set_mayWrite(true);
   out.set_mayPosition(false);
   defaultOutput = &out;
-  ExternalFileUnit &in{ExternalFileUnit::LookUpOrCreate(5)};
+  ExternalFileUnit &in{ExternalFileUnit::LookUpOrCreate(5, terminator)};
   in.Predefine(0);
   in.set_mayRead(true);
   in.set_mayWrite(false);
   in.set_mayPosition(false);
   // TODO: Set UTF-8 mode from the environment
+  return *unitMap;
 }
 
 void ExternalFileUnit::CloseAll(IoErrorHandler &handler) {
-  CriticalSection criticalSection{mapLock};
+  CriticalSection critical{unitMapLock};
+  if (unitMap) {
+    unitMap->CloseAll(handler);
+    FreeMemoryAndNullify(unitMap);
+  }
   defaultOutput = nullptr;
-  while (!unitMap.empty()) {
-    auto &pair{*unitMap.begin()};
-    pair.second.CloseUnit(CloseStatus::Keep, handler);
-  }
-}
-
-bool ExternalFileUnit::SetPositionInRecord(
-    std::int64_t n, IoErrorHandler &handler) {
-  n = std::max<std::int64_t>(0, n);
-  bool ok{true};
-  if (n > static_cast<std::int64_t>(recordLength.value_or(n))) {
-    handler.SignalEor();
-    n = *recordLength;
-    ok = false;
-  }
-  if (n > furthestPositionInRecord) {
-    if (!isReading_ && ok) {
-      WriteFrame(recordOffsetInFile, n, handler);
-      std::fill_n(Frame() + furthestPositionInRecord,
-          n - furthestPositionInRecord, ' ');
-    }
-    furthestPositionInRecord = n;
-  }
-  positionInRecord = n;
-  return ok;
 }
 
 bool ExternalFileUnit::Emit(
     const char *data, std::size_t bytes, IoErrorHandler &handler) {
   auto furthestAfter{std::max(furthestPositionInRecord,
       positionInRecord + static_cast<std::int64_t>(bytes))};
-  WriteFrame(recordOffsetInFile, furthestAfter, handler);
+  if (furthestAfter > recordLength.value_or(furthestAfter)) {
+    handler.SignalError(IostatRecordWriteOverrun);
+    return false;
+  }
+  WriteFrame(frameOffsetInFile_, recordOffsetInFrame_ + furthestAfter, handler);
   std::memcpy(Frame() + positionInRecord, data, bytes);
   positionInRecord += bytes;
   furthestPositionInRecord = furthestAfter;
   return true;
 }
 
+std::optional<char32_t> ExternalFileUnit::GetCurrentChar(
+    IoErrorHandler &handler) {
+  isReading_ = true;  // TODO: manage read/write transitions
+  if (isUnformatted) {
+    handler.Crash("GetCurrentChar() called for unformatted input");
+    return std::nullopt;
+  }
+  std::size_t chunk{256};  // for stream input
+  if (recordLength.has_value()) {
+    if (positionInRecord >= *recordLength) {
+      return std::nullopt;
+    }
+    chunk = *recordLength - positionInRecord;
+  }
+  auto at{recordOffsetInFrame_ + positionInRecord};
+  std::size_t need{static_cast<std::size_t>(at + 1)};
+  std::size_t want{need + chunk};
+  auto got{ReadFrame(frameOffsetInFile_, want, handler)};
+  if (got <= need) {
+    endfileRecordNumber = currentRecordNumber;
+    handler.SignalEnd();
+    return std::nullopt;
+  }
+  const char *p{Frame() + at};
+  if (isUTF8) {
+    // TODO: UTF-8 decoding
+  }
+  return *p;
+}
+
 void ExternalFileUnit::SetLeftTabLimit() {
   leftTabLimit = furthestPositionInRecord;
   positionInRecord = furthestPositionInRecord;
@@ -157,13 +172,29 @@ void ExternalFileUnit::SetLeftTabLimit() {
 
 bool ExternalFileUnit::AdvanceRecord(IoErrorHandler &handler) {
   bool ok{true};
-  if (recordLength.has_value()) {  // fill fixed-size record
-    ok &= SetPositionInRecord(*recordLength, handler);
-  } else if (!isUnformatted && !isReading_) {
-    ok &= SetPositionInRecord(furthestPositionInRecord, handler) &&
-        Emit("\n", 1, handler);
+  if (isReading_) {
+    if (access == Access::Sequential) {
+      if (isUnformatted) {
+        NextSequentialUnformattedInputRecord(handler);
+      } else {
+        NextSequentialFormattedInputRecord(handler);
+      }
+    }
+  } else if (!isUnformatted) {
+    if (recordLength.has_value()) {
+      // fill fixed-size record
+      if (furthestPositionInRecord < *recordLength) {
+        WriteFrame(frameOffsetInFile_, *recordLength, handler);
+        std::memset(Frame() + recordOffsetInFrame_ + furthestPositionInRecord,
+            ' ', *recordLength - furthestPositionInRecord);
+      }
+    } else {
+      positionInRecord = furthestPositionInRecord + 1;
+      ok &= Emit("\n", 1, handler);  // TODO: Windows CR+LF
+      frameOffsetInFile_ += recordOffsetInFrame_ + furthestPositionInRecord;
+      recordOffsetInFrame_ = 0;
+    }
   }
-  recordOffsetInFile += furthestPositionInRecord;
   ++currentRecordNumber;
   positionInRecord = 0;
   furthestPositionInRecord = 0;
@@ -171,15 +202,23 @@ bool ExternalFileUnit::AdvanceRecord(IoErrorHandler &handler) {
   return ok;
 }
 
-bool ExternalFileUnit::HandleAbsolutePosition(
-    std::int64_t n, IoErrorHandler &handler) {
-  return SetPositionInRecord(
-      std::max(n, std::int64_t{0}) + leftTabLimit.value_or(0), handler);
-}
-
-bool ExternalFileUnit::HandleRelativePosition(
-    std::int64_t n, IoErrorHandler &handler) {
-  return HandleAbsolutePosition(positionInRecord + n, handler);
+void ExternalFileUnit::BackspaceRecord(IoErrorHandler &handler) {
+  if (!isReading_) {
+    handler.Crash("ExternalFileUnit::BackspaceRecord() called during writing");
+    // TODO: create endfile record, &c.
+  }
+  if (access == Access::Sequential) {
+    if (isUnformatted) {
+      BackspaceSequentialUnformattedRecord(handler);
+    } else {
+      BackspaceSequentialFormattedRecord(handler);
+    }
+  } else {
+    // TODO
+  }
+  positionInRecord = 0;
+  furthestPositionInRecord = 0;
+  leftTabLimit.reset();
 }
 
 void ExternalFileUnit::FlushIfTerminal(IoErrorHandler &handler) {
@@ -189,7 +228,186 @@ void ExternalFileUnit::FlushIfTerminal(IoErrorHandler &handler) {
 }
 
 void ExternalFileUnit::EndIoStatement() {
+  frameOffsetInFile_ += recordOffsetInFrame_;
+  recordOffsetInFrame_ = 0;
   io_.reset();
   u_.emplace<std::monostate>();
+  lock_.Drop();
+}
+
+void ExternalFileUnit::NextSequentialUnformattedInputRecord(
+    IoErrorHandler &handler) {
+  std::int32_t header{0}, footer{0};
+  // Retain previous footer (if any) in frame for more efficient BACKSPACE
+  std::size_t retain{sizeof header};
+  if (recordLength) {  // not first record - advance to next
+    ++currentRecordNumber;
+    if (endfileRecordNumber && currentRecordNumber >= *endfileRecordNumber) {
+      handler.SignalEnd();
+      return;
+    }
+    frameOffsetInFile_ +=
+        recordOffsetInFrame_ + *recordLength + 2 * sizeof header;
+    recordOffsetInFrame_ = 0;
+  } else {
+    retain = 0;
+  }
+  std::size_t need{retain + sizeof header};
+  std::size_t got{ReadFrame(frameOffsetInFile_ - retain, need, handler)};
+  // Try to emit informative errors to help debug corrupted files.
+  const char *error{nullptr};
+  if (got < need) {
+    if (got == retain) {
+      handler.SignalEnd();
+    } else {
+      error = "Unformatted sequential file input failed at record #%jd (file "
+              "offset %jd): truncated record header";
+    }
+  } else {
+    std::memcpy(&header, Frame() + retain, sizeof header);
+    need = retain + header + 2 * sizeof header;
+    got = ReadFrame(frameOffsetInFile_ - retain,
+        need + sizeof header /* next one */, handler);
+    if (got < need) {
+      error = "Unformatted sequential file input failed at record #%jd (file "
+              "offset %jd): hit EOF reading record with length %jd bytes";
+    } else {
+      const char *start{Frame() + retain + sizeof header};
+      std::memcpy(&footer, start + header, sizeof footer);
+      if (footer != header) {
+        error = "Unformatted sequential file input failed at record #%jd (file "
+                "offset %jd): record header has length %jd that does not match "
+                "record footer (%jd)";
+      } else {
+        recordLength = header;
+      }
+    }
+  }
+  if (error) {
+    handler.SignalError(error, static_cast<std::intmax_t>(currentRecordNumber),
+        static_cast<std::intmax_t>(frameOffsetInFile_),
+        static_cast<std::intmax_t>(header), static_cast<std::intmax_t>(footer));
+  }
+  positionInRecord = sizeof header;
+}
+
+void ExternalFileUnit::NextSequentialFormattedInputRecord(
+    IoErrorHandler &handler) {
+  static constexpr std::size_t chunk{256};
+  std::size_t length{0};
+  if (recordLength.has_value()) {
+    // not first record - advance to next
+    ++currentRecordNumber;
+    if (endfileRecordNumber && currentRecordNumber >= *endfileRecordNumber) {
+      handler.SignalEnd();
+      return;
+    }
+    if (Frame()[*recordLength] == '\r') {
+      ++*recordLength;
+    }
+    recordOffsetInFrame_ += *recordLength + 1;
+  }
+  while (true) {
+    std::size_t got{ReadFrame(
+        frameOffsetInFile_, recordOffsetInFrame_ + length + chunk, handler)};
+    if (got <= recordOffsetInFrame_ + length) {
+      handler.SignalEnd();
+      break;
+    }
+    const char *frame{Frame() + recordOffsetInFrame_};
+    if (const char *nl{reinterpret_cast<const char *>(
+            std::memchr(frame + length, '\n', chunk))}) {
+      recordLength = nl - (frame + length) + 1;
+      if (*recordLength > 0 && frame[*recordLength - 1] == '\r') {
+        --*recordLength;
+      }
+      return;
+    }
+    length += got;
+  }
+}
+
+void ExternalFileUnit::BackspaceSequentialUnformattedRecord(
+    IoErrorHandler &handler) {
+  std::int32_t header{0}, footer{0};
+  RUNTIME_CHECK(handler, currentRecordNumber > 1);
+  --currentRecordNumber;
+  int overhead{static_cast<int>(2 * sizeof header)};
+  // Error conditions here cause crashes, not file format errors, because the
+  // validity of the file structure before the current record will have been
+  // checked informatively in NextSequentialUnformattedInputRecord().
+  RUNTIME_CHECK(handler, frameOffsetInFile_ >= overhead);
+  std::size_t got{
+      ReadFrame(frameOffsetInFile_ - sizeof footer, sizeof footer, handler)};
+  RUNTIME_CHECK(handler, got >= sizeof footer);
+  std::memcpy(&footer, Frame(), sizeof footer);
+  RUNTIME_CHECK(handler, frameOffsetInFile_ >= footer + overhead);
+  frameOffsetInFile_ -= footer + 2 * sizeof footer;
+  auto extra{std::max<std::size_t>(sizeof footer, frameOffsetInFile_)};
+  std::size_t want{extra + footer + 2 * sizeof footer};
+  got = ReadFrame(frameOffsetInFile_ - extra, want, handler);
+  RUNTIME_CHECK(handler, got >= want);
+  std::memcpy(&header, Frame() + extra, sizeof header);
+  RUNTIME_CHECK(handler, header == footer);
+  positionInRecord = sizeof header;
+  recordLength = footer;
+}
+
+// There's no portable memrchr(), unfortunately, and strrchr() would
+// fail on a record with a NUL, so we have to do it the hard way.
+static const char *FindLastNewline(const char *str, std::size_t length) {
+  for (const char *p{str + length}; p-- > str;) {
+    if (*p == '\n') {
+      return p;
+    }
+  }
+  return nullptr;
+}
+
+void ExternalFileUnit::BackspaceSequentialFormattedRecord(
+    IoErrorHandler &handler) {
+  std::int64_t start{frameOffsetInFile_ + recordOffsetInFrame_};
+  --currentRecordNumber;
+  RUNTIME_CHECK(handler, currentRecordNumber > 0);
+  if (currentRecordNumber == 1) {
+    // To simplify the code below, treat a backspace to the first record
+    // as a special case;
+    RUNTIME_CHECK(handler, start > 0);
+    *recordLength = start - 1;
+    frameOffsetInFile_ = 0;
+    recordOffsetInFrame_ = 0;
+    ReadFrame(0, *recordLength + 1, handler);
+  } else {
+    RUNTIME_CHECK(handler, start > 1);
+    std::int64_t at{start - 2};  // byte before previous record's newline
+    while (true) {
+      if (const char *p{
+              FindLastNewline(Frame(), at - frameOffsetInFile_ + 1)}) {
+        // This is the newline that ends the record before the previous one.
+        recordOffsetInFrame_ = p - Frame() + 1;
+        *recordLength = start - 1 - (frameOffsetInFile_ + recordOffsetInFrame_);
+        break;
+      }
+      RUNTIME_CHECK(handler, frameOffsetInFile_ > 0);
+      at = frameOffsetInFile_ - 1;
+      if (auto bytesBefore{BytesBufferedBeforeFrame()}) {
+        frameOffsetInFile_ = FrameAt() - bytesBefore;
+      } else {
+        static constexpr int chunk{1024};
+        frameOffsetInFile_ = std::max<std::int64_t>(0, at - chunk);
+      }
+      std::size_t want{static_cast<std::size_t>(start - frameOffsetInFile_)};
+      std::size_t got{ReadFrame(frameOffsetInFile_, want, handler)};
+      RUNTIME_CHECK(handler, got >= want);
+    }
+  }
+  std::size_t want{
+      static_cast<std::size_t>(recordOffsetInFrame_ + *recordLength + 1)};
+  RUNTIME_CHECK(handler, FrameLength() >= want);
+  RUNTIME_CHECK(handler, Frame()[recordOffsetInFrame_ + *recordLength] == '\n');
+  if (*recordLength > 0 &&
+      Frame()[recordOffsetInFrame_ + *recordLength - 1] == '\r') {
+    --*recordLength;
+  }
 }
 }

flang/runtime/unit.h

@@ -27,6 +27,8 @@
 
 namespace Fortran::runtime::io {
 
+class UnitMap;
+
 class ExternalFileUnit : public ConnectionState,
                          public OpenFile,
                          public FileFrame<ExternalFileUnit> {
@@ -36,19 +38,21 @@ public:
 
   static ExternalFileUnit *LookUp(int unit);
   static ExternalFileUnit &LookUpOrCrash(int unit, const Terminator &);
-  static ExternalFileUnit &LookUpOrCreate(int unit, bool *wasExtant = nullptr);
-  static int NewUnit();
-  static void InitializePredefinedUnits();
+  static ExternalFileUnit &LookUpOrCreate(
+      int unit, const Terminator &, bool *wasExtant = nullptr);
+  static ExternalFileUnit *LookUpForClose(int unit);
+  static int NewUnit(const Terminator &);
   static void CloseAll(IoErrorHandler &);
 
   void OpenUnit(OpenStatus, Position, OwningPtr<char> &&path,
       std::size_t pathLength, IoErrorHandler &);
   void CloseUnit(CloseStatus, IoErrorHandler &);
+  void DestroyClosed();
 
   template<typename A, typename... X>
   IoStatementState &BeginIoStatement(X &&... xs) {
-    // TODO: lock().Take() here, and keep it until EndIoStatement()?
-    // Nested I/O from derived types wouldn't work, though.
+    // TODO: Child data transfer statements vs. locking
+    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;
@@ -58,26 +62,47 @@ public:
   }
 
   bool Emit(const char *, std::size_t bytes, IoErrorHandler &);
+  std::optional<char32_t> GetCurrentChar(IoErrorHandler &);
   void SetLeftTabLimit();
   bool AdvanceRecord(IoErrorHandler &);
-  bool HandleAbsolutePosition(std::int64_t, IoErrorHandler &);
-  bool HandleRelativePosition(std::int64_t, IoErrorHandler &);
-
+  void BackspaceRecord(IoErrorHandler &);
   void FlushIfTerminal(IoErrorHandler &);
   void EndIoStatement();
+  void SetPosition(std::int64_t pos) {
+    frameOffsetInFile_ = pos;
+    recordOffsetInFrame_ = 0;
+  }
 
 private:
-  bool SetPositionInRecord(std::int64_t, IoErrorHandler &);
+  static UnitMap &GetUnitMap();
+  void NextSequentialUnformattedInputRecord(IoErrorHandler &);
+  void NextSequentialFormattedInputRecord(IoErrorHandler &);
+  void BackspaceSequentialUnformattedRecord(IoErrorHandler &);
+  void BackspaceSequentialFormattedRecord(IoErrorHandler &);
 
   int unitNumber_{-1};
   bool isReading_{false};
+
+  Lock lock_;
+
   // When an I/O statement is in progress on this unit, holds its state.
   std::variant<std::monostate, OpenStatementState, CloseStatementState,
-      ExternalFormattedIoStatementState<false>,
-      ExternalListIoStatementState<false>, UnformattedIoStatementState<false>>
+      ExternalFormattedIoStatementState<Direction::Output>,
+      ExternalFormattedIoStatementState<Direction::Input>,
+      ExternalListIoStatementState<Direction::Output>,
+      ExternalListIoStatementState<Direction::Input>,
+      UnformattedIoStatementState<Direction::Output>,
+      UnformattedIoStatementState<Direction::Input>>
       u_;
-  // Points to the active alternative, if any, in u_, for use as a Cookie
+
+  // 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.
+  std::int64_t frameOffsetInFile_{0};
+  std::int64_t recordOffsetInFrame_{0};  // of currentRecordNumber
 };
 
 }

flang/test/Evaluate/reshape.cpp

@@ -9,9 +9,8 @@ using namespace Fortran::runtime;
 int main() {
   static const SubscriptValue ones[]{1, 1, 1};
   static const SubscriptValue sourceExtent[]{2, 3, 4};
-  std::unique_ptr<Descriptor> source{
-      Descriptor::Create(TypeCategory::Integer, sizeof(std::int32_t), nullptr,
-          3, sourceExtent, CFI_attribute_allocatable)};
+  auto source{Descriptor::Create(TypeCategory::Integer, sizeof(std::int32_t),
+      nullptr, 3, sourceExtent, CFI_attribute_allocatable)};
   source->Check();
   MATCH(3, source->rank());
   MATCH(sizeof(std::int32_t), source->ElementBytes());
@@ -25,12 +24,12 @@ int main() {
   MATCH(4, source->GetDimension(2).Extent());
   MATCH(24, source->Elements());
   for (std::size_t j{0}; j < 24; ++j) {
-    *source->Element<std::int32_t>(j * sizeof(std::int32_t)) = j;
+    *source->OffsetElement<std::int32_t>(j * sizeof(std::int32_t)) = j;
   }
 
   static const std::int16_t shapeData[]{8, 4};
   static const SubscriptValue shapeExtent{2};
-  std::unique_ptr<Descriptor> shape{Descriptor::Create(TypeCategory::Integer,
+  auto shape{Descriptor::Create(TypeCategory::Integer,
       static_cast<int>(sizeof shapeData[0]),
       const_cast<void *>(reinterpret_cast<const void *>(shapeData)), 1,
       &shapeExtent, CFI_attribute_pointer)};
@@ -54,15 +53,14 @@ int main() {
   MATCH(2, pad.GetDimension(1).Extent());
   MATCH(3, pad.GetDimension(2).Extent());
 
-  std::unique_ptr<Descriptor> result{RESHAPE(*source, *shape, &pad)};
-
+  auto result{RESHAPE(*source, *shape, &pad)};
   TEST(result.get() != nullptr);
   result->Check();
   MATCH(sizeof(std::int32_t), result->ElementBytes());
   MATCH(2, result->rank());
   TEST(result->type().IsInteger());
   for (std::int32_t j{0}; j < 32; ++j) {
-    MATCH(j, *result->Element<std::int32_t>(j * sizeof(std::int32_t)));
+    MATCH(j, *result->OffsetElement<std::int32_t>(j * sizeof(std::int32_t)));
   }
   for (std::int32_t j{0}; j < 32; ++j) {
     SubscriptValue ss[2]{1 + (j % 8), 1 + (j / 8)};

flang/test/Runtime/CMakeLists.txt

@@ -10,12 +10,17 @@ if(CMAKE_COMPILER_IS_GNUCXX OR (CMAKE_CXX_COMPILER_ID MATCHES "Clang"))
   set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -fexceptions")
 endif()
 
+add_library(RuntimeTesting
+  testing.cpp
+)
+
 add_executable(format-test
   format.cpp
 )
 
 target_link_libraries(format-test
   FortranRuntime
+  RuntimeTesting
 )
 
 add_test(Format format-test)
@@ -26,6 +31,7 @@ add_executable(hello-world
 
 target_link_libraries(hello-world
   FortranRuntime
+  RuntimeTesting
 )
 
 add_test(HelloWorld hello-world)
@@ -37,3 +43,14 @@ add_executable(external-hello-world
 target_link_libraries(external-hello-world
   FortranRuntime
 )
+
+add_executable(list-input-test
+  list-input.cpp
+)
+
+target_link_libraries(list-input-test
+  FortranRuntime
+  RuntimeTesting
+)
+
+add_test(ListInput list-input-test)

flang/test/Runtime/format.cpp

@@ -1,7 +1,8 @@
 // Tests basic FORMAT string traversal
 
+#include "testing.h"
 #include "../runtime/format-implementation.h"
-#include "../runtime/terminator.h"
+#include "../runtime/io-error.h"
 #include <cstdarg>
 #include <cstring>
 #include <iostream>
@@ -12,20 +13,19 @@ using namespace Fortran::runtime;
 using namespace Fortran::runtime::io;
 using namespace std::literals::string_literals;
 
-static int failures{0};
 using Results = std::vector<std::string>;
 
 // A test harness context for testing FormatControl
-class TestFormatContext : public Terminator {
+class TestFormatContext : public IoErrorHandler {
 public:
   using CharType = char;
-  TestFormatContext() : Terminator{"format.cpp", 1} {}
+  TestFormatContext() : IoErrorHandler{"format.cpp", 1} {}
   bool Emit(const char *, std::size_t);
   bool Emit(const char16_t *, std::size_t);
   bool Emit(const char32_t *, std::size_t);
   bool AdvanceRecord(int = 1);
-  bool HandleRelativePosition(std::int64_t);
-  bool HandleAbsolutePosition(std::int64_t);
+  void HandleRelativePosition(std::int64_t);
+  void HandleAbsolutePosition(std::int64_t);
   void Report(const DataEdit &);
   void Check(Results &);
   Results results;
@@ -35,17 +35,6 @@ private:
   MutableModes mutableModes_;
 };
 
-// Override the runtime's Crash() for testing purposes
-[[noreturn]] void Fortran::runtime::Terminator::Crash(
-    const char *message, ...) const {
-  std::va_list ap;
-  va_start(ap, message);
-  char buffer[1000];
-  std::vsnprintf(buffer, sizeof buffer, message, ap);
-  va_end(ap);
-  throw std::string{buffer};
-}
-
 bool TestFormatContext::Emit(const char *s, std::size_t len) {
   std::string str{s, len};
   results.push_back("'"s + str + '\'');
@@ -67,18 +56,16 @@ bool TestFormatContext::AdvanceRecord(int n) {
   return true;
 }
 
-bool TestFormatContext::HandleAbsolutePosition(std::int64_t n) {
+void TestFormatContext::HandleAbsolutePosition(std::int64_t n) {
   results.push_back("T"s + std::to_string(n));
-  return true;
 }
 
-bool TestFormatContext::HandleRelativePosition(std::int64_t n) {
+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');
   }
-  return true;
 }
 
 void TestFormatContext::Report(const DataEdit &edit) {
@@ -104,7 +91,7 @@ void TestFormatContext::Report(const DataEdit &edit) {
 
 void TestFormatContext::Check(Results &expect) {
   if (expect != results) {
-    std::cerr << "expected:";
+    Fail() << "expected:";
     for (const std::string &s : expect) {
       std::cerr << ' ' << s;
     }
@@ -113,7 +100,6 @@ void TestFormatContext::Check(Results &expect) {
       std::cerr << ' ' << s;
     }
     std::cerr << '\n';
-    ++failures;
   }
   expect.clear();
   results.clear();
@@ -127,7 +113,10 @@ static void Test(int n, const char *format, Results &&expect, int repeat = 1) {
     for (int j{0}; j < n; ++j) {
       context.Report(control.GetNextDataEdit(context, repeat));
     }
-    control.FinishOutput(context);
+    control.Finish(context);
+    if (int iostat{context.GetIoStat()}) {
+      context.Crash("GetIoStat() == %d", iostat);
+    }
   } catch (const std::string &crash) {
     context.results.push_back("Crash:"s + crash);
   }
@@ -135,6 +124,7 @@ static void Test(int n, const char *format, Results &&expect, int repeat = 1) {
 }
 
 int main() {
+  StartTests();
   Test(1, "('PI=',F9.7)", Results{"'PI='", "F9.7"});
   Test(1, "(3HPI=F9.7)", Results{"'PI='", "F9.7"});
   Test(1, "(3HPI=/F9.7)", Results{"'PI='", "/", "F9.7"});
@@ -146,5 +136,5 @@ int main() {
   Test(2, "(*('PI=',F9.7,:),'tooFar')",
       Results{"'PI='", "F9.7", "'PI='", "F9.7"});
   Test(1, "(3F9.7)", Results{"2*F9.7"}, 2);
-  return failures > 0;
+  return EndTests();
 }

flang/test/Runtime/hello.cpp

@@ -1,5 +1,6 @@
 // Basic sanity tests of I/O API; exhaustive testing will be done in Fortran
 
+#include "testing.h"
 #include "../../runtime/descriptor.h"
 #include "../../runtime/io-api.h"
 #include <cstring>
@@ -8,16 +9,15 @@
 using namespace Fortran::runtime;
 using namespace Fortran::runtime::io;
 
-static int failures{0};
-
-static void test(const char *format, const char *expect, std::string &&got) {
+static bool test(const char *format, const char *expect, std::string &&got) {
   std::string want{expect};
   want.resize(got.length(), ' ');
   if (got != want) {
-    std::cerr << '\'' << format << "' failed;\n     got '" << got
-              << "',\nexpected '" << want << "'\n";
-    ++failures;
+    Fail() << '\'' << format << "' failed;\n     got '" << got
+           << "',\nexpected '" << want << "'\n";
+    return false;
   }
+  return true;
 }
 
 static void hello() {
@@ -30,9 +30,8 @@ static void hello() {
   IONAME(OutputInteger64)(cookie, 0xfeedface);
   IONAME(OutputLogical)(cookie, true);
   if (auto status{IONAME(EndIoStatement)(cookie)}) {
-    std::cerr << "hello: '" << format << "' failed, status "
-              << static_cast<int>(status) << '\n';
-    ++failures;
+    Fail() << "hello: '" << format << "' failed, status "
+           << static_cast<int>(status) << '\n';
   } else {
     test(format, "HELLO, WORLD  678 0xFEEDFACE T",
         std::string{buffer, sizeof buffer});
@@ -46,21 +45,18 @@ static void multiline() {
   SubscriptValue extent[]{4};
   whole.Establish(TypeCode{CFI_type_char}, sizeof buffer[0], &buffer, 1, extent,
       CFI_attribute_pointer);
-  //  whole.Dump(std::cout);
+  whole.Dump();
   whole.Check();
   Descriptor &section{staticDescriptor[1].descriptor()};
   SubscriptValue lowers[]{0}, uppers[]{3}, strides[]{1};
   section.Establish(whole.type(), whole.ElementBytes(), nullptr, 1, extent,
       CFI_attribute_pointer);
-  //  section.Dump(std::cout);
-  section.Check();
   if (auto error{
           CFI_section(&section.raw(), &whole.raw(), lowers, uppers, strides)}) {
-    std::cerr << "multiline: CFI_section failed: " << error << '\n';
-    ++failures;
+    Fail() << "multiline: CFI_section failed: " << error << '\n';
     return;
   }
-  section.Dump(std::cout);
+  section.Dump();
   section.Check();
   const char *format{"('?abcde,',T1,'>',T9,A,TL12,A,TR25,'<'//G0,25X,'done')"};
   auto cookie{IONAME(BeginInternalArrayFormattedOutput)(
@@ -69,9 +65,8 @@ static void multiline() {
   IONAME(OutputAscii)(cookie, "HELLO", 5);
   IONAME(OutputInteger64)(cookie, 789);
   if (auto status{IONAME(EndIoStatement)(cookie)}) {
-    std::cerr << "multiline: '" << format << "' failed, status "
-              << static_cast<int>(status) << '\n';
-    ++failures;
+    Fail() << "multiline: '" << format << "' failed, status "
+           << static_cast<int>(status) << '\n';
   } else {
     test(format,
         ">HELLO, WORLD                  <"
@@ -88,15 +83,41 @@ static void realTest(const char *format, double x, const char *expect) {
       buffer, sizeof buffer, format, std::strlen(format))};
   IONAME(OutputReal64)(cookie, x);
   if (auto status{IONAME(EndIoStatement)(cookie)}) {
-    std::cerr << '\'' << format << "' failed, status "
-              << static_cast<int>(status) << '\n';
-    ++failures;
+    Fail() << '\'' << format << "' failed, status " << static_cast<int>(status)
+           << '\n';
   } else {
     test(format, expect, std::string{buffer, sizeof buffer});
   }
 }
 
+static void realInTest(
+    const char *format, const char *data, std::uint64_t want) {
+  auto cookie{IONAME(BeginInternalFormattedInput)(
+      data, std::strlen(data), format, std::strlen(format))};
+  union {
+    double x;
+    std::uint64_t raw;
+  } u;
+  u.raw = 0;
+  IONAME(EnableHandlers)(cookie, true, true, true, true, true);
+  IONAME(InputReal64)(cookie, u.x);
+  char iomsg[65];
+  iomsg[0] = '\0';
+  iomsg[sizeof iomsg - 1] = '\0';
+  IONAME(GetIoMsg)(cookie, iomsg, sizeof iomsg - 1);
+  auto status{IONAME(EndIoStatement)(cookie)};
+  if (status) {
+    Fail() << '\'' << format << "' failed reading '" << data << "', status "
+           << static_cast<int>(status) << " iomsg '" << iomsg << "'\n";
+  } else if (u.raw != want) {
+    Fail() << '\'' << format << "' failed reading '" << data << "', want 0x"
+           << std::hex << want << ", got 0x" << u.raw << std::dec << '\n';
+  }
+}
+
 int main() {
+  StartTests();
+
   hello();
   multiline();
 
@@ -382,10 +403,22 @@ int main() {
       "4040261841248583680000+306;");
   realTest("(G0,';')", u.d, ".17976931348623157+309;");
 
-  if (failures == 0) {
-    std::cout << "PASS\n";
-  } else {
-    std::cout << "FAIL " << failures << " tests\n";
-  }
-  return failures > 0;
+  realInTest("(F18.0)", "                 0", 0x0);
+  realInTest("(F18.0)", "                  ", 0x0);
+  realInTest("(F18.0)", "                -0", 0x8000000000000000);
+  realInTest("(F18.0)", "                 1", 0x3ff0000000000000);
+  realInTest("(F18.0)", "              125.", 0x405f400000000000);
+  realInTest("(F18.0)", "              12.5", 0x4029000000000000);
+  realInTest("(F18.0)", "              1.25", 0x3ff4000000000000);
+  realInTest("(F18.0)", "              .125", 0x3fc0000000000000);
+  realInTest("(F18.0)", "               125", 0x405f400000000000);
+  realInTest("(F18.1)", "               125", 0x4029000000000000);
+  realInTest("(F18.2)", "               125", 0x3ff4000000000000);
+  realInTest("(F18.3)", "               125", 0x3fc0000000000000);
+  realInTest("(-1P,F18.0)", "               125", 0x4093880000000000);  // 1250
+  realInTest("(1P,F18.0)", "               125", 0x4029000000000000);  // 12.5
+  realInTest("(BZ,F18.0)", "              125 ", 0x4093880000000000);  // 1250
+  realInTest("(DC,F18.0)", "              12,5", 0x4029000000000000);
+
+  return EndTests();
 }

flang/test/Runtime/list-input.cpp

@@ -0,0 +1,68 @@
+// Basic sanity tests for list-directed input
+
+#include "testing.h"
+#include "../../runtime/descriptor.h"
+#include "../../runtime/io-api.h"
+#include "../../runtime/io-error.h"
+#include <algorithm>
+#include <cstring>
+#include <iostream>
+
+using namespace Fortran::runtime;
+using namespace Fortran::runtime::io;
+
+int main() {
+  StartTests();
+
+  char buffer[4][32];
+  int j{0};
+  for (const char *p : {"1 2 2*3  ,", ",6,,8,123*",
+           "2*'abcdefghijklmnopqrstuvwxyzABC", "DEFGHIJKLMNOPQRSTUVWXYZ'"}) {
+    SetCharacter(buffer[j++], sizeof buffer[0], p);
+  }
+  for (; j < 4; ++j) {
+    SetCharacter(buffer[j], sizeof buffer[0], "");
+  }
+
+  StaticDescriptor<1> staticDescriptor;
+  Descriptor &whole{staticDescriptor.descriptor()};
+  SubscriptValue extent[]{4};
+  whole.Establish(TypeCode{CFI_type_char}, sizeof buffer[0], &buffer, 1, extent,
+      CFI_attribute_pointer);
+  whole.Dump();
+  whole.Check();
+
+  try {
+    auto cookie{IONAME(BeginInternalArrayListInput)(whole)};
+    std::int64_t n[9]{-1, -2, -3, -4, 5, -6, 7, -8, 9};
+    std::int64_t want[9]{1, 2, 3, 3, 5, 6, 7, 8, 9};
+    for (j = 0; j < 9; ++j) {
+      IONAME(InputInteger)(cookie, n[j]);
+    }
+    char asc[2][54]{};
+    IONAME(InputAscii)(cookie, asc[0], sizeof asc[0] - 1);
+    IONAME(InputAscii)(cookie, asc[1], sizeof asc[1] - 1);
+    if (auto status{IONAME(EndIoStatement)(cookie)}) {
+      Fail() << "list-directed input failed, status "
+             << static_cast<int>(status) << '\n';
+    } else {
+      for (j = 0; j < 9; ++j) {
+        if (n[j] != want[j]) {
+          Fail() << "wanted n[" << j << "]==" << want[j] << ", got " << n[j]
+                 << '\n';
+        }
+      }
+      for (j = 0; j < 2; ++j) {
+        if (std::strcmp(asc[j],
+                "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ ") != 0) {
+          Fail() << "wanted asc[" << j << "]=alphabets, got '" << asc[j]
+                 << "'\n";
+        }
+      }
+    }
+  } catch (const std::string &crash) {
+    Fail() << "crash: " << crash << '\n';
+  }
+
+  return EndTests();
+}

flang/test/Runtime/testing.cpp

@@ -0,0 +1,43 @@
+#include "testing.h"
+#include "../../runtime/terminator.h"
+#include <cstdarg>
+#include <cstdio>
+#include <cstring>
+#include <iostream>
+#include <string>
+
+static int failures{0};
+
+// Override the Fortran runtime's Crash() for testing purposes
+[[noreturn]] static void CatchCrash(const char *message, va_list &ap) {
+  char buffer[1000];
+  std::vsnprintf(buffer, sizeof buffer, message, ap);
+  va_end(ap);
+  throw std::string{buffer};
+}
+
+void StartTests() {
+  Fortran::runtime::Terminator::RegisterCrashHandler(CatchCrash);
+}
+
+std::ostream &Fail() {
+  ++failures;
+  return std::cerr;
+}
+
+int EndTests() {
+  if (failures == 0) {
+    std::cout << "PASS\n";
+  } else {
+    std::cout << "FAIL " << failures << " tests\n";
+  }
+  return failures != 0;
+}
+
+void SetCharacter(char *to, std::size_t n, const char *from) {
+  auto len{std::strlen(from)};
+  std::memcpy(to, from, std::min(len, n));
+  if (len < n) {
+    std::memset(to + len, ' ', n - len);
+  }
+}

flang/test/Runtime/testing.h

@@ -0,0 +1,13 @@
+#ifndef FORTRAN_TEST_RUNTIME_TESTING_H_
+#define FORTRAN_TEST_RUNTIME_TESTING_H_
+
+#include <cstddef>
+#include <iosfwd>
+
+void StartTests();
+std::ostream &Fail();
+int EndTests();
+
+void SetCharacter(char *, std::size_t, const char *);
+
+#endif  // FORTRAN_TEST_RUNTIME_TESTING_H_

flang/test/Semantics/call15.f90

@@ -7,7 +7,7 @@ subroutine s(arg1, arg2, arg3)
 
   call inner(arg1) ! OK, assumed rank
   call inner(arg2) ! OK, assumed shape
-  !ERROR: Assumed-type TYPE(*) 'arg3' must be either assumed shape or assumed rank to be associated with TYPE(*) dummy argument 'dummy='
+  !ERROR: Assumed-type 'arg3' must be either assumed shape or assumed rank to be associated with assumed-type dummy argument 'dummy='
   call inner(arg3)
 
     contains