Get Gentoo!
gentoo.org sites
gentoo.org Wiki Bugs Forums Packages
Planet Archives Sources
Infra Status
aboutsummaryrefslogtreecommitdiff
path: root/flang/unittests
diff options
context:
space:
mode:
Diffstat (limited to 'flang/unittests')
-rw-r--r--flang/unittests/Evaluate/reshape.cpp2
-rw-r--r--flang/unittests/Runtime/CMakeLists.txt10
-rw-r--r--flang/unittests/Runtime/buffer.cpp115
-rw-r--r--flang/unittests/Runtime/hello.cpp526
-rw-r--r--flang/unittests/RuntimeGTest/CMakeLists.txt7
-rw-r--r--flang/unittests/RuntimeGTest/MiscIntrinsic.cpp70
-rw-r--r--flang/unittests/RuntimeGTest/Numeric.cpp156
-rw-r--r--flang/unittests/RuntimeGTest/NumericalFormatTest.cpp694
-rw-r--r--flang/unittests/RuntimeGTest/Random.cpp63
-rw-r--r--flang/unittests/RuntimeGTest/Reduction.cpp265
-rw-r--r--flang/unittests/RuntimeGTest/tools.h56
11 files changed, 1431 insertions, 533 deletions
diff --git a/flang/unittests/Evaluate/reshape.cpp b/flang/unittests/Evaluate/reshape.cpp
index bcc8b49f054d..a51acdb5fca8 100644
--- a/flang/unittests/Evaluate/reshape.cpp
+++ b/flang/unittests/Evaluate/reshape.cpp
@@ -52,7 +52,7 @@ int main() {
MATCH(2, pad.GetDimension(1).Extent());
MATCH(3, pad.GetDimension(2).Extent());
- auto result{RESHAPE(*source, *shape, &pad)};
+ auto result{RTNAME(Reshape)(*source, *shape, &pad)};
TEST(result.get() != nullptr);
result->Check();
MATCH(sizeof(std::int32_t), result->ElementBytes());
diff --git a/flang/unittests/Runtime/CMakeLists.txt b/flang/unittests/Runtime/CMakeLists.txt
index b80eceac7446..cc7ac7277183 100644
--- a/flang/unittests/Runtime/CMakeLists.txt
+++ b/flang/unittests/Runtime/CMakeLists.txt
@@ -23,11 +23,6 @@ add_flang_nongtest_unittest(format
FortranRuntime
)
-add_flang_nongtest_unittest(hello
- RuntimeTesting
- FortranRuntime
-)
-
# This test is not run by default as it requires input.
add_executable(external-hello-world
external-hello.cpp
@@ -46,3 +41,8 @@ add_flang_nongtest_unittest(list-input
RuntimeTesting
FortranRuntime
)
+
+add_flang_nongtest_unittest(buffer
+ RuntimeTesting
+ FortranRuntime
+)
diff --git a/flang/unittests/Runtime/buffer.cpp b/flang/unittests/Runtime/buffer.cpp
new file mode 100644
index 000000000000..f5eca0338939
--- /dev/null
+++ b/flang/unittests/Runtime/buffer.cpp
@@ -0,0 +1,115 @@
+#include "../../runtime/buffer.h"
+#include "testing.h"
+#include <algorithm>
+#include <cstdint>
+#include <cstring>
+#include <memory>
+
+static constexpr std::size_t tinyBuffer{32};
+using FileOffset = std::int64_t;
+using namespace Fortran::runtime;
+using namespace Fortran::runtime::io;
+
+class Store : public FileFrame<Store, tinyBuffer> {
+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 %= tinyBuffer;
+ auto chunk{
+ static_cast<int>(((j % 2) ? j : (tinyBuffer - 1 - j)) % tinyBuffer)};
+ return std::min(chunk, most);
+}
+
+inline int ValueFor(int at) { return (at ^ (at >> 8)) & 0xff; }
+
+int main() {
+ StartTests();
+ 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)};
+ if (frame < static_cast<std::size_t>(chunk)) {
+ Fail() << "Badly-sized ReadFrame at " << at << ", chunk=" << chunk
+ << ", got " << frame << '\n';
+ break;
+ }
+ const char *from{store.Frame()};
+ for (int k{0}; k < chunk; ++k) {
+ auto expect{static_cast<char>(ValueFor(at + k))};
+ if (from[k] != expect) {
+ Fail() << "At " << at << '+' << k << '(' << (at + k) << "), read "
+ << (from[k] & 0xff) << ", expected " << static_cast<int>(expect)
+ << '\n';
+ }
+ }
+ at += chunk;
+ ++j;
+ }
+ return EndTests();
+}
diff --git a/flang/unittests/Runtime/hello.cpp b/flang/unittests/Runtime/hello.cpp
deleted file mode 100644
index d17c98e74c13..000000000000
--- a/flang/unittests/Runtime/hello.cpp
+++ /dev/null
@@ -1,526 +0,0 @@
-// Basic sanity tests of I/O API; exhaustive testing will be done in Fortran
-
-#include "testing.h"
-#include "../../runtime/descriptor.h"
-#include "../../runtime/io-api.h"
-#include <cstring>
-
-using namespace Fortran::runtime;
-using namespace Fortran::runtime::io;
-
-static bool test(const char *format, const char *expect, std::string &&got) {
- std::string want{expect};
- want.resize(got.length(), ' ');
- if (got != want) {
- Fail() << '\'' << format << "' failed;\n got '" << got
- << "',\nexpected '" << want << "'\n";
- return false;
- }
- return true;
-}
-
-static void hello() {
- char buffer[32];
- const char *format{"(6HHELLO,,A6,2X,I3,1X,'0x',Z8,1X,L1)"};
- auto cookie{IONAME(BeginInternalFormattedOutput)(
- buffer, sizeof buffer, format, std::strlen(format))};
- IONAME(OutputAscii)(cookie, "WORLD", 5);
- IONAME(OutputInteger64)(cookie, 678);
- IONAME(OutputInteger64)(cookie, 0xfeedface);
- IONAME(OutputLogical)(cookie, true);
- if (auto status{IONAME(EndIoStatement)(cookie)}) {
- Fail() << "hello: '" << format << "' failed, status "
- << static_cast<int>(status) << '\n';
- } else {
- test(format, "HELLO, WORLD 678 0xFEEDFACE T",
- std::string{buffer, sizeof buffer});
- }
-}
-
-static void multiline() {
- char buffer[5][32];
- StaticDescriptor<1> staticDescriptor[2];
- Descriptor &whole{staticDescriptor[0].descriptor()};
- SubscriptValue extent[]{5};
- whole.Establish(TypeCode{CFI_type_char}, sizeof buffer[0], &buffer, 1, extent,
- CFI_attribute_pointer);
- whole.Dump();
- whole.Check();
- Descriptor &section{staticDescriptor[1].descriptor()};
- SubscriptValue lowers[]{0}, uppers[]{4}, strides[]{1};
- section.Establish(whole.type(), whole.ElementBytes(), nullptr, 1, extent,
- CFI_attribute_pointer);
- if (auto error{
- CFI_section(&section.raw(), &whole.raw(), lowers, uppers, strides)}) {
- Fail() << "multiline: CFI_section failed: " << error << '\n';
- return;
- }
- section.Dump();
- section.Check();
- const char *format{
- "('?abcde,',T1,'>',T9,A,TL12,A,TR25,'<'//G0,17X,'abcd',1(2I4))"};
- auto cookie{IONAME(BeginInternalArrayFormattedOutput)(
- section, format, std::strlen(format))};
- 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);
- }
- if (auto status{IONAME(EndIoStatement)(cookie)}) {
- Fail() << "multiline: '" << format << "' failed, status "
- << static_cast<int>(status) << '\n';
- } else {
- test(format,
- ">HELLO, WORLD <"
- " "
- "789 abcd 666 777"
- " 888 999 "
- " ",
- std::string{buffer[0], sizeof buffer});
- }
-}
-
-static void listInputTest() {
- static const char input[]{",1*,(5.,6..)"};
- auto cookie{IONAME(BeginInternalListInput)(input, sizeof input - 1)};
- float z[6];
- for (int j{0}; j < 6; ++j) {
- z[j] = -(j + 1);
- }
- for (int j{0}; j < 6; j += 2) {
- if (!IONAME(InputComplex32)(cookie, &z[j])) {
- Fail() << "InputComplex32 failed\n";
- }
- }
- auto status{IONAME(EndIoStatement)(cookie)};
- if (status) {
- Fail() << "Failed complex list-directed input, status "
- << static_cast<int>(status) << '\n';
- } else {
- char output[33];
- output[32] = '\0';
- cookie = IONAME(BeginInternalListOutput)(output, 32);
- for (int j{0}; j < 6; j += 2) {
- if (!IONAME(OutputComplex32)(cookie, z[j], z[j + 1])) {
- Fail() << "OutputComplex32 failed\n";
- }
- }
- status = IONAME(EndIoStatement)(cookie);
- static const char expect[33]{" (-1.,-2.) (-3.,-4.) (5.,6.) "};
- if (status) {
- Fail() << "Failed complex list-directed output, status "
- << static_cast<int>(status) << '\n';
- } else if (std::strncmp(output, expect, 33) != 0) {
- Fail() << "Failed complex list-directed output, expected '" << expect
- << "', but got '" << output << "'\n";
- }
- }
-}
-
-static void descrOutputTest() {
- char buffer[9];
- // Formatted
- const char *format{"(2A4)"};
- auto cookie{IONAME(BeginInternalFormattedOutput)(
- buffer, sizeof buffer, format, std::strlen(format))};
- StaticDescriptor<1> staticDescriptor;
- Descriptor &desc{staticDescriptor.descriptor()};
- SubscriptValue extent[]{2};
- char data[2][4];
- std::memcpy(data[0], "ABCD", 4);
- std::memcpy(data[1], "EFGH", 4);
- desc.Establish(TypeCode{CFI_type_char}, sizeof data[0], &data, 1, extent);
- desc.Dump();
- desc.Check();
- IONAME(OutputDescriptor)(cookie, desc);
- if (auto status{IONAME(EndIoStatement)(cookie)}) {
- Fail() << "descrOutputTest: '" << format << "' failed, status "
- << static_cast<int>(status) << '\n';
- } else {
- test("descrOutputTest(formatted)", "ABCDEFGH ",
- std::string{buffer, sizeof buffer});
- }
- // List-directed
- cookie = IONAME(BeginInternalListOutput)(buffer, sizeof buffer);
- IONAME(OutputDescriptor)(cookie, desc);
- if (auto status{IONAME(EndIoStatement)(cookie)}) {
- Fail() << "descrOutputTest: list-directed failed, status "
- << static_cast<int>(status) << '\n';
- } else {
- test("descrOutputTest(list)", " ABCDEFGH",
- std::string{buffer, sizeof buffer});
- }
-}
-
-static void realTest(const char *format, double x, const char *expect) {
- char buffer[800];
- auto cookie{IONAME(BeginInternalFormattedOutput)(
- buffer, sizeof buffer, format, std::strlen(format))};
- IONAME(OutputReal64)(cookie, x);
- if (auto status{IONAME(EndIoStatement)(cookie)}) {
- Fail() << '\'' << format << "' failed, status " << static_cast<int>(status)
- << '\n';
- } else {
- test(format, expect, std::string{buffer, sizeof buffer});
- }
-}
-
-static void realInTest(
- const char *format, const char *data, std::uint64_t want) {
- auto cookie{IONAME(BeginInternalFormattedInput)(
- data, std::strlen(data), format, std::strlen(format))};
- union {
- double x;
- std::uint64_t raw;
- } u;
- u.raw = 0;
- IONAME(EnableHandlers)(cookie, true, true, true, true, true);
- IONAME(InputReal64)(cookie, u.x);
- char iomsg[65];
- iomsg[0] = '\0';
- iomsg[sizeof iomsg - 1] = '\0';
- IONAME(GetIoMsg)(cookie, iomsg, sizeof iomsg - 1);
- auto status{IONAME(EndIoStatement)(cookie)};
- if (status) {
- Fail() << '\'' << format << "' failed reading '" << data << "', status "
- << static_cast<int>(status) << " iomsg '" << iomsg << "'\n";
- } else if (u.raw != want) {
- Fail() << '\'' << format << "' failed reading '" << data << "', want 0x";
- Fail().write_hex(want) << ", got 0x" << u.raw << '\n';
- }
-}
-
-int main() {
- StartTests();
-
- hello();
- multiline();
-
- static const char *zeroes[][2]{
- {"(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 (int j{0}; zeroes[j][0]; ++j) {
- realTest(zeroes[j][0], 0.0, zeroes[j][1]);
- }
-
- static const char *ones[][2]{
- {"(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 (int j{0}; ones[j][0]; ++j) {
- realTest(ones[j][0], 1.0, ones[j][1]);
- }
-
- realTest("(E32.17,';')", -1.0, " -0.10000000000000000E+01;");
- realTest("(F32.17,';')", -1.0, " -1.00000000000000000;");
- realTest("(G32.17,';')", -1.0, " -1.0000000000000000 ;");
- realTest("(G0,';')", -1.0, "-1.;");
-
- volatile union {
- double d;
- std::uint64_t n;
- } u;
- u.n = 0x8000000000000000; // -0
- realTest("(E9.1,';')", u.d, " -0.0E+00;");
- realTest("(F4.0,';')", u.d, " -0.;");
- realTest("(G8.0,';')", u.d, "-0.0E+00;");
- realTest("(G8.1,';')", u.d, " -0. ;");
- realTest("(G0,';')", u.d, "-0.;");
- u.n = 0x7ff0000000000000; // +Inf
- realTest("(E9.1,';')", u.d, " Inf;");
- realTest("(F9.1,';')", u.d, " Inf;");
- realTest("(G9.1,';')", u.d, " Inf;");
- realTest("(SP,E9.1,';')", u.d, " +Inf;");
- realTest("(SP,F9.1,';')", u.d, " +Inf;");
- realTest("(SP,G9.1,';')", u.d, " +Inf;");
- realTest("(G0,';')", u.d, "Inf;");
- u.n = 0xfff0000000000000; // -Inf
- realTest("(E9.1,';')", u.d, " -Inf;");
- realTest("(F9.1,';')", u.d, " -Inf;");
- realTest("(G9.1,';')", u.d, " -Inf;");
- realTest("(G0,';')", u.d, "-Inf;");
- u.n = 0x7ff0000000000001; // NaN
- realTest("(E9.1,';')", u.d, " NaN;");
- realTest("(F9.1,';')", u.d, " NaN;");
- realTest("(G9.1,';')", u.d, " NaN;");
- realTest("(G0,';')", u.d, "NaN;");
- u.n = 0xfff0000000000001; // NaN (sign irrelevant)
- realTest("(E9.1,';')", u.d, " NaN;");
- realTest("(F9.1,';')", u.d, " NaN;");
- realTest("(G9.1,';')", u.d, " NaN;");
- realTest("(SP,E9.1,';')", u.d, " NaN;");
- realTest("(SP,F9.1,';')", u.d, " NaN;");
- realTest("(SP,G9.1,';')", u.d, " NaN;");
- realTest("(G0,';')", u.d, "NaN;");
-
- u.n = 0x3fb999999999999a; // 0.1 rounded
- realTest("(E62.55,';')", u.d,
- " 0.1000000000000000055511151231257827021181583404541015625E+00;");
- realTest("(E0.0,';')", u.d, "0.E+00;");
- realTest("(E0.55,';')", u.d,
- "0.1000000000000000055511151231257827021181583404541015625E+00;");
- realTest("(E0,';')", u.d, ".1E+00;");
- realTest("(F58.55,';')", u.d,
- " 0.1000000000000000055511151231257827021181583404541015625;");
- realTest("(F0.0,';')", u.d, "0.;");
- realTest("(F0.55,';')", u.d,
- ".1000000000000000055511151231257827021181583404541015625;");
- realTest("(F0,';')", u.d, ".1;");
- realTest("(G62.55,';')", u.d,
- " 0.1000000000000000055511151231257827021181583404541015625 ;");
- realTest("(G0.0,';')", u.d, "0.;");
- realTest("(G0.55,';')", u.d,
- ".1000000000000000055511151231257827021181583404541015625;");
- realTest("(G0,';')", u.d, ".1;");
-
- u.n = 0x3ff8000000000000; // 1.5
- realTest("(E9.2,';')", u.d, " 0.15E+01;");
- realTest("(F4.1,';')", u.d, " 1.5;");
- realTest("(G7.1,';')", u.d, " 2. ;");
- realTest("(RN,E8.1,';')", u.d, " 0.2E+01;");
- realTest("(RN,F3.0,';')", u.d, " 2.;");
- realTest("(RN,G7.0,';')", u.d, " 0.E+01;");
- realTest("(RN,G7.1,';')", u.d, " 2. ;");
- realTest("(RD,E8.1,';')", u.d, " 0.1E+01;");
- realTest("(RD,F3.0,';')", u.d, " 1.;");
- realTest("(RD,G7.0,';')", u.d, " 0.E+01;");
- realTest("(RD,G7.1,';')", u.d, " 1. ;");
- realTest("(RU,E8.1,';')", u.d, " 0.2E+01;");
- realTest("(RU,G7.0,';')", u.d, " 0.E+01;");
- realTest("(RU,G7.1,';')", u.d, " 2. ;");
- realTest("(RZ,E8.1,';')", u.d, " 0.1E+01;");
- realTest("(RZ,F3.0,';')", u.d, " 1.;");
- realTest("(RZ,G7.0,';')", u.d, " 0.E+01;");
- realTest("(RZ,G7.1,';')", u.d, " 1. ;");
- realTest("(RC,E8.1,';')", u.d, " 0.2E+01;");
- realTest("(RC,F3.0,';')", u.d, " 2.;");
- realTest("(RC,G7.0,';')", u.d, " 0.E+01;");
- realTest("(RC,G7.1,';')", u.d, " 2. ;");
-
- // TODO continue F and G editing tests on these data
-
- u.n = 0xbff8000000000000; // -1.5
- realTest("(E9.2,';')", u.d, "-0.15E+01;");
- realTest("(RN,E8.1,';')", u.d, "-0.2E+01;");
- realTest("(RD,E8.1,';')", u.d, "-0.2E+01;");
- realTest("(RU,E8.1,';')", u.d, "-0.1E+01;");
- realTest("(RZ,E8.1,';')", u.d, "-0.1E+01;");
- realTest("(RC,E8.1,';')", u.d, "-0.2E+01;");
-
- u.n = 0x4004000000000000; // 2.5
- realTest("(E9.2,';')", u.d, " 0.25E+01;");
- realTest("(RN,E8.1,';')", u.d, " 0.2E+01;");
- realTest("(RD,E8.1,';')", u.d, " 0.2E+01;");
- realTest("(RU,E8.1,';')", u.d, " 0.3E+01;");
- realTest("(RZ,E8.1,';')", u.d, " 0.2E+01;");
- realTest("(RC,E8.1,';')", u.d, " 0.3E+01;");
-
- u.n = 0xc004000000000000; // -2.5
- realTest("(E9.2,';')", u.d, "-0.25E+01;");
- realTest("(RN,E8.1,';')", u.d, "-0.2E+01;");
- realTest("(RD,E8.1,';')", u.d, "-0.3E+01;");
- realTest("(RU,E8.1,';')", u.d, "-0.2E+01;");
- realTest("(RZ,E8.1,';')", u.d, "-0.2E+01;");
- realTest("(RC,E8.1,';')", u.d, "-0.3E+01;");
-
- u.n = 1; // least positive nonzero subnormal
- realTest("(E32.17,';')", u.d, " 0.49406564584124654-323;");
- realTest("(ES32.17,';')", u.d, " 4.94065645841246544-324;");
- realTest("(EN32.17,';')", u.d, " 4.94065645841246544-324;");
- realTest("(E759.752,';')", u.d,
- " 0."
- "494065645841246544176568792868221372365059802614324764425585682500675507"
- "270208751865299836361635992379796564695445717730926656710355939796398774"
- "796010781878126300713190311404527845817167848982103688718636056998730723"
- "050006387409153564984387312473397273169615140031715385398074126238565591"
- "171026658556686768187039560310624931945271591492455329305456544401127480"
- "129709999541931989409080416563324524757147869014726780159355238611550134"
- "803526493472019379026810710749170333222684475333572083243193609238289345"
- "836806010601150616980975307834227731832924790498252473077637592724787465"
- "608477820373446969953364701797267771758512566055119913150489110145103786"
- "273816725095583738973359899366480994116420570263709027924276754456522908"
- "75386825064197182655334472656250-323;");
- realTest("(G0,';')", u.d, ".5-323;");
- realTest("(E757.750,';')", u.d,
- " 0."
- "494065645841246544176568792868221372365059802614324764425585682500675507"
- "270208751865299836361635992379796564695445717730926656710355939796398774"
- "796010781878126300713190311404527845817167848982103688718636056998730723"
- "050006387409153564984387312473397273169615140031715385398074126238565591"
- "171026658556686768187039560310624931945271591492455329305456544401127480"
- "129709999541931989409080416563324524757147869014726780159355238611550134"
- "803526493472019379026810710749170333222684475333572083243193609238289345"
- "836806010601150616980975307834227731832924790498252473077637592724787465"
- "608477820373446969953364701797267771758512566055119913150489110145103786"
- "273816725095583738973359899366480994116420570263709027924276754456522908"
- "753868250641971826553344726562-323;");
- realTest("(RN,E757.750,';')", u.d,
- " 0."
- "494065645841246544176568792868221372365059802614324764425585682500675507"
- "270208751865299836361635992379796564695445717730926656710355939796398774"
- "796010781878126300713190311404527845817167848982103688718636056998730723"
- "050006387409153564984387312473397273169615140031715385398074126238565591"
- "171026658556686768187039560310624931945271591492455329305456544401127480"
- "129709999541931989409080416563324524757147869014726780159355238611550134"
- "803526493472019379026810710749170333222684475333572083243193609238289345"
- "836806010601150616980975307834227731832924790498252473077637592724787465"
- "608477820373446969953364701797267771758512566055119913150489110145103786"
- "273816725095583738973359899366480994116420570263709027924276754456522908"
- "753868250641971826553344726562-323;");
- realTest("(RD,E757.750,';')", u.d,
- " 0."
- "494065645841246544176568792868221372365059802614324764425585682500675507"
- "270208751865299836361635992379796564695445717730926656710355939796398774"
- "796010781878126300713190311404527845817167848982103688718636056998730723"
- "050006387409153564984387312473397273169615140031715385398074126238565591"
- "171026658556686768187039560310624931945271591492455329305456544401127480"
- "129709999541931989409080416563324524757147869014726780159355238611550134"
- "803526493472019379026810710749170333222684475333572083243193609238289345"
- "836806010601150616980975307834227731832924790498252473077637592724787465"
- "608477820373446969953364701797267771758512566055119913150489110145103786"
- "273816725095583738973359899366480994116420570263709027924276754456522908"
- "753868250641971826553344726562-323;");
- realTest("(RU,E757.750,';')", u.d,
- " 0."
- "494065645841246544176568792868221372365059802614324764425585682500675507"
- "270208751865299836361635992379796564695445717730926656710355939796398774"
- "796010781878126300713190311404527845817167848982103688718636056998730723"
- "050006387409153564984387312473397273169615140031715385398074126238565591"
- "171026658556686768187039560310624931945271591492455329305456544401127480"
- "129709999541931989409080416563324524757147869014726780159355238611550134"
- "803526493472019379026810710749170333222684475333572083243193609238289345"
- "836806010601150616980975307834227731832924790498252473077637592724787465"
- "608477820373446969953364701797267771758512566055119913150489110145103786"
- "273816725095583738973359899366480994116420570263709027924276754456522908"
- "753868250641971826553344726563-323;");
- realTest("(RC,E757.750,';')", u.d,
- " 0."
- "494065645841246544176568792868221372365059802614324764425585682500675507"
- "270208751865299836361635992379796564695445717730926656710355939796398774"
- "796010781878126300713190311404527845817167848982103688718636056998730723"
- "050006387409153564984387312473397273169615140031715385398074126238565591"
- "171026658556686768187039560310624931945271591492455329305456544401127480"
- "129709999541931989409080416563324524757147869014726780159355238611550134"
- "803526493472019379026810710749170333222684475333572083243193609238289345"
- "836806010601150616980975307834227731832924790498252473077637592724787465"
- "608477820373446969953364701797267771758512566055119913150489110145103786"
- "273816725095583738973359899366480994116420570263709027924276754456522908"
- "753868250641971826553344726563-323;");
-
- u.n = 0x10000000000000; // least positive nonzero normal
- realTest("(E723.716,';')", u.d,
- " 0."
- "222507385850720138309023271733240406421921598046233183055332741688720443"
- "481391819585428315901251102056406733973103581100515243416155346010885601"
- "238537771882113077799353200233047961014744258363607192156504694250373420"
- "837525080665061665815894872049117996859163964850063590877011830487479978"
- "088775374994945158045160505091539985658247081864511353793580499211598108"
- "576605199243335211435239014879569960959128889160299264151106346631339366"
- "347758651302937176204732563178148566435087212282863764204484681140761391"
- "147706280168985324411002416144742161856716615054015428508471675290190316"
- "132277889672970737312333408698898317506783884692609277397797285865965494"
- "10913690954061364675687023986783152906809846172109246253967285156250-"
- "307;");
- realTest("(G0,';')", u.d, ".22250738585072014-307;");
-
- u.n = 0x7fefffffffffffffuLL; // greatest finite
- realTest("(E32.17,';')", u.d, " 0.17976931348623157+309;");
- realTest("(E317.310,';')", u.d,
- " 0."
- "179769313486231570814527423731704356798070567525844996598917476803157260"
- "780028538760589558632766878171540458953514382464234321326889464182768467"
- "546703537516986049910576551282076245490090389328944075868508455133942304"
- "583236903222948165808559332123348274797826204144723168738177180919299881"
- "2504040261841248583680+309;");
- realTest("(ES317.310,';')", u.d,
- " 1."
- "797693134862315708145274237317043567980705675258449965989174768031572607"
- "800285387605895586327668781715404589535143824642343213268894641827684675"
- "467035375169860499105765512820762454900903893289440758685084551339423045"
- "832369032229481658085593321233482747978262041447231687381771809192998812"
- "5040402618412485836800+308;");
- realTest("(EN319.310,';')", u.d,
- " 179."
- "769313486231570814527423731704356798070567525844996598917476803157260780"
- "028538760589558632766878171540458953514382464234321326889464182768467546"
- "703537516986049910576551282076245490090389328944075868508455133942304583"
- "236903222948165808559332123348274797826204144723168738177180919299881250"
- "4040261841248583680000+306;");
- realTest("(G0,';')", u.d, ".17976931348623157+309;");
-
- realTest("(F5.3,';')", 25., "*****;");
- realTest("(F5.3,';')", 2.5, "2.500;");
- realTest("(F5.3,';')", 0.25, "0.250;");
- realTest("(F5.3,';')", 0.025, "0.025;");
- realTest("(F5.3,';')", 0.0025, "0.003;");
- realTest("(F5.3,';')", 0.00025, "0.000;");
- realTest("(F5.3,';')", 0.000025, "0.000;");
- realTest("(F5.3,';')", -25., "*****;");
- realTest("(F5.3,';')", -2.5, "*****;");
- realTest("(F5.3,';')", -0.25, "-.250;");
- realTest("(F5.3,';')", -0.025, "-.025;");
- realTest("(F5.3,';')", -0.0025, "-.003;");
- realTest("(F5.3,';')", -0.00025, "-.000;");
- realTest("(F5.3,';')", -0.000025, "-.000;");
-
- realInTest("(F18.0)", " 0", 0x0);
- realInTest("(F18.0)", " ", 0x0);
- realInTest("(F18.0)", " -0", 0x8000000000000000);
- realInTest("(F18.0)", " 01", 0x3ff0000000000000);
- realInTest("(F18.0)", " 1", 0x3ff0000000000000);
- realInTest("(F18.0)", " 125.", 0x405f400000000000);
- realInTest("(F18.0)", " 12.5", 0x4029000000000000);
- realInTest("(F18.0)", " 1.25", 0x3ff4000000000000);
- realInTest("(F18.0)", " 01.25", 0x3ff4000000000000);
- realInTest("(F18.0)", " .125", 0x3fc0000000000000);
- realInTest("(F18.0)", " 0.125", 0x3fc0000000000000);
- realInTest("(F18.0)", " .0625", 0x3fb0000000000000);
- realInTest("(F18.0)", " 0.0625", 0x3fb0000000000000);
- realInTest("(F18.0)", " 125", 0x405f400000000000);
- realInTest("(F18.1)", " 125", 0x4029000000000000);
- realInTest("(F18.2)", " 125", 0x3ff4000000000000);
- realInTest("(F18.3)", " 125", 0x3fc0000000000000);
- realInTest("(-1P,F18.0)", " 125", 0x4093880000000000); // 1250
- realInTest("(1P,F18.0)", " 125", 0x4029000000000000); // 12.5
- realInTest("(BZ,F18.0)", " 125 ", 0x4093880000000000); // 1250
- realInTest("(BZ,F18.0)", " 125 . e +1 ", 0x42a6bcc41e900000); // 1.25e13
- realInTest("(DC,F18.0)", " 12,5", 0x4029000000000000);
-
- listInputTest();
- descrOutputTest();
-
- return EndTests();
-}
diff --git a/flang/unittests/RuntimeGTest/CMakeLists.txt b/flang/unittests/RuntimeGTest/CMakeLists.txt
index f26cb44be5fe..80314c124831 100644
--- a/flang/unittests/RuntimeGTest/CMakeLists.txt
+++ b/flang/unittests/RuntimeGTest/CMakeLists.txt
@@ -1,7 +1,12 @@
add_flang_unittest(FlangRuntimeTests
CharacterTest.cpp
- RuntimeCrashTest.cpp
CrashHandlerFixture.cpp
+ MiscIntrinsic.cpp
+ Numeric.cpp
+ NumericalFormatTest.cpp
+ Random.cpp
+ Reduction.cpp
+ RuntimeCrashTest.cpp
)
target_link_libraries(FlangRuntimeTests
diff --git a/flang/unittests/RuntimeGTest/MiscIntrinsic.cpp b/flang/unittests/RuntimeGTest/MiscIntrinsic.cpp
new file mode 100644
index 000000000000..62213d01021e
--- /dev/null
+++ b/flang/unittests/RuntimeGTest/MiscIntrinsic.cpp
@@ -0,0 +1,70 @@
+//===-- 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();
+}
diff --git a/flang/unittests/RuntimeGTest/Numeric.cpp b/flang/unittests/RuntimeGTest/Numeric.cpp
new file mode 100644
index 000000000000..b930b0a708de
--- /dev/null
+++ b/flang/unittests/RuntimeGTest/Numeric.cpp
@@ -0,0 +1,156 @@
+//===-- 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, 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())));
+}
diff --git a/flang/unittests/RuntimeGTest/NumericalFormatTest.cpp b/flang/unittests/RuntimeGTest/NumericalFormatTest.cpp
new file mode 100644
index 000000000000..7788c436cdab
--- /dev/null
+++ b/flang/unittests/RuntimeGTest/NumericalFormatTest.cpp
@@ -0,0 +1,694 @@
+//===-- 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))};
+ 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};
+ static char buffer[numLines][lineLength];
+
+ // Create descriptor for entire buffer
+ static constexpr int staticDescriptorMaxRank{1};
+ static StaticDescriptor<staticDescriptorMaxRank> wholeStaticDescriptor;
+ static Descriptor &whole{wholeStaticDescriptor.descriptor()};
+ static 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
+ static StaticDescriptor<staticDescriptorMaxRank> sectionStaticDescriptor;
+ static 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))"};
+ static 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
+ ASSERT_TRUE(
+ CompareFormattedStrings(expect, std::string{buffer[0], sizeof buffer}))
+ << "Expected " << expect << " but got " << buffer;
+}
+
+TEST(IOApiTests, ListInputTest) {
+ static const char input[]{",1*,(5.,6..)"};
+ static auto *cookie{IONAME(BeginInternalListInput)(input, sizeof input - 1)};
+
+ // Create real values for IO tests
+ static constexpr int numRealValues{6};
+ static 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
+ static 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};
+ static 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{9};
+ static char buffer[bufferSize];
+ static const char *format{"(2A4)"};
+ static auto *cookie{IONAME(BeginInternalFormattedOutput)(
+ buffer, bufferSize, format, std::strlen(format))};
+
+ // Create descriptor for output
+ static constexpr int staticDescriptorMaxRank{1};
+ static StaticDescriptor<staticDescriptorMaxRank> staticDescriptor;
+ static Descriptor &desc{staticDescriptor.descriptor()};
+ static constexpr int subscriptExtent{2};
+ static const SubscriptValue extent[]{subscriptExtent};
+
+ // Manually write to descriptor buffer
+ static constexpr int dataLength{4};
+ static 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
+ static auto formatStatus{IONAME(EndIoStatement)(cookie)};
+ ASSERT_EQ(formatStatus, 0)
+ << "descrOutputTest: '" << format << "' failed, status "
+ << static_cast<int>(formatStatus);
+
+ // Ensure buffer matches expected output
+ ASSERT_TRUE(
+ CompareFormattedStrings("ABCDEFGH ", 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
+ static auto listDirectedStatus{IONAME(EndIoStatement)(cookie)};
+ ASSERT_EQ(listDirectedStatus, 0)
+ << "descrOutputTest: list-directed failed, status "
+ << static_cast<int>(listDirectedStatus);
+
+ // Ensure buffer matches expected output
+ ASSERT_TRUE(
+ CompareFormattedStrings(" ABCDEFGH", 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 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 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};
+ static 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);
+ static 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;
+ }
+}
diff --git a/flang/unittests/RuntimeGTest/Random.cpp b/flang/unittests/RuntimeGTest/Random.cpp
new file mode 100644
index 000000000000..f16f3dc1a47f
--- /dev/null
+++ b/flang/unittests/RuntimeGTest/Random.cpp
@@ -0,0 +1,63 @@
+//===-- 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);
+}
diff --git a/flang/unittests/RuntimeGTest/Reduction.cpp b/flang/unittests/RuntimeGTest/Reduction.cpp
new file mode 100644
index 000000000000..111b5674285f
--- /dev/null
+++ b/flang/unittests/RuntimeGTest/Reduction.cpp
@@ -0,0 +1,265 @@
+//===-- flang/unittests/RuntimeGTest/Reductions.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/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, SumInt4) {
+ 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;
+}
+
+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> 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, DoubleMaxMin) {
+ 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=
+ auto array{MakeArray<TypeCategory::Real, 8>(shape,
+ std::vector<double>{0, -1, 2, -3, 4, -5, 6, -7, 8, -9, 10, -11, 12, -13,
+ 14, -15, 16, -17, 18, -19, 20, -21, 22, 22})};
+ EXPECT_EQ(RTNAME(MaxvalReal8)(*array, __FILE__, __LINE__), 22.0);
+ EXPECT_EQ(RTNAME(MinvalReal8)(*array, __FILE__, __LINE__), -21.0);
+ StaticDescriptor<2> 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> statDesc;
+ Descriptor &res{statDesc.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();
+}
+
+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(Count)(*array, __FILE__, __LINE__), 2);
+ StaticDescriptor<2> statDesc;
+ Descriptor &res{statDesc.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(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();
+}
diff --git a/flang/unittests/RuntimeGTest/tools.h b/flang/unittests/RuntimeGTest/tools.h
new file mode 100644
index 000000000000..c2c31dcef414
--- /dev/null
+++ b/flang/unittests/RuntimeGTest/tools.h
@@ -0,0 +1,56 @@
+//===-- 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 = 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_