[flang-commits] [flang] a39e9cf - [flang] Basic tests of external I/O runtime (part 9/9)

peter klausler via flang-commits flang-commits at lists.llvm.org
Mon Jul 6 10:38:02 PDT 2020


Author: peter klausler
Date: 2020-07-06T10:37:13-07:00
New Revision: a39e9cf6bec4e7c8e2e947972421c1d5a6f473d6

URL: https://github.com/llvm/llvm-project/commit/a39e9cf6bec4e7c8e2e947972421c1d5a6f473d6
DIFF: https://github.com/llvm/llvm-project/commit/a39e9cf6bec4e7c8e2e947972421c1d5a6f473d6.diff

LOG: [flang] Basic tests of external I/O runtime (part 9/9)

Add new unit tests for external Fortran I/O that drive the
Fortran I/O runtime API from C++ and exercise basic writing
and read-back in the various combinations of access modes,
record length variability, and formatting.  Sequential modes
are tested with positioning.  More thorough tests written in
Fortran will follow when they can be compiled and run.

The Fortran runtime's error termination callback registration
was extended with source file and line number positions for
better failure messages in unit testing.

Reviewed By: sscalpone

Differential Revision: https://reviews.llvm.org/D83164

Added: 
    flang/unittests/Runtime/external-io.cpp

Modified: 
    flang/runtime/terminator.cpp
    flang/runtime/terminator.h
    flang/unittests/Runtime/CMakeLists.txt
    flang/unittests/Runtime/external-hello.cpp
    flang/unittests/Runtime/testing.cpp
    flang/unittests/Runtime/testing.h

Removed: 
    


################################################################################
diff  --git a/flang/runtime/terminator.cpp b/flang/runtime/terminator.cpp
index cea1a8673eeb..e2ea80d3aa55 100644
--- a/flang/runtime/terminator.cpp
+++ b/flang/runtime/terminator.cpp
@@ -18,17 +18,18 @@ namespace Fortran::runtime {
   CrashArgs(message, ap);
 }
 
-static void (*crashHandler)(const char *, va_list &){nullptr};
+static void (*crashHandler)(const char *, int, const char *, va_list &){
+    nullptr};
 
 void Terminator::RegisterCrashHandler(
-    void (*handler)(const char *, va_list &)) {
+    void (*handler)(const char *, int, const char *, va_list &)) {
   crashHandler = handler;
 }
 
 [[noreturn]] void Terminator::CrashArgs(
     const char *message, va_list &ap) const {
   if (crashHandler) {
-    crashHandler(message, ap);
+    crashHandler(sourceFileName_, sourceLine_, message, ap);
   }
   std::fputs("\nfatal Fortran runtime error", stderr);
   if (sourceFileName_) {

diff  --git a/flang/runtime/terminator.h b/flang/runtime/terminator.h
index 66bc92ae4e25..33a6d5d2c156 100644
--- a/flang/runtime/terminator.h
+++ b/flang/runtime/terminator.h
@@ -34,7 +34,8 @@ class Terminator {
       const char *predicate, const char *file, int line) const;
 
   // For test harnessing - overrides CrashArgs().
-  static void RegisterCrashHandler(void (*)(const char *, va_list &));
+  static void RegisterCrashHandler(void (*)(const char *sourceFile,
+      int sourceLine, const char *message, va_list &ap));
 
 private:
   const char *sourceFileName_{nullptr};

diff  --git a/flang/unittests/Runtime/CMakeLists.txt b/flang/unittests/Runtime/CMakeLists.txt
index e1464e54e8c5..aa189188903b 100644
--- a/flang/unittests/Runtime/CMakeLists.txt
+++ b/flang/unittests/Runtime/CMakeLists.txt
@@ -41,6 +41,18 @@ target_link_libraries(external-hello-world
   LLVMSupport
 )
 
+add_executable(external-io
+  external-io.cpp
+)
+
+target_link_libraries(external-io
+  RuntimeTesting
+  FortranRuntime
+  LLVMSupport
+)
+
+add_test(NAME ExternalIO COMMAND external-io)
+
 add_executable(list-input-test
   list-input.cpp
 )

diff  --git a/flang/unittests/Runtime/external-hello.cpp b/flang/unittests/Runtime/external-hello.cpp
index 400d345e1b39..eba345481db9 100644
--- a/flang/unittests/Runtime/external-hello.cpp
+++ b/flang/unittests/Runtime/external-hello.cpp
@@ -5,9 +5,8 @@
 
 using namespace Fortran::runtime::io;
 
-int main(int argc, const char *argv[], const char *envp[]) {
-  RTNAME(ProgramStart)(argc, argv, envp);
-  auto *io{IONAME(BeginExternalListOutput)()};
+void output1() {
+  auto io{IONAME(BeginExternalListOutput)()};
   const char str[]{"Hello, world!"};
   IONAME(OutputAscii)(io, str, std::strlen(str));
   IONAME(OutputInteger64)(io, 678);
@@ -21,6 +20,31 @@ int main(int argc, const char *argv[], const char *envp[]) {
   IONAME(OutputLogical)(io, false);
   IONAME(OutputLogical)(io, true);
   IONAME(EndIoStatement)(io);
+}
+
+void input1() {
+  auto io{IONAME(BeginExternalListOutput)()};
+  const char prompt[]{"Enter an integer value:"};
+  IONAME(OutputAscii)(io, prompt, std::strlen(prompt));
+  IONAME(EndIoStatement)(io);
+
+  io = IONAME(BeginExternalListInput)();
+  std::int64_t n{-666};
+  IONAME(InputInteger)(io, n);
+  IONAME(EndIoStatement)(io);
+
+  io = IONAME(BeginExternalListOutput)();
+  const char str[]{"Result:"};
+  IONAME(OutputAscii)(io, str, std::strlen(str));
+  IONAME(OutputInteger64)(io, n);
+  IONAME(EndIoStatement)(io);
+}
+
+int main(int argc, const char *argv[], const char *envp[]) {
+  RTNAME(ProgramStart)(argc, argv, envp);
+  output1();
+  input1();
+  RTNAME(PauseStatement)();
   RTNAME(ProgramEndStatement)();
   return 0;
 }

diff  --git a/flang/unittests/Runtime/external-io.cpp b/flang/unittests/Runtime/external-io.cpp
new file mode 100644
index 000000000000..63b910b23956
--- /dev/null
+++ b/flang/unittests/Runtime/external-io.cpp
@@ -0,0 +1,399 @@
+// Sanity test for all external I/O modes
+
+#include "testing.h"
+#include "../../runtime/io-api.h"
+#include "../../runtime/main.h"
+#include "../../runtime/stop.h"
+#include "llvm/Support/raw_ostream.h"
+#include <cstring>
+
+using namespace Fortran::runtime::io;
+
+void TestDirectUnformatted() {
+  llvm::errs() << "begin TestDirectUnformatted()\n";
+  // OPEN(NEWUNIT=unit,ACCESS='DIRECT',ACTION='READWRITE',&
+  //   FORM='UNFORMATTED',RECL=8,STATUS='SCRATCH')
+  auto io{IONAME(BeginOpenNewUnit)(__FILE__, __LINE__)};
+  IONAME(SetAccess)(io, "DIRECT", 6) || (Fail() << "SetAccess(DIRECT)", 0);
+  IONAME(SetAction)
+  (io, "READWRITE", 9) || (Fail() << "SetAction(READWRITE)", 0);
+  IONAME(SetForm)
+  (io, "UNFORMATTED", 11) || (Fail() << "SetForm(UNFORMATTED)", 0);
+  std::int64_t buffer;
+  static constexpr std::size_t recl{sizeof buffer};
+  IONAME(SetRecl)(io, recl) || (Fail() << "SetRecl()", 0);
+  IONAME(SetStatus)(io, "SCRATCH", 7) || (Fail() << "SetStatus(SCRATCH)", 0);
+  int unit{-1};
+  IONAME(GetNewUnit)(io, unit) || (Fail() << "GetNewUnit()", 0);
+  llvm::errs() << "unit=" << unit << '\n';
+  IONAME(EndIoStatement)
+  (io) == IostatOk || (Fail() << "EndIoStatement() for OpenNewUnit", 0);
+  static constexpr int records{10};
+  for (int j{1}; j <= records; ++j) {
+    // WRITE(UNIT=unit,REC=j) j
+    io = IONAME(BeginUnformattedOutput)(unit, __FILE__, __LINE__);
+    IONAME(SetRec)(io, j) || (Fail() << "SetRec(" << j << ')', 0);
+    buffer = j;
+    IONAME(OutputUnformattedBlock)
+    (io, reinterpret_cast<const char *>(&buffer), recl) ||
+        (Fail() << "OutputUnformattedBlock()", 0);
+    IONAME(EndIoStatement)
+    (io) == IostatOk ||
+        (Fail() << "EndIoStatement() for OutputUnformattedBlock", 0);
+  }
+  for (int j{records}; j >= 1; --j) {
+    // READ(UNIT=unit,REC=j) n
+    io = IONAME(BeginUnformattedInput)(unit, __FILE__, __LINE__);
+    IONAME(SetRec)
+    (io, j) || (Fail() << "SetRec(" << j << ')', 0);
+    IONAME(InputUnformattedBlock)
+    (io, reinterpret_cast<char *>(&buffer), recl) ||
+        (Fail() << "InputUnformattedBlock()", 0);
+    IONAME(EndIoStatement)
+    (io) == IostatOk ||
+        (Fail() << "EndIoStatement() for InputUnformattedBlock", 0);
+    if (buffer != j) {
+      Fail() << "Read back " << buffer << " from direct unformatted record "
+             << j << ", expected " << j << '\n';
+    }
+  }
+  // CLOSE(UNIT=unit,STATUS='DELETE')
+  io = IONAME(BeginClose)(unit, __FILE__, __LINE__);
+  IONAME(SetStatus)(io, "DELETE", 6) || (Fail() << "SetStatus(DELETE)", 0);
+  IONAME(EndIoStatement)
+  (io) == IostatOk || (Fail() << "EndIoStatement() for Close", 0);
+  llvm::errs() << "end TestDirectUnformatted()\n";
+}
+
+void TestSequentialFixedUnformatted() {
+  llvm::errs() << "begin TestSequentialFixedUnformatted()\n";
+  // OPEN(NEWUNIT=unit,ACCESS='SEQUENTIAL',ACTION='READWRITE',&
+  //   FORM='UNFORMATTED',RECL=8,STATUS='SCRATCH')
+  auto io{IONAME(BeginOpenNewUnit)(__FILE__, __LINE__)};
+  IONAME(SetAccess)
+      (io, "SEQUENTIAL", 10) || (Fail() << "SetAccess(SEQUENTIAL)", 0);
+  IONAME(SetAction)
+  (io, "READWRITE", 9) || (Fail() << "SetAction(READWRITE)", 0);
+  IONAME(SetForm)
+  (io, "UNFORMATTED", 11) || (Fail() << "SetForm(UNFORMATTED)", 0);
+  std::int64_t buffer;
+  static constexpr std::size_t recl{sizeof buffer};
+  IONAME(SetRecl)(io, recl) || (Fail() << "SetRecl()", 0);
+  IONAME(SetStatus)(io, "SCRATCH", 7) || (Fail() << "SetStatus(SCRATCH)", 0);
+  int unit{-1};
+  IONAME(GetNewUnit)(io, unit) || (Fail() << "GetNewUnit()", 0);
+  llvm::errs() << "unit=" << unit << '\n';
+  IONAME(EndIoStatement)
+  (io) == IostatOk || (Fail() << "EndIoStatement() for OpenNewUnit", 0);
+  static const int records{10};
+  for (int j{1}; j <= records; ++j) {
+    // DO J=1,RECORDS; WRITE(UNIT=unit) j; END DO
+    io = IONAME(BeginUnformattedOutput)(unit, __FILE__, __LINE__);
+    buffer = j;
+    IONAME(OutputUnformattedBlock)
+    (io, reinterpret_cast<const char *>(&buffer), recl) ||
+        (Fail() << "OutputUnformattedBlock()", 0);
+    IONAME(EndIoStatement)
+    (io) == IostatOk ||
+        (Fail() << "EndIoStatement() for OutputUnformattedBlock", 0);
+  }
+  // REWIND(UNIT=unit)
+  io = IONAME(BeginRewind)(unit, __FILE__, __LINE__);
+  IONAME(EndIoStatement)
+  (io) == IostatOk || (Fail() << "EndIoStatement() for Rewind", 0);
+  for (int j{1}; j <= records; ++j) {
+    // DO J=1,RECORDS; READ(UNIT=unit) n; check n; END DO
+    io = IONAME(BeginUnformattedInput)(unit, __FILE__, __LINE__);
+    IONAME(InputUnformattedBlock)
+    (io, reinterpret_cast<char *>(&buffer), recl) ||
+        (Fail() << "InputUnformattedBlock()", 0);
+    IONAME(EndIoStatement)
+    (io) == IostatOk ||
+        (Fail() << "EndIoStatement() for InputUnformattedBlock", 0);
+    if (buffer != j) {
+      Fail() << "Read back " << buffer
+             << " from sequential fixed unformatted record " << j
+             << ", expected " << j << '\n';
+    }
+  }
+  for (int j{records}; j >= 1; --j) {
+    // BACKSPACE(UNIT=unit)
+    io = IONAME(BeginBackspace)(unit, __FILE__, __LINE__);
+    IONAME(EndIoStatement)
+    (io) == IostatOk ||
+        (Fail() << "EndIoStatement() for Backspace (before read)", 0);
+    // READ(UNIT=unit) n
+    io = IONAME(BeginUnformattedInput)(unit, __FILE__, __LINE__);
+    IONAME(InputUnformattedBlock)
+    (io, reinterpret_cast<char *>(&buffer), recl) ||
+        (Fail() << "InputUnformattedBlock()", 0);
+    IONAME(EndIoStatement)
+    (io) == IostatOk ||
+        (Fail() << "EndIoStatement() for InputUnformattedBlock", 0);
+    if (buffer != j) {
+      Fail() << "Read back " << buffer
+             << " from sequential fixed unformatted record " << j
+             << " after backspacing, expected " << j << '\n';
+    }
+    // BACKSPACE(UNIT=unit)
+    io = IONAME(BeginBackspace)(unit, __FILE__, __LINE__);
+    IONAME(EndIoStatement)
+    (io) == IostatOk ||
+        (Fail() << "EndIoStatement() for Backspace (after read)", 0);
+  }
+  // CLOSE(UNIT=unit,STATUS='DELETE')
+  io = IONAME(BeginClose)(unit, __FILE__, __LINE__);
+  IONAME(SetStatus)(io, "DELETE", 6) || (Fail() << "SetStatus(DELETE)", 0);
+  IONAME(EndIoStatement)
+  (io) == IostatOk || (Fail() << "EndIoStatement() for Close", 0);
+  llvm::errs() << "end TestSequentialFixedUnformatted()\n";
+}
+
+void TestSequentialVariableUnformatted() {
+  llvm::errs() << "begin TestSequentialVariableUnformatted()\n";
+  // OPEN(NEWUNIT=unit,ACCESS='SEQUENTIAL',ACTION='READWRITE',&
+  //   FORM='UNFORMATTED',STATUS='SCRATCH')
+  auto io{IONAME(BeginOpenNewUnit)(__FILE__, __LINE__)};
+  IONAME(SetAccess)
+  (io, "SEQUENTIAL", 10) || (Fail() << "SetAccess(SEQUENTIAL)", 0);
+  IONAME(SetAction)
+  (io, "READWRITE", 9) || (Fail() << "SetAction(READWRITE)", 0);
+  IONAME(SetForm)
+  (io, "UNFORMATTED", 11) || (Fail() << "SetForm(UNFORMATTED)", 0);
+  IONAME(SetStatus)(io, "SCRATCH", 7) || (Fail() << "SetStatus(SCRATCH)", 0);
+  int unit{-1};
+  IONAME(GetNewUnit)(io, unit) || (Fail() << "GetNewUnit()", 0);
+  llvm::errs() << "unit=" << unit << '\n';
+  IONAME(EndIoStatement)
+  (io) == IostatOk || (Fail() << "EndIoStatement() for OpenNewUnit", 0);
+  static const int records{10};
+  std::int64_t buffer[records]; // INTEGER*8 :: BUFFER(0:9) = [(j,j=0,9)]
+  for (int j{0}; j < records; ++j) {
+    buffer[j] = j;
+  }
+  for (int j{1}; j <= records; ++j) {
+    // DO J=1,RECORDS; WRITE(UNIT=unit) BUFFER(0:j); END DO
+    io = IONAME(BeginUnformattedOutput)(unit, __FILE__, __LINE__);
+    IONAME(OutputUnformattedBlock)
+    (io, reinterpret_cast<const char *>(&buffer), j * sizeof *buffer) ||
+        (Fail() << "OutputUnformattedBlock()", 0);
+    IONAME(EndIoStatement)
+    (io) == IostatOk ||
+        (Fail() << "EndIoStatement() for OutputUnformattedBlock", 0);
+  }
+  // REWIND(UNIT=unit)
+  io = IONAME(BeginRewind)(unit, __FILE__, __LINE__);
+  IONAME(EndIoStatement)
+  (io) == IostatOk || (Fail() << "EndIoStatement() for Rewind", 0);
+  for (int j{1}; j <= records; ++j) {
+    // DO J=1,RECORDS; READ(UNIT=unit) n; check n; END DO
+    io = IONAME(BeginUnformattedInput)(unit, __FILE__, __LINE__);
+    IONAME(InputUnformattedBlock)
+    (io, reinterpret_cast<char *>(&buffer), j * sizeof *buffer) ||
+        (Fail() << "InputUnformattedBlock()", 0);
+    IONAME(EndIoStatement)
+    (io) == IostatOk ||
+        (Fail() << "EndIoStatement() for InputUnformattedBlock", 0);
+    for (int k{0}; k < j; ++k) {
+      if (buffer[k] != k) {
+        Fail() << "Read back [" << k << "]=" << buffer[k]
+               << " from direct unformatted record " << j << ", expected " << k
+               << '\n';
+      }
+    }
+  }
+  for (int j{records}; j >= 1; --j) {
+    // BACKSPACE(unit)
+    io = IONAME(BeginBackspace)(unit, __FILE__, __LINE__);
+    IONAME(EndIoStatement)
+    (io) == IostatOk ||
+        (Fail() << "EndIoStatement() for Backspace (before read)", 0);
+    // READ(unit=unit) n; check
+    io = IONAME(BeginUnformattedInput)(unit, __FILE__, __LINE__);
+    IONAME(InputUnformattedBlock)
+    (io, reinterpret_cast<char *>(&buffer), j * sizeof *buffer) ||
+        (Fail() << "InputUnformattedBlock()", 0);
+    IONAME(EndIoStatement)
+    (io) == IostatOk ||
+        (Fail() << "EndIoStatement() for InputUnformattedBlock", 0);
+    for (int k{0}; k < j; ++k) {
+      if (buffer[k] != k) {
+        Fail() << "Read back [" << k << "]=" << buffer[k]
+               << " from sequential variable unformatted record " << j
+               << ", expected " << k << '\n';
+      }
+    }
+    // BACKSPACE(unit)
+    io = IONAME(BeginBackspace)(unit, __FILE__, __LINE__);
+    IONAME(EndIoStatement)
+    (io) == IostatOk ||
+        (Fail() << "EndIoStatement() for Backspace (after read)", 0);
+  }
+  // CLOSE(UNIT=unit,STATUS='DELETE')
+  io = IONAME(BeginClose)(unit, __FILE__, __LINE__);
+  IONAME(SetStatus)(io, "DELETE", 6) || (Fail() << "SetStatus(DELETE)", 0);
+  IONAME(EndIoStatement)
+  (io) == IostatOk || (Fail() << "EndIoStatement() for Close", 0);
+  llvm::errs() << "end TestSequentialVariableUnformatted()\n";
+}
+
+void TestDirectFormatted() {
+  llvm::errs() << "begin TestDirectFormatted()\n";
+  // OPEN(NEWUNIT=unit,ACCESS='DIRECT',ACTION='READWRITE',&
+  //   FORM='FORMATTED',RECL=8,STATUS='SCRATCH')
+  auto io{IONAME(BeginOpenNewUnit)(__FILE__, __LINE__)};
+  IONAME(SetAccess)(io, "DIRECT", 6) || (Fail() << "SetAccess(DIRECT)", 0);
+  IONAME(SetAction)
+  (io, "READWRITE", 9) || (Fail() << "SetAction(READWRITE)", 0);
+  IONAME(SetForm)
+  (io, "FORMATTED", 9) || (Fail() << "SetForm(FORMATTED)", 0);
+  static constexpr std::size_t recl{8};
+  IONAME(SetRecl)(io, recl) || (Fail() << "SetRecl()", 0);
+  IONAME(SetStatus)(io, "SCRATCH", 7) || (Fail() << "SetStatus(SCRATCH)", 0);
+  int unit{-1};
+  IONAME(GetNewUnit)(io, unit) || (Fail() << "GetNewUnit()", 0);
+  llvm::errs() << "unit=" << unit << '\n';
+  IONAME(EndIoStatement)
+  (io) == IostatOk || (Fail() << "EndIoStatement() for OpenNewUnit", 0);
+  static constexpr int records{10};
+  static const char fmt[]{"(I4)"};
+  for (int j{1}; j <= records; ++j) {
+    // WRITE(UNIT=unit,FMT=fmt,REC=j) j
+    io = IONAME(BeginExternalFormattedOutput)(
+        fmt, sizeof fmt - 1, unit, __FILE__, __LINE__);
+    IONAME(SetRec)(io, j) || (Fail() << "SetRec(" << j << ')', 0);
+    IONAME(OutputInteger64)(io, j) || (Fail() << "OutputInteger64()", 0);
+    IONAME(EndIoStatement)
+    (io) == IostatOk || (Fail() << "EndIoStatement() for OutputInteger64", 0);
+  }
+  for (int j{records}; j >= 1; --j) {
+    // READ(UNIT=unit,FMT=fmt,REC=j) n
+    io = IONAME(BeginExternalFormattedInput)(
+        fmt, sizeof fmt - 1, unit, __FILE__, __LINE__);
+    IONAME(SetRec)(io, j) || (Fail() << "SetRec(" << j << ')', 0);
+    std::int64_t buffer;
+    IONAME(InputInteger)(io, buffer) || (Fail() << "InputInteger()", 0);
+    IONAME(EndIoStatement)
+    (io) == IostatOk || (Fail() << "EndIoStatement() for InputInteger", 0);
+    if (buffer != j) {
+      Fail() << "Read back " << buffer << " from direct formatted record " << j
+             << ", expected " << j << '\n';
+    }
+  }
+  // CLOSE(UNIT=unit,STATUS='DELETE')
+  io = IONAME(BeginClose)(unit, __FILE__, __LINE__);
+  IONAME(SetStatus)(io, "DELETE", 6) || (Fail() << "SetStatus(DELETE)", 0);
+  IONAME(EndIoStatement)
+  (io) == IostatOk || (Fail() << "EndIoStatement() for Close", 0);
+  llvm::errs() << "end TestDirectformatted()\n";
+}
+
+void TestSequentialVariableFormatted() {
+  llvm::errs() << "begin TestSequentialVariableFormatted()\n";
+  // OPEN(NEWUNIT=unit,ACCESS='SEQUENTIAL',ACTION='READWRITE',&
+  //   FORM='FORMATTED',STATUS='SCRATCH')
+  auto io{IONAME(BeginOpenNewUnit)(__FILE__, __LINE__)};
+  IONAME(SetAccess)
+  (io, "SEQUENTIAL", 10) || (Fail() << "SetAccess(SEQUENTIAL)", 0);
+  IONAME(SetAction)
+  (io, "READWRITE", 9) || (Fail() << "SetAction(READWRITE)", 0);
+  IONAME(SetForm)
+  (io, "FORMATTED", 9) || (Fail() << "SetForm(FORMATTED)", 0);
+  IONAME(SetStatus)(io, "SCRATCH", 7) || (Fail() << "SetStatus(SCRATCH)", 0);
+  int unit{-1};
+  IONAME(GetNewUnit)(io, unit) || (Fail() << "GetNewUnit()", 0);
+  llvm::errs() << "unit=" << unit << '\n';
+  IONAME(EndIoStatement)
+  (io) == IostatOk || (Fail() << "EndIoStatement() for OpenNewUnit", 0);
+  static const int records{10};
+  std::int64_t buffer[records]; // INTEGER*8 :: BUFFER(0:9) = [(j,j=0,9)]
+  for (int j{0}; j < records; ++j) {
+    buffer[j] = j;
+  }
+  char fmt[32];
+  for (int j{1}; j <= records; ++j) {
+    std::snprintf(fmt, sizeof fmt, "(%dI4)", j);
+    // DO J=1,RECORDS; WRITE(UNIT=unit,FMT=fmt) BUFFER(0:j); END DO
+    io = IONAME(BeginExternalFormattedOutput)(
+        fmt, std::strlen(fmt), unit, __FILE__, __LINE__);
+    for (int k{0}; k < j; ++k) {
+      IONAME(OutputInteger64)
+      (io, buffer[k]) || (Fail() << "OutputInteger64()", 0);
+    }
+    IONAME(EndIoStatement)
+    (io) == IostatOk || (Fail() << "EndIoStatement() for OutputInteger64", 0);
+  }
+  // REWIND(UNIT=unit)
+  io = IONAME(BeginRewind)(unit, __FILE__, __LINE__);
+  IONAME(EndIoStatement)
+  (io) == IostatOk || (Fail() << "EndIoStatement() for Rewind", 0);
+  for (int j{1}; j <= records; ++j) {
+    std::snprintf(fmt, sizeof fmt, "(%dI4)", j);
+    // DO J=1,RECORDS; READ(UNIT=unit,FMT=fmt) n; check n; END DO
+    io = IONAME(BeginExternalFormattedInput)(
+        fmt, std::strlen(fmt), unit, __FILE__, __LINE__);
+    std::int64_t check[records];
+    for (int k{0}; k < j; ++k) {
+      IONAME(InputInteger)(io, check[k]) || (Fail() << "InputInteger()", 0);
+    }
+    IONAME(EndIoStatement)
+    (io) == IostatOk || (Fail() << "EndIoStatement() for InputInteger", 0);
+    for (int k{0}; k < j; ++k) {
+      if (buffer[k] != check[k]) {
+        Fail() << "Read back [" << k << "]=" << check[k]
+               << " from sequential variable formatted record " << j
+               << ", expected " << buffer[k] << '\n';
+      }
+    }
+  }
+  for (int j{records}; j >= 1; --j) {
+    // BACKSPACE(unit)
+    io = IONAME(BeginBackspace)(unit, __FILE__, __LINE__);
+    IONAME(EndIoStatement)
+    (io) == IostatOk ||
+        (Fail() << "EndIoStatement() for Backspace (before read)", 0);
+    std::snprintf(fmt, sizeof fmt, "(%dI4)", j);
+    // READ(UNIT=unit,FMT=fmt) n; check
+    io = IONAME(BeginExternalFormattedInput)(
+        fmt, std::strlen(fmt), unit, __FILE__, __LINE__);
+    std::int64_t check[records];
+    for (int k{0}; k < j; ++k) {
+      IONAME(InputInteger)(io, check[k]) || (Fail() << "InputInteger()", 0);
+    }
+    IONAME(EndIoStatement)
+    (io) == IostatOk || (Fail() << "EndIoStatement() for InputInteger", 0);
+    for (int k{0}; k < j; ++k) {
+      if (buffer[k] != check[k]) {
+        Fail() << "Read back [" << k << "]=" << buffer[k]
+               << " from sequential variable formatted record " << j
+               << ", expected " << buffer[k] << '\n';
+      }
+    }
+    // BACKSPACE(unit)
+    io = IONAME(BeginBackspace)(unit, __FILE__, __LINE__);
+    IONAME(EndIoStatement)
+    (io) == IostatOk ||
+        (Fail() << "EndIoStatement() for Backspace (after read)", 0);
+  }
+  // CLOSE(UNIT=unit,STATUS='DELETE')
+  io = IONAME(BeginClose)(unit, __FILE__, __LINE__);
+  IONAME(SetStatus)(io, "DELETE", 6) || (Fail() << "SetStatus(DELETE)", 0);
+  IONAME(EndIoStatement)
+  (io) == IostatOk || (Fail() << "EndIoStatement() for Close", 0);
+  llvm::errs() << "end TestSequentialVariableFormatted()\n";
+}
+
+void TestStreamUnformatted() {
+  // TODO
+}
+
+int main() {
+  StartTests();
+  TestDirectUnformatted();
+  TestSequentialFixedUnformatted();
+  TestSequentialVariableUnformatted();
+  TestDirectFormatted();
+  TestSequentialVariableFormatted();
+  TestStreamUnformatted();
+  return EndTests();
+}

diff  --git a/flang/unittests/Runtime/testing.cpp b/flang/unittests/Runtime/testing.cpp
index 146b37db9a57..546a1e1da51d 100644
--- a/flang/unittests/Runtime/testing.cpp
+++ b/flang/unittests/Runtime/testing.cpp
@@ -9,10 +9,13 @@
 static int failures{0};
 
 // Override the Fortran runtime's Crash() for testing purposes
-[[noreturn]] static void CatchCrash(const char *message, va_list &ap) {
+[[noreturn]] static void CatchCrash(
+    const char *sourceFile, int sourceLine, const char *message, va_list &ap) {
   char buffer[1000];
   std::vsnprintf(buffer, sizeof buffer, message, ap);
   va_end(ap);
+  llvm::errs() << (sourceFile ? sourceFile : "unknown source file") << '('
+               << sourceLine << "): CRASH: " << buffer << '\n';
   throw std::string{buffer};
 }
 

diff  --git a/flang/unittests/Runtime/testing.h b/flang/unittests/Runtime/testing.h
index 1b401aaf8543..d3551ba5ef07 100644
--- a/flang/unittests/Runtime/testing.h
+++ b/flang/unittests/Runtime/testing.h
@@ -12,6 +12,7 @@ void StartTests();
 llvm::raw_ostream &Fail();
 int EndTests();
 
+// Defines a CHARACTER object with padding when needed
 void SetCharacter(char *, std::size_t, const char *);
 
 #endif // FORTRAN_TEST_RUNTIME_TESTING_H_


        


More information about the flang-commits mailing list