[flang] Move External IO tests to use GTest

[ashermancinelli]

Summary

Port external-io test to use GTest. Remove Runtime tests directory. Rename RuntimeGTest directory to Runtime.

[awarzynski]

This is the final patch to complete the porting of runtime unit tests to GTest. It's an important milestone! @ashermancinelli, many thanks for seeing this through! I've compared flang/unittests/Runtime/ExternalIOTest.cpp and flang/unittests/Runtime/external-io.cpp - the semantics are identical and only the clang-tidy warnings need addressing before merging.

As for the failing CI tests - I can see that external-io is currently not being run on Windows: https://lab.llvm.org/staging/#/builders/179/builds/653/steps/7/logs/stdio. This suggests that this patch _exposes_ rather than _introduces_ these failures. I suspect that there is something Linux-specific about that test (file I/O?), but I can't see anything obvious. @Meinersbur set-up that Windows BuildBot worker - perhaps he'll have a suggestion? If we can't identify anything, GTEST_SKIP + bugzilla should be sufficient.

flang/unittests/Runtime/ExternalIOTest.cpp

9

[nit] Perhaps add the original comment here: https://github.com/llvm/llvm-project/blob/main/flang/unittests/Runtime/external-io.cpp#L1. Just to make sure that everything is preserved.

[Meinersbur]

Sorry for the wait. Flang-OldUnit indeed currently does not run under ninja make-check because Windows executables have an .exe suffix (external-io.test.exe) that is not in lit's suffixes list. The CMake target otherwise unusual name is external-io.text (or external-io-slow) because

config.suffixes = [".test"]

in NonGTestUnit/lit.cfg.py. Glad that this is fixing this.

The Windows fails are fixed by D106726.

[ashermancinelli]

Update comments and formatting in response to feedback and clang-tidy.

[awarzynski]

Tests on Windows should be passing now.

According to Phabricator, your revision is based on https://reviews.llvm.org/rG56fa49878b71a1d92b9a93b586cff26829abe157. Michael's fix came a few commits later: https://reviews.llvm.org/rGcbad57613e769d0653e13cf877d80eae421b2314. @ashermancinelli could you rebase on top of main? That should address the CI failures, Thanks!

[ashermancinelli]

Rebase on main.

[awarzynski]

Still failing :( @Meinersbur, do you have any spare cycles to take a look?

[Meinersbur]

The diff is still based on rG56fa49878b71 from one month ago, as the "commits" tab shows. The Semantics::unpack.f90 test has been fixed since then. How do you update the diff?

When applying locally, I don't see any errors.

[Meinersbur]

• Rebase diff

[Meinersbur]

The pre-merge check had a small clang-format suggestion for ExternalIOTest.cpp. Otherwise, LGTM.

[awarzynski]

Thank you for your help Michael! Fixing those Windows failures would have been _really_ tricky without your input.

@ashermancinelli, many thanks for seeing flang/unittests/Runtime through :) With your refactoring, we have much better test coverage, a few bugs got fixed and the code itself is much more modern and neater. LGTM (modulo that clang-format suggestion)

[ashermancinelli]

Apply clang-format.

[ashermancinelli]

Thanks for the kind words @awarzynski! Glad I could help 🙂

[ashermancinelli]

Rebase to retrigger CI.

[awarzynski]

In D105315#2914681, @ashermancinelli wrote:

Rebase to retrigger CI.

The most recent failure in the CI is unrelated to this patch and was fixed in https://reviews.llvm.org/D107107. It is safe to merge this change.

flang/unittests/CMakeLists.txt

if(NOT ARG_SLOW_TEST)
     add_dependencies(FlangUnitTests ${test_name}${suffix})
   endif()
 endfunction()
 
 add_subdirectory(Optimizer)
 add_subdirectory(Decimal)
 add_subdirectory(Evaluate)
 add_subdirectory(Runtime)
-add_subdirectory(RuntimeGTest)
 
 if (FLANG_BUILD_NEW_DRIVER)
   add_subdirectory(Frontend)
 endif()

flang/unittests/Runtime/BufferTest.cpp

 //===-- flang/unittests/RuntimeGTest/BufferTest.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 "../../runtime/buffer.h"
 #include "CrashHandlerFixture.h"
 #include "gtest/gtest.h"
 #include <algorithm>
 #include <cstdint>
 #include <cstring>
 #include <memory>
 
 static constexpr std::size_t tinyBufferSize{32};
 using FileOffset = std::int64_t;
 using namespace Fortran::runtime;
 using namespace Fortran::runtime::io;
 
 class Store : public FileFrame<Store, tinyBufferSize> {
 public:
   explicit Store(std::size_t bytes = 65536) : bytes_{bytes} {
     data_.reset(new char[bytes]);
     std::memset(&data_[0], 0, bytes);
   }
   std::size_t bytes() const { return bytes_; }
   void set_enforceSequence(bool yes = true) { enforceSequence_ = yes; }
   void set_expect(FileOffset to) { expect_ = to; }
 
   std::size_t Read(FileOffset at, char *to, std::size_t minBytes,
       std::size_t maxBytes, IoErrorHandler &handler) {
     if (enforceSequence_ && at != expect_) {
       handler.SignalError("Read(%d,%d,%d) not at expected %d",
           static_cast<int>(at), static_cast<int>(minBytes),
           static_cast<int>(maxBytes), static_cast<int>(expect_));
     } else if (at < 0 || at + minBytes > bytes_) {
       handler.SignalError("Read(%d,%d,%d) is out of bounds",
           static_cast<int>(at), static_cast<int>(minBytes),
           static_cast<int>(maxBytes));
     }
     auto result{std::min<std::size_t>(maxBytes, bytes_ - at)};
     std::memcpy(to, &data_[at], result);
     expect_ = at + result;
     return result;
   }
   std::size_t Write(FileOffset at, const char *from, std::size_t bytes,
       IoErrorHandler &handler) {
     if (enforceSequence_ && at != expect_) {
       handler.SignalError("Write(%d,%d) not at expected %d",
           static_cast<int>(at), static_cast<int>(bytes),
           static_cast<int>(expect_));
     } else if (at < 0 || at + bytes > bytes_) {
       handler.SignalError("Write(%d,%d) is out of bounds", static_cast<int>(at),
           static_cast<int>(bytes));
     }
     std::memcpy(&data_[at], from, bytes);
     expect_ = at + bytes;
     return bytes;
   }
 
 private:
   std::size_t bytes_;
   std::unique_ptr<char[]> data_;
   bool enforceSequence_{false};
   FileOffset expect_{0};
 };
 
 inline int ChunkSize(int j, int most) {
   // 31, 1, 29, 3, 27, ...
   j %= tinyBufferSize;
   auto chunk{static_cast<int>(
       ((j % 2) ? j : (tinyBufferSize - 1 - j)) % tinyBufferSize)};
   return std::min(chunk, most);
 }
 
 inline int ValueFor(int at) { return (at ^ (at >> 8)) & 0xff; }
 
 struct BufferTests : CrashHandlerFixture {};
 
 TEST(BufferTests, TestFrameBufferReadAndWrite) {
   Terminator terminator{__FILE__, __LINE__};
   IoErrorHandler handler{terminator};
   Store store;
   store.set_enforceSequence(true);
   const auto bytes{static_cast<FileOffset>(store.bytes())};
   // Fill with an assortment of chunks
   int at{0}, j{0};
   while (at < bytes) {
     auto chunk{ChunkSize(j, static_cast<int>(bytes - at))};
     store.WriteFrame(at, chunk, handler);
     char *to{store.Frame()};
     for (int k{0}; k < chunk; ++k) {
       to[k] = ValueFor(at + k);
     }
     at += chunk;
     ++j;
   }
   store.Flush(handler);
   // Validate
   store.set_expect(0);
   at = 0;
   while (at < bytes) {
     auto chunk{ChunkSize(j, static_cast<int>(bytes - at))};
     std::size_t frame{store.ReadFrame(at, chunk, handler)};
     ASSERT_GE(frame, static_cast<std::size_t>(chunk))
         << "Badly-sized ReadFrame at " << at << ", chunk=" << chunk << ", got "
         << frame << '\n';
 
     const char *from{store.Frame()};
     for (int k{0}; k < chunk; ++k) {
       auto expect{static_cast<char>(ValueFor(at + k))};
       ASSERT_EQ(from[k], expect)
           << "At " << at << '+' << k << '(' << (at + k) << "), read "
           << (from[k] & 0xff) << ", expected " << static_cast<int>(expect)
           << '\n';
     }
     at += chunk;
     ++j;
   }
 }

flang/unittests/Runtime/CMakeLists.txt

-set(CMAKE_RUNTIME_OUTPUT_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR})
-
-# RuntimeTesting needs exceptions enabled
-set(LLVM_REQUIRES_EH ON)
-set(LLVM_REQUIRES_RTTI ON)
-add_library(RuntimeTesting
-  testing.cpp
-)
-llvm_update_compile_flags(RuntimeTesting)
-
-if (LLVM_LINK_LLVM_DYLIB)
-  set(llvm_libs LLVM)
-else()
-  llvm_map_components_to_libnames(llvm_libs Support)
-endif()
-target_link_libraries(RuntimeTesting
-  FortranRuntime
-  ${llvm_libs}
+add_flang_unittest(FlangRuntimeTests
+  BufferTest.cpp
+  CharacterTest.cpp
+  CrashHandlerFixture.cpp
+  ExternalIOTest.cpp
+  Format.cpp
+  ListInputTest.cpp
+  Matmul.cpp
+  MiscIntrinsic.cpp
+  Namelist.cpp
+  Numeric.cpp
+  NumericalFormatTest.cpp
+  Random.cpp
+  Reduction.cpp
+  RuntimeCrashTest.cpp
+  Time.cpp
+  Transformational.cpp
 )
 
-add_flang_nongtest_unittest(external-io
-  RuntimeTesting
+target_link_libraries(FlangRuntimeTests
+  PRIVATE
   FortranRuntime
 )

flang/unittests/Runtime/CharacterTest.cpp

 //===-- flang/unittests/RuntimeGTest/CharacterTest.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
 //
 //===----------------------------------------------------------------------===//
 
 // Basic sanity tests of CHARACTER API; exhaustive testing will be done
 // in Fortran.
 
 #include "../../runtime/character.h"
-#include "../../runtime/descriptor.h"
 #include "gtest/gtest.h"
+#include "../../runtime/descriptor.h"
 #include <cstring>
 #include <functional>
 #include <tuple>
 #include <vector>
 
 using namespace Fortran::runtime;
 
 using CharacterTypes = ::testing::Types<char, char16_t, char32_t>;
for (const auto &t : testCases) {
     }
   }
 }
 
 template <typename CHAR> struct ExtremumTests : public ::testing::Test {};
 TYPED_TEST_SUITE(ExtremumTests, CharacterTypes, );
 
 TYPED_TEST(ExtremumTests, MinTests) {
-  static std::vector<ExtremumTestCase> tests{
-      {{}, {"a"}, {"z"}, {"a"}},
+  static std::vector<ExtremumTestCase> tests{{{}, {"a"}, {"z"}, {"a"}},
       {{1}, {"zaaa"}, {"aa"}, {"aa  "}},
       {{1, 1}, {"aaz"}, {"aaaaa"}, {"aaaaa"}},
-      {
-        { 2, 3 },
-        { "a",  "b",  "c",  "d",  "E",  "f" },
-        { "xa", "ya", "az", "dd", "Sz", "cc"},
-        { "a ", "b ", "az", "d ", "E ", "cc"}
-      }
-  };
+      {{2, 3}, {"a", "b", "c", "d", "E", "f"},
+          {"xa", "ya", "az", "dd", "Sz", "cc"},
+          {"a ", "b ", "az", "d ", "E ", "cc"}}};
   RunExtremumTests<TypeParam>("MIN", RTNAME(CharacterMin), tests);
 }
 
 TYPED_TEST(ExtremumTests, MaxTests) {
   static std::vector<ExtremumTestCase> tests{
       {{}, {"a"}, {"z"}, {"z"}},
       {{1}, {"zaa"}, {"aaaaa"}, {"zaa  "}},
       {{1, 1, 1}, {"aaaaa"}, {"aazaa"}, {"aazaa"}},

flang/unittests/Runtime/CrashHandlerFixture.h

 //===-- flang/unittests/RuntimeGTest/CrashHandlerFixture.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
 //
 //===----------------------------------------------------------------------===//
 //
 /// Test fixture registers a custom crash handler to ensure death tests fail
 /// with expected message.
 //
 //===----------------------------------------------------------------------===//
 #ifndef LLVM_FLANG_UNITTESTS_RUNTIMEGTEST_CRASHHANDLERFIXTURE_H
 #define LLVM_FLANG_UNITTESTS_RUNTIMEGTEST_CRASHHANDLERFIXTURE_H
 #include <gtest/gtest.h>
 
 struct CrashHandlerFixture : testing::Test {
   void SetUp();
 };
 
 #endif

flang/unittests/Runtime/CrashHandlerFixture.cpp

 //===-- flang/unittests/RuntimeGTest/CrashHandlerFixture.cpp ----*- C++ -*-===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 #include "CrashHandlerFixture.h"
 #include "../../runtime/terminator.h"
 #include <cstdarg>
 #include <cstdlib>
 
 // Replaces Fortran runtime's crash handler so we can verify the crash message
 [[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()
       << "Test "
       << ::testing::UnitTest::GetInstance()->current_test_info()->name()
       << " crashed in file "
       << (sourceFile ? sourceFile : "unknown source file") << '(' << sourceLine
       << "): " << buffer << '\n';
   std::exit(EXIT_FAILURE);
 }
 
 // Register the crash handler above when creating each unit test in this suite
 void CrashHandlerFixture::SetUp() {
   static bool isCrashHanlderRegistered{false};
 
   if (!isCrashHanlderRegistered) {
     Fortran::runtime::Terminator::RegisterCrashHandler(CatchCrash);
   }
 
   isCrashHanlderRegistered = true;
 }

flang/unittests/Runtime/ExternalIOTest.cpp

+//===-- flang/unittests/RuntimeGTest/ExternalIOTest.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
+//
+//===----------------------------------------------------------------------===//
+//
+// Sanity test for all external I/O modes
+//
+//===----------------------------------------------------------------------===//
+
+#include "CrashHandlerFixture.h"
+#include "gtest/gtest.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;
+
+struct ExternalIOTests : public CrashHandlerFixture {};
+
+TEST(ExternalIOTests, TestDirectUnformatted) {
+  // OPEN(NEWUNIT=unit,ACCESS='DIRECT',ACTION='READWRITE',&
+  //   FORM='UNFORMATTED',RECL=8,STATUS='SCRATCH')
+  Cookie io{IONAME(BeginOpenNewUnit)(__FILE__, __LINE__)};
+  ASSERT_TRUE(IONAME(SetAccess)(io, "DIRECT", 6)) << "SetAccess(DIRECT)";
+  ASSERT_TRUE(IONAME(SetAction)(io, "READWRITE", 9)) << "SetAction(READWRITE)";
+  ASSERT_TRUE(IONAME(SetForm)(io, "UNFORMATTED", 11)) << "SetForm(UNFORMATTED)";
+
+  std::int64_t buffer;
+  static constexpr std::size_t recl{sizeof buffer};
+  ASSERT_TRUE(IONAME(SetRecl)(io, recl)) << "SetRecl()";
+  ASSERT_TRUE(IONAME(SetStatus)(io, "SCRATCH", 7)) << "SetStatus(SCRATCH)";
+
+  int unit{-1};
+  ASSERT_TRUE(IONAME(GetNewUnit)(io, unit)) << "GetNewUnit()";
+  ASSERT_EQ(IONAME(EndIoStatement)(io), IostatOk)
+      << "EndIoStatement() for OpenNewUnit";
+
+  static constexpr int records{10};
+  for (int j{1}; j <= records; ++j) {
+    // WRITE(UNIT=unit,REC=j) j
+    io = IONAME(BeginUnformattedOutput)(unit, __FILE__, __LINE__);
+    ASSERT_TRUE(IONAME(SetRec)(io, j)) << "SetRec(" << j << ')';
+
+    buffer = j;
+    ASSERT_TRUE(IONAME(OutputUnformattedBlock)(
+        io, reinterpret_cast<const char *>(&buffer), recl, recl))
+        << "OutputUnformattedBlock()";
+
+    ASSERT_EQ(IONAME(EndIoStatement)(io), IostatOk)
+        << "EndIoStatement() for OutputUnformattedBlock";
+  }
+
+  for (int j{records}; j >= 1; --j) {
+    // READ(UNIT=unit,REC=j) n
+    io = IONAME(BeginUnformattedInput)(unit, __FILE__, __LINE__);
+    ASSERT_TRUE(IONAME(SetRec)(io, j)) << "SetRec(" << j << ')';
+    ASSERT_TRUE(IONAME(InputUnformattedBlock)(
+        io, reinterpret_cast<char *>(&buffer), recl, recl))
+        << "InputUnformattedBlock()";
+
+    ASSERT_EQ(IONAME(EndIoStatement)(io), IostatOk)
+        << "EndIoStatement() for InputUnformattedBlock";
+
+    ASSERT_EQ(buffer, j) << "Read back " << buffer
+                         << " from direct unformatted record " << j
+                         << ", expected " << j << '\n';
+  }
+  // CLOSE(UNIT=unit,STATUS='DELETE')
+  io = IONAME(BeginClose)(unit, __FILE__, __LINE__);
+  ASSERT_TRUE(IONAME(SetStatus)(io, "DELETE", 6)) << "SetStatus(DELETE)";
+  ASSERT_EQ(IONAME(EndIoStatement)(io), IostatOk)
+      << "EndIoStatement() for Close";
+}
+
+TEST(ExternalIOTests, TestDirectUnformattedSwapped) {
+  // OPEN(NEWUNIT=unit,ACCESS='DIRECT',ACTION='READWRITE',&
+  //   FORM='UNFORMATTED',RECL=8,STATUS='SCRATCH',CONVERT='NATIVE')
+  auto *io{IONAME(BeginOpenNewUnit)(__FILE__, __LINE__)};
+  ASSERT_TRUE(IONAME(SetAccess)(io, "DIRECT", 6)) << "SetAccess(DIRECT)";
+  ASSERT_TRUE(IONAME(SetAction)(io, "READWRITE", 9)) << "SetAction(READWRITE)";
+  ASSERT_TRUE(IONAME(SetForm)(io, "UNFORMATTED", 11)) << "SetForm(UNFORMATTED)";
+  ASSERT_TRUE(IONAME(SetConvert)(io, "NATIVE", 6)) << "SetConvert(NATIVE)";
+
+  std::int64_t buffer;
+  static constexpr std::size_t recl{sizeof buffer};
+  ASSERT_TRUE(IONAME(SetRecl)(io, recl)) << "SetRecl()";
+  ASSERT_TRUE(IONAME(SetStatus)(io, "SCRATCH", 7)) << "SetStatus(SCRATCH)";
+
+  int unit{-1};
+  ASSERT_TRUE(IONAME(GetNewUnit)(io, unit)) << "GetNewUnit()";
+  ASSERT_EQ(IONAME(EndIoStatement)(io), IostatOk)
+      << "EndIoStatement() for OpenNewUnit";
+
+  static constexpr int records{10};
+  for (int j{1}; j <= records; ++j) {
+    // WRITE(UNIT=unit,REC=j) j
+    io = IONAME(BeginUnformattedOutput)(unit, __FILE__, __LINE__);
+    ASSERT_TRUE(IONAME(SetRec)(io, j)) << "SetRec(" << j << ')';
+    buffer = j;
+    ASSERT_TRUE(IONAME(OutputUnformattedBlock)(
+        io, reinterpret_cast<const char *>(&buffer), recl, recl))
+        << "OutputUnformattedBlock()";
+    ASSERT_EQ(IONAME(EndIoStatement)(io), IostatOk)
+        << "EndIoStatement() for OutputUnformattedBlock";
+  }
+
+  // OPEN(UNIT=unit,STATUS='OLD',CONVERT='SWAP')
+  io = IONAME(BeginOpenUnit)(unit, __FILE__, __LINE__);
+  ASSERT_TRUE(IONAME(SetStatus)(io, "OLD", 3)) << "SetStatus(OLD)";
+  ASSERT_TRUE(IONAME(SetConvert)(io, "SWAP", 4)) << "SetConvert(SWAP)";
+  ASSERT_EQ(IONAME(EndIoStatement)(io), IostatOk)
+      << "EndIoStatement() for OpenUnit";
+
+  for (int j{records}; j >= 1; --j) {
+    // READ(UNIT=unit,REC=j) n
+    io = IONAME(BeginUnformattedInput)(unit, __FILE__, __LINE__);
+    ASSERT_TRUE(IONAME(SetRec)(io, j)) << "SetRec(" << j << ')';
+    ASSERT_TRUE(IONAME(InputUnformattedBlock)(
+        io, reinterpret_cast<char *>(&buffer), recl, recl))
+        << "InputUnformattedBlock()";
+    ASSERT_EQ(IONAME(EndIoStatement)(io), IostatOk)
+        << "EndIoStatement() for InputUnformattedBlock";
+    ASSERT_EQ(buffer >> 56, j)
+        << "Read back " << (buffer >> 56) << " from direct unformatted record "
+        << j << ", expected " << j << '\n';
+  }
+
+  // CLOSE(UNIT=unit,STATUS='DELETE')
+  io = IONAME(BeginClose)(unit, __FILE__, __LINE__);
+  ASSERT_TRUE(IONAME(SetStatus)(io, "DELETE", 6)) << "SetStatus(DELETE)";
+  ASSERT_EQ(IONAME(EndIoStatement)(io), IostatOk)
+      << "EndIoStatement() for Close";
+}
+
+TEST(ExternalIOTests, TestSequentialFixedUnformatted) {
+  // OPEN(NEWUNIT=unit,ACCESS='SEQUENTIAL',ACTION='READWRITE',&
+  //   FORM='UNFORMATTED',RECL=8,STATUS='SCRATCH')
+  auto * io{IONAME(BeginOpenNewUnit)(__FILE__, __LINE__)};
+  ASSERT_TRUE(IONAME(SetAccess)(io, "SEQUENTIAL", 10))
+      << "SetAccess(SEQUENTIAL)";
+  ASSERT_TRUE(IONAME(SetAction)(io, "READWRITE", 9)) << "SetAction(READWRITE)";
+  ASSERT_TRUE(IONAME(SetForm)(io, "UNFORMATTED", 11)) << "SetForm(UNFORMATTED)";
+
+  std::int64_t buffer;
+  static constexpr std::size_t recl{sizeof buffer};
+
+  ASSERT_TRUE(IONAME(SetRecl)(io, recl)) << "SetRecl()";
+  ASSERT_TRUE(IONAME(SetStatus)(io, "SCRATCH", 7)) << "SetStatus(SCRATCH)";
+
+  int unit{-1};
+  ASSERT_TRUE(IONAME(GetNewUnit)(io, unit)) << "GetNewUnit()";
+  ASSERT_EQ(IONAME(EndIoStatement)(io), IostatOk)
+      << "EndIoStatement() for OpenNewUnit";
+
+  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;
+    ASSERT_TRUE(IONAME(OutputUnformattedBlock)(
+        io, reinterpret_cast<const char *>(&buffer), recl, recl))
+        << "OutputUnformattedBlock()";
+    ASSERT_EQ(IONAME(EndIoStatement)(io), IostatOk)
+        << "EndIoStatement() for OutputUnformattedBlock";
+  }
+
+  // REWIND(UNIT=unit)
+  io = IONAME(BeginRewind)(unit, __FILE__, __LINE__);
+  ASSERT_EQ(IONAME(EndIoStatement)(io), IostatOk)
+      << "EndIoStatement() for Rewind";
+
+  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__);
+    ASSERT_TRUE(IONAME(InputUnformattedBlock)(
+        io, reinterpret_cast<char *>(&buffer), recl, recl))
+        << "InputUnformattedBlock()";
+    ASSERT_EQ(IONAME(EndIoStatement)(io), IostatOk)
+        << "EndIoStatement() for InputUnformattedBlock";
+    ASSERT_EQ(buffer, j) << "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__);
+    ASSERT_EQ(IONAME(EndIoStatement)(io), IostatOk)
+        << "EndIoStatement() for Backspace (before read)";
+    // READ(UNIT=unit) n
+    io = IONAME(BeginUnformattedInput)(unit, __FILE__, __LINE__);
+    ASSERT_TRUE(IONAME(InputUnformattedBlock)(
+        io, reinterpret_cast<char *>(&buffer), recl, recl))
+        << "InputUnformattedBlock()";
+    ASSERT_EQ(IONAME(EndIoStatement)(io), IostatOk)
+        << "EndIoStatement() for InputUnformattedBlock";
+    ASSERT_EQ(buffer, j) << "Read back " << buffer
+                         << " from sequential fixed unformatted record " << j
+                         << " after backspacing, expected " << j << '\n';
+    // BACKSPACE(UNIT=unit)
+    io = IONAME(BeginBackspace)(unit, __FILE__, __LINE__);
+    ASSERT_EQ(IONAME(EndIoStatement)(io), IostatOk)
+        << "EndIoStatement() for Backspace (after read)";
+  }
+
+  // CLOSE(UNIT=unit,STATUS='DELETE')
+  io = IONAME(BeginClose)(unit, __FILE__, __LINE__);
+  ASSERT_TRUE(IONAME(SetStatus)(io, "DELETE", 6)) << "SetStatus(DELETE)";
+  ASSERT_EQ(IONAME(EndIoStatement)(io), IostatOk)
+      << "EndIoStatement() for Close";
+}
+
+TEST(ExternalIOTests, TestSequentialVariableUnformatted) {
+  // OPEN(NEWUNIT=unit,ACCESS='SEQUENTIAL',ACTION='READWRITE',&
+  //   FORM='UNFORMATTED',STATUS='SCRATCH')
+  auto *io{IONAME(BeginOpenNewUnit)(__FILE__, __LINE__)};
+
+  ASSERT_TRUE(IONAME(SetAccess)(io, "SEQUENTIAL", 10))
+      << "SetAccess(SEQUENTIAL)";
+  ASSERT_TRUE(IONAME(SetAction)(io, "READWRITE", 9)) << "SetAction(READWRITE)";
+  ASSERT_TRUE(IONAME(SetForm)(io, "UNFORMATTED", 11)) << "SetForm(UNFORMATTED)";
+  ASSERT_TRUE(IONAME(SetStatus)(io, "SCRATCH", 7)) << "SetStatus(SCRATCH)";
+
+  int unit{-1};
+  ASSERT_TRUE(IONAME(GetNewUnit)(io, unit)) << "GetNewUnit()";
+  ASSERT_EQ(IONAME(EndIoStatement)(io), IostatOk)
+      << "EndIoStatement() for OpenNewUnit";
+
+  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__);
+    ASSERT_TRUE(IONAME(OutputUnformattedBlock)(io,
+        reinterpret_cast<const char *>(&buffer), j * sizeof *buffer,
+        sizeof *buffer))
+        << "OutputUnformattedBlock()";
+    ASSERT_EQ(IONAME(EndIoStatement)(io), IostatOk)
+        << "EndIoStatement() for OutputUnformattedBlock";
+  }
+
+  // REWIND(UNIT=unit)
+  io = IONAME(BeginRewind)(unit, __FILE__, __LINE__);
+  ASSERT_EQ(IONAME(EndIoStatement)(io), IostatOk)
+      << "EndIoStatement() for Rewind";
+  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__);
+    ASSERT_TRUE(IONAME(InputUnformattedBlock)(io,
+        reinterpret_cast<char *>(&buffer), j * sizeof *buffer, sizeof *buffer))
+        << "InputUnformattedBlock()";
+    ASSERT_EQ(IONAME(EndIoStatement)(io), IostatOk)
+        << "EndIoStatement() for InputUnformattedBlock";
+    for (int k{0}; k < j; ++k) {
+      ASSERT_EQ(buffer[k], k) << "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__);
+    ASSERT_EQ(IONAME(EndIoStatement)(io), IostatOk)
+        << "EndIoStatement() for Backspace (before read)";
+    // READ(unit=unit) n; check
+    io = IONAME(BeginUnformattedInput)(unit, __FILE__, __LINE__);
+    ASSERT_TRUE(IONAME(InputUnformattedBlock)(io,
+        reinterpret_cast<char *>(&buffer), j * sizeof *buffer, sizeof *buffer))
+        << "InputUnformattedBlock()";
+    ASSERT_EQ(IONAME(EndIoStatement)(io), IostatOk)
+        << "EndIoStatement() for InputUnformattedBlock";
+    for (int k{0}; k < j; ++k) {
+      ASSERT_EQ(buffer[k], k) << "Read back [" << k << "]=" << buffer[k]
+                              << " from sequential variable unformatted record "
+                              << j << ", expected " << k << '\n';
+    }
+    // BACKSPACE(unit)
+    io = IONAME(BeginBackspace)(unit, __FILE__, __LINE__);
+    ASSERT_EQ(IONAME(EndIoStatement)(io), IostatOk)
+        << "EndIoStatement() for Backspace (after read)";
+  }
+
+  // CLOSE(UNIT=unit,STATUS='DELETE')
+  io = IONAME(BeginClose)(unit, __FILE__, __LINE__);
+  ASSERT_TRUE(IONAME(SetStatus)(io, "DELETE", 6)) << "SetStatus(DELETE)";
+  ASSERT_EQ(IONAME(EndIoStatement)(io), IostatOk)
+      << "EndIoStatement() for Close";
+}
+
+TEST(ExternalIOTests, TestDirectFormatted) {
+  // OPEN(NEWUNIT=unit,ACCESS='DIRECT',ACTION='READWRITE',&
+  //   FORM='FORMATTED',RECL=8,STATUS='SCRATCH')
+  auto *io{IONAME(BeginOpenNewUnit)(__FILE__, __LINE__)};
+  ASSERT_TRUE(IONAME(SetAccess)(io, "DIRECT", 6)) << "SetAccess(DIRECT)";
+  ASSERT_TRUE(IONAME(SetAction)(io, "READWRITE", 9)) << "SetAction(READWRITE)";
+  ASSERT_TRUE(IONAME(SetForm)(io, "FORMATTED", 9)) << "SetForm(FORMATTED)";
+
+  static constexpr std::size_t recl{8};
+  ASSERT_TRUE(IONAME(SetRecl)(io, recl)) << "SetRecl()";
+  ASSERT_TRUE(IONAME(SetStatus)(io, "SCRATCH", 7)) << "SetStatus(SCRATCH)";
+
+  int unit{-1};
+  ASSERT_TRUE(IONAME(GetNewUnit)(io, unit)) << "GetNewUnit()";
+  ASSERT_EQ(IONAME(EndIoStatement)(io), IostatOk)
+      << "EndIoStatement() for OpenNewUnit";
+
+  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__);
+    ASSERT_TRUE(IONAME(SetRec)(io, j)) << "SetRec(" << j << ')';
+    ASSERT_TRUE(IONAME(OutputInteger64)(io, j)) << "OutputInteger64()";
+    ASSERT_EQ(IONAME(EndIoStatement)(io), IostatOk)
+        << "EndIoStatement() for OutputInteger64";
+  }
+
+  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__);
+    ASSERT_TRUE(IONAME(SetRec)(io, j)) << "SetRec(" << j << ')';
+    std::int64_t buffer;
+    ASSERT_TRUE(IONAME(InputInteger)(io, buffer)) << "InputInteger()";
+    ASSERT_EQ(IONAME(EndIoStatement)(io), IostatOk)
+        << "EndIoStatement() for InputInteger";
+
+    ASSERT_EQ(buffer, j) << "Read back " << buffer
+                         << " from direct formatted record " << j
+                         << ", expected " << j << '\n';
+  }
+
+  // CLOSE(UNIT=unit,STATUS='DELETE')
+  io = IONAME(BeginClose)(unit, __FILE__, __LINE__);
+  ASSERT_TRUE(IONAME(SetStatus)(io, "DELETE", 6)) << "SetStatus(DELETE)";
+  ASSERT_EQ(IONAME(EndIoStatement)(io), IostatOk)
+      << "EndIoStatement() for Close";
+}
+
+TEST(ExternalIOTests, TestSequentialVariableFormatted) {
+  // OPEN(NEWUNIT=unit,ACCESS='SEQUENTIAL',ACTION='READWRITE',&
+  //   FORM='FORMATTED',STATUS='SCRATCH')
+  auto *io{IONAME(BeginOpenNewUnit)(__FILE__, __LINE__)};
+  ASSERT_TRUE(IONAME(SetAccess)(io, "SEQUENTIAL", 10))
+      << "SetAccess(SEQUENTIAL)";
+  ASSERT_TRUE(IONAME(SetAction)(io, "READWRITE", 9)) << "SetAction(READWRITE)";
+  ASSERT_TRUE(IONAME(SetForm)(io, "FORMATTED", 9)) << "SetForm(FORMATTED)";
+  ASSERT_TRUE(IONAME(SetStatus)(io, "SCRATCH", 7)) << "SetStatus(SCRATCH)";
+
+  int unit{-1};
+  ASSERT_TRUE(IONAME(GetNewUnit)(io, unit)) << "GetNewUnit()";
+  ASSERT_EQ(IONAME(EndIoStatement)(io), IostatOk)
+      << "EndIoStatement() for OpenNewUnit";
+
+  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) {
+      ASSERT_TRUE(IONAME(OutputInteger64)(io, buffer[k]))
+          << "OutputInteger64()";
+    }
+    ASSERT_EQ(IONAME(EndIoStatement)(io), IostatOk)
+        << "EndIoStatement() for OutputInteger64";
+  }
+
+  // REWIND(UNIT=unit)
+  io = IONAME(BeginRewind)(unit, __FILE__, __LINE__);
+  ASSERT_EQ(IONAME(EndIoStatement)(io), IostatOk)
+      << "EndIoStatement() for Rewind";
+
+  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) {
+      ASSERT_TRUE(IONAME(InputInteger)(io, check[k])) << "InputInteger()";
+    }
+    ASSERT_EQ(IONAME(EndIoStatement)(io), IostatOk)
+        << "EndIoStatement() for InputInteger";
+
+    for (int k{0}; k < j; ++k) {
+      ASSERT_EQ(buffer[k], check[k])
+          << "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__);
+    ASSERT_EQ(IONAME(EndIoStatement)(io), IostatOk)
+        << "EndIoStatement() for Backspace (before read)";
+
+    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) {
+      ASSERT_TRUE(IONAME(InputInteger)(io, check[k])) << "InputInteger()";
+    }
+
+    ASSERT_EQ(IONAME(EndIoStatement)(io), IostatOk)
+        << "EndIoStatement() for InputInteger";
+    for (int k{0}; k < j; ++k) {
+      ASSERT_EQ(buffer[k], check[k])
+          << "Read back [" << k << "]=" << buffer[k]
+          << " from sequential variable formatted record " << j << ", expected "
+          << buffer[k] << '\n';
+    }
+
+    // BACKSPACE(unit)
+    io = IONAME(BeginBackspace)(unit, __FILE__, __LINE__);
+    ASSERT_EQ(IONAME(EndIoStatement)(io), IostatOk)
+        << "EndIoStatement() for Backspace (after read)";
+  }
+
+  // CLOSE(UNIT=unit,STATUS='DELETE')
+  io = IONAME(BeginClose)(unit, __FILE__, __LINE__);
+  ASSERT_TRUE(IONAME(SetStatus)(io, "DELETE", 6)) << "SetStatus(DELETE)";
+  ASSERT_EQ(IONAME(EndIoStatement)(io), IostatOk)
+      << "EndIoStatement() for Close";
+}

flang/unittests/Runtime/Format.cpp

 //===-- flang/unittests/RuntimeGTest/Format.cpp -----------------*- C++ -*-===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #include "CrashHandlerFixture.h"
 #include "../runtime/format-implementation.h"
 #include "../runtime/io-error.h"
 #include <string>
 #include <tuple>
 #include <vector>
 
 using namespace Fortran::runtime;
 using namespace Fortran::runtime::io;
 using namespace std::literals::string_literals;
 
 using ResultsTy = std::vector<std::string>;
 
 // A test harness context for testing FormatControl
 class TestFormatContext : public IoErrorHandler {
 public:
   using CharType = char;
   TestFormatContext() : IoErrorHandler{"format.cpp", 1} {}
   bool Emit(const char *, std::size_t);
   bool Emit(const char16_t *, std::size_t);
   bool Emit(const char32_t *, std::size_t);
   bool AdvanceRecord(int = 1);
   void HandleRelativePosition(std::int64_t);
   void HandleAbsolutePosition(std::int64_t);
   void Report(const DataEdit &);
   ResultsTy results;
   MutableModes &mutableModes() { return mutableModes_; }
 
 private:
   MutableModes mutableModes_;
 };
 
 bool TestFormatContext::Emit(const char *s, std::size_t len) {
   std::string str{s, len};
   results.push_back("'"s + str + '\'');
   return true;
 }
 bool TestFormatContext::Emit(const char16_t *, std::size_t) {
   Crash("TestFormatContext::Emit(const char16_t *) called");
   return false;
 }
 bool TestFormatContext::Emit(const char32_t *, std::size_t) {
   Crash("TestFormatContext::Emit(const char32_t *) called");
   return false;
 }
 
 bool TestFormatContext::AdvanceRecord(int n) {
   while (n-- > 0) {
     results.emplace_back("/");
   }
   return true;
 }
 
 void TestFormatContext::HandleAbsolutePosition(std::int64_t n) {
   results.push_back("T"s + std::to_string(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');
   }
 }
 
 void TestFormatContext::Report(const DataEdit &edit) {
   std::string str{edit.descriptor};
   if (edit.repeat != 1) {
     str = std::to_string(edit.repeat) + '*' + str;
   }
   if (edit.variation) {
     str += edit.variation;
   }
   if (edit.width) {
     str += std::to_string(*edit.width);
   }
   if (edit.digits) {
     str += "."s + std::to_string(*edit.digits);
   }
   if (edit.expoDigits) {
     str += "E"s + std::to_string(*edit.expoDigits);
   }
   // modes?
   results.push_back(str);
 }
 
 struct FormatTests : public CrashHandlerFixture {};
 
 TEST(FormatTests, FormatStringTraversal) {
 
   using ParamsTy = std::tuple<int, const char *, ResultsTy, int>;
 
   static const std::vector<ParamsTy> params{
       {1, "('PI=',F9.7)", ResultsTy{"'PI='", "F9.7"}, 1},
       {1, "(3HPI=F9.7)", ResultsTy{"'PI='", "F9.7"}, 1},
       {1, "(3HPI=/F9.7)", ResultsTy{"'PI='", "/", "F9.7"}, 1},
       {2, "('PI=',F9.7)", ResultsTy{"'PI='", "F9.7", "/", "'PI='", "F9.7"}, 1},
       {2, "(2('PI=',F9.7),'done')",
           ResultsTy{"'PI='", "F9.7", "'PI='", "F9.7", "'done'"}, 1},
       {2, "(3('PI=',F9.7,:),'tooFar')",
           ResultsTy{"'PI='", "F9.7", "'PI='", "F9.7"}, 1},
       {2, "(*('PI=',F9.7,:),'tooFar')",
           ResultsTy{"'PI='", "F9.7", "'PI='", "F9.7"}, 1},
       {1, "(3F9.7)", ResultsTy{"2*F9.7"}, 2},
   };
 
   for (const auto &[n, format, expect, repeat] : params) {
     TestFormatContext context;
     FormatControl<decltype(context)> control{
         context, format, std::strlen(format)};
 
     for (auto i{0}; i < n; i++) {
       context.Report(/*edit=*/control.GetNextDataEdit(context, repeat));
     }
     control.Finish(context);
 
     auto iostat{context.GetIoStat()};
     ASSERT_EQ(iostat, 0) << "Expected iostat == 0, but GetIoStat() == "
                          << iostat;
 
     // Create strings of the expected/actual results for printing errors
     std::string allExpectedResults{""}, allActualResults{""};
     for (const auto &res : context.results) {
       allActualResults += " "s + res;
     }
     for (const auto &res : expect) {
       allExpectedResults += " "s + res;
     }
 
     const auto &results = context.results;
     ASSERT_EQ(expect, results) << "Expected '" << allExpectedResults
                                << "' but got '" << allActualResults << "'";
   }
 }
 
 struct InvalidFormatFailure : CrashHandlerFixture {};
 
 TEST(InvalidFormatFailure, ParenMismatch) {
   static constexpr const char *format{"("};
   static constexpr int repeat{1};
 
   TestFormatContext context;
   FormatControl<decltype(context)> control{
       context, format, std::strlen(format)};
 
   ASSERT_DEATH(
       context.Report(/*edit=*/control.GetNextDataEdit(context, repeat)),
       R"(FORMAT missing at least one '\)')");
 }
 
 TEST(InvalidFormatFailure, MissingPrecision) {
   static constexpr const char *format{"(F9.)"};
   static constexpr int repeat{1};
 
   TestFormatContext context;
   FormatControl<decltype(context)> control{
       context, format, std::strlen(format)};
 
   ASSERT_DEATH(
       context.Report(/*edit=*/control.GetNextDataEdit(context, repeat)),
       R"(Invalid FORMAT: integer expected at '\)')");
 }
 
 TEST(InvalidFormatFailure, MissingFormatWidth) {
   static constexpr const char *format{"(F.9)"};
   static constexpr int repeat{1};
 
   TestFormatContext context;
   FormatControl<decltype(context)> control{
       context, format, std::strlen(format)};
 
   ASSERT_DEATH(
       context.Report(/*edit=*/control.GetNextDataEdit(context, repeat)),
       "Invalid FORMAT: integer expected at '.'");
 }

flang/unittests/Runtime/ListInputTest.cpp

 //===-- flang/unittests/RuntimeGTest/ListInputTest.cpp ----------*- C++ -*-===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #include "CrashHandlerFixture.h"
 #include "../../runtime/descriptor.h"
 #include "../../runtime/io-api.h"
 #include "../../runtime/io-error.h"
 
 using namespace Fortran::runtime;
 using namespace Fortran::runtime::io;
 
 // Pads characters with whitespace when needed
 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);
   }
 }
 
 struct InputTest : CrashHandlerFixture {};
 
 TEST(InputTest, TestListInputAlphabet) {
   constexpr int numInputBuffers{2};
   constexpr int maxInputBufferLength{32};
   char inputBuffers[numInputBuffers][maxInputBufferLength];
   const char expectedOutput[]{
       "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ "};
   int j{0};
 
   // Use _two_ input buffers and _three_ output buffers. Note the `3*` in the
   // _inputBuffers_.
   SetCharacter(inputBuffers[j++], maxInputBufferLength,
       "3*'abcdefghijklmnopqrstuvwxyzABC");
   SetCharacter(
       inputBuffers[j++], maxInputBufferLength, "DEFGHIJKLMNOPQRSTUVWXYZ'");
 
   StaticDescriptor<1> staticDescriptor;
   Descriptor &whole{staticDescriptor.descriptor()};
   SubscriptValue extent[]{numInputBuffers};
   whole.Establish(TypeCode{CFI_type_char}, maxInputBufferLength, &inputBuffers,
       1, extent, CFI_attribute_pointer);
   whole.Check();
   auto *cookie{IONAME(BeginInternalArrayListInput)(whole)};
 
   constexpr int numOutputBuffers{3};
   constexpr int outputBufferLength{54};
   char outputBuffers[numOutputBuffers][outputBufferLength]{};
   for (j = 0; j < numOutputBuffers; ++j) {
     IONAME(InputAscii)(cookie, outputBuffers[j], outputBufferLength - 1);
   }
 
   const auto status{IONAME(EndIoStatement)(cookie)};
   ASSERT_EQ(status, 0) << "list-directed input failed, status "
                        << static_cast<int>(status) << '\n';
 
   // Verify results that the _two_ ascii inputs result in _three_ alphabets
   for (j = 0; j < numOutputBuffers; ++j) {
     ASSERT_EQ(std::strcmp(outputBuffers[j], expectedOutput), 0)
         << "wanted outputBuffers[" << j << "]=" << expectedOutput << ", got '"
         << outputBuffers[j] << "'\n";
   }
 }
 
 TEST(InputTest, TestListInputIntegerList) {
   constexpr int numBuffers{2};
   constexpr int maxBufferLength{32};
   char buffer[numBuffers][maxBufferLength];
   int j{0};
   SetCharacter(buffer[j++], maxBufferLength, "1 2 2*3  ,");
   SetCharacter(buffer[j++], maxBufferLength, ",6,,8,1*");
 
   StaticDescriptor<1> staticDescriptor;
   Descriptor &whole{staticDescriptor.descriptor()};
   SubscriptValue extent[]{numBuffers};
   whole.Establish(TypeCode{CFI_type_char}, maxBufferLength, &buffer, 1, extent,
       CFI_attribute_pointer);
   whole.Check();
   auto *cookie{IONAME(BeginInternalArrayListInput)(whole)};
 
   constexpr int listInputLength{9};
 
   // Negative numbers will be overwritten by _expectedOutput_, and positive
   // numbers will not be as their indices are "Null values" of the Fortran 2018
   // standard 13.10.3.2 in the format strings _buffer_
   std::int64_t actualOutput[listInputLength]{-1, -2, -3, -4, 5, -6, 7, -8, 9};
   const std::int64_t expectedOutput[listInputLength]{1, 2, 3, 3, 5, 6, 7, 8, 9};
   for (j = 0; j < listInputLength; ++j) {
     IONAME(InputInteger)(cookie, actualOutput[j]);
   }
 
   const auto status{IONAME(EndIoStatement)(cookie)};
   ASSERT_EQ(status, 0) << "list-directed input failed, status "
                        << static_cast<int>(status) << '\n';
 
   // Verify the calls to _InputInteger_ resulted in _expectedOutput_
   for (j = 0; j < listInputLength; ++j) {
     ASSERT_EQ(actualOutput[j], expectedOutput[j])
         << "wanted actualOutput[" << j << "]==" << expectedOutput[j] << ", got "
         << actualOutput[j] << '\n';
   }
 }
 
 TEST(InputTest, TestListInputInvalidFormatWithSingleSuccess) {
   std::string formatBuffer{"1, g"};
   constexpr int numBuffers{1};
 
   StaticDescriptor<1> staticDescriptor;
   Descriptor &whole{staticDescriptor.descriptor()};
   SubscriptValue extent[]{numBuffers};
   whole.Establish(TypeCode{CFI_type_char}, formatBuffer.size(),
       formatBuffer.data(), 1, extent, CFI_attribute_pointer);
   whole.Check();
 
   auto *cookie{IONAME(BeginInternalArrayListInput)(whole)};
   std::int64_t dummy;
 
   // Perform _InputInteger_ once successfully
   IONAME(InputInteger)(cookie, dummy);
 
   // Perform failing InputInteger
   ASSERT_DEATH(IONAME(InputInteger)(cookie, dummy),
       "Bad character 'g' in INTEGER input field");
 }
 
 // Same test as _TestListInputInvalidFormatWithSingleSuccess_, however no
 // successful call to _InputInteger_ is performed first.
 TEST(InputTest, TestListInputInvalidFormat) {
   std::string formatBuffer{"g"};
   constexpr int numBuffers{1};
 
   StaticDescriptor<1> staticDescriptor;
   Descriptor &whole{staticDescriptor.descriptor()};
   SubscriptValue extent[]{numBuffers};
   whole.Establish(TypeCode{CFI_type_char}, formatBuffer.size(),
       formatBuffer.data(), 1, extent, CFI_attribute_pointer);
   whole.Check();
 
   auto *cookie{IONAME(BeginInternalArrayListInput)(whole)};
   std::int64_t dummy;
 
   // Perform failing InputInteger
   ASSERT_DEATH(IONAME(InputInteger)(cookie, dummy),
       "Bad character 'g' in INTEGER input field");
 }
 
 using ParamTy = std::tuple<std::string, std::vector<int>>;
 
 struct SimpleListInputTest : testing::TestWithParam<ParamTy> {};
 
 TEST_P(SimpleListInputTest, TestListInput) {
   auto [formatBuffer, expectedOutput] = GetParam();
   constexpr int numBuffers{1};
 
   StaticDescriptor<1> staticDescriptor;
   Descriptor &whole{staticDescriptor.descriptor()};
   SubscriptValue extent[]{numBuffers};
   whole.Establish(TypeCode{CFI_type_char}, formatBuffer.size(),
       formatBuffer.data(), 1, extent, CFI_attribute_pointer);
   whole.Check();
   auto *cookie{IONAME(BeginInternalArrayListInput)(whole)};
 
   const auto listInputLength{expectedOutput.size()};
   std::vector<std::int64_t> actualOutput(listInputLength);
   for (std::size_t j = 0; j < listInputLength; ++j) {
     IONAME(InputInteger)(cookie, actualOutput[j]);
   }
 
   const auto status{IONAME(EndIoStatement)(cookie)};
   ASSERT_EQ(status, 0) << "list-directed input failed, status "
                        << static_cast<int>(status) << '\n';
 
   // Verify the calls to _InputInteger_ resulted in _expectedOutput_
   for (std::size_t j = 0; j < listInputLength; ++j) {
     ASSERT_EQ(actualOutput[j], expectedOutput[j])
         << "wanted actualOutput[" << j << "]==" << expectedOutput[j] << ", got "
         << actualOutput[j] << '\n';
   }
 }
 
 INSTANTIATE_TEST_SUITE_P(SimpleListInputTestInstantiation, SimpleListInputTest,
     testing::Values(std::make_tuple("", std::vector<int>{}),
         std::make_tuple("0", std::vector<int>{}),
         std::make_tuple("1", std::vector<int>{1}),
         std::make_tuple("1, 2", std::vector<int>{1, 2}),
         std::make_tuple("3*2", std::vector<int>{2, 2, 2})));

flang/unittests/Runtime/Matmul.cpp

 //===-- flang/unittests/RuntimeGTest/Matmul.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 "../../runtime/matmul.h"
 #include "gtest/gtest.h"
 #include "tools.h"
 #include "../../runtime/allocatable.h"
 #include "../../runtime/cpp-type.h"
 #include "../../runtime/descriptor.h"
 #include "../../runtime/type-code.h"
 
 using namespace Fortran::runtime;
 using Fortran::common::TypeCategory;
 
 TEST(Matmul, Basic) {
   // X 0 2 4   Y 6  9   V -1 -2
   //   1 3 5     7 10
   //             8 11
   auto x{MakeArray<TypeCategory::Integer, 4>(
       std::vector<int>{2, 3}, std::vector<std::int32_t>{0, 1, 2, 3, 4, 5})};
   auto y{MakeArray<TypeCategory::Integer, 2>(
       std::vector<int>{3, 2}, std::vector<std::int16_t>{6, 7, 8, 9, 10, 11})};
   auto v{MakeArray<TypeCategory::Integer, 8>(
       std::vector<int>{2}, std::vector<std::int64_t>{-1, -2})};
   StaticDescriptor<2, true> statDesc;
   Descriptor &result{statDesc.descriptor()};
 
   RTNAME(Matmul)(result, *x, *y, __FILE__, __LINE__);
   ASSERT_EQ(result.rank(), 2);
   EXPECT_EQ(result.GetDimension(0).LowerBound(), 1);
   EXPECT_EQ(result.GetDimension(0).Extent(), 2);
   EXPECT_EQ(result.GetDimension(1).LowerBound(), 1);
   EXPECT_EQ(result.GetDimension(1).Extent(), 2);
   ASSERT_EQ(result.type(), (TypeCode{TypeCategory::Integer, 4}));
   EXPECT_EQ(*result.ZeroBasedIndexedElement<std::int32_t>(0), 46);
   EXPECT_EQ(*result.ZeroBasedIndexedElement<std::int32_t>(1), 67);
   EXPECT_EQ(*result.ZeroBasedIndexedElement<std::int32_t>(2), 64);
   EXPECT_EQ(*result.ZeroBasedIndexedElement<std::int32_t>(3), 94);
 
   std::memset(
       result.raw().base_addr, 0, result.Elements() * result.ElementBytes());
   result.GetDimension(0).SetLowerBound(0);
   result.GetDimension(1).SetLowerBound(2);
   RTNAME(MatmulDirect)(result, *x, *y, __FILE__, __LINE__);
   EXPECT_EQ(*result.ZeroBasedIndexedElement<std::int32_t>(0), 46);
   EXPECT_EQ(*result.ZeroBasedIndexedElement<std::int32_t>(1), 67);
   EXPECT_EQ(*result.ZeroBasedIndexedElement<std::int32_t>(2), 64);
   EXPECT_EQ(*result.ZeroBasedIndexedElement<std::int32_t>(3), 94);
   result.Destroy();
 
   RTNAME(Matmul)(result, *v, *x, __FILE__, __LINE__);
   ASSERT_EQ(result.rank(), 1);
   EXPECT_EQ(result.GetDimension(0).LowerBound(), 1);
   EXPECT_EQ(result.GetDimension(0).Extent(), 3);
   ASSERT_EQ(result.type(), (TypeCode{TypeCategory::Integer, 8}));
   EXPECT_EQ(*result.ZeroBasedIndexedElement<std::int64_t>(0), -2);
   EXPECT_EQ(*result.ZeroBasedIndexedElement<std::int64_t>(1), -8);
   EXPECT_EQ(*result.ZeroBasedIndexedElement<std::int64_t>(2), -14);
   result.Destroy();
 
   RTNAME(Matmul)(result, *y, *v, __FILE__, __LINE__);
   ASSERT_EQ(result.rank(), 1);
   EXPECT_EQ(result.GetDimension(0).LowerBound(), 1);
   EXPECT_EQ(result.GetDimension(0).Extent(), 3);
   ASSERT_EQ(result.type(), (TypeCode{TypeCategory::Integer, 8}));
   EXPECT_EQ(*result.ZeroBasedIndexedElement<std::int64_t>(0), -24);
   EXPECT_EQ(*result.ZeroBasedIndexedElement<std::int64_t>(1), -27);
   EXPECT_EQ(*result.ZeroBasedIndexedElement<std::int64_t>(2), -30);
   result.Destroy();
 
   // X F F T  Y F T
   //   F T T    F T
   //            F F
   auto xLog{MakeArray<TypeCategory::Logical, 1>(std::vector<int>{2, 3},
       std::vector<std::uint8_t>{false, false, false, true, true, false})};
   auto yLog{MakeArray<TypeCategory::Logical, 2>(std::vector<int>{3, 2},
       std::vector<std::uint16_t>{false, false, false, true, true, false})};
   RTNAME(Matmul)(result, *xLog, *yLog, __FILE__, __LINE__);
   ASSERT_EQ(result.rank(), 2);
   EXPECT_EQ(result.GetDimension(0).LowerBound(), 1);
   EXPECT_EQ(result.GetDimension(0).Extent(), 2);
   EXPECT_EQ(result.GetDimension(1).LowerBound(), 1);
   EXPECT_EQ(result.GetDimension(1).Extent(), 2);
   ASSERT_EQ(result.type(), (TypeCode{TypeCategory::Logical, 2}));
   EXPECT_FALSE(
       static_cast<bool>(*result.ZeroBasedIndexedElement<std::uint16_t>(0)));
   EXPECT_FALSE(
       static_cast<bool>(*result.ZeroBasedIndexedElement<std::uint16_t>(1)));
   EXPECT_FALSE(
       static_cast<bool>(*result.ZeroBasedIndexedElement<std::uint16_t>(2)));
   EXPECT_TRUE(
       static_cast<bool>(*result.ZeroBasedIndexedElement<std::uint16_t>(3)));
 }

flang/unittests/Runtime/MiscIntrinsic.cpp

 //===-- flang/unittests/RuntimeGTest/MiscIntrinsic.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 "gtest/gtest.h"
 #include "tools.h"
 #include "../../runtime/allocatable.h"
 #include "../../runtime/cpp-type.h"
 #include "../../runtime/descriptor.h"
 #include "../../runtime/misc-intrinsic.h"
 
 using namespace Fortran::runtime;
 
 // TRANSFER examples from Fortran 2018
 
 TEST(MiscIntrinsic, TransferScalar) {
   StaticDescriptor<2, true, 2> staticDesc[2];
   auto &result{staticDesc[0].descriptor()};
   auto source{MakeArray<TypeCategory::Integer, 4>(
       std::vector<int>{}, std::vector<std::int32_t>{1082130432})};
   auto &mold{staticDesc[1].descriptor()};
   mold.Establish(TypeCategory::Real, 4, nullptr, 0);
   RTNAME(Transfer)(result, *source, mold, __FILE__, __LINE__);
   EXPECT_EQ(result.rank(), 0);
   EXPECT_EQ(result.type().raw(), (TypeCode{TypeCategory::Real, 4}.raw()));
   EXPECT_EQ(*result.OffsetElement<float>(), 4.0);
   result.Destroy();
 }
 
 TEST(MiscIntrinsic, TransferMold) {
   StaticDescriptor<2, true, 2> staticDesc[2];
   auto &result{staticDesc[0].descriptor()};
   auto source{MakeArray<TypeCategory::Real, 4>(
       std::vector<int>{3}, std::vector<float>{1.1F, 2.2F, 3.3F})};
   auto &mold{staticDesc[1].descriptor()};
   SubscriptValue extent[1]{1};
   mold.Establish(TypeCategory::Complex, 4, nullptr, 1, extent);
   RTNAME(Transfer)(result, *source, mold, __FILE__, __LINE__);
   EXPECT_EQ(result.rank(), 1);
   EXPECT_EQ(result.GetDimension(0).LowerBound(), 1);
   EXPECT_EQ(result.GetDimension(0).Extent(), 2);
   EXPECT_EQ(result.type().raw(), (TypeCode{TypeCategory::Complex, 4}.raw()));
   EXPECT_EQ(result.OffsetElement<float>()[0], 1.1F);
   EXPECT_EQ(result.OffsetElement<float>()[1], 2.2F);
   EXPECT_EQ(result.OffsetElement<float>()[2], 3.3F);
   EXPECT_EQ(result.OffsetElement<float>()[3], 0.0F);
   result.Destroy();
 }
 
 TEST(MiscIntrinsic, TransferSize) {
   StaticDescriptor<2, true, 2> staticDesc[2];
   auto &result{staticDesc[0].descriptor()};
   auto source{MakeArray<TypeCategory::Real, 4>(
       std::vector<int>{3}, std::vector<float>{1.1F, 2.2F, 3.3F})};
   auto &mold{staticDesc[1].descriptor()};
   SubscriptValue extent[1]{1};
   mold.Establish(TypeCategory::Complex, 4, nullptr, 1, extent);
   RTNAME(TransferSize)(result, *source, mold, __FILE__, __LINE__, 1);
   EXPECT_EQ(result.rank(), 1);
   EXPECT_EQ(result.GetDimension(0).LowerBound(), 1);
   EXPECT_EQ(result.GetDimension(0).Extent(), 1);
   EXPECT_EQ(result.type().raw(), (TypeCode{TypeCategory::Complex, 4}.raw()));
   EXPECT_EQ(result.OffsetElement<float>()[0], 1.1F);
   EXPECT_EQ(result.OffsetElement<float>()[1], 2.2F);
   result.Destroy();
 }

flang/unittests/Runtime/Namelist.cpp

 //===-- flang/unittests/RuntimeGTest/Namelist.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 "../../runtime/namelist.h"
 #include "CrashHandlerFixture.h"
 #include "tools.h"
 #include "../../runtime/descriptor.h"
 #include "../../runtime/io-api.h"
 #include <algorithm>
 #include <cinttypes>
 #include <complex>
 #include <cstring>
 #include <gtest/gtest.h>
 #include <limits>
 #include <string>
 #include <vector>
 
 using namespace Fortran::runtime;
 using namespace Fortran::runtime::io;
 
 struct NamelistTests : CrashHandlerFixture {};
 
 static void ClearDescriptorStorage(const Descriptor &descriptor) {
   std::memset(descriptor.raw().base_addr, 0,
       descriptor.Elements() * descriptor.ElementBytes());
 }
 
 TEST(NamelistTests, BasicSanity) {
   static constexpr int numLines{12};
   static constexpr int lineLength{32};
   static char buffer[numLines][lineLength];
   StaticDescriptor<1, true> statDescs[1];
   Descriptor &internalDesc{statDescs[0].descriptor()};
   SubscriptValue extent[]{numLines};
   internalDesc.Establish(TypeCode{CFI_type_char}, /*elementBytes=*/lineLength,
       &buffer, 1, extent, CFI_attribute_pointer);
   // Set up data arrays
   std::vector<int> ints;
   for (int j{0}; j < 20; ++j) {
     ints.push_back(j % 2 == 0 ? (1 << j) : -(1 << j));
   }
   std::vector<double> reals{0.0, -0.0, std::numeric_limits<double>::infinity(),
       -std::numeric_limits<double>::infinity(),
       std::numeric_limits<double>::quiet_NaN(),
       std::numeric_limits<double>::max(), std::numeric_limits<double>::lowest(),
       std::numeric_limits<double>::epsilon()};
   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'\"              ");
   // 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{
       MakeArray<TypeCategory::Logical, static_cast<int>(sizeof(std::uint8_t))>(
           std::vector<int>{3}, std::move(logicals))};
   OwningPtr<Descriptor> complexDesc{
       MakeArray<TypeCategory::Complex, static_cast<int>(sizeof(float))>(
           std::vector<int>{}, std::move(complexes))};
   OwningPtr<Descriptor> characterDesc{MakeArray<TypeCategory::Character, 1>(
       std::vector<int>{2}, std::move(characters), characters[0].size())};
   // Create a NAMELIST group
   static constexpr int items{5};
   const NamelistGroup::Item itemArray[items]{{"ints", *intDesc},
       {"reals", *realDesc}, {"logicals", *logicalDesc},
       {"complexes", *complexDesc}, {"characters", *characterDesc}};
   const NamelistGroup group{"group1", items, itemArray};
   // Do an internal NAMELIST write and check results
   auto outCookie1{IONAME(BeginInternalArrayListOutput)(
       internalDesc, nullptr, 0, __FILE__, __LINE__)};
   ASSERT_TRUE(IONAME(SetDelim)(outCookie1, "APOSTROPHE", 10));
   ASSERT_TRUE(IONAME(OutputNamelist)(outCookie1, group));
   auto outStatus1{IONAME(EndIoStatement)(outCookie1)};
   ASSERT_EQ(outStatus1, 0) << "Failed namelist output sanity, status "
                            << static_cast<int>(outStatus1);
 
   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''\"     '"
                                   "'         '/                    "};
   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);
   ClearDescriptorStorage(*characterDesc);
   auto inCookie{IONAME(BeginInternalArrayListInput)(
       internalDesc, nullptr, 0, __FILE__, __LINE__)};
   ASSERT_TRUE(IONAME(InputNamelist)(inCookie, group));
   auto inStatus{IONAME(EndIoStatement)(inCookie)};
   ASSERT_EQ(inStatus, 0) << "Failed namelist input sanity, status "
                          << static_cast<int>(inStatus);
   auto outCookie2{IONAME(BeginInternalArrayListOutput)(
       internalDesc, nullptr, 0, __FILE__, __LINE__)};
   ASSERT_TRUE(IONAME(SetDelim)(outCookie2, "APOSTROPHE", 10));
   ASSERT_TRUE(IONAME(OutputNamelist)(outCookie2, group));
   auto outStatus2{IONAME(EndIoStatement)(outCookie2)};
   ASSERT_EQ(outStatus2, 0) << "Failed namelist output sanity rewrite, status "
                            << static_cast<int>(outStatus2);
   std::string got2{buffer[0], sizeof buffer};
   EXPECT_EQ(got2, expect);
 }
 
 TEST(NamelistTests, Subscripts) {
   // INTEGER :: A(-1:0, -1:1)
   OwningPtr<Descriptor> aDesc{
       MakeArray<TypeCategory::Integer, static_cast<int>(sizeof(int))>(
           std::vector<int>{2, 3}, std::vector<int>(6, 0))};
   aDesc->GetDimension(0).SetBounds(-1, 0);
   aDesc->GetDimension(1).SetBounds(-1, 1);
   const NamelistGroup::Item items[]{{"a", *aDesc}};
   const NamelistGroup group{"justa", 1, items};
   static char t1[]{"&justa A(0,1:-1:-2)=1 2/"};
   StaticDescriptor<1, true> statDescs[2];
   Descriptor &internalDesc{statDescs[0].descriptor()};
   internalDesc.Establish(TypeCode{CFI_type_char},
       /*elementBytes=*/std::strlen(t1), t1, 0, nullptr, CFI_attribute_pointer);
   auto inCookie{IONAME(BeginInternalArrayListInput)(
       internalDesc, nullptr, 0, __FILE__, __LINE__)};
   ASSERT_TRUE(IONAME(InputNamelist)(inCookie, group));
   auto inStatus{IONAME(EndIoStatement)(inCookie)};
   ASSERT_EQ(inStatus, 0) << "Failed namelist input subscripts, status "
                          << static_cast<int>(inStatus);
   char out[40];
   internalDesc.Establish(TypeCode{CFI_type_char}, /*elementBytes=*/sizeof out,
       out, 0, nullptr, CFI_attribute_pointer);
   auto outCookie{IONAME(BeginInternalArrayListOutput)(
       internalDesc, nullptr, 0, __FILE__, __LINE__)};
   ASSERT_TRUE(IONAME(OutputNamelist)(outCookie, group));
   auto outStatus{IONAME(EndIoStatement)(outCookie)};
   ASSERT_EQ(outStatus, 0)
       << "Failed namelist output subscripts rewrite, status "
       << static_cast<int>(outStatus);
   std::string got{out, sizeof out};
   static const std::string expect{"&JUSTA A= 0 2 0 0 0 1/                  "};
   EXPECT_EQ(got, expect);
 }
 
 // TODO: Internal NAMELIST error tests

flang/unittests/Runtime/Numeric.cpp

 //===-- flang/unittests/RuntimeGTest/Numeric.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 "../../runtime/numeric.h"
 #include "gtest/gtest.h"
 #include <cmath>
 #include <limits>
 
 using namespace Fortran::runtime;
 using Fortran::common::TypeCategory;
 template <int KIND> using Int = CppTypeFor<TypeCategory::Integer, KIND>;
 template <int KIND> using Real = CppTypeFor<TypeCategory::Real, KIND>;
 
 // Simple tests of numeric intrinsic functions using examples from Fortran 2018
 
 TEST(Numeric, Aint) {
   EXPECT_EQ(RTNAME(Aint4_4)(Real<4>{3.7}), 3.0);
   EXPECT_EQ(RTNAME(Aint8_4)(Real<8>{-3.7}), -3.0);
   EXPECT_EQ(RTNAME(Aint8_8)(Real<8>{0}), 0.0);
   EXPECT_EQ(RTNAME(Aint4_4)(std::numeric_limits<Real<4>>::infinity()),
       std::numeric_limits<Real<4>>::infinity());
   EXPECT_TRUE(
       std::isnan(RTNAME(Aint8_8)(std::numeric_limits<Real<8>>::quiet_NaN())));
 }
 
 TEST(Numeric, Anint) {
   EXPECT_EQ(RTNAME(Anint4_4)(Real<4>{2.783}), 3.0);
   EXPECT_EQ(RTNAME(Anint8_4)(Real<8>{-2.783}), -3.0);
   EXPECT_EQ(RTNAME(Anint4_4)(Real<4>{2.5}), 3.0);
   EXPECT_EQ(RTNAME(Anint8_4)(Real<8>{-2.5}), -3.0);
   EXPECT_EQ(RTNAME(Anint8_8)(Real<8>{0}), 0.0);
   EXPECT_EQ(RTNAME(Anint4_4)(std::numeric_limits<Real<4>>::infinity()),
       std::numeric_limits<Real<4>>::infinity());
   EXPECT_TRUE(
       std::isnan(RTNAME(Aint8_8)(std::numeric_limits<Real<8>>::quiet_NaN())));
 }
 
 TEST(Numeric, Ceiling) {
   EXPECT_EQ(RTNAME(Ceiling4_4)(Real<4>{3.7}), 4);
   EXPECT_EQ(RTNAME(Ceiling8_8)(Real<8>{-3.7}), -3);
   EXPECT_EQ(RTNAME(Ceiling4_1)(Real<4>{0}), 0);
 }
 
 TEST(Numeric, Floor) {
   EXPECT_EQ(RTNAME(Floor4_4)(Real<4>{3.7}), 3);
   EXPECT_EQ(RTNAME(Floor8_8)(Real<8>{-3.7}), -4);
   EXPECT_EQ(RTNAME(Floor4_1)(Real<4>{0}), 0);
 }
 
 TEST(Numeric, Exponent) {
   EXPECT_EQ(RTNAME(Exponent4_4)(Real<4>{0}), 0);
   EXPECT_EQ(RTNAME(Exponent4_8)(Real<4>{1.0}), 1);
   EXPECT_EQ(RTNAME(Exponent8_4)(Real<8>{4.1}), 3);
   EXPECT_EQ(RTNAME(Exponent8_8)(std::numeric_limits<Real<8>>::infinity()),
       std::numeric_limits<Int<8>>::max());
   EXPECT_EQ(RTNAME(Exponent8_8)(std::numeric_limits<Real<8>>::quiet_NaN()),
       std::numeric_limits<Int<8>>::max());
 }
 
 TEST(Numeric, Fraction) {
   EXPECT_EQ(RTNAME(Fraction4)(Real<4>{0}), 0);
   EXPECT_EQ(RTNAME(Fraction8)(Real<8>{3.0}), 0.75);
   EXPECT_TRUE(
       std::isnan(RTNAME(Fraction4)(std::numeric_limits<Real<4>>::infinity())));
   EXPECT_TRUE(
       std::isnan(RTNAME(Fraction8)(std::numeric_limits<Real<8>>::quiet_NaN())));
 }
 
 TEST(Numeric, IsNaN) {
   EXPECT_FALSE(RTNAME(IsNaN4)(Real<4>{0}));
   EXPECT_FALSE(RTNAME(IsNaN8)(std::numeric_limits<Real<8>>::infinity()));
   EXPECT_TRUE(RTNAME(IsNaN8)(std::numeric_limits<Real<8>>::quiet_NaN()));
 }
 
 TEST(Numeric, Mod) {
   EXPECT_EQ(RTNAME(ModInteger1)(Int<1>{8}, Int<1>(5)), 3);
   EXPECT_EQ(RTNAME(ModInteger4)(Int<4>{-8}, Int<4>(5)), -3);
   EXPECT_EQ(RTNAME(ModInteger2)(Int<2>{8}, Int<2>(-5)), 3);
   EXPECT_EQ(RTNAME(ModInteger8)(Int<8>{-8}, Int<8>(-5)), -3);
   EXPECT_EQ(RTNAME(ModReal4)(Real<4>{8.0}, Real<4>(5.0)), 3.0);
   EXPECT_EQ(RTNAME(ModReal4)(Real<4>{-8.0}, Real<4>(5.0)), -3.0);
   EXPECT_EQ(RTNAME(ModReal8)(Real<8>{8.0}, Real<8>(-5.0)), 3.0);
   EXPECT_EQ(RTNAME(ModReal8)(Real<8>{-8.0}, Real<8>(-5.0)), -3.0);
 }
 
 TEST(Numeric, Modulo) {
   EXPECT_EQ(RTNAME(ModuloInteger1)(Int<1>{8}, Int<1>(5)), 3);
   EXPECT_EQ(RTNAME(ModuloInteger4)(Int<4>{-8}, Int<4>(5)), 2);
   EXPECT_EQ(RTNAME(ModuloInteger2)(Int<2>{8}, Int<2>(-5)), -2);
   EXPECT_EQ(RTNAME(ModuloInteger8)(Int<8>{-8}, Int<8>(-5)), -3);
   EXPECT_EQ(RTNAME(ModuloReal4)(Real<4>{8.0}, Real<4>(5.0)), 3.0);
   EXPECT_EQ(RTNAME(ModuloReal4)(Real<4>{-8.0}, Real<4>(5.0)), 2.0);
   EXPECT_EQ(RTNAME(ModuloReal8)(Real<8>{8.0}, Real<8>(-5.0)), -2.0);
   EXPECT_EQ(RTNAME(ModuloReal8)(Real<8>{-8.0}, Real<8>(-5.0)), -3.0);
 }
 
 TEST(Numeric, Nearest) {
   EXPECT_EQ(RTNAME(Nearest4)(Real<4>{0}, true),
       std::numeric_limits<Real<4>>::denorm_min());
   EXPECT_EQ(RTNAME(Nearest4)(Real<4>{3.0}, true),
       Real<4>{3.0} + std::ldexp(Real<4>{1.0}, -22));
   EXPECT_EQ(RTNAME(Nearest8)(Real<8>{1.0}, true),
       Real<8>{1.0} + std::ldexp(Real<8>{1.0}, -52));
   EXPECT_EQ(RTNAME(Nearest8)(Real<8>{1.0}, false),
       Real<8>{1.0} - std::ldexp(Real<8>{1.0}, -52));
 }
 
 TEST(Numeric, Nint) {
   EXPECT_EQ(RTNAME(Nint4_4)(Real<4>{2.783}), 3);
   EXPECT_EQ(RTNAME(Nint8_4)(Real<8>{-2.783}), -3);
   EXPECT_EQ(RTNAME(Nint4_4)(Real<4>{2.5}), 3);
   EXPECT_EQ(RTNAME(Nint8_4)(Real<8>{-2.5}), -3);
   EXPECT_EQ(RTNAME(Nint8_8)(Real<8>{0}), 0);
 }
 
 TEST(Numeric, RRSpacing) {
   EXPECT_EQ(RTNAME(RRSpacing8)(Real<8>{0}), 0);
   EXPECT_EQ(RTNAME(RRSpacing4)(Real<4>{-3.0}), 0.75 * (1 << 24));
   EXPECT_EQ(RTNAME(RRSpacing8)(Real<8>{-3.0}), 0.75 * (std::int64_t{1} << 53));
   EXPECT_TRUE(
       std::isnan(RTNAME(RRSpacing4)(std::numeric_limits<Real<4>>::infinity())));
   EXPECT_TRUE(std::isnan(
       RTNAME(RRSpacing8)(std::numeric_limits<Real<8>>::quiet_NaN())));
 }
 
 TEST(Numeric, Scale) {
   EXPECT_EQ(RTNAME(Scale4)(Real<4>{0}, 0), 0);
   EXPECT_EQ(RTNAME(Scale4)(Real<4>{1.0}, 0), 1.0);
   EXPECT_EQ(RTNAME(Scale4)(Real<4>{1.0}, 1), 2.0);
   EXPECT_EQ(RTNAME(Scale4)(Real<4>{1.0}, -1), 0.5);
   EXPECT_TRUE(
       std::isinf(RTNAME(Scale4)(std::numeric_limits<Real<4>>::infinity(), 1)));
   EXPECT_TRUE(
       std::isnan(RTNAME(Scale8)(std::numeric_limits<Real<8>>::quiet_NaN(), 1)));
 }
 
 TEST(Numeric, SetExponent) {
   EXPECT_EQ(RTNAME(SetExponent4)(Real<4>{0}, 0), 0);
   EXPECT_EQ(RTNAME(SetExponent8)(Real<8>{0}, 666), 0);
   EXPECT_EQ(RTNAME(SetExponent8)(Real<8>{3.0}, 0), 1.5);
   EXPECT_EQ(RTNAME(SetExponent4)(Real<4>{1.0}, 0), 1.0);
   EXPECT_EQ(RTNAME(SetExponent4)(Real<4>{1.0}, 1), 2.0);
   EXPECT_EQ(RTNAME(SetExponent4)(Real<4>{1.0}, -1), 0.5);
   EXPECT_TRUE(std::isnan(
       RTNAME(SetExponent4)(std::numeric_limits<Real<4>>::infinity(), 1)));
   EXPECT_TRUE(std::isnan(
       RTNAME(SetExponent8)(std::numeric_limits<Real<8>>::quiet_NaN(), 1)));
 }
 
 TEST(Numeric, Spacing) {
   EXPECT_EQ(RTNAME(Spacing8)(Real<8>{0}), std::numeric_limits<Real<8>>::min());
   EXPECT_EQ(RTNAME(Spacing4)(Real<4>{3.0}), std::ldexp(Real<4>{1.0}, -22));
   EXPECT_TRUE(
       std::isnan(RTNAME(Spacing4)(std::numeric_limits<Real<4>>::infinity())));
   EXPECT_TRUE(
       std::isnan(RTNAME(Spacing8)(std::numeric_limits<Real<8>>::quiet_NaN())));
 }

flang/unittests/Runtime/NumericalFormatTest.cpp

 //===-- flang/unittests/RuntimeGTest/NumericalFormatTest.cpp ----*- C++ -*-===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #include "CrashHandlerFixture.h"
 #include "../../runtime/descriptor.h"
 #include "../../runtime/io-api.h"
 #include <algorithm>
 #include <array>
 #include <cstring>
 #include <gtest/gtest.h>
 #include <tuple>
 
 using namespace Fortran::runtime;
 using namespace Fortran::runtime::io;
 
 static bool CompareFormattedStrings(
     const std::string &expect, const std::string &&got) {
   std::string want{expect};
   want.resize(got.size(), ' ');
   return want == got;
 }
 
 static bool CompareFormattedStrings(
     const char *expect, const std::string &&got) {
   return CompareFormattedStrings(std::string(expect), std::move(got));
 }
 
 // Perform format and compare the result with expected value
 static bool CompareFormatReal(
     const char *format, double x, const char *expect) {
   char buffer[800];
   auto cookie{IONAME(BeginInternalFormattedOutput)(
       buffer, sizeof buffer, format, std::strlen(format))};
   EXPECT_TRUE(IONAME(OutputReal64)(cookie, x));
   auto status{IONAME(EndIoStatement)(cookie)};
   EXPECT_EQ(status, 0);
   return CompareFormattedStrings(expect, std::string{buffer, sizeof buffer});
 }
 
 // Convert raw uint64 into double, perform format, and compare with expected
 static bool CompareFormatReal(
     const char *format, std::uint64_t xInt, const char *expect) {
   double x;
   static_assert(sizeof(double) == sizeof(std::uint64_t),
       "Size of double != size of uint64_t!");
   std::memcpy(&x, &xInt, sizeof xInt);
   return CompareFormatReal(format, x, expect);
 }
 
 struct IOApiTests : CrashHandlerFixture {};
 
 TEST(IOApiTests, HelloWorldOutputTest) {
   static constexpr int bufferSize{32};
   char buffer[bufferSize];
 
   // Create format for all types and values to be written
   const char *format{"(6HHELLO,,A6,2X,I3,1X,'0x',Z8,1X,L1)"};
   auto cookie{IONAME(BeginInternalFormattedOutput)(
       buffer, bufferSize, format, std::strlen(format))};
 
   // Write string, integer, and logical values to buffer
   IONAME(OutputAscii)(cookie, "WORLD", 5);
   IONAME(OutputInteger64)(cookie, 678);
   IONAME(OutputInteger64)(cookie, 0xfeedface);
   IONAME(OutputLogical)(cookie, true);
 
   // Ensure IO succeeded
   auto status{IONAME(EndIoStatement)(cookie)};
   ASSERT_EQ(status, 0) << "hello: '" << format << "' failed, status "
                        << static_cast<int>(status);
 
   // Ensure final buffer matches expected string output
   static const std::string expect{"HELLO, WORLD  678 0xFEEDFACE T"};
   ASSERT_TRUE(
       CompareFormattedStrings(expect, std::string{buffer, sizeof buffer}))
       << "Expected '" << expect << "', got " << buffer;
 }
 
 TEST(IOApiTests, MultilineOutputTest) {
   // Allocate buffer for multiline output
   static constexpr int numLines{5};
   static constexpr int lineLength{32};
   char buffer[numLines][lineLength];
 
   // Create descriptor for entire buffer
   static constexpr int staticDescriptorMaxRank{1};
   StaticDescriptor<staticDescriptorMaxRank> wholeStaticDescriptor;
   Descriptor &whole{wholeStaticDescriptor.descriptor()};
   static const SubscriptValue extent[]{numLines};
   whole.Establish(TypeCode{CFI_type_char}, /*elementBytes=*/lineLength, &buffer,
       staticDescriptorMaxRank, extent, CFI_attribute_pointer);
   whole.Dump(stderr);
   whole.Check();
 
   // Create descriptor for buffer section
   StaticDescriptor<staticDescriptorMaxRank> sectionStaticDescriptor;
   Descriptor &section{sectionStaticDescriptor.descriptor()};
   static const SubscriptValue lowers[]{0}, uppers[]{4}, strides[]{1};
   section.Establish(whole.type(), /*elementBytes=*/whole.ElementBytes(),
       nullptr, /*maxRank=*/staticDescriptorMaxRank, extent,
       CFI_attribute_pointer);
 
   // Ensure C descriptor address `section.raw()` is updated without error
   const auto error{
       CFI_section(&section.raw(), &whole.raw(), lowers, uppers, strides)};
   ASSERT_EQ(error, 0) << "multiline: CFI_section failed: " << error;
   section.Dump(stderr);
   section.Check();
 
   // Create format string and initialize IO operation
   const char *format{
       "('?abcde,',T1,'>',T9,A,TL12,A,TR25,'<'//G0,17X,'abcd',1(2I4))"};
   auto cookie{IONAME(BeginInternalArrayFormattedOutput)(
       section, format, std::strlen(format))};
 
   // Write data to buffer
   IONAME(OutputAscii)(cookie, "WORLD", 5);
   IONAME(OutputAscii)(cookie, "HELLO", 5);
   IONAME(OutputInteger64)(cookie, 789);
   for (int j{666}; j <= 999; j += 111) {
     IONAME(OutputInteger64)(cookie, j);
   }
 
   // Ensure no errors occured in write operations above
   const auto status{IONAME(EndIoStatement)(cookie)};
   ASSERT_EQ(status, 0) << "multiline: '" << format << "' failed, status "
                        << static_cast<int>(status);
 
   static const std::string expect{">HELLO, WORLD                  <"
                                   "                                "
                                   "789                 abcd 666 777"
                                   " 888 999                        "
                                   "                                "};
   // Ensure formatted string matches expected output
   EXPECT_TRUE(
       CompareFormattedStrings(expect, std::string{buffer[0], sizeof buffer}))
       << "Expected '" << expect << "' but got '"
       << std::string{buffer[0], sizeof buffer} << "'";
 }
 
 TEST(IOApiTests, ListInputTest) {
   static const char input[]{",1*,(5.,6..)"};
   auto cookie{IONAME(BeginInternalListInput)(input, sizeof input - 1)};
 
   // Create real values for IO tests
   static constexpr int numRealValues{6};
   float z[numRealValues];
   for (int j{0}; j < numRealValues; ++j) {
     z[j] = -(j + 1);
   }
 
   // Ensure reading complex values to floats does not result in an error
   for (int j{0}; j < numRealValues; j += 2) {
     ASSERT_TRUE(IONAME(InputComplex32)(cookie, &z[j]))
         << "InputComplex32 failed with value " << z[j];
   }
 
   // Ensure no IO errors occured during IO operations above
   auto status{IONAME(EndIoStatement)(cookie)};
   ASSERT_EQ(status, 0) << "Failed complex list-directed input, status "
                        << static_cast<int>(status);
 
   // Ensure writing complex values from floats does not result in an error
   static constexpr int bufferSize{33};
   char output[bufferSize];
   output[bufferSize - 1] = '\0';
   cookie = IONAME(BeginInternalListOutput)(output, bufferSize - 1);
   for (int j{0}; j < numRealValues; j += 2) {
     ASSERT_TRUE(IONAME(OutputComplex32)(cookie, z[j], z[j + 1]))
         << "OutputComplex32 failed when outputting value " << z[j] << ", "
         << z[j + 1];
   }
 
   // Ensure no IO errors occured during IO operations above
   status = IONAME(EndIoStatement)(cookie);
   ASSERT_EQ(status, 0) << "Failed complex list-directed output, status "
                        << static_cast<int>(status);
 
   // Verify output buffer against expected value
   static const char expect[bufferSize]{" (-1.,-2.) (-3.,-4.) (5.,6.)    "};
   ASSERT_EQ(std::strncmp(output, expect, bufferSize), 0)
       << "Failed complex list-directed output, expected '" << expect
       << "', but got '" << output << "'";
 }
 
 TEST(IOApiTests, DescriptorOutputTest) {
   static constexpr int bufferSize{10};
   char buffer[bufferSize];
   const char *format{"(2A4)"};
   auto cookie{IONAME(BeginInternalFormattedOutput)(
       buffer, bufferSize, format, std::strlen(format))};
 
   // Create descriptor for output
   static constexpr int staticDescriptorMaxRank{1};
   StaticDescriptor<staticDescriptorMaxRank> staticDescriptor;
   Descriptor &desc{staticDescriptor.descriptor()};
   static constexpr int subscriptExtent{2};
   static const SubscriptValue extent[]{subscriptExtent};
 
   // Manually write to descriptor buffer
   static constexpr int dataLength{4};
   char data[subscriptExtent][dataLength];
   std::memcpy(data[0], "ABCD", dataLength);
   std::memcpy(data[1], "EFGH", dataLength);
   desc.Establish(TypeCode{CFI_type_char}, dataLength, &data,
       staticDescriptorMaxRank, extent);
   desc.Dump(stderr);
   desc.Check();
   IONAME(OutputDescriptor)(cookie, desc);
 
   // Ensure no errors were encountered in initializing the cookie and descriptor
   auto formatStatus{IONAME(EndIoStatement)(cookie)};
   ASSERT_EQ(formatStatus, 0)
       << "descrOutputTest: '" << format << "' failed, status "
       << static_cast<int>(formatStatus);
 
   // Ensure buffer matches expected output
   EXPECT_TRUE(
       CompareFormattedStrings("ABCDEFGH  ", std::string{buffer, sizeof buffer}))
       << "descrOutputTest: formatted: got '"
       << std::string{buffer, sizeof buffer} << "'";
 
   // Begin list-directed output on cookie by descriptor
   cookie = IONAME(BeginInternalListOutput)(buffer, sizeof buffer);
   IONAME(OutputDescriptor)(cookie, desc);
 
   // Ensure list-directed output does not result in an IO error
   auto listDirectedStatus{IONAME(EndIoStatement)(cookie)};
   ASSERT_EQ(listDirectedStatus, 0)
       << "descrOutputTest: list-directed failed, status "
       << static_cast<int>(listDirectedStatus);
 
   // Ensure buffer matches expected output
   EXPECT_TRUE(
       CompareFormattedStrings(" ABCDEFGH ", std::string{buffer, sizeof buffer}))
       << "descrOutputTest: list-directed: got '"
       << std::string{buffer, sizeof buffer} << "'";
 }
 
 //------------------------------------------------------------------------------
 /// Tests for output formatting real values
 //------------------------------------------------------------------------------
 
 TEST(IOApiTests, FormatZeroes) {
   static constexpr std::pair<const char *, const char *> zeroes[]{
       {"(E32.17,';')", "         0.00000000000000000E+00;"},
       {"(F32.17,';')", "             0.00000000000000000;"},
       {"(G32.17,';')", "          0.0000000000000000    ;"},
       {"(DC,E32.17,';')", "         0,00000000000000000E+00;"},
       {"(DC,F32.17,';')", "             0,00000000000000000;"},
       {"(DC,G32.17,';')", "          0,0000000000000000    ;"},
       {"(D32.17,';')", "         0.00000000000000000D+00;"},
       {"(E32.17E1,';')", "          0.00000000000000000E+0;"},
       {"(G32.17E1,';')", "           0.0000000000000000   ;"},
       {"(E32.17E0,';')", "          0.00000000000000000E+0;"},
       {"(G32.17E0,';')", "          0.0000000000000000    ;"},
       {"(1P,E32.17,';')", "         0.00000000000000000E+00;"},
       {"(1PE32.17,';')", "         0.00000000000000000E+00;"}, // no comma
       {"(1P,F32.17,';')", "             0.00000000000000000;"},
       {"(1P,G32.17,';')", "          0.0000000000000000    ;"},
       {"(2P,E32.17,';')", "         00.0000000000000000E+00;"},
       {"(-1P,E32.17,';')", "         0.00000000000000000E+00;"},
       {"(G0,';')", "0.;"},
   };
 
   for (auto const &[format, expect] : zeroes) {
     ASSERT_TRUE(CompareFormatReal(format, 0.0, expect))
         << "Failed to format " << format << ", expected " << expect;
   }
 }
 
 TEST(IOApiTests, FormatOnes) {
   static constexpr std::pair<const char *, const char *> ones[]{
       {"(E32.17,';')", "         0.10000000000000000E+01;"},
       {"(F32.17,';')", "             1.00000000000000000;"},
       {"(G32.17,';')", "          1.0000000000000000    ;"},
       {"(E32.17E1,';')", "          0.10000000000000000E+1;"},
       {"(G32.17E1,';')", "           1.0000000000000000   ;"},
       {"(E32.17E0,';')", "          0.10000000000000000E+1;"},
       {"(G32.17E0,';')", "          1.0000000000000000    ;"},
       {"(E32.17E4,';')", "       0.10000000000000000E+0001;"},
       {"(G32.17E4,';')", "        1.0000000000000000      ;"},
       {"(1P,E32.17,';')", "         1.00000000000000000E+00;"},
       {"(1PE32.17,';')", "         1.00000000000000000E+00;"}, // no comma
       {"(1P,F32.17,';')", "            10.00000000000000000;"},
       {"(1P,G32.17,';')", "          1.0000000000000000    ;"},
       {"(ES32.17,';')", "         1.00000000000000000E+00;"},
       {"(2P,E32.17,';')", "         10.0000000000000000E-01;"},
       {"(2P,G32.17,';')", "          1.0000000000000000    ;"},
       {"(-1P,E32.17,';')", "         0.01000000000000000E+02;"},
       {"(-1P,G32.17,';')", "          1.0000000000000000    ;"},
       {"(G0,';')", "1.;"},
   };
 
   for (auto const &[format, expect] : ones) {
     ASSERT_TRUE(CompareFormatReal(format, 1.0, expect))
         << "Failed to format " << format << ", expected " << expect;
   }
 }
 
 TEST(IOApiTests, FormatNegativeOnes) {
   static constexpr std::tuple<const char *, const char *> negOnes[]{
       {"(E32.17,';')", "        -0.10000000000000000E+01;"},
       {"(F32.17,';')", "            -1.00000000000000000;"},
       {"(G32.17,';')", "         -1.0000000000000000    ;"},
       {"(G0,';')", "-1.;"},
   };
   for (auto const &[format, expect] : negOnes) {
     ASSERT_TRUE(CompareFormatReal(format, -1.0, expect))
         << "Failed to format " << format << ", expected " << expect;
   }
 }
 
 // Each test case contains a raw uint64, a format string for a real value, and
 // the expected resulting string from formatting the raw uint64. The double
 // representation of the uint64 is commented above each test case.
 TEST(IOApiTests, FormatDoubleValues) {
 
   using TestCaseTy = std::tuple<std::uint64_t,
       std::vector<std::tuple<const char *, const char *>>>;
   static const std::vector<TestCaseTy> testCases{
       {// -0
           0x8000000000000000,
           {
               {"(E9.1,';')", " -0.0E+00;"},
               {"(F4.0,';')", " -0.;"},
               {"(G8.0,';')", "-0.0E+00;"},
               {"(G8.1,';')", " -0.    ;"},
               {"(G0,';')", "-0.;"},
               {"(E9.1,';')", " -0.0E+00;"},
           }},
       {// +Inf
           0x7ff0000000000000,
           {
               {"(E9.1,';')", "      Inf;"},
               {"(F9.1,';')", "      Inf;"},
               {"(G9.1,';')", "      Inf;"},
               {"(SP,E9.1,';')", "     +Inf;"},
               {"(SP,F9.1,';')", "     +Inf;"},
               {"(SP,G9.1,';')", "     +Inf;"},
               {"(G0,';')", "Inf;"},
           }},
       {// -Inf
           0xfff0000000000000,
           {
               {"(E9.1,';')", "     -Inf;"},
               {"(F9.1,';')", "     -Inf;"},
               {"(G9.1,';')", "     -Inf;"},
               {"(G0,';')", "-Inf;"},
           }},
       {// NaN
           0x7ff0000000000001,
           {
               {"(E9.1,';')", "      NaN;"},
               {"(F9.1,';')", "      NaN;"},
               {"(G9.1,';')", "      NaN;"},
               {"(G0,';')", "NaN;"},
           }},
       {// NaN (sign irrelevant)
           0xfff0000000000001,
           {
               {"(E9.1,';')", "      NaN;"},
               {"(F9.1,';')", "      NaN;"},
               {"(G9.1,';')", "      NaN;"},
               {"(SP,E9.1,';')", "      NaN;"},
               {"(SP,F9.1,';')", "      NaN;"},
               {"(SP,G9.1,';')", "      NaN;"},
               {"(G0,';')", "NaN;"},
           }},
       {// 0.1 rounded
           0x3fb999999999999a,
           {
               {"(E62.55,';')",
                   " 0.1000000000000000055511151231257827021181583404541015625E+"
                   "00;"},
               {"(E0.0,';')", "0.E+00;"},
               {"(E0.55,';')",
                   "0.1000000000000000055511151231257827021181583404541015625E+"
                   "00;"},
               {"(E0,';')", ".1E+00;"},
               {"(F58.55,';')",
                   " 0."
                   "1000000000000000055511151231257827021181583404541015625;"},
               {"(F0.0,';')", "0.;"},
               {"(F0.55,';')",
                   ".1000000000000000055511151231257827021181583404541015625;"},
               {"(F0,';')", ".1;"},
               {"(G62.55,';')",
                   " 0.1000000000000000055511151231257827021181583404541015625  "
                   "  ;"},
               {"(G0.0,';')", "0.;"},
               {"(G0.55,';')",
                   ".1000000000000000055511151231257827021181583404541015625;"},
               {"(G0,';')", ".1;"},
           }},
       {// 1.5
           0x3ff8000000000000,
           {
               {"(E9.2,';')", " 0.15E+01;"},
               {"(F4.1,';')", " 1.5;"},
               {"(G7.1,';')", " 2.    ;"},
               {"(RN,E8.1,';')", " 0.2E+01;"},
               {"(RN,F3.0,';')", " 2.;"},
               {"(RN,G7.0,';')", " 0.E+01;"},
               {"(RN,G7.1,';')", " 2.    ;"},
               {"(RD,E8.1,';')", " 0.1E+01;"},
               {"(RD,F3.0,';')", " 1.;"},
               {"(RD,G7.0,';')", " 0.E+01;"},
               {"(RD,G7.1,';')", " 1.    ;"},
               {"(RU,E8.1,';')", " 0.2E+01;"},
               {"(RU,G7.0,';')", " 0.E+01;"},
               {"(RU,G7.1,';')", " 2.    ;"},
               {"(RZ,E8.1,';')", " 0.1E+01;"},
               {"(RZ,F3.0,';')", " 1.;"},
               {"(RZ,G7.0,';')", " 0.E+01;"},
               {"(RZ,G7.1,';')", " 1.    ;"},
               {"(RC,E8.1,';')", " 0.2E+01;"},
               {"(RC,F3.0,';')", " 2.;"},
               {"(RC,G7.0,';')", " 0.E+01;"},
               {"(RC,G7.1,';')", " 2.    ;"},
           }},
       {// -1.5
           0xbff8000000000000,
           {
               {"(E9.2,';')", "-0.15E+01;"},
               {"(RN,E8.1,';')", "-0.2E+01;"},
               {"(RD,E8.1,';')", "-0.2E+01;"},
               {"(RU,E8.1,';')", "-0.1E+01;"},
               {"(RZ,E8.1,';')", "-0.1E+01;"},
               {"(RC,E8.1,';')", "-0.2E+01;"},
           }},
       {// 2.5
           0x4004000000000000,
           {
               {"(E9.2,';')", " 0.25E+01;"},
               {"(RN,E8.1,';')", " 0.2E+01;"},
               {"(RD,E8.1,';')", " 0.2E+01;"},
               {"(RU,E8.1,';')", " 0.3E+01;"},
               {"(RZ,E8.1,';')", " 0.2E+01;"},
               {"(RC,E8.1,';')", " 0.3E+01;"},
           }},
       {// -2.5
           0xc004000000000000,
           {
               {"(E9.2,';')", "-0.25E+01;"},
               {"(RN,E8.1,';')", "-0.2E+01;"},
               {"(RD,E8.1,';')", "-0.3E+01;"},
               {"(RU,E8.1,';')", "-0.2E+01;"},
               {"(RZ,E8.1,';')", "-0.2E+01;"},
               {"(RC,E8.1,';')", "-0.3E+01;"},
           }},
       {// least positive nonzero subnormal
           1,
           {
               {"(E32.17,';')", "         0.49406564584124654-323;"},
               {"(ES32.17,';')", "         4.94065645841246544-324;"},
               {"(EN32.17,';')", "         4.94065645841246544-324;"},
               {"(E759.752,';')",
                   " 0."
                   "494065645841246544176568792868221372365059802614324764425585"
                   "682500675507270208751865299836361635992379796564695445717730"
                   "926656710355939796398774796010781878126300713190311404527845"
                   "817167848982103688718636056998730723050006387409153564984387"
                   "312473397273169615140031715385398074126238565591171026658556"
                   "686768187039560310624931945271591492455329305456544401127480"
                   "129709999541931989409080416563324524757147869014726780159355"
                   "238611550134803526493472019379026810710749170333222684475333"
                   "572083243193609238289345836806010601150616980975307834227731"
                   "832924790498252473077637592724787465608477820373446969953364"
                   "701797267771758512566055119913150489110145103786273816725095"
                   "583738973359899366480994116420570263709027924276754456522908"
                   "75386825064197182655334472656250-323;"},
               {"(G0,';')", ".5-323;"},
               {"(E757.750,';')",
                   " 0."
                   "494065645841246544176568792868221372365059802614324764425585"
                   "682500675507270208751865299836361635992379796564695445717730"
                   "926656710355939796398774796010781878126300713190311404527845"
                   "817167848982103688718636056998730723050006387409153564984387"
                   "312473397273169615140031715385398074126238565591171026658556"
                   "686768187039560310624931945271591492455329305456544401127480"
                   "129709999541931989409080416563324524757147869014726780159355"
                   "238611550134803526493472019379026810710749170333222684475333"
                   "572083243193609238289345836806010601150616980975307834227731"
                   "832924790498252473077637592724787465608477820373446969953364"
                   "701797267771758512566055119913150489110145103786273816725095"
                   "583738973359899366480994116420570263709027924276754456522908"
                   "753868250641971826553344726562-323;"},
               {"(RN,E757.750,';')",
                   " 0."
                   "494065645841246544176568792868221372365059802614324764425585"
                   "682500675507270208751865299836361635992379796564695445717730"
                   "926656710355939796398774796010781878126300713190311404527845"
                   "817167848982103688718636056998730723050006387409153564984387"
                   "312473397273169615140031715385398074126238565591171026658556"
                   "686768187039560310624931945271591492455329305456544401127480"
                   "129709999541931989409080416563324524757147869014726780159355"
                   "238611550134803526493472019379026810710749170333222684475333"
                   "572083243193609238289345836806010601150616980975307834227731"
                   "832924790498252473077637592724787465608477820373446969953364"
                   "701797267771758512566055119913150489110145103786273816725095"
                   "583738973359899366480994116420570263709027924276754456522908"
                   "753868250641971826553344726562-323;"},
               {"(RD,E757.750,';')",
                   " 0."
                   "494065645841246544176568792868221372365059802614324764425585"
                   "682500675507270208751865299836361635992379796564695445717730"
                   "926656710355939796398774796010781878126300713190311404527845"
                   "817167848982103688718636056998730723050006387409153564984387"
                   "312473397273169615140031715385398074126238565591171026658556"
                   "686768187039560310624931945271591492455329305456544401127480"
                   "129709999541931989409080416563324524757147869014726780159355"
                   "238611550134803526493472019379026810710749170333222684475333"
                   "572083243193609238289345836806010601150616980975307834227731"
                   "832924790498252473077637592724787465608477820373446969953364"
                   "701797267771758512566055119913150489110145103786273816725095"
                   "583738973359899366480994116420570263709027924276754456522908"
                   "753868250641971826553344726562-323;"},
               {"(RU,E757.750,';')",
                   " 0."
                   "494065645841246544176568792868221372365059802614324764425585"
                   "682500675507270208751865299836361635992379796564695445717730"
                   "926656710355939796398774796010781878126300713190311404527845"
                   "817167848982103688718636056998730723050006387409153564984387"
                   "312473397273169615140031715385398074126238565591171026658556"
                   "686768187039560310624931945271591492455329305456544401127480"
                   "129709999541931989409080416563324524757147869014726780159355"
                   "238611550134803526493472019379026810710749170333222684475333"
                   "572083243193609238289345836806010601150616980975307834227731"
                   "832924790498252473077637592724787465608477820373446969953364"
                   "701797267771758512566055119913150489110145103786273816725095"
                   "583738973359899366480994116420570263709027924276754456522908"
                   "753868250641971826553344726563-323;"},
               {"(RC,E757.750,';')",
                   " 0."
                   "494065645841246544176568792868221372365059802614324764425585"
                   "682500675507270208751865299836361635992379796564695445717730"
                   "926656710355939796398774796010781878126300713190311404527845"
                   "817167848982103688718636056998730723050006387409153564984387"
                   "312473397273169615140031715385398074126238565591171026658556"
                   "686768187039560310624931945271591492455329305456544401127480"
                   "129709999541931989409080416563324524757147869014726780159355"
                   "238611550134803526493472019379026810710749170333222684475333"
                   "572083243193609238289345836806010601150616980975307834227731"
                   "832924790498252473077637592724787465608477820373446969953364"
                   "701797267771758512566055119913150489110145103786273816725095"
                   "583738973359899366480994116420570263709027924276754456522908"
                   "753868250641971826553344726563-323;"},
           }},
       {// least positive nonzero normal
           0x10000000000000,
           {
               {"(E723.716,';')",
                   " 0."
                   "222507385850720138309023271733240406421921598046233183055332"
                   "741688720443481391819585428315901251102056406733973103581100"
                   "515243416155346010885601238537771882113077799353200233047961"
                   "014744258363607192156504694250373420837525080665061665815894"
                   "872049117996859163964850063590877011830487479978088775374994"
                   "945158045160505091539985658247081864511353793580499211598108"
                   "576605199243335211435239014879569960959128889160299264151106"
                   "346631339366347758651302937176204732563178148566435087212282"
                   "863764204484681140761391147706280168985324411002416144742161"
                   "856716615054015428508471675290190316132277889672970737312333"
                   "408698898317506783884692609277397797285865965494109136909540"
                   "61364675687023986783152906809846172109246253967285156250-"
                   "307;"},
               {"(G0,';')", ".22250738585072014-307;"},
           }},
       {// greatest finite
           0x7fefffffffffffffuLL,
           {
               {"(E32.17,';')", "         0.17976931348623157+309;"},
               {"(E317.310,';')",
                   " 0."
                   "179769313486231570814527423731704356798070567525844996598917"
                   "476803157260780028538760589558632766878171540458953514382464"
                   "234321326889464182768467546703537516986049910576551282076245"
                   "490090389328944075868508455133942304583236903222948165808559"
                   "332123348274797826204144723168738177180919299881250404026184"
                   "1248583680+309;"},
               {"(ES317.310,';')",
                   " 1."
                   "797693134862315708145274237317043567980705675258449965989174"
                   "768031572607800285387605895586327668781715404589535143824642"
                   "343213268894641827684675467035375169860499105765512820762454"
                   "900903893289440758685084551339423045832369032229481658085593"
                   "321233482747978262041447231687381771809192998812504040261841"
                   "2485836800+308;"},
               {"(EN319.310,';')",
                   " 179."
                   "769313486231570814527423731704356798070567525844996598917476"
                   "803157260780028538760589558632766878171540458953514382464234"
                   "321326889464182768467546703537516986049910576551282076245490"
                   "090389328944075868508455133942304583236903222948165808559332"
                   "123348274797826204144723168738177180919299881250404026184124"
                   "8583680000+306;"},
               {"(G0,';')", ".17976931348623157+309;"},
           }},
   };
 
   for (auto const &[value, cases] : testCases) {
     for (auto const &[format, expect] : cases) {
       ASSERT_TRUE(CompareFormatReal(format, value, expect))
           << "Failed to format " << format << ", expected " << expect;
     }
   }
 
   using IndividualTestCaseTy = std::tuple<const char *, double, const char *>;
   static const std::vector<IndividualTestCaseTy> individualTestCases{
       {"(F5.3,';')", 25., "*****;"},
       {"(F5.3,';')", 2.5, "2.500;"},
       {"(F5.3,';')", 0.25, "0.250;"},
       {"(F5.3,';')", 0.025, "0.025;"},
       {"(F5.3,';')", 0.0025, "0.003;"},
       {"(F5.3,';')", 0.00025, "0.000;"},
       {"(F5.3,';')", 0.000025, "0.000;"},
       {"(F5.3,';')", -25., "*****;"},
       {"(F5.3,';')", -2.5, "*****;"},
       {"(F5.3,';')", -0.25, "-.250;"},
       {"(F5.3,';')", -0.025, "-.025;"},
       {"(F5.3,';')", -0.0025, "-.003;"},
       {"(F5.3,';')", -0.00025, "-.000;"},
       {"(F5.3,';')", -0.000025, "-.000;"},
   };
 
   for (auto const &[format, value, expect] : individualTestCases) {
     ASSERT_TRUE(CompareFormatReal(format, value, expect))
         << "Failed to format " << format << ", expected " << expect;
   }
 }
 
 //------------------------------------------------------------------------------
 /// Tests for input formatting real values
 //------------------------------------------------------------------------------
 
 // Ensure double input values correctly map to raw uint64 values
 TEST(IOApiTests, FormatDoubleInputValues) {
   using TestCaseTy = std::tuple<const char *, const char *, std::uint64_t>;
   static const std::vector<TestCaseTy> testCases{
       {"(F18.0)", "                 0", 0x0},
       {"(F18.0)", "                  ", 0x0},
       {"(F18.0)", "                -0", 0x8000000000000000},
       {"(F18.0)", "                01", 0x3ff0000000000000},
       {"(F18.0)", "                 1", 0x3ff0000000000000},
       {"(F18.0)", "              125.", 0x405f400000000000},
       {"(F18.0)", "              12.5", 0x4029000000000000},
       {"(F18.0)", "              1.25", 0x3ff4000000000000},
       {"(F18.0)", "             01.25", 0x3ff4000000000000},
       {"(F18.0)", "              .125", 0x3fc0000000000000},
       {"(F18.0)", "             0.125", 0x3fc0000000000000},
       {"(F18.0)", "             .0625", 0x3fb0000000000000},
       {"(F18.0)", "            0.0625", 0x3fb0000000000000},
       {"(F18.0)", "               125", 0x405f400000000000},
       {"(F18.1)", "               125", 0x4029000000000000},
       {"(F18.2)", "               125", 0x3ff4000000000000},
       {"(F18.3)", "               125", 0x3fc0000000000000},
       {"(-1P,F18.0)", "               125", 0x4093880000000000}, // 1250
       {"(1P,F18.0)", "               125", 0x4029000000000000}, // 12.5
       {"(BZ,F18.0)", "              125 ", 0x4093880000000000}, // 1250
       {"(BZ,F18.0)", "       125 . e +1 ", 0x42a6bcc41e900000}, // 1.25e13
       {"(DC,F18.0)", "              12,5", 0x4029000000000000},
   };
   for (auto const &[format, data, want] : testCases) {
     auto cookie{IONAME(BeginInternalFormattedInput)(
         data, std::strlen(data), format, std::strlen(format))};
     union {
       double x;
       std::uint64_t raw;
     } u;
     u.raw = 0;
 
     // Read buffer into union value
     IONAME(EnableHandlers)(cookie, true, true, true, true, true);
     IONAME(InputReal64)(cookie, u.x);
 
     static constexpr int bufferSize{65};
     char iomsg[bufferSize];
     std::memset(iomsg, '\0', bufferSize - 1);
 
     // Ensure no errors were encountered reading input buffer into union value
     IONAME(GetIoMsg)(cookie, iomsg, bufferSize - 1);
     auto status{IONAME(EndIoStatement)(cookie)};
     ASSERT_EQ(status, 0) << '\'' << format << "' failed reading '" << data
                          << "', status " << static_cast<int>(status)
                          << " iomsg '" << iomsg << "'";
 
     // Ensure raw uint64 value matches expected conversion from double
     ASSERT_EQ(u.raw, want) << '\'' << format << "' failed reading '" << data
                            << "', want 0x" << std::hex << want << ", got 0x"
                            << u.raw;
   }
 }

flang/unittests/Runtime/Random.cpp

 //===-- flang/unittests/RuntimeGTest/Random.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 "../../runtime/random.h"
 #include "gtest/gtest.h"
 #include "../../runtime/descriptor.h"
 #include "../../runtime/type-code.h"
 #include <cmath>
 
 using namespace Fortran::runtime;
 
 TEST(RandomNumber, Real4) {
   StaticDescriptor<1> statDesc;
   Descriptor &harvest{statDesc.descriptor()};
   static constexpr int n{10000};
   float xs[n]{};
   SubscriptValue extent[1]{n};
   harvest.Establish(TypeCategory::Real, 4, xs, 1, extent);
   RTNAME(RandomNumber)(harvest, __FILE__, __LINE__);
   double sum{0};
   for (int j{0}; j < n; ++j) {
     sum += xs[j];
   }
   double mean{sum / n};
   std::fprintf(stderr, "mean of %d random numbers: %g\n", n, mean);
   EXPECT_GE(mean, 0.95 * 0.5); // mean of uniform dist [0..1] is of course 0.5
   EXPECT_LE(mean, 1.05 * 0.5);
   double sumsq{0};
   for (int j{0}; j < n; ++j) {
     double diff{xs[j] - mean};
     sumsq += diff * diff;
   }
   double sdev{std::sqrt(sumsq / n)};
   std::fprintf(stderr, "stddev of %d random numbers: %g\n", n, sdev);
   double expect{1.0 / std::sqrt(12.0)}; // stddev of uniform dist [0..1]
   EXPECT_GE(sdev, 0.95 * expect);
   EXPECT_LT(sdev, 1.05 * expect);
 }
 
 TEST(RandomNumber, RandomSeed) {
   StaticDescriptor<1> statDesc[2];
   Descriptor &desc{statDesc[0].descriptor()};
   std::int32_t n;
   desc.Establish(TypeCategory::Integer, 4, &n, 0, nullptr);
   RTNAME(RandomSeedSize)(desc, __FILE__, __LINE__);
   EXPECT_EQ(n, 1);
   SubscriptValue extent[1]{1};
   desc.Establish(TypeCategory::Integer, 4, &n, 1, extent);
   RTNAME(RandomSeedGet)(desc, __FILE__, __LINE__);
   Descriptor &harvest{statDesc[1].descriptor()};
   float x;
   harvest.Establish(TypeCategory::Real, 4, &x, 1, extent);
   RTNAME(RandomNumber)(harvest, __FILE__, __LINE__);
   float got{x};
   RTNAME(RandomSeedPut)(desc, __FILE__, __LINE__); // n from RandomSeedGet()
   RTNAME(RandomNumber)(harvest, __FILE__, __LINE__);
   EXPECT_EQ(x, got);
 }

flang/unittests/Runtime/Reduction.cpp

 //===-- flang/unittests/RuntimeGTest/Reductions.cpp -----------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #include "../../runtime/reduction.h"
 #include "gtest/gtest.h"
 #include "tools.h"
 #include "../../runtime/allocatable.h"
 #include "../../runtime/cpp-type.h"
 #include "../../runtime/descriptor.h"
 #include "../../runtime/type-code.h"
 #include <cstdint>
 #include <cstring>
 #include <string>
 #include <vector>
 
 using namespace Fortran::runtime;
 using Fortran::common::TypeCategory;
 
 TEST(Reductions, Int4Ops) {
   auto array{MakeArray<TypeCategory::Integer, 4>(
       std::vector<int>{2, 3}, std::vector<std::int32_t>{1, 2, 3, 4, 5, 6})};
   std::int32_t sum{RTNAME(SumInteger4)(*array, __FILE__, __LINE__)};
   EXPECT_EQ(sum, 21) << sum;
   std::int32_t all{RTNAME(IAll4)(*array, __FILE__, __LINE__)};
   EXPECT_EQ(all, 0) << all;
   std::int32_t any{RTNAME(IAny4)(*array, __FILE__, __LINE__)};
   EXPECT_EQ(any, 7) << any;
   std::int32_t eor{RTNAME(IParity4)(*array, __FILE__, __LINE__)};
   EXPECT_EQ(eor, 7) << eor;
 }
 
 TEST(Reductions, DimMaskProductInt4) {
   std::vector<int> shape{2, 3};
   auto array{MakeArray<TypeCategory::Integer, 4>(
       shape, std::vector<std::int32_t>{1, 2, 3, 4, 5, 6})};
   auto mask{MakeArray<TypeCategory::Logical, 1>(
       shape, std::vector<bool>{true, false, false, true, true, true})};
   StaticDescriptor<1, true> statDesc;
   Descriptor &prod{statDesc.descriptor()};
   RTNAME(ProductDim)(prod, *array, 1, __FILE__, __LINE__, &*mask);
   EXPECT_EQ(prod.rank(), 1);
   EXPECT_EQ(prod.GetDimension(0).LowerBound(), 1);
   EXPECT_EQ(prod.GetDimension(0).Extent(), 3);
   EXPECT_EQ(*prod.ZeroBasedIndexedElement<std::int32_t>(0), 1);
   EXPECT_EQ(*prod.ZeroBasedIndexedElement<std::int32_t>(1), 4);
   EXPECT_EQ(*prod.ZeroBasedIndexedElement<std::int32_t>(2), 30);
   EXPECT_EQ(RTNAME(SumInteger4)(prod, __FILE__, __LINE__), 35);
   prod.Destroy();
 }
 
 TEST(Reductions, DoubleMaxMinNorm2) {
   std::vector<int> shape{3, 4, 2}; // rows, columns, planes
   //   0  -3   6  -9     12 -15  18 -21
   //  -1   4  -7  10    -13  16 -19  22
   //   2  -5   8 -11     14 -17  20  22   <- note last two are equal to test
   //   BACK=
   std::vector<double> rawData{0, -1, 2, -3, 4, -5, 6, -7, 8, -9, 10, -11, 12,
       -13, 14, -15, 16, -17, 18, -19, 20, -21, 22, 22};
   auto array{MakeArray<TypeCategory::Real, 8>(shape, rawData)};
   EXPECT_EQ(RTNAME(MaxvalReal8)(*array, __FILE__, __LINE__), 22.0);
   EXPECT_EQ(RTNAME(MinvalReal8)(*array, __FILE__, __LINE__), -21.0);
   double naiveNorm2{0};
   for (auto x : rawData) {
     naiveNorm2 += x * x;
   }
   naiveNorm2 = std::sqrt(naiveNorm2);
   double norm2Error{
       std::abs(naiveNorm2 - RTNAME(Norm2_8)(*array, __FILE__, __LINE__))};
   EXPECT_LE(norm2Error, 0.000001 * naiveNorm2);
   StaticDescriptor<2, true> statDesc;
   Descriptor &loc{statDesc.descriptor()};
   RTNAME(Maxloc)
   (loc, *array, /*KIND=*/8, __FILE__, __LINE__, /*MASK=*/nullptr,
       /*BACK=*/false);
   EXPECT_EQ(loc.rank(), 1);
   EXPECT_EQ(loc.type().raw(), (TypeCode{TypeCategory::Integer, 8}.raw()));
   EXPECT_EQ(loc.GetDimension(0).LowerBound(), 1);
   EXPECT_EQ(loc.GetDimension(0).Extent(), 3);
   EXPECT_EQ(
       *array->Element<double>(loc.ZeroBasedIndexedElement<SubscriptValue>(0)),
       22.0);
   EXPECT_EQ(*loc.ZeroBasedIndexedElement<std::int64_t>(0), 2);
   EXPECT_EQ(*loc.ZeroBasedIndexedElement<std::int64_t>(1), 4);
   EXPECT_EQ(*loc.ZeroBasedIndexedElement<std::int64_t>(2), 2);
   loc.Destroy();
   RTNAME(Maxloc)
   (loc, *array, /*KIND=*/8, __FILE__, __LINE__, /*MASK=*/nullptr,
       /*BACK=*/true);
   EXPECT_EQ(loc.rank(), 1);
   EXPECT_EQ(loc.type().raw(), (TypeCode{TypeCategory::Integer, 8}.raw()));
   EXPECT_EQ(loc.GetDimension(0).LowerBound(), 1);
   EXPECT_EQ(loc.GetDimension(0).Extent(), 3);
   EXPECT_EQ(
       *array->Element<double>(loc.ZeroBasedIndexedElement<SubscriptValue>(0)),
       22.0);
   EXPECT_EQ(*loc.ZeroBasedIndexedElement<std::int64_t>(0), 3);
   EXPECT_EQ(*loc.ZeroBasedIndexedElement<std::int64_t>(1), 4);
   EXPECT_EQ(*loc.ZeroBasedIndexedElement<std::int64_t>(2), 2);
   loc.Destroy();
   RTNAME(MinlocDim)
   (loc, *array, /*KIND=*/2, /*DIM=*/1, __FILE__, __LINE__, /*MASK=*/nullptr,
       /*BACK=*/false);
   EXPECT_EQ(loc.rank(), 2);
   EXPECT_EQ(loc.type().raw(), (TypeCode{TypeCategory::Integer, 2}.raw()));
   EXPECT_EQ(loc.GetDimension(0).LowerBound(), 1);
   EXPECT_EQ(loc.GetDimension(0).Extent(), 4);
   EXPECT_EQ(loc.GetDimension(1).LowerBound(), 1);
   EXPECT_EQ(loc.GetDimension(1).Extent(), 2);
   EXPECT_EQ(*loc.ZeroBasedIndexedElement<std::int16_t>(0), 2); // -1
   EXPECT_EQ(*loc.ZeroBasedIndexedElement<std::int16_t>(1), 3); // -5
   EXPECT_EQ(*loc.ZeroBasedIndexedElement<std::int16_t>(2), 2); // -2
   EXPECT_EQ(*loc.ZeroBasedIndexedElement<std::int16_t>(3), 3); // -11
   EXPECT_EQ(*loc.ZeroBasedIndexedElement<std::int16_t>(4), 2); // -13
   EXPECT_EQ(*loc.ZeroBasedIndexedElement<std::int16_t>(5), 3); // -17
   EXPECT_EQ(*loc.ZeroBasedIndexedElement<std::int16_t>(6), 2); // -19
   EXPECT_EQ(*loc.ZeroBasedIndexedElement<std::int16_t>(7), 1); // -21
   loc.Destroy();
   auto mask{MakeArray<TypeCategory::Logical, 1>(shape,
       std::vector<bool>{false, false, false, false, false, true, false, true,
           false, false, true, true, true, false, false, true, false, true, true,
           true, false, true, true, true})};
   RTNAME(MaxlocDim)
   (loc, *array, /*KIND=*/2, /*DIM=*/3, __FILE__, __LINE__, /*MASK=*/&*mask,
       false);
   EXPECT_EQ(loc.rank(), 2);
   EXPECT_EQ(loc.type().raw(), (TypeCode{TypeCategory::Integer, 2}.raw()));
   EXPECT_EQ(loc.GetDimension(0).LowerBound(), 1);
   EXPECT_EQ(loc.GetDimension(0).Extent(), 3);
   EXPECT_EQ(loc.GetDimension(1).LowerBound(), 1);
   EXPECT_EQ(loc.GetDimension(1).Extent(), 4);
   EXPECT_EQ(*loc.ZeroBasedIndexedElement<std::int16_t>(0), 2); // 12
   EXPECT_EQ(*loc.ZeroBasedIndexedElement<std::int16_t>(1), 0);
   EXPECT_EQ(*loc.ZeroBasedIndexedElement<std::int16_t>(2), 0);
   EXPECT_EQ(*loc.ZeroBasedIndexedElement<std::int16_t>(3), 2); // -15
   EXPECT_EQ(*loc.ZeroBasedIndexedElement<std::int16_t>(4), 0);
   EXPECT_EQ(*loc.ZeroBasedIndexedElement<std::int16_t>(5), 1); // -5
   EXPECT_EQ(*loc.ZeroBasedIndexedElement<std::int16_t>(6), 2); // 18
   EXPECT_EQ(*loc.ZeroBasedIndexedElement<std::int16_t>(7), 1); // -7
   EXPECT_EQ(*loc.ZeroBasedIndexedElement<std::int16_t>(8), 0);
   EXPECT_EQ(*loc.ZeroBasedIndexedElement<std::int16_t>(9), 2); // -21
   EXPECT_EQ(*loc.ZeroBasedIndexedElement<std::int16_t>(10), 2); // 22
   EXPECT_EQ(*loc.ZeroBasedIndexedElement<std::int16_t>(11), 2); // 22
   loc.Destroy();
 }
 
 TEST(Reductions, Character) {
   std::vector<int> shape{2, 3};
   auto array{MakeArray<TypeCategory::Character, 1>(shape,
       std::vector<std::string>{"abc", "def", "ghi", "jkl", "mno", "abc"}, 3)};
   StaticDescriptor<1, true> statDesc[2];
   Descriptor &res{statDesc[0].descriptor()};
   RTNAME(MaxvalCharacter)(res, *array, __FILE__, __LINE__);
   EXPECT_EQ(res.rank(), 0);
   EXPECT_EQ(res.type().raw(), (TypeCode{TypeCategory::Character, 1}.raw()));
   EXPECT_EQ(std::memcmp(res.OffsetElement<char>(), "mno", 3), 0);
   res.Destroy();
   RTNAME(MinvalCharacter)(res, *array, __FILE__, __LINE__);
   EXPECT_EQ(res.rank(), 0);
   EXPECT_EQ(res.type().raw(), (TypeCode{TypeCategory::Character, 1}.raw()));
   EXPECT_EQ(std::memcmp(res.OffsetElement<char>(), "abc", 3), 0);
   res.Destroy();
   RTNAME(Maxloc)
   (res, *array, /*KIND=*/4, __FILE__, __LINE__, /*MASK=*/nullptr,
       /*BACK=*/false);
   EXPECT_EQ(res.rank(), 1);
   EXPECT_EQ(res.type().raw(), (TypeCode{TypeCategory::Integer, 4}.raw()));
   EXPECT_EQ(res.GetDimension(0).LowerBound(), 1);
   EXPECT_EQ(res.GetDimension(0).Extent(), 2);
   EXPECT_EQ(*res.ZeroBasedIndexedElement<std::int32_t>(0), 1);
   EXPECT_EQ(*res.ZeroBasedIndexedElement<std::int32_t>(1), 3);
   res.Destroy();
   auto mask{MakeArray<TypeCategory::Logical, 1>(
       shape, std::vector<bool>{false, true, false, true, false, true})};
   RTNAME(Maxloc)
   (res, *array, /*KIND=*/4, __FILE__, __LINE__, /*MASK=*/&*mask,
       /*BACK=*/false);
   EXPECT_EQ(res.rank(), 1);
   EXPECT_EQ(res.type().raw(), (TypeCode{TypeCategory::Integer, 4}.raw()));
   EXPECT_EQ(res.GetDimension(0).LowerBound(), 1);
   EXPECT_EQ(res.GetDimension(0).Extent(), 2);
   EXPECT_EQ(*res.ZeroBasedIndexedElement<std::int32_t>(0), 2);
   EXPECT_EQ(*res.ZeroBasedIndexedElement<std::int32_t>(1), 2);
   res.Destroy();
   RTNAME(Minloc)
   (res, *array, /*KIND=*/4, __FILE__, __LINE__, /*MASK=*/nullptr,
       /*BACK=*/false);
   EXPECT_EQ(res.rank(), 1);
   EXPECT_EQ(res.type().raw(), (TypeCode{TypeCategory::Integer, 4}.raw()));
   EXPECT_EQ(res.GetDimension(0).LowerBound(), 1);
   EXPECT_EQ(res.GetDimension(0).Extent(), 2);
   EXPECT_EQ(*res.ZeroBasedIndexedElement<std::int32_t>(0), 1);
   EXPECT_EQ(*res.ZeroBasedIndexedElement<std::int32_t>(1), 1);
   res.Destroy();
   RTNAME(Minloc)
   (res, *array, /*KIND=*/4, __FILE__, __LINE__, /*MASK=*/nullptr,
       /*BACK=*/true);
   EXPECT_EQ(res.rank(), 1);
   EXPECT_EQ(res.type().raw(), (TypeCode{TypeCategory::Integer, 4}.raw()));
   EXPECT_EQ(res.GetDimension(0).LowerBound(), 1);
   EXPECT_EQ(res.GetDimension(0).Extent(), 2);
   EXPECT_EQ(*res.ZeroBasedIndexedElement<std::int32_t>(0), 2);
   EXPECT_EQ(*res.ZeroBasedIndexedElement<std::int32_t>(1), 3);
   res.Destroy();
   RTNAME(Minloc)
   (res, *array, /*KIND=*/4, __FILE__, __LINE__, /*MASK=*/&*mask,
       /*BACK=*/true);
   EXPECT_EQ(res.rank(), 1);
   EXPECT_EQ(res.type().raw(), (TypeCode{TypeCategory::Integer, 4}.raw()));
   EXPECT_EQ(res.GetDimension(0).LowerBound(), 1);
   EXPECT_EQ(res.GetDimension(0).Extent(), 2);
   EXPECT_EQ(*res.ZeroBasedIndexedElement<std::int32_t>(0), 2);
   EXPECT_EQ(*res.ZeroBasedIndexedElement<std::int32_t>(1), 3);
   res.Destroy();
   static const char targetChar[]{"abc"};
   Descriptor &target{statDesc[1].descriptor()};
   target.Establish(1, std::strlen(targetChar),
       const_cast<void *>(static_cast<const void *>(&targetChar)), 0, nullptr,
       CFI_attribute_pointer);
   RTNAME(Findloc)
   (res, *array, target, /*KIND=*/4, __FILE__, __LINE__, nullptr,
       /*BACK=*/false);
   EXPECT_EQ(res.rank(), 1);
   EXPECT_EQ(res.type().raw(), (TypeCode{TypeCategory::Integer, 4}.raw()));
   EXPECT_EQ(res.GetDimension(0).LowerBound(), 1);
   EXPECT_EQ(res.GetDimension(0).Extent(), 2);
   EXPECT_EQ(*res.ZeroBasedIndexedElement<std::int32_t>(0), 1);
   EXPECT_EQ(*res.ZeroBasedIndexedElement<std::int32_t>(1), 1);
   res.Destroy();
   RTNAME(Findloc)
   (res, *array, target, /*KIND=*/4, __FILE__, __LINE__, nullptr, /*BACK=*/true);
   EXPECT_EQ(res.rank(), 1);
   EXPECT_EQ(res.type().raw(), (TypeCode{TypeCategory::Integer, 4}.raw()));
   EXPECT_EQ(res.GetDimension(0).LowerBound(), 1);
   EXPECT_EQ(res.GetDimension(0).Extent(), 2);
   EXPECT_EQ(*res.ZeroBasedIndexedElement<std::int32_t>(0), 2);
   EXPECT_EQ(*res.ZeroBasedIndexedElement<std::int32_t>(1), 3);
   res.Destroy();
 }
 
 TEST(Reductions, Logical) {
   std::vector<int> shape{2, 2};
   auto array{MakeArray<TypeCategory::Logical, 4>(
       shape, std::vector<std::int32_t>{false, false, true, true})};
   ASSERT_EQ(array->ElementBytes(), std::size_t{4});
   EXPECT_EQ(RTNAME(All)(*array, __FILE__, __LINE__), false);
   EXPECT_EQ(RTNAME(Any)(*array, __FILE__, __LINE__), true);
   EXPECT_EQ(RTNAME(Parity)(*array, __FILE__, __LINE__), false);
   EXPECT_EQ(RTNAME(Count)(*array, __FILE__, __LINE__), 2);
   StaticDescriptor<2, true> statDesc[2];
   Descriptor &res{statDesc[0].descriptor()};
   RTNAME(AllDim)(res, *array, /*DIM=*/1, __FILE__, __LINE__);
   EXPECT_EQ(res.rank(), 1);
   EXPECT_EQ(res.type().raw(), (TypeCode{TypeCategory::Logical, 4}.raw()));
   EXPECT_EQ(res.GetDimension(0).LowerBound(), 1);
   EXPECT_EQ(res.GetDimension(0).Extent(), 2);
   EXPECT_EQ(*res.ZeroBasedIndexedElement<std::int32_t>(0), 0);
   EXPECT_EQ(*res.ZeroBasedIndexedElement<std::int32_t>(1), 1);
   res.Destroy();
   RTNAME(AllDim)(res, *array, /*DIM=*/2, __FILE__, __LINE__);
   EXPECT_EQ(res.rank(), 1);
   EXPECT_EQ(res.type().raw(), (TypeCode{TypeCategory::Logical, 4}.raw()));
   EXPECT_EQ(res.GetDimension(0).LowerBound(), 1);
   EXPECT_EQ(res.GetDimension(0).Extent(), 2);
   EXPECT_EQ(*res.ZeroBasedIndexedElement<std::int32_t>(0), 0);
   EXPECT_EQ(*res.ZeroBasedIndexedElement<std::int32_t>(1), 0);
   res.Destroy();
   RTNAME(AnyDim)(res, *array, /*DIM=*/1, __FILE__, __LINE__);
   EXPECT_EQ(res.rank(), 1);
   EXPECT_EQ(res.type().raw(), (TypeCode{TypeCategory::Logical, 4}.raw()));
   EXPECT_EQ(res.GetDimension(0).LowerBound(), 1);
   EXPECT_EQ(res.GetDimension(0).Extent(), 2);
   EXPECT_EQ(*res.ZeroBasedIndexedElement<std::int32_t>(0), 0);
   EXPECT_EQ(*res.ZeroBasedIndexedElement<std::int32_t>(1), 1);
   res.Destroy();
   RTNAME(AnyDim)(res, *array, /*DIM=*/2, __FILE__, __LINE__);
   EXPECT_EQ(res.rank(), 1);
   EXPECT_EQ(res.type().raw(), (TypeCode{TypeCategory::Logical, 4}.raw()));
   EXPECT_EQ(res.GetDimension(0).LowerBound(), 1);
   EXPECT_EQ(res.GetDimension(0).Extent(), 2);
   EXPECT_EQ(*res.ZeroBasedIndexedElement<std::int32_t>(0), 1);
   EXPECT_EQ(*res.ZeroBasedIndexedElement<std::int32_t>(1), 1);
   res.Destroy();
   RTNAME(ParityDim)(res, *array, /*DIM=*/1, __FILE__, __LINE__);
   EXPECT_EQ(res.rank(), 1);
   EXPECT_EQ(res.type().raw(), (TypeCode{TypeCategory::Logical, 4}.raw()));
   EXPECT_EQ(res.GetDimension(0).LowerBound(), 1);
   EXPECT_EQ(res.GetDimension(0).Extent(), 2);
   EXPECT_EQ(*res.ZeroBasedIndexedElement<std::int32_t>(0), 0);
   EXPECT_EQ(*res.ZeroBasedIndexedElement<std::int32_t>(1), 0);
   res.Destroy();
   RTNAME(ParityDim)(res, *array, /*DIM=*/2, __FILE__, __LINE__);
   EXPECT_EQ(res.rank(), 1);
   EXPECT_EQ(res.type().raw(), (TypeCode{TypeCategory::Logical, 4}.raw()));
   EXPECT_EQ(res.GetDimension(0).LowerBound(), 1);
   EXPECT_EQ(res.GetDimension(0).Extent(), 2);
   EXPECT_EQ(*res.ZeroBasedIndexedElement<std::int32_t>(0), 1);
   EXPECT_EQ(*res.ZeroBasedIndexedElement<std::int32_t>(1), 1);
   res.Destroy();
   RTNAME(CountDim)(res, *array, /*DIM=*/1, /*KIND=*/4, __FILE__, __LINE__);
   EXPECT_EQ(res.rank(), 1);
   EXPECT_EQ(res.type().raw(), (TypeCode{TypeCategory::Integer, 4}.raw()));
   EXPECT_EQ(res.GetDimension(0).LowerBound(), 1);
   EXPECT_EQ(res.GetDimension(0).Extent(), 2);
   EXPECT_EQ(*res.ZeroBasedIndexedElement<std::int32_t>(0), 0);
   EXPECT_EQ(*res.ZeroBasedIndexedElement<std::int32_t>(1), 2);
   res.Destroy();
   RTNAME(CountDim)(res, *array, /*DIM=*/2, /*KIND=*/8, __FILE__, __LINE__);
   EXPECT_EQ(res.rank(), 1);
   EXPECT_EQ(res.type().raw(), (TypeCode{TypeCategory::Integer, 8}.raw()));
   EXPECT_EQ(res.GetDimension(0).LowerBound(), 1);
   EXPECT_EQ(res.GetDimension(0).Extent(), 2);
   EXPECT_EQ(*res.ZeroBasedIndexedElement<std::int64_t>(0), 1);
   EXPECT_EQ(*res.ZeroBasedIndexedElement<std::int64_t>(1), 1);
   res.Destroy();
   bool boolValue{false};
   Descriptor &target{statDesc[1].descriptor()};
   target.Establish(TypeCategory::Logical, 1, static_cast<void *>(&boolValue), 0,
       nullptr, CFI_attribute_pointer);
   RTNAME(Findloc)
   (res, *array, target, /*KIND=*/4, __FILE__, __LINE__, nullptr,
       /*BACK=*/false);
   EXPECT_EQ(res.rank(), 1);
   EXPECT_EQ(res.type().raw(), (TypeCode{TypeCategory::Integer, 4}.raw()));
   EXPECT_EQ(res.GetDimension(0).LowerBound(), 1);
   EXPECT_EQ(res.GetDimension(0).Extent(), 2);
   EXPECT_EQ(*res.ZeroBasedIndexedElement<std::int32_t>(0), 1);
   EXPECT_EQ(*res.ZeroBasedIndexedElement<std::int32_t>(1), 1);
   res.Destroy();
   boolValue = true;
   RTNAME(Findloc)
   (res, *array, target, /*KIND=*/4, __FILE__, __LINE__, nullptr, /*BACK=*/true);
   EXPECT_EQ(res.rank(), 1);
   EXPECT_EQ(res.type().raw(), (TypeCode{TypeCategory::Integer, 4}.raw()));
   EXPECT_EQ(res.GetDimension(0).LowerBound(), 1);
   EXPECT_EQ(res.GetDimension(0).Extent(), 2);
   EXPECT_EQ(*res.ZeroBasedIndexedElement<std::int32_t>(0), 2);
   EXPECT_EQ(*res.ZeroBasedIndexedElement<std::int32_t>(1), 2);
   res.Destroy();
 }
 
 TEST(Reductions, FindlocNumeric) {
   std::vector<int> shape{2, 3};
   auto realArray{MakeArray<TypeCategory::Real, 8>(shape,
       std::vector<double>{0.0, -0.0, 1.0, 3.14,
           std::numeric_limits<double>::quiet_NaN(),
           std::numeric_limits<double>::infinity()})};
   ASSERT_EQ(realArray->ElementBytes(), sizeof(double));
   StaticDescriptor<2, true> statDesc[2];
   Descriptor &res{statDesc[0].descriptor()};
   // Find the first zero
   Descriptor &target{statDesc[1].descriptor()};
   double value{0.0};
   target.Establish(TypeCategory::Real, 8, static_cast<void *>(&value), 0,
       nullptr, CFI_attribute_pointer);
   RTNAME(Findloc)
   (res, *realArray, target, 8, __FILE__, __LINE__, nullptr, /*BACK=*/false);
   EXPECT_EQ(res.rank(), 1);
   EXPECT_EQ(res.type().raw(), (TypeCode{TypeCategory::Integer, 8}.raw()));
   EXPECT_EQ(res.GetDimension(0).LowerBound(), 1);
   EXPECT_EQ(res.GetDimension(0).UpperBound(), 2);
   EXPECT_EQ(*res.ZeroBasedIndexedElement<SubscriptValue>(0), 1);
   EXPECT_EQ(*res.ZeroBasedIndexedElement<SubscriptValue>(1), 1);
   res.Destroy();
   // Find last zero (even though it's negative)
   RTNAME(Findloc)
   (res, *realArray, target, 8, __FILE__, __LINE__, nullptr, /*BACK=*/true);
   EXPECT_EQ(res.rank(), 1);
   EXPECT_EQ(res.type().raw(), (TypeCode{TypeCategory::Integer, 8}.raw()));
   EXPECT_EQ(res.GetDimension(0).LowerBound(), 1);
   EXPECT_EQ(res.GetDimension(0).UpperBound(), 2);
   EXPECT_EQ(*res.ZeroBasedIndexedElement<SubscriptValue>(0), 2);
   EXPECT_EQ(*res.ZeroBasedIndexedElement<SubscriptValue>(1), 1);
   res.Destroy();
   // Find the +Inf
   value = std::numeric_limits<double>::infinity();
   RTNAME(Findloc)
   (res, *realArray, target, 8, __FILE__, __LINE__, nullptr, /*BACK=*/false);
   EXPECT_EQ(res.rank(), 1);
   EXPECT_EQ(res.type().raw(), (TypeCode{TypeCategory::Integer, 8}.raw()));
   EXPECT_EQ(res.GetDimension(0).LowerBound(), 1);
   EXPECT_EQ(res.GetDimension(0).UpperBound(), 2);
   EXPECT_EQ(*res.ZeroBasedIndexedElement<SubscriptValue>(0), 2);
   EXPECT_EQ(*res.ZeroBasedIndexedElement<SubscriptValue>(1), 3);
   res.Destroy();
   // Ensure that we can't find a NaN
   value = std::numeric_limits<double>::quiet_NaN();
   RTNAME(Findloc)
   (res, *realArray, target, 8, __FILE__, __LINE__, nullptr, /*BACK=*/false);
   EXPECT_EQ(res.rank(), 1);
   EXPECT_EQ(res.type().raw(), (TypeCode{TypeCategory::Integer, 8}.raw()));
   EXPECT_EQ(res.GetDimension(0).LowerBound(), 1);
   EXPECT_EQ(res.GetDimension(0).UpperBound(), 2);
   EXPECT_EQ(*res.ZeroBasedIndexedElement<SubscriptValue>(0), 0);
   EXPECT_EQ(*res.ZeroBasedIndexedElement<SubscriptValue>(1), 0);
   res.Destroy();
   // Find a value of a distinct type
   int intValue{1};
   target.Establish(TypeCategory::Integer, 4, static_cast<void *>(&intValue), 0,
       nullptr, CFI_attribute_pointer);
   RTNAME(Findloc)
   (res, *realArray, target, 8, __FILE__, __LINE__, nullptr, /*BACK=*/false);
   EXPECT_EQ(res.rank(), 1);
   EXPECT_EQ(res.type().raw(), (TypeCode{TypeCategory::Integer, 8}.raw()));
   EXPECT_EQ(res.GetDimension(0).LowerBound(), 1);
   EXPECT_EQ(res.GetDimension(0).UpperBound(), 2);
   EXPECT_EQ(*res.ZeroBasedIndexedElement<SubscriptValue>(0), 1);
   EXPECT_EQ(*res.ZeroBasedIndexedElement<SubscriptValue>(1), 2);
   res.Destroy();
   // Partial reductions
   value = 1.0;
   target.Establish(TypeCategory::Real, 8, static_cast<void *>(&value), 0,
       nullptr, CFI_attribute_pointer);
   RTNAME(FindlocDim)
   (res, *realArray, target, 8, /*DIM=*/1, __FILE__, __LINE__, nullptr,
       /*BACK=*/false);
   EXPECT_EQ(res.rank(), 1);
   EXPECT_EQ(res.type().raw(), (TypeCode{TypeCategory::Integer, 8}.raw()));
   EXPECT_EQ(res.GetDimension(0).LowerBound(), 1);
   EXPECT_EQ(res.GetDimension(0).UpperBound(), 3);
   EXPECT_EQ(*res.ZeroBasedIndexedElement<SubscriptValue>(0), 0);
   EXPECT_EQ(*res.ZeroBasedIndexedElement<SubscriptValue>(1), 1);
   EXPECT_EQ(*res.ZeroBasedIndexedElement<SubscriptValue>(2), 0);
   res.Destroy();
   RTNAME(FindlocDim)
   (res, *realArray, target, 8, /*DIM=*/2, __FILE__, __LINE__, nullptr,
       /*BACK=*/true);
   EXPECT_EQ(res.rank(), 1);
   EXPECT_EQ(res.type().raw(), (TypeCode{TypeCategory::Integer, 8}.raw()));
   EXPECT_EQ(res.GetDimension(0).LowerBound(), 1);
   EXPECT_EQ(res.GetDimension(0).UpperBound(), 2);
   EXPECT_EQ(*res.ZeroBasedIndexedElement<SubscriptValue>(0), 2);
   EXPECT_EQ(*res.ZeroBasedIndexedElement<SubscriptValue>(1), 0);
   res.Destroy();
 }
 
 TEST(Reductions, DotProduct) {
   auto realVector{MakeArray<TypeCategory::Real, 8>(
       std::vector<int>{4}, std::vector<double>{0.0, -0.0, 1.0, -2.0})};
   EXPECT_EQ(
       RTNAME(DotProductReal8)(*realVector, *realVector, __FILE__, __LINE__),
       5.0);
   auto complexVector{MakeArray<TypeCategory::Complex, 4>(std::vector<int>{4},
       std::vector<std::complex<float>>{
           {0.0}, {-0.0, -0.0}, {1.0, -2.0}, {-2.0, 4.0}})};
   std::complex<double> result8;
   RTNAME(CppDotProductComplex8)
   (result8, *realVector, *complexVector, __FILE__, __LINE__);
   EXPECT_EQ(result8, (std::complex<double>{5.0, -10.0}));
   RTNAME(CppDotProductComplex8)
   (result8, *complexVector, *realVector, __FILE__, __LINE__);
   EXPECT_EQ(result8, (std::complex<double>{5.0, 10.0}));
   std::complex<float> result4;
   RTNAME(CppDotProductComplex4)
   (result4, *complexVector, *complexVector, __FILE__, __LINE__);
   EXPECT_EQ(result4, (std::complex<float>{25.0, 0.0}));
   auto logicalVector1{MakeArray<TypeCategory::Logical, 1>(
       std::vector<int>{4}, std::vector<bool>{false, false, true, true})};
   EXPECT_TRUE(RTNAME(DotProductLogical)(
       *logicalVector1, *logicalVector1, __FILE__, __LINE__));
   auto logicalVector2{MakeArray<TypeCategory::Logical, 1>(
       std::vector<int>{4}, std::vector<bool>{true, true, false, false})};
   EXPECT_TRUE(RTNAME(DotProductLogical)(
       *logicalVector2, *logicalVector2, __FILE__, __LINE__));
   EXPECT_FALSE(RTNAME(DotProductLogical)(
       *logicalVector1, *logicalVector2, __FILE__, __LINE__));
   EXPECT_FALSE(RTNAME(DotProductLogical)(
       *logicalVector2, *logicalVector1, __FILE__, __LINE__));
 }

flang/unittests/Runtime/RuntimeCrashTest.cpp

 //===-- flang/unittests/RuntimeGTest/CrashHandlerFixture.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
 //
 //===----------------------------------------------------------------------===//
 //
 /// Selected APIs are tested here to support development of unit tests for other
 /// runtime components and ensure the test fixture handles crashes as we expect.
 //
 //===----------------------------------------------------------------------===//
 #include "CrashHandlerFixture.h"
 #include "../../runtime/io-api.h"
 #include "../../runtime/terminator.h"
 #include <gtest/gtest.h>
 
 using namespace Fortran::runtime;
 using namespace Fortran::runtime::io;
 
 //------------------------------------------------------------------------------
 /// Test crashes through direct calls to terminator methods
 //------------------------------------------------------------------------------
 struct TestTerminator : CrashHandlerFixture {};
 
 #define TEST_CRASH_HANDLER_MESSAGE \
   "Intentionally crashing runtime for unit test"
 
 TEST(TestTerminator, CrashTest) {
   static Fortran::runtime::Terminator t;
   ASSERT_DEATH(t.Crash(TEST_CRASH_HANDLER_MESSAGE), TEST_CRASH_HANDLER_MESSAGE);
 }
 
 #undef TEST_CRASH_HANDLER_MESSAGE
 
 TEST(TestTerminator, CheckFailedLocationTest) {
   static Fortran::runtime::Terminator t;
   ASSERT_DEATH(t.CheckFailed("predicate", "someFileName", 789),
       "RUNTIME_CHECK\\(predicate\\) failed at someFileName\\(789\\)");
 }
 
 TEST(TestTerminator, CheckFailedTest) {
   static Fortran::runtime::Terminator t;
   ASSERT_DEATH(t.CheckFailed("predicate"),
       "RUNTIME_CHECK\\(predicate\\) failed at \\(null\\)\\(0\\)");
 }
 
 //------------------------------------------------------------------------------
 /// Test misuse of io api
 //------------------------------------------------------------------------------
 struct TestIOCrash : CrashHandlerFixture {};
 
 TEST(TestIOCrash, FormatDescriptorWriteMismatchTest) {
   static constexpr int bufferSize{4};
   static char buffer[bufferSize];
   static const char *format{"(A4)"};
   auto *cookie{IONAME(BeginInternalFormattedOutput)(
       buffer, bufferSize, format, std::strlen(format))};
   ASSERT_DEATH(IONAME(OutputInteger64)(cookie, 0xfeedface),
       "Data edit descriptor 'A' may not be used with an INTEGER data item");
 }
 
 TEST(TestIOCrash, InvalidFormatCharacterTest) {
   static constexpr int bufferSize{1};
   static char buffer[bufferSize];
   static const char *format{"(C1)"};
   auto *cookie{IONAME(BeginInternalFormattedOutput)(
       buffer, bufferSize, format, std::strlen(format))};
   ASSERT_DEATH(IONAME(OutputInteger64)(cookie, 0xfeedface),
       "Unknown 'C' edit descriptor in FORMAT");
 }
 
 //------------------------------------------------------------------------------
 /// Test buffer overwrites with Output* functions
 /// Each test performs the tested IO operation correctly first, before causing
 /// an overwrite to demonstrate that the failure is caused by the overwrite and
 /// not a misuse of the API.
 //------------------------------------------------------------------------------
 TEST(TestIOCrash, OverwriteBufferAsciiTest) {
   static constexpr int bufferSize{4};
   static char buffer[bufferSize];
   static const char *format{"(A4)"};
   auto *cookie{IONAME(BeginInternalFormattedOutput)(
       buffer, bufferSize, format, std::strlen(format))};
   IONAME(OutputAscii)(cookie, "four", bufferSize);
   ASSERT_DEATH(IONAME(OutputAscii)(cookie, "Too many characters!", 20),
       "Internal write overran available records");
 }
 
 TEST(TestIOCrash, OverwriteBufferCharacterTest) {
   static constexpr int bufferSize{1};
   static char buffer[bufferSize];
   static const char *format{"(A1)"};
   auto *cookie{IONAME(BeginInternalFormattedOutput)(
       buffer, bufferSize, format, std::strlen(format))};
   IONAME(OutputCharacter)(cookie, "a", 1);
   ASSERT_DEATH(IONAME(OutputCharacter)(cookie, "a", 1),
       "Internal write overran available records");
 }
 
 TEST(TestIOCrash, OverwriteBufferLogicalTest) {
   static constexpr int bufferSize{1};
   static char buffer[bufferSize];
   static const char *format{"(L1)"};
   auto *cookie{IONAME(BeginInternalFormattedOutput)(
       buffer, bufferSize, format, std::strlen(format))};
   IONAME(OutputLogical)(cookie, true);
   ASSERT_DEATH(IONAME(OutputLogical)(cookie, true),
       "Internal write overran available records");
 }
 
 TEST(TestIOCrash, OverwriteBufferRealTest) {
   static constexpr int bufferSize{1};
   static char buffer[bufferSize];
   static const char *format{"(F1)"};
   auto *cookie{IONAME(BeginInternalFormattedOutput)(
       buffer, bufferSize, format, std::strlen(format))};
   IONAME(OutputReal32)(cookie, 1.);
   EXPECT_DEATH(IONAME(OutputReal32)(cookie, 1.),
       "Internal write overran available records");
 
   std::memset(buffer, '\0', bufferSize);
   cookie = IONAME(BeginInternalFormattedOutput)(
       buffer, bufferSize, format, std::strlen(format));
   IONAME(OutputReal64)(cookie, 1.);
   EXPECT_DEATH(IONAME(OutputReal64)(cookie, 1.),
       "Internal write overran available records");
 }
 
 TEST(TestIOCrash, OverwriteBufferComplexTest) {
   static constexpr int bufferSize{8};
   static char buffer[bufferSize];
   static const char *format{"(Z1,Z1)"};
   auto *cookie{IONAME(BeginInternalFormattedOutput)(
       buffer, bufferSize, format, std::strlen(format))};
   IONAME(OutputComplex32)(cookie, 1., 1.);
   EXPECT_DEATH(IONAME(OutputComplex32)(cookie, 1., 1.),
       "Internal write overran available records");
 
   std::memset(buffer, '\0', bufferSize);
   cookie = IONAME(BeginInternalFormattedOutput)(
       buffer, bufferSize, format, std::strlen(format));
   IONAME(OutputComplex64)(cookie, 1., 1.);
   EXPECT_DEATH(IONAME(OutputComplex64)(cookie, 1., 1.),
       "Internal write overran available records");
 }
 
 TEST(TestIOCrash, OverwriteBufferIntegerTest) {
   static constexpr int bufferSize{1};
   static char buffer[bufferSize];
   static const char *format{"(I1)"};
   auto *cookie{IONAME(BeginInternalFormattedOutput)(
       buffer, bufferSize, format, std::strlen(format))};
   IONAME(OutputInteger64)(cookie, 0xdeadbeef);
   ASSERT_DEATH(IONAME(OutputInteger64)(cookie, 0xdeadbeef),
       "Internal write overran available records");
 }

flang/unittests/Runtime/Time.cpp

 //===-- flang/unittests/RuntimeGTest/Time.cpp -----------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #include "gtest/gtest.h"
 #include "../../runtime/time-intrinsic.h"
 
 using namespace Fortran::runtime;
 
 TEST(TimeIntrinsics, CpuTime) {
   // We can't really test that we get the "right" result for CPU_TIME, but we
   // can have a smoke test to see that we get something reasonable on the
   // platforms where we expect to support it.
   double start = RTNAME(CpuTime)();
   ASSERT_GE(start, 0.0);
 
   // Loop until we get a different value from CpuTime. If we don't get one
   // before we time out, then we should probably look into an implementation
   // for CpuTime with a better timer resolution.
   for (double end = start; end == start; end = RTNAME(CpuTime)()) {
     ASSERT_GT(end, 0.0);
     ASSERT_GE(end, start);
   }
 }

flang/unittests/Runtime/Transformational.cpp

 //===-- flang/unittests/RuntimeGTest/Transformational.cpp -----------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #include "../../runtime/transformational.h"
 #include "gtest/gtest.h"
 #include "tools.h"
 #include "../../runtime/type-code.h"
 
 using namespace Fortran::runtime;
 using Fortran::common::TypeCategory;
 
 TEST(Transformational, Shifts) {
   // ARRAY  1 3 5
   //        2 4 6
   auto array{MakeArray<TypeCategory::Integer, 4>(
       std::vector<int>{2, 3}, std::vector<std::int32_t>{1, 2, 3, 4, 5, 6})};
   array->GetDimension(0).SetLowerBound(0); // shouldn't matter
   array->GetDimension(1).SetLowerBound(-1);
   StaticDescriptor<2, true> statDesc;
   Descriptor &result{statDesc.descriptor()};
 
   auto shift3{MakeArray<TypeCategory::Integer, 8>(
       std::vector<int>{3}, std::vector<std::int64_t>{1, -1, 2})};
   RTNAME(Cshift)(result, *array, *shift3, 1, __FILE__, __LINE__);
   EXPECT_EQ(result.type(), array->type());
   EXPECT_EQ(result.rank(), 2);
   EXPECT_EQ(result.GetDimension(0).LowerBound(), 1);
   EXPECT_EQ(result.GetDimension(0).Extent(), 2);
   EXPECT_EQ(result.GetDimension(1).LowerBound(), 1);
   EXPECT_EQ(result.GetDimension(1).Extent(), 3);
   EXPECT_EQ(result.type(), (TypeCode{TypeCategory::Integer, 4}));
   static std::int32_t cshiftExpect1[6]{2, 1, 4, 3, 5, 6};
   for (int j{0}; j < 6; ++j) {
     EXPECT_EQ(
         *result.ZeroBasedIndexedElement<std::int32_t>(j), cshiftExpect1[j]);
   }
   result.Destroy();
 
   auto shift2{MakeArray<TypeCategory::Integer, 1>(
       std::vector<int>{2}, std::vector<std::int8_t>{1, -1})};
   shift2->GetDimension(0).SetLowerBound(-1); // shouldn't matter
   shift2->GetDimension(1).SetLowerBound(2);
   RTNAME(Cshift)(result, *array, *shift2, 2, __FILE__, __LINE__);
   EXPECT_EQ(result.type(), array->type());
   EXPECT_EQ(result.rank(), 2);
   EXPECT_EQ(result.GetDimension(0).LowerBound(), 1);
   EXPECT_EQ(result.GetDimension(0).Extent(), 2);
   EXPECT_EQ(result.GetDimension(1).LowerBound(), 1);
   EXPECT_EQ(result.GetDimension(1).Extent(), 3);
   EXPECT_EQ(result.type(), (TypeCode{TypeCategory::Integer, 4}));
   static std::int32_t cshiftExpect2[6]{3, 6, 5, 2, 1, 4};
   for (int j{0}; j < 6; ++j) {
     EXPECT_EQ(
         *result.ZeroBasedIndexedElement<std::int32_t>(j), cshiftExpect2[j]);
   }
   result.Destroy();
 
   auto boundary{MakeArray<TypeCategory::Integer, 4>(
       std::vector<int>{3}, std::vector<std::int32_t>{-1, -2, -3})};
   boundary->GetDimension(0).SetLowerBound(9); // shouldn't matter
   RTNAME(Eoshift)(result, *array, *shift3, &*boundary, 1, __FILE__, __LINE__);
   EXPECT_EQ(result.type(), array->type());
   EXPECT_EQ(result.rank(), 2);
   EXPECT_EQ(result.GetDimension(0).LowerBound(), 1);
   EXPECT_EQ(result.GetDimension(0).Extent(), 2);
   EXPECT_EQ(result.GetDimension(1).LowerBound(), 1);
   EXPECT_EQ(result.GetDimension(1).Extent(), 3);
   EXPECT_EQ(result.type(), (TypeCode{TypeCategory::Integer, 4}));
   static std::int32_t eoshiftExpect1[6]{2, -1, -2, 3, -3, -3};
   for (int j{0}; j < 6; ++j) {
     EXPECT_EQ(
         *result.ZeroBasedIndexedElement<std::int32_t>(j), eoshiftExpect1[j]);
   }
   result.Destroy();
 }
 
 TEST(Transformational, Pack) {
   // ARRAY  1 3 5
   //        2 4 6
   auto array{MakeArray<TypeCategory::Integer, 4>(
       std::vector<int>{2, 3}, std::vector<std::int32_t>{1, 2, 3, 4, 5, 6})};
   array->GetDimension(0).SetLowerBound(2); // shouldn't matter
   array->GetDimension(1).SetLowerBound(-1);
   auto mask{MakeArray<TypeCategory::Logical, 1>(std::vector<int>{2, 3},
       std::vector<std::uint8_t>{false, true, true, false, false, true})};
   mask->GetDimension(0).SetLowerBound(0); // shouldn't matter
   mask->GetDimension(1).SetLowerBound(2);
   StaticDescriptor<1, true> statDesc;
   Descriptor &result{statDesc.descriptor()};
 
   RTNAME(Pack)(result, *array, *mask, nullptr, __FILE__, __LINE__);
   EXPECT_EQ(result.type(), array->type());
   EXPECT_EQ(result.rank(), 1);
   EXPECT_EQ(result.GetDimension(0).LowerBound(), 1);
   EXPECT_EQ(result.GetDimension(0).Extent(), 3);
   static std::int32_t packExpect1[3]{2, 3, 6};
   for (int j{0}; j < 3; ++j) {
     EXPECT_EQ(*result.ZeroBasedIndexedElement<std::int32_t>(j), packExpect1[j])
         << " at " << j;
   }
   result.Destroy();
 
   auto vector{MakeArray<TypeCategory::Integer, 4>(
       std::vector<int>{5}, std::vector<std::int32_t>{-1, -2, -3, -4, -5})};
   RTNAME(Pack)(result, *array, *mask, &*vector, __FILE__, __LINE__);
   EXPECT_EQ(result.type(), array->type());
   EXPECT_EQ(result.rank(), 1);
   EXPECT_EQ(result.GetDimension(0).LowerBound(), 1);
   EXPECT_EQ(result.GetDimension(0).Extent(), 5);
   static std::int32_t packExpect2[5]{2, 3, 6, -4, -5};
   for (int j{0}; j < 5; ++j) {
     EXPECT_EQ(*result.ZeroBasedIndexedElement<std::int32_t>(j), packExpect2[j])
         << " at " << j;
   }
   result.Destroy();
 }
 
 TEST(Transformational, Spread) {
   auto array{MakeArray<TypeCategory::Integer, 4>(
       std::vector<int>{3}, std::vector<std::int32_t>{1, 2, 3})};
   array->GetDimension(0).SetLowerBound(2); // shouldn't matter
   StaticDescriptor<2, true> statDesc;
   Descriptor &result{statDesc.descriptor()};
 
   RTNAME(Spread)(result, *array, 1, 2, __FILE__, __LINE__);
   EXPECT_EQ(result.type(), array->type());
   EXPECT_EQ(result.rank(), 2);
   EXPECT_EQ(result.GetDimension(0).LowerBound(), 1);
   EXPECT_EQ(result.GetDimension(0).Extent(), 2);
   EXPECT_EQ(result.GetDimension(1).LowerBound(), 1);
   EXPECT_EQ(result.GetDimension(1).Extent(), 3);
   for (int j{0}; j < 6; ++j) {
     EXPECT_EQ(*result.ZeroBasedIndexedElement<std::int32_t>(j), 1 + j / 2);
   }
   result.Destroy();
 
   RTNAME(Spread)(result, *array, 2, 2, __FILE__, __LINE__);
   EXPECT_EQ(result.type(), array->type());
   EXPECT_EQ(result.rank(), 2);
   EXPECT_EQ(result.GetDimension(0).LowerBound(), 1);
   EXPECT_EQ(result.GetDimension(0).Extent(), 3);
   EXPECT_EQ(result.GetDimension(1).LowerBound(), 1);
   EXPECT_EQ(result.GetDimension(1).Extent(), 2);
   for (int j{0}; j < 6; ++j) {
     EXPECT_EQ(*result.ZeroBasedIndexedElement<std::int32_t>(j), 1 + j % 3);
   }
   result.Destroy();
 }
 
 TEST(Transformational, Transpose) {
   // ARRAY  1 3 5
   //        2 4 6
   auto array{MakeArray<TypeCategory::Integer, 4>(
       std::vector<int>{2, 3}, std::vector<std::int32_t>{1, 2, 3, 4, 5, 6})};
   array->GetDimension(0).SetLowerBound(2); // shouldn't matter
   array->GetDimension(1).SetLowerBound(-6);
   StaticDescriptor<2, true> statDesc;
   Descriptor &result{statDesc.descriptor()};
   RTNAME(Transpose)(result, *array, __FILE__, __LINE__);
   EXPECT_EQ(result.type(), array->type());
   EXPECT_EQ(result.rank(), 2);
   EXPECT_EQ(result.GetDimension(0).LowerBound(), 1);
   EXPECT_EQ(result.GetDimension(0).Extent(), 3);
   EXPECT_EQ(result.GetDimension(1).LowerBound(), 1);
   EXPECT_EQ(result.GetDimension(1).Extent(), 2);
   static std::int32_t expect[6]{1, 3, 5, 2, 4, 6};
   for (int j{0}; j < 6; ++j) {
     EXPECT_EQ(*result.ZeroBasedIndexedElement<std::int32_t>(j), expect[j]);
   }
   result.Destroy();
 }
 
 TEST(Transformational, Unpack) {
   auto vector{MakeArray<TypeCategory::Integer, 4>(
       std::vector<int>{4}, std::vector<std::int32_t>{1, 2, 3, 4})};
   vector->GetDimension(0).SetLowerBound(2); // shouldn't matter
   auto mask{MakeArray<TypeCategory::Logical, 1>(std::vector<int>{2, 3},
       std::vector<std::uint8_t>{false, true, true, false, false, true})};
   mask->GetDimension(0).SetLowerBound(0); // shouldn't matter
   mask->GetDimension(1).SetLowerBound(2);
   auto field{MakeArray<TypeCategory::Integer, 4>(std::vector<int>{2, 3},
       std::vector<std::int32_t>{-1, -2, -3, -4, -5, -6})};
   field->GetDimension(0).SetLowerBound(-1); // shouldn't matter
   StaticDescriptor<2, true> statDesc;
   Descriptor &result{statDesc.descriptor()};
   RTNAME(Unpack)(result, *vector, *mask, *field, __FILE__, __LINE__);
   EXPECT_EQ(result.type(), vector->type());
   EXPECT_EQ(result.rank(), 2);
   EXPECT_EQ(result.GetDimension(0).LowerBound(), 1);
   EXPECT_EQ(result.GetDimension(0).Extent(), 2);
   EXPECT_EQ(result.GetDimension(1).LowerBound(), 1);
   EXPECT_EQ(result.GetDimension(1).Extent(), 3);
   static std::int32_t expect[6]{-1, 1, 2, -4, -5, 3};
   for (int j{0}; j < 6; ++j) {
     EXPECT_EQ(*result.ZeroBasedIndexedElement<std::int32_t>(j), expect[j]);
   }
   result.Destroy();
 }

flang/unittests/Runtime/external-io.cpp

-// 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, 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, 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 TestDirectUnformattedSwapped() {
-  llvm::errs() << "begin TestDirectUnformattedSwapped()\n";
-  // OPEN(NEWUNIT=unit,ACCESS='DIRECT',ACTION='READWRITE',&
-  //   FORM='UNFORMATTED',RECL=8,STATUS='SCRATCH',CONVERT='NATIVE')
-  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);
-  IONAME(SetConvert)
-  (io, "NATIVE", 6) || (Fail() << "SetConvert(NATIVE)", 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, recl) ||
-        (Fail() << "OutputUnformattedBlock()", 0);
-    IONAME(EndIoStatement)
-    (io) == IostatOk ||
-        (Fail() << "EndIoStatement() for OutputUnformattedBlock", 0);
-  }
-  // OPEN(UNIT=unit,STATUS='OLD',CONVERT='SWAP')
-  io = IONAME(BeginOpenUnit)(unit, __FILE__, __LINE__);
-  IONAME(SetStatus)(io, "OLD", 3) || (Fail() << "SetStatus(OLD)", 0);
-  IONAME(SetConvert)
-  (io, "SWAP", 4) || (Fail() << "SetConvert(SWAP)", 0);
-  IONAME(EndIoStatement)
-  (io) == IostatOk || (Fail() << "EndIoStatement() for OpenUnit", 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, recl) ||
-        (Fail() << "InputUnformattedBlock()", 0);
-    IONAME(EndIoStatement)
-    (io) == IostatOk ||
-        (Fail() << "EndIoStatement() for InputUnformattedBlock", 0);
-    if (buffer >> 56 != j) {
-      Fail() << "Read back " << (buffer >> 56)
-             << " 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, 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, 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, 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,
-        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,
-        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,
-        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();
-  TestDirectUnformattedSwapped();
-  TestSequentialFixedUnformatted();
-  TestSequentialVariableUnformatted();
-  TestDirectFormatted();
-  TestSequentialVariableFormatted();
-  TestStreamUnformatted();
-  return EndTests();
-}

flang/unittests/Runtime/testing.h

-#ifndef FORTRAN_TEST_RUNTIME_TESTING_H_
-#define FORTRAN_TEST_RUNTIME_TESTING_H_
-
-#include "llvm/Support/raw_ostream.h"
-#include <cstddef>
-
-namespace llvm {
-class raw_ostream;
-}
-
-void StartTests();
-llvm::raw_ostream &Fail();
-int EndTests();
-
-#endif // FORTRAN_TEST_RUNTIME_TESTING_H_

flang/unittests/Runtime/testing.cpp

-#include "testing.h"
-#include "../../runtime/terminator.h"
-#include <algorithm>
-#include <cstdarg>
-#include <cstdio>
-#include <cstring>
-#include <string>
-
-static int failures{0};
-
-// Override the Fortran runtime's Crash() for testing purposes
-[[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};
-}
-
-void StartTests() {
-  Fortran::runtime::Terminator::RegisterCrashHandler(CatchCrash);
-}
-
-llvm::raw_ostream &Fail() {
-  ++failures;
-  return llvm::errs();
-}
-
-int EndTests() {
-  if (failures == 0) {
-    llvm::outs() << "PASS\n";
-  } else {
-    llvm::outs() << "FAIL " << failures << " tests\n";
-  }
-  return failures != 0;
-}

flang/unittests/Runtime/tools.h

 //===-- flang/unittests/RuntimeGTest/tools.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_UNITTESTS_RUNTIME_TOOLS_H_
 #define FORTRAN_UNITTESTS_RUNTIME_TOOLS_H_
 
 #include "gtest/gtest.h"
 #include "../../runtime/allocatable.h"
 #include "../../runtime/cpp-type.h"
 #include "../../runtime/descriptor.h"
 #include "../../runtime/type-code.h"
 #include <cstdint>
 #include <cstring>
 #include <vector>
 
 namespace Fortran::runtime {
 
 template <typename A>
 static void StoreElement(void *p, const A &x, std::size_t bytes) {
   std::memcpy(p, &x, bytes);
 }
 
 template <typename CHAR>
 static void StoreElement(
     void *p, const std::basic_string<CHAR> &str, std::size_t bytes) {
   ASSERT_LE(bytes, sizeof(CHAR) * str.size());
   std::memcpy(p, str.data(), bytes);
 }
 
 template <TypeCategory CAT, int KIND, typename A>
 static OwningPtr<Descriptor> MakeArray(const std::vector<int> &shape,
     const std::vector<A> &data,
     std::size_t elemLen = CAT == TypeCategory::Complex ? 2 * KIND : KIND) {
   auto rank{static_cast<int>(shape.size())};
   auto result{Descriptor::Create(TypeCode{CAT, KIND}, elemLen, nullptr, rank,
       nullptr, CFI_attribute_allocatable)};
   for (int j{0}; j < rank; ++j) {
     result->GetDimension(j).SetBounds(1, shape[j]);
   }
   int stat{result->Allocate()};
   EXPECT_EQ(stat, 0) << stat;
   EXPECT_LE(data.size(), result->Elements());
   char *p{result->OffsetElement<char>()};
   for (A x : data) {
     StoreElement(p, x, elemLen);
     p += elemLen;
   }
   return result;
 }
 
 } // namespace Fortran::runtime
 #endif // FORTRAN_UNITTESTS_RUNTIME_TOOLS_H_

flang/unittests/RuntimeGTest/CMakeLists.txt

-add_flang_unittest(FlangRuntimeTests
-  BufferTest.cpp
-  CharacterTest.cpp
-  CrashHandlerFixture.cpp
-  Format.cpp
-  ListInputTest.cpp
-  Matmul.cpp
-  MiscIntrinsic.cpp
-  Namelist.cpp
-  Numeric.cpp
-  NumericalFormatTest.cpp
-  Random.cpp
-  Reduction.cpp
-  RuntimeCrashTest.cpp
-  Time.cpp
-  Transformational.cpp
-)
-
-target_link_libraries(FlangRuntimeTests
-  PRIVATE
-  FortranRuntime
-)