More CHARACTER runtime support

runtime/character.cpp

@@ -7,11 +7,60 @@
 //===----------------------------------------------------------------------===//
 
 #include "character.h"
+#include "descriptor.h"
 #include "terminator.h"
 #include <algorithm>
 #include <cstring>
 
 namespace Fortran::runtime {
+
+template <typename C>
+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 <typename C, int shift>
+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<char, 0>(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<char16_t, 1>(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<char32_t, 2>(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);
   }
 }
 }

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 <cstddef>
 
 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_

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)

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 <cstring>
+
+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();
+}

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 <cstdarg>
 #include <cstring>
 #include <string>

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 <cstring>
 
 using namespace Fortran::runtime;

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 <algorithm>
 #include <cstring>
 

unittests/Runtime/testing.cpp

@@ -1,6 +1,5 @@
 #include "testing.h"
 #include "../../runtime/terminator.h"
-#include "llvm/Support/raw_ostream.h"
 #include <algorithm>
 #include <cstdarg>
 #include <cstdio>

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 <cstddef>
-#include <iosfwd>
 
 namespace llvm {
 class raw_ostream;