[flang] runtime: fix problems with I/O around EOF & delimited characters

[klausler]

Summary

When a WRITE overwrites an endfile record, we need to forget
that there was an endfile record. When doing a BACKSPACE
after an explicit ENDFILE statement, the position afterwards
must be upon the endfile record.

Attempts to join list-directed delimited character input across
record boundaries was due to a bad reading of the standard
and has been deleted, now that the requirements are better understood.
This problem would cause a read attempt past EOF if a delimited
character input value was at the end of a record.

It turns out that delimited list-directed (and NAMELIST) character
output is required to emit contiguous doubled instances of the
delimiter character when it appears in the output value. When
fixed-size records are being emitted, as is the case with internal
output, this is not possible when the problematic character falls
on the last position of a record. No two other Fortran compilers
do the same thing in this situation so there is no good precedent
to follow.

Because it seems least wrong, with this patch we now emit one copy
of the delimiter as the last character of the current record and
another as the first character of the next record. (The
second-least-wrong alternative might be to flag a runtime error,
but that seems harsh since it's not an explicit error in the standard,
and the output may not have to be usable later as input anyway.)
Consequently, the output is not suitable for use as list-directed or
NAMELIST input.

If a later standard were to clarify this case, this behavior will of
course change as needed to conform.

[PeteSteinfeld]

All builds, tests, and looks good.

flang/docs/Extensions.md

* Scalar `INTEGER` actual argument expressions (not variables!)
   when the interface is explicit and the kinds differ.
   This conversion allows the results of the intrinsics like
   `SIZE` that (as mentioned below) may return non-default
   `INTEGER` results by default to be passed.  A warning is
   emitted when truncation is possible.
 * We are not strict on the contents of `BLOCK DATA` subprograms
   so long as they contain no executable code, no internal subprograms,
   and allocate no storage outside a named `COMMON` block.  (C1415)
+* Delimited list-directed (and NAMELIST) character output is required
+  to emit contiguous doubled instances of the delimiter character
+  when it appears in the output value.  When fixed-size records
+  are being emitted, as is the case with internal output, this
+  is not possible when the problematic character falls on the last
+  position of a record.  No two other Fortran compilers do the same
+  thing in this situation so there is no good precedent to follow.
+  Because it seems least wrong, we emit one copy of the delimiter as
+  the last character of the current record and another as the first
+  character of the next record.  (The second-least-wrong alternative
+  might be to flag a runtime error, but that seems harsh since it's
+  not an explicit error in the standard, and the output may not have
+  to be usable later as input anyway.)
+  Consequently, the output is not suitable for use as list-directed or
+  NAMELIST input.  If a later standard were to clarify this case, this
+  behavior will change as needed to conform.
+```
+character(11) :: buffer(3)
+character(10) :: quotes = '""""""""""'
+write(buffer,*,delim="QUOTE") quotes
+print "('>',a10,'<')", buffer
+end
+```
 
 ## Extensions, deletions, and legacy features supported by default
 
 * Tabs in source
 * `<>` as synonym for `.NE.` and `/=`
 * `$` and `@` as legal characters in names
 * Initialization in type declaration statements using `/values/`
 * Kind specification with `*`, e.g. `REAL*4`

flang/runtime/edit-input.cpp

if (!ch) {
         continue;
       } else {
         result = false; // EOF in character value
         break;
       }
     }
     io.HandleRelativePosition(1);
     if (*ch == delimiter) {
-      if (auto next{io.GetCurrentChar()}) {
-        if (*next == delimiter) {
-          // Repeated delimiter: use as character value
-          io.HandleRelativePosition(1);
-        } else { // closing delimiter
-          break;
-        }
-      } else { // delimiter was at the end of the record
-        if (length > 0) {
-          // Look ahead on next record: if it begins with the delimiter,
-          // treat it as a split character value, ignoring both delimiters
-          ConnectionState &connection{io.GetConnectionState()};
-          auto position{connection.positionInRecord};
-          if (io.AdvanceRecord()) {
-            if (auto next{io.GetCurrentChar()}; next && *next == delimiter) {
-              // Character constant split over a record boundary
-              io.HandleRelativePosition(1);
-              continue;
-            }
-            // Not a character value split over a record boundary.
-            io.BackspaceRecord();
-            connection.HandleAbsolutePosition(position);
-          }
-        }
-        break;
+      auto next{io.GetCurrentChar()};
+      if (next && *next == delimiter) {
+      } else {
+        break; // closing delimiter
       }
     }
     if (length > 0) {
       *x++ = *ch;
       --length;
     }
   }
   std::fill_n(x, length, ' ');

flang/runtime/edit-output.cpp

bool ListDirectedDefaultCharacterOutput(IoStatementState &io,
     ListDirectedStatementState<Direction::Output> &list, const char *x,
     std::size_t length) {
   bool ok{true};
   MutableModes &modes{io.mutableModes()};
   ConnectionState &connection{io.GetConnectionState()};
   if (modes.delim) {
     ok = ok && list.EmitLeadingSpaceOrAdvance(io);
     // Value is delimited with ' or " marks, and interior
-    // instances of that character are doubled.  When split
-    // over multiple lines, delimit each lines' part.
+    // instances of that character are doubled.
     ok = ok && io.Emit(&modes.delim, 1);
-    for (std::size_t j{0}; j < length; ++j) {
-      if (connection.NeedAdvance(2)) {
-        ok = ok && io.Emit(&modes.delim, 1) && io.AdvanceRecord() &&
-            io.Emit(&modes.delim, 1);
+    auto EmitOne{[&](char ch) {
+      if (connection.NeedAdvance(1)) {
+        ok = ok && io.AdvanceRecord();
       }
+      ok = ok && io.Emit(&ch, 1);
+    }};
+    for (std::size_t j{0}; j < length; ++j) {
+      // Doubled delimiters must be put on the same record
+      // in order to be acceptable as list-directed or NAMELIST
+      // input; however, this requirement is not always possible
+      // when the records have a fixed length, as is the case with
+      // internal output.  The standard is silent on what should
+      // happen, and no two extant Fortran implementations do
+      // the same thing when tested with this case.
+      // This runtime splits the doubled delimiters across
+      // two records for lack of a better alternative.
       if (x[j] == modes.delim) {
-        ok = ok && io.EmitRepeated(modes.delim, 2);
-      } else {
-        ok = ok && io.Emit(&x[j], 1);
+        EmitOne(x[j]);
       }
+      EmitOne(x[j]);
     }
-    ok = ok && io.Emit(&modes.delim, 1);
+    EmitOne(modes.delim);
   } else {
     // Undelimited list-directed output
     ok = ok &&
         list.EmitLeadingSpaceOrAdvance(
             io, length > 0 && !list.lastWasUndelimitedCharacter());
     std::size_t put{0};
     while (ok && put < length) {
       auto chunk{std::min(length - put, connection.RemainingSpaceInRecord())};

flang/runtime/unit.cpp

if (handler.InError()) {
     } else {
       RUNTIME_CHECK(handler, isUnformatted.has_value());
       if (isUnformatted.value_or(false)) {
         // Retain footer in frame for more efficient BACKSPACE
         frameOffsetInFile_ += recordOffsetInFrame_ + *recordLength;
         recordOffsetInFrame_ = sizeof(std::uint32_t);
         recordLength.reset();
       } else { // formatted
-        if (Frame()[recordOffsetInFrame_ + *recordLength] == '\r') {
+        if (FrameLength() > recordOffsetInFrame_ + *recordLength &&
+            Frame()[recordOffsetInFrame_ + *recordLength] == '\r') {
           ++recordOffsetInFrame_;
         }
-        if (Frame()[recordOffsetInFrame_ + *recordLength] == '\n') {
+        if (FrameLength() >= recordOffsetInFrame_ &&
+            Frame()[recordOffsetInFrame_ + *recordLength] == '\n') {
           ++recordOffsetInFrame_;
         }
         recordOffsetInFrame_ += *recordLength;
         recordLength.reset();
       }
     }
   }
   ++currentRecordNumber;
if (isFixedRecordLength && recordLength) {
       } else {
         // Terminate formatted variable length record
         ok = ok && Emit("\n", 1, 1, handler); // TODO: Windows CR+LF
       }
     }
     CommitWrites();
     impliedEndfile_ = true;
     ++currentRecordNumber;
+    if (endfileRecordNumber && currentRecordNumber >= *endfileRecordNumber) {
+      endfileRecordNumber.reset();
+    }
     return ok;
   }
 }
 
 void ExternalFileUnit::BackspaceRecord(IoErrorHandler &handler) {
   if (access != Access::Sequential) {
     handler.SignalError(IostatBackspaceNonSequential,
         "BACKSPACE(UNIT=%d) on non-sequential file", unitNumber());
   } else {
     if (endfileRecordNumber && currentRecordNumber > *endfileRecordNumber) {
-      // BACKSPACE after ENDFILE
+      // BACKSPACE after explicit ENDFILE
+      currentRecordNumber = *endfileRecordNumber;
     } else {
       DoImpliedEndfile(handler);
       if (frameOffsetInFile_ + recordOffsetInFrame_ > 0) {
         --currentRecordNumber;
         if (isFixedRecordLength) {
           BackspaceFixedRecord(handler);
         } else {
           RUNTIME_CHECK(handler, isUnformatted.has_value());
void ExternalFileUnit::Endfile(IoErrorHandler &handler) {
   } else if (!mayWrite()) {
     handler.SignalError(IostatEndfileUnwritable,
         "ENDFILE(UNIT=%d) on read-only file", unitNumber());
   } else if (endfileRecordNumber &&
       currentRecordNumber > *endfileRecordNumber) {
     // ENDFILE after ENDFILE
   } else {
     DoEndfile(handler);
-    ++currentRecordNumber;
+    // Explicit ENDFILE leaves position *after* the endfile record
+    RUNTIME_CHECK(handler, endfileRecordNumber.has_value());
+    currentRecordNumber = *endfileRecordNumber + 1;
   }
 }
 
 void ExternalFileUnit::Rewind(IoErrorHandler &handler) {
   if (access == Access::Direct) {
     handler.SignalError(IostatRewindNonSequential,
         "REWIND(UNIT=%d) on non-sequential file", unitNumber());
   } else {

flang/unittests/RuntimeGTest/Namelist.cpp

TEST(NamelistTests, BasicSanity) {
   std::vector<std::uint8_t> logicals;
   logicals.push_back(false);
   logicals.push_back(true);
   logicals.push_back(false);
   std::vector<std::complex<float>> complexes;
   complexes.push_back(std::complex<float>{123.0, -0.5});
   std::vector<std::string> characters;
   characters.emplace_back("aBcDeFgHiJkLmNoPqRsTuVwXyZ");
-  characters.emplace_back("0123456789'\"              ");
+  characters.emplace_back("0123456789'\"..............");
   // Copy the data into new descriptors
   OwningPtr<Descriptor> intDesc{
       MakeArray<TypeCategory::Integer, static_cast<int>(sizeof(int))>(
           std::vector<int>{5, 4}, std::move(ints))};
   OwningPtr<Descriptor> realDesc{
       MakeArray<TypeCategory::Real, static_cast<int>(sizeof(double))>(
           std::vector<int>{4, 2}, std::move(reals))};
   OwningPtr<Descriptor> logicalDesc{
static const std::string expect{"&GROUP1 INTS= 1 -2 4 -8 16 -32  "
                                   " 64 -128 256 -512 1024 -2048    "
                                   " 4096 -8192 16384 -32768 65536  "
                                   " -131072 262144 -524288,REALS=  "
                                   " 0. -0. Inf -Inf NaN            "
                                   " 1.7976931348623157E+308        "
                                   " -1.7976931348623157E+308       "
                                   " 2.220446049250313E-16,LOGICALS="
                                   "F T F,COMPLEXES= (123.,-.5),    "
-                                  " CHARACTERS= 'aBcDeFgHiJkLmNoPq'"
-                                  "'RsTuVwXyZ' '0123456789''\"     '"
-                                  "'         '/                    "};
+                                  " CHARACTERS= 'aBcDeFgHiJkLmNoPqR"
+                                  "sTuVwXyZ' '0123456789''\"........"
+                                  "......'/                        "};
   std::string got{buffer[0], sizeof buffer};
   EXPECT_EQ(got, expect);
 
   // Clear the arrays, read them back, write out again, and compare
   ClearDescriptorStorage(*intDesc);
   ClearDescriptorStorage(*realDesc);
   ClearDescriptorStorage(*logicalDesc);
   ClearDescriptorStorage(*complexDesc);