[flang] More CHARACTER runtime support + unit test

Summary:
This is a continuation of development of the runtime support library's functions for
CHARACTER data; specifically, it implements CHARACTER comparisons.
It includes a new unit test, and moves an #include directive to the
runtime's unit testing main header.

Reviewers: tskeith, sscalpone, DavidTruby, jdoerfert

Reviewed By: tskeith

Subscribers: flang-commits, mgorny, llvm-commits

Tags: #llvm, #flang

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

2 files changed, 110 insertions, 14 deletions

diff --git a/flang/runtime/character.cpp b/flang/runtime/character.cpp
index b6a804dfa03f..e65ac38dee87 100644
--- a/flang/runtime/character.cpp
+++ b/flang/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);
   }
 }
 }
diff --git a/flang/runtime/character.h b/flang/runtime/character.h
index ff182dec5445..6705d98bc8f0 100644
--- a/flang/runtime/character.h
+++ b/flang/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_