From 5492cdba2141eaa82eeb082a7a5b96792f086368 Mon Sep 17 00:00:00 2001 From: peter klausler Date: Wed, 8 Apr 2020 12:47:51 -0700 Subject: [PATCH] More CHARACTER runtime support --- runtime/character.cpp | 86 +++++++++++++++++++++++++++++--- runtime/character.h | 38 +++++++++++--- unittests/Runtime/CMakeLists.txt | 22 ++++++-- unittests/Runtime/character.cpp | 59 ++++++++++++++++++++++ unittests/Runtime/format.cpp | 1 - unittests/Runtime/hello.cpp | 1 - unittests/Runtime/list-input.cpp | 1 - unittests/Runtime/testing.cpp | 1 - unittests/Runtime/testing.h | 2 +- 9 files changed, 187 insertions(+), 24 deletions(-) create mode 100644 unittests/Runtime/character.cpp diff --git a/runtime/character.cpp b/runtime/character.cpp index b6a804dfa03f..e65ac38dee87 100644 --- a/runtime/character.cpp +++ b/runtime/character.cpp @@ -7,11 +7,60 @@ //===----------------------------------------------------------------------===// #include "character.h" +#include "descriptor.h" #include "terminator.h" #include #include namespace Fortran::runtime { + +template +inline int CompareToBlankPadding(const C *x, std::size_t chars) { + for (; chars-- > 0; ++x) { + if (*x < ' ') { + return -1; + } + if (*x > ' ') { + return 1; + } + } + return 0; +} + +template +static int Compare( + const C *x, const C *y, std::size_t xBytes, std::size_t yBytes) { + auto minBytes{std::min(xBytes, yBytes)}; + if constexpr (shift == 0) { + // don't use for kind=2 or =4, that would fail on little-endian machines + int cmp{std::memcmp(x, y, minBytes)}; + if (cmp < 0) { + return -1; + } + if (cmp > 0) { + return 1; + } + if (xBytes == yBytes) { + return 0; + } + x += minBytes; + y += minBytes; + } else { + for (std::size_t n{minBytes >> shift}; n-- > 0; ++x, ++y) { + if (*x < *y) { + return -1; + } + if (*x > *y) { + return 1; + } + } + } + if (int cmp{CompareToBlankPadding(x, (xBytes - minBytes) >> shift)}) { + return cmp; + } + return -CompareToBlankPadding(y, (yBytes - minBytes) >> shift); +} + extern "C" { void RTNAME(CharacterConcatenate)(Descriptor & /*temp*/, @@ -30,18 +79,43 @@ void RTNAME(CharacterAssign)(Descriptor & /*lhs*/, const Descriptor & /*rhs*/, // TODO } -std::size_t RTNAME(CharacterAppend)(char *lhs, std::size_t lhsLength, - std::size_t offset, const char *rhs, std::size_t rhsLength) { - if (auto n{std::min(lhsLength - offset, rhsLength)}) { +int RTNAME(CharacterCompareScalar)(const Descriptor &, const Descriptor &) { + // TODO real soon once there's type codes for character(kind=2 & 4) + return 0; +} + +int RTNAME(CharacterCompareScalar1)( + const char *x, const char *y, std::size_t xBytes, std::size_t yBytes) { + return Compare(x, y, xBytes, yBytes); +} + +int RTNAME(CharacterCompareScalar2)(const char16_t *x, const char16_t *y, + std::size_t xBytes, std::size_t yBytes) { + return Compare(x, y, xBytes, yBytes); +} + +int RTNAME(CharacterCompareScalar4)(const char32_t *x, const char32_t *y, + std::size_t xBytes, std::size_t yBytes) { + return Compare(x, y, xBytes, yBytes); +} + +void RTNAME(CharacterCompare)( + Descriptor &, const Descriptor &, const Descriptor &) { + // TODO real soon once there's type codes for character(kind=2 & 4) +} + +std::size_t RTNAME(CharacterAppend1)(char *lhs, std::size_t lhsBytes, + std::size_t offset, const char *rhs, std::size_t rhsBytes) { + if (auto n{std::min(lhsBytes - offset, rhsBytes)}) { std::memcpy(lhs + offset, rhs, n); offset += n; } return offset; } -void RTNAME(CharacterPad)(char *lhs, std::size_t length, std::size_t offset) { - if (length > offset) { - std::memset(lhs + offset, ' ', length - offset); +void RTNAME(CharacterPad1)(char *lhs, std::size_t bytes, std::size_t offset) { + if (bytes > offset) { + std::memset(lhs + offset, ' ', bytes - offset); } } } diff --git a/runtime/character.h b/runtime/character.h index ff182dec5445..6705d98bc8f0 100644 --- a/runtime/character.h +++ b/runtime/character.h @@ -11,11 +11,13 @@ #ifndef FORTRAN_RUNTIME_CHARACTER_H_ #define FORTRAN_RUNTIME_CHARACTER_H_ -#include "descriptor.h" #include "entry-names.h" #include namespace Fortran::runtime { + +class Descriptor; + extern "C" { // Appends the corresponding (or expanded) characters of 'operand' @@ -26,8 +28,8 @@ extern "C" { void RTNAME(CharacterConcatenate)(Descriptor &temp, const Descriptor &operand, const char *sourceFile = nullptr, int sourceLine = 0); -// Convenience specialization for character scalars. -void RTNAME(CharacterConcatenateScalar)( +// Convenience specialization for ASCII scalars. +void RTNAME(CharacterConcatenateScalar1)( Descriptor &temp, const char *, std::size_t byteLength); // Assigns the value(s) of 'rhs' to 'lhs'. Handles reallocation, @@ -38,16 +40,36 @@ void RTNAME(CharacterConcatenateScalar)( void RTNAME(CharacterAssign)(Descriptor &lhs, const Descriptor &rhs, const char *sourceFile = nullptr, int sourceLine = 0); -// Special-case support for optimized scalar CHARACTER concatenation -// expressions. +// CHARACTER comparisons. The kinds must match. Like std::memcmp(), +// the result is less than zero, zero, or greater than zero if the first +// argument is less than the second, equal to the second, or greater than +// the second, respectively. The shorter argument is treated as if it were +// padded on the right with blanks. +// N.B.: Calls to the restricted specific intrinsic functions LGE, LGT, LLE, +// & LLT are converted into calls to these during lowering; they don't have +// to be able to be passed as actual procedure arguments. +int RTNAME(CharacterCompareScalar)(const Descriptor &, const Descriptor &); +int RTNAME(CharacterCompareScalar1)( + const char *x, const char *y, std::size_t xBytes, std::size_t yBytes); +int RTNAME(CharacterCompareScalar2)(const char16_t *x, const char16_t *y, + std::size_t xBytes, std::size_t yBytes); +int RTNAME(CharacterCompareScalar4)(const char32_t *x, const char32_t *y, + std::size_t xBytes, std::size_t yBytes); + +// General CHARACTER comparison; the result is a LOGICAL(KIND=1) array that +// is established and populated. +void RTNAME(CharacterCompare)( + Descriptor &result, const Descriptor &, const Descriptor &); + +// Special-case support for optimized ASCII scalar expressions. // Copies data from 'rhs' to the remaining space (lhsLength - offset) // in 'lhs', if any. Returns the new offset. Assumes independence. -std::size_t RTNAME(CharacterAppend)(char *lhs, std::size_t lhsLength, - std::size_t offset, const char *rhs, std::size_t rhsLength); +std::size_t RTNAME(CharacterAppend1)(char *lhs, std::size_t lhsBytes, + std::size_t offset, const char *rhs, std::size_t rhsBytes); // Appends any necessary spaces to a CHARACTER(KIND=1) scalar. -void RTNAME(CharacterPad)(char *lhs, std::size_t length, std::size_t offset); +void RTNAME(CharacterPad1)(char *lhs, std::size_t bytes, std::size_t offset); } } // namespace Fortran::runtime #endif // FORTRAN_RUNTIME_CHARACTER_H_ diff --git a/unittests/Runtime/CMakeLists.txt b/unittests/Runtime/CMakeLists.txt index a5297ac67821..4d6ac6411fe2 100644 --- a/unittests/Runtime/CMakeLists.txt +++ b/unittests/Runtime/CMakeLists.txt @@ -5,15 +5,15 @@ set(CMAKE_RUNTIME_OUTPUT_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}) add_library(RuntimeTesting testing.cpp - ) +) add_executable(format-test format.cpp ) target_link_libraries(format-test - FortranRuntime RuntimeTesting + FortranRuntime LLVMSupport ) @@ -24,8 +24,8 @@ add_executable(hello-world ) target_link_libraries(hello-world - FortranRuntime RuntimeTesting + FortranRuntime LLVMSupport ) @@ -42,12 +42,24 @@ target_link_libraries(external-hello-world add_executable(list-input-test list-input.cpp - ) +) target_link_libraries(list-input-test - FortranRuntime RuntimeTesting + FortranRuntime LLVMSupport ) add_test(NAME ListInput COMMAND list-input-test) + +add_executable(character-test + character.cpp +) + +target_link_libraries(character-test + RuntimeTesting + FortranRuntime + LLVMSupport +) + +add_test(NAME CharacterTest COMMAND character-test) diff --git a/unittests/Runtime/character.cpp b/unittests/Runtime/character.cpp new file mode 100644 index 000000000000..fb023473f64a --- /dev/null +++ b/unittests/Runtime/character.cpp @@ -0,0 +1,59 @@ +// Basic sanity tests of CHARACTER API; exhaustive testing will be done +// in Fortran. + +#include "../../runtime/character.h" +#include "testing.h" +#include + +using namespace Fortran::runtime; + +static void AppendAndPad(std::size_t limit) { + char x[8]; + std::size_t xLen{0}; + std::memset(x, 0, sizeof x); + xLen = RTNAME(CharacterAppend1)(x, limit, xLen, "abc", 3); + xLen = RTNAME(CharacterAppend1)(x, limit, xLen, "DE", 2); + RTNAME(CharacterPad1)(x, limit, xLen); + if (xLen > limit) { + Fail() << "xLen " << xLen << ">" << limit << '\n'; + } + if (x[limit]) { + Fail() << "x[" << limit << "]='" << x[limit] << "'\n"; + x[limit] = '\0'; + } + if (std::memcmp(x, "abcDE ", limit)) { + Fail() << "x = '" << x << "'\n"; + } +} + +static void TestCharCompare(const char *x, const char *y, std::size_t xBytes, + std::size_t yBytes, int expect) { + int cmp{RTNAME(CharacterCompareScalar1)(x, y, xBytes, yBytes)}; + if (cmp != expect) { + char buf[2][8]; + std::memset(buf, 0, sizeof buf); + std::memcpy(buf[0], x, xBytes); + std::memcpy(buf[1], y, yBytes); + Fail() << "compare '" << buf[0] << "'(" << xBytes << ") to '" << buf[1] + << "'(" << yBytes << "), got " << cmp << ", should be " << expect + << '\n'; + } +} + +static void Compare(const char *x, const char *y, std::size_t xBytes, + std::size_t yBytes, int expect) { + TestCharCompare(x, y, xBytes, yBytes, expect); + TestCharCompare(y, x, yBytes, xBytes, -expect); +} + +int main() { + StartTests(); + for (std::size_t j{0}; j < 8; ++j) { + AppendAndPad(j); + } + Compare("abc", "abc", 3, 3, 0); + Compare("abc", "def", 3, 3, -1); + Compare("ab ", "abc", 3, 2, 0); + Compare("abc", "abc", 2, 3, -1); + return EndTests(); +} diff --git a/unittests/Runtime/format.cpp b/unittests/Runtime/format.cpp index c855523b427e..87989eacebcb 100644 --- a/unittests/Runtime/format.cpp +++ b/unittests/Runtime/format.cpp @@ -3,7 +3,6 @@ #include "testing.h" #include "../runtime/format-implementation.h" #include "../runtime/io-error.h" -#include "llvm/Support/raw_ostream.h" #include #include #include diff --git a/unittests/Runtime/hello.cpp b/unittests/Runtime/hello.cpp index 64ed2cbaba72..22e7380128f3 100644 --- a/unittests/Runtime/hello.cpp +++ b/unittests/Runtime/hello.cpp @@ -3,7 +3,6 @@ #include "testing.h" #include "../../runtime/descriptor.h" #include "../../runtime/io-api.h" -#include "llvm/Support/raw_ostream.h" #include using namespace Fortran::runtime; diff --git a/unittests/Runtime/list-input.cpp b/unittests/Runtime/list-input.cpp index 9f6377656f91..c7a660dc87aa 100644 --- a/unittests/Runtime/list-input.cpp +++ b/unittests/Runtime/list-input.cpp @@ -4,7 +4,6 @@ #include "../../runtime/descriptor.h" #include "../../runtime/io-api.h" #include "../../runtime/io-error.h" -#include "llvm/Support/raw_ostream.h" #include #include diff --git a/unittests/Runtime/testing.cpp b/unittests/Runtime/testing.cpp index 8a31f23e9ef5..146b37db9a57 100644 --- a/unittests/Runtime/testing.cpp +++ b/unittests/Runtime/testing.cpp @@ -1,6 +1,5 @@ #include "testing.h" #include "../../runtime/terminator.h" -#include "llvm/Support/raw_ostream.h" #include #include #include diff --git a/unittests/Runtime/testing.h b/unittests/Runtime/testing.h index 943b6fd8d915..1b401aaf8543 100644 --- a/unittests/Runtime/testing.h +++ b/unittests/Runtime/testing.h @@ -1,8 +1,8 @@ #ifndef FORTRAN_TEST_RUNTIME_TESTING_H_ #define FORTRAN_TEST_RUNTIME_TESTING_H_ +#include "llvm/Support/raw_ostream.h" #include -#include namespace llvm { class raw_ostream;