[flang] More CHARACTER runtime support + unit test

[klausler]

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.

flang/runtime/character.h

 //===-- runtime/character.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
 //
 //===----------------------------------------------------------------------===//
 
 // Defines API between compiled code and the CHARACTER
 // support functions in the runtime library.
 
 #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'
 // to the (elements of) a (re)allocation of 'temp', which must be an
 // initialized CHARACTER allocatable scalar or array descriptor -- use
 // AllocatableInitCharacter() to set one up.  Crashes when not
 // conforming.  Assumes independence of data.
 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,
 // truncation, or padding ss necessary.  Crashes when not conforming.
 // Assumes independence of data.
 // Call MoveAlloc() instead as an optimization when a temporary value is
 // being assigned to a deferred-length allocatable.
 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_

flang/runtime/character.cpp

 //===-- runtime/character.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 "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*/,
     const Descriptor & /*operand*/, const char * /*sourceFile*/,
     int /*sourceLine*/) {
   // TODO
 }
 
 void RTNAME(CharacterConcatenateScalar)(
     Descriptor & /*temp*/, const char * /*from*/, std::size_t /*byteLength*/) {
   // TODO
 }
 
 void RTNAME(CharacterAssign)(Descriptor & /*lhs*/, const Descriptor & /*rhs*/,
     const char * /*sourceFile*/, int /*sourceLine*/) {
   // 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);
   }
 }
 }
 } // namespace Fortran::runtime

flang/unittests/Runtime/CMakeLists.txt

 if(CMAKE_COMPILER_IS_GNUCXX OR (CMAKE_CXX_COMPILER_ID MATCHES "Clang"))
   set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -fexceptions")
 endif()
 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
 )
 
 add_test(NAME Format COMMAND format-test)
 
 add_executable(hello-world
   hello.cpp
 )
 
 target_link_libraries(hello-world
-  FortranRuntime
   RuntimeTesting
+  FortranRuntime
   LLVMSupport
 )
 
 add_test(NAME HelloWorld COMMAND hello-world)
 
 add_executable(external-hello-world
   external-hello.cpp
 )
 
 target_link_libraries(external-hello-world
   FortranRuntime
   LLVMSupport
 )
 
 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)

flang/unittests/Runtime/character.cpp

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

flang/unittests/Runtime/format.cpp

 // Tests basic FORMAT string traversal
 
 #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>
 #include <vector>
 
 using namespace Fortran::runtime;
 using namespace Fortran::runtime::io;
 using namespace std::literals::string_literals;

flang/unittests/Runtime/hello.cpp

 // 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 "llvm/Support/raw_ostream.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(), ' ');

flang/unittests/Runtime/list-input.cpp

 // Basic sanity tests for list-directed input
 
 #include "testing.h"
 #include "../../runtime/descriptor.h"
 #include "../../runtime/io-api.h"
 #include "../../runtime/io-error.h"
-#include "llvm/Support/raw_ostream.h"
 #include <algorithm>
 #include <cstring>
 
 using namespace Fortran::runtime;
 using namespace Fortran::runtime::io;
 
 int main() {
   StartTests();

flang/unittests/Runtime/testing.h

 #ifndef FORTRAN_TEST_RUNTIME_TESTING_H_
 #define FORTRAN_TEST_RUNTIME_TESTING_H_
 
+#include "llvm/Support/raw_ostream.h"
 #include <cstddef>
-#include <iosfwd>
 
 namespace llvm {
 class raw_ostream;
 }
 
 void StartTests();
 llvm::raw_ostream &Fail();
 int EndTests();
 
 void SetCharacter(char *, std::size_t, const char *);
 
 #endif // FORTRAN_TEST_RUNTIME_TESTING_H_

flang/unittests/Runtime/testing.cpp

 #include "testing.h"
 #include "../../runtime/terminator.h"
-#include "llvm/Support/raw_ostream.h"
 #include <algorithm>
 #include <cstdarg>
 #include <cstdio>
 #include <cstring>
 #include <string>
 
 static int failures{0};