[flang] Implement Posix version of DATE_AND_TIME runtime

[jeanPerier]

Summary

Use gettimeofday and localtime_r to implement DATE_AND_TIME intrinsic.
The Windows version fallbacks to the "no date and time information
available" defined by the standard (strings set to blanks and values to
-HUGE).

The implementation uses an ifdef between windows and the rest because
from my tests, the SFINAE approach leads to undeclared name bogus errors
with clang 8 that seems to ignore failure to instantiate is not an error
for the function names (i.e., it understands it should not instantiate
the version using gettimeofday if it is not there, but still yields an
error that it is not declared on the spot where it is called in the
uninstantiated version).

[Leporacanthicus]

Looks like it's doing what's needed. Is there a follow-on patch to fix the fact that values isn't being passed to the DATE_AND_TIME subroutine?

[jeanPerier]

Fix windows build and accept zone == 0 in unit tests.

[jeanPerier]

In D108622#2962219, @Leporacanthicus wrote:

Looks like it's doing what's needed. Is there a follow-on patch to fix the fact that values isn't being passed to the DATE_AND_TIME subroutine?

Do you mean a patch in lowering ?

If so, yes, once this is up streamed, lowering will be updated.

[Leporacanthicus]

In D108622#2962282, @jeanPerier wrote:

In D108622#2962219, @Leporacanthicus wrote:

Looks like it's doing what's needed. Is there a follow-on patch to fix the fact that values isn't being passed to the DATE_AND_TIME subroutine?

Do you mean a patch in lowering ?

If so, yes, once this is up streamed, lowering will be updated.

Yes, I mean the lowering of calls to DATE_AND_TIME - line 2080 in IntrinsicCall.cpp which prints a message saying values is not yet implemented.

If you remember, do add me to that review.

[klausler]

flang/runtime/time-intrinsic.cpp

178

You may not need distinct anonymous namespaces here.

[jeanPerier]

Merge anonymous namespaces.

flang/runtime/time-intrinsic.h

 
 #ifndef FORTRAN_RUNTIME_TIME_INTRINSIC_H_
 #define FORTRAN_RUNTIME_TIME_INTRINSIC_H_
 
 #include "cpp-type.h"
 #include "entry-names.h"
 
 namespace Fortran::runtime {
+
+class Descriptor;
+
 extern "C" {
 
 // Lowering may need to cast this result to match the precision of the default
 // real kind.
 double RTNAME(CpuTime)();
 
 // Interface for the SYSTEM_CLOCK intrinsic. We break it up into 3 distinct
 // function calls, one for each of SYSTEM_CLOCK's optional output arguments.
 // Lowering will have to cast the results to whatever type it prefers.
 CppTypeFor<TypeCategory::Integer, 8> RTNAME(SystemClockCount)();
 CppTypeFor<TypeCategory::Integer, 8> RTNAME(SystemClockCountRate)();
 CppTypeFor<TypeCategory::Integer, 8> RTNAME(SystemClockCountMax)();
+
+// Interface for DATE_AND_TIME intrinsic.
+void RTNAME(DateAndTime)(char *date, std::size_t dateChars, char *time,
+    std::size_t timeChars, char *zone, std::size_t zoneChars,
+    const char *source = nullptr, int line = 0,
+    const Descriptor *values = nullptr);
+
 } // extern "C"
 } // namespace Fortran::runtime
 #endif // FORTRAN_RUNTIME_TIME_INTRINSIC_H_

flang/runtime/time-intrinsic.cpp

 //===-- runtime/time-intrinsic.cpp ----------------------------------------===//
 //
 // 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
 //
 //===----------------------------------------------------------------------===//
 
 // Implements time-related intrinsic subroutines.
 
 #include "time-intrinsic.h"
 
+#include "descriptor.h"
+#include "terminator.h"
+#include "tools.h"
+#include <algorithm>
+#include <cstdint>
+#include <cstdio>
+#include <cstdlib>
+#include <cstring>
 #include <ctime>
+#ifndef _WIN32
+#include <sys/time.h> // gettimeofday
+#endif
 
 // CPU_TIME (Fortran 2018 16.9.57)
 // SYSTEM_CLOCK (Fortran 2018 16.9.168)
 //
 // We can use std::clock() from the <ctime> header as a fallback implementation
 // that should be available everywhere. This may not provide the best resolution
 // and is particularly troublesome on (some?) POSIX systems where CLOCKS_PER_SEC
 // is defined as 10^6 regardless of the actual precision of std::clock().

 template <typename T = int, typename U = struct timespec>
 count_t GetSystemClockCountMax(preferred_implementation,
     // We need some dummy parameters to pass to decltype(clock_gettime).
     T ClockId = 0, U *Timespec = nullptr,
     decltype(clock_gettime(ClockId, Timespec)) *Enabled = nullptr) {
   count_t max_secs{std::numeric_limits<count_t>::max() / NSECS_PER_SEC};
   return max_secs * NSECS_PER_SEC - 1;
 }
+
+} // anonymous namespace
+
+namespace {
+// DATE_AND_TIME implementation.
+
+// Helper to store integer value in result[at].
+template <int KIND> struct StoreIntegerAt {
+  void operator()(const Fortran::runtime::Descriptor &result, std::size_t at,
+      std::int64_t value) const {
+    *result.ZeroBasedIndexedElement<Fortran::runtime::CppTypeFor<
+        Fortran::common::TypeCategory::Integer, KIND>>(at) = value;
+  }
+};
+
+// Helper to set an integer value to -HUGE
+template <int KIND> struct StoreNegativeHugeAt {
+  void operator()(
+      const Fortran::runtime::Descriptor &result, std::size_t at) const {
+    *result.ZeroBasedIndexedElement<Fortran::runtime::CppTypeFor<
+        Fortran::common::TypeCategory::Integer, KIND>>(at) =
+        -std::numeric_limits<Fortran::runtime::CppTypeFor<
+            Fortran::common::TypeCategory::Integer, KIND>>::max();
+  }
+};
+
+// Default implementation when date and time information is not available (set
+// strings to blanks and values to -HUGE as defined by the standard).
+void DateAndTimeUnavailable(Fortran::runtime::Terminator &terminator,
+    char *date, std::size_t dateChars, char *time, std::size_t timeChars,
+    char *zone, std::size_t zoneChars,
+    const Fortran::runtime::Descriptor *values) {
+  if (date) {
+    std::memset(date, static_cast<int>(' '), dateChars);
+  }
+  if (time) {
+    std::memset(time, static_cast<int>(' '), timeChars);
+  }
+  if (zone) {
+    std::memset(zone, static_cast<int>(' '), zoneChars);
+  }
+  if (values) {
+    auto typeCode{values->type().GetCategoryAndKind()};
+    RUNTIME_CHECK(terminator,
+        values->rank() == 1 && values->GetDimension(0).Extent() >= 8 &&
+            typeCode &&
+            typeCode->first == Fortran::common::TypeCategory::Integer);
+    // DATE_AND_TIME values argument must have decimal range > 4. Do not accept
+    // KIND 1 here.
+    int kind{typeCode->second};
+    RUNTIME_CHECK(terminator, kind != 1);
+    for (std::size_t i = 0; i < 8; ++i) {
+      Fortran::runtime::ApplyIntegerKind<StoreNegativeHugeAt, void>(
+          kind, terminator, *values, i);
+    }
+  }
+}
+
+#ifndef _WIN32
+
+// SFINAE helper to return the struct tm.tm_gmtoff which is not a POSIX standard
+// field.
+template <int KIND, typename TM = struct tm>
+Fortran::runtime::CppTypeFor<Fortran::common::TypeCategory::Integer, KIND>
+GetGmtOffset(const TM &tm, preferred_implementation,
+    decltype(tm.tm_gmtoff) *Enabled = nullptr) {
+  // Returns the GMT offset in minutes.
+  return tm.tm_gmtoff / 60;
+}
+template <int KIND, typename TM = struct tm>
+Fortran::runtime::CppTypeFor<Fortran::common::TypeCategory::Integer, KIND>
+GetGmtOffset(const TM &tm, fallback_implementation) {
+  // tm.tm_gmtoff is not available, there may be platform dependent alternatives
+  // (such as using timezone from <time.h> when available), but so far just
+  // return -HUGE to report that this information is not available.
+  return -std::numeric_limits<Fortran::runtime::CppTypeFor<
+      Fortran::common::TypeCategory::Integer, KIND>>::max();
+}
+template <typename TM = struct tm> struct GmtOffsetHelper {
+  template <int KIND> struct StoreGmtOffset {
+    void operator()(const Fortran::runtime::Descriptor &result, std::size_t at,
+        TM &tm) const {
+      *result.ZeroBasedIndexedElement<Fortran::runtime::CppTypeFor<
+          Fortran::common::TypeCategory::Integer, KIND>>(at) =
+          GetGmtOffset<KIND>(tm, 0);
+    }
+  };
+};
+
+// Dispatch to posix implemetation when gettimeofday and localtime_r are
+// available.
+void GetDateAndTime(Fortran::runtime::Terminator &terminator, char *date,
+    std::size_t dateChars, char *time, std::size_t timeChars, char *zone,
+    std::size_t zoneChars, const Fortran::runtime::Descriptor *values) {
+
+  timeval t;
+  if (gettimeofday(&t, nullptr) != 0) {
+    DateAndTimeUnavailable(
+        terminator, date, dateChars, time, timeChars, zone, zoneChars, values);
+    return;
+  }
+  time_t timer{t.tv_sec};
+  tm localTime;
+  localtime_r(&timer, &localTime);
+  std::intmax_t ms{t.tv_usec / 1000};
+
+  static constexpr std::size_t buffSize{16};
+  char buffer[buffSize];
+  auto copyBufferAndPad{
+      [&](char *dest, std::size_t destChars, std::size_t len) {
+        auto copyLen{std::min(len, destChars)};
+        std::memcpy(dest, buffer, copyLen);
+        for (auto i{copyLen}; i < destChars; ++i) {
+          dest[i] = ' ';
+        }
+      }};
+  if (date) {
+    auto len = std::strftime(buffer, buffSize, "%Y%m%d", &localTime);
+    copyBufferAndPad(date, dateChars, len);
+  }
+  if (time) {
+    auto len{std::snprintf(buffer, buffSize, "%02d%02d%02d.%03jd",
+        localTime.tm_hour, localTime.tm_min, localTime.tm_sec, ms)};
+    copyBufferAndPad(time, timeChars, len);
+  }
+  if (zone) {
+    // Note: this may leave the buffer empty on many platforms. Classic flang
+    // has a much more complex way of doing this (see __io_timezone in classic
+    // flang).
+    auto len{std::strftime(buffer, buffSize, "%z", &localTime)};
+    copyBufferAndPad(zone, zoneChars, len);
+  }
+  if (values) {
+    auto typeCode{values->type().GetCategoryAndKind()};
+    RUNTIME_CHECK(terminator,
+        values->rank() == 1 && values->GetDimension(0).Extent() >= 8 &&
+            typeCode &&
+            typeCode->first == Fortran::common::TypeCategory::Integer);
+    // DATE_AND_TIME values argument must have decimal range > 4. Do not accept
+    // KIND 1 here.
+    int kind{typeCode->second};
+    RUNTIME_CHECK(terminator, kind != 1);
+    auto storeIntegerAt = [&](std::size_t atIndex, std::int64_t value) {
+      Fortran::runtime::ApplyIntegerKind<StoreIntegerAt, void>(
+          kind, terminator, *values, atIndex, value);
+    };
+    storeIntegerAt(0, localTime.tm_year + 1900);
+    storeIntegerAt(1, localTime.tm_mon + 1);
+    storeIntegerAt(2, localTime.tm_mday);
+    Fortran::runtime::ApplyIntegerKind<
+        GmtOffsetHelper<struct tm>::StoreGmtOffset, void>(
+        kind, terminator, *values, 3, localTime);
+    storeIntegerAt(4, localTime.tm_hour);
+    storeIntegerAt(5, localTime.tm_min);
+    storeIntegerAt(6, localTime.tm_sec);
+    storeIntegerAt(7, ms);
+  }
+}
+
+#else
+// Fallback implementation when gettimeofday or localtime_r is not available
+// (e.g. windows).
+void GetDateAndTime(Fortran::runtime::Terminator &terminator, char *date,
+    std::size_t dateChars, char *time, std::size_t timeChars, char *zone,
+    std::size_t zoneChars, const Fortran::runtime::Descriptor *values) {
+  // TODO: An actual implementation for non Posix system should be added.
+  // So far, implement as if the date and time is not available on those
+  // platforms.
+  DateAndTimeUnavailable(
+      terminator, date, dateChars, time, timeChars, zone, zoneChars, values);
+}
+#endif
 } // anonymous namespace
 
 namespace Fortran::runtime {
 extern "C" {
 
 double RTNAME(CpuTime)() { return GetCpuTime(0); }
 
-CppTypeFor<TypeCategory::Integer, 8> RTNAME(SystemClockCount)() {
+CppTypeFor<Fortran::common::TypeCategory::Integer, 8> RTNAME(
+    SystemClockCount)() {
   return GetSystemClockCount(0);
 }
 
-CppTypeFor<TypeCategory::Integer, 8> RTNAME(SystemClockCountRate)() {
+CppTypeFor<Fortran::common::TypeCategory::Integer, 8> RTNAME(
+    SystemClockCountRate)() {
   return GetSystemClockCountRate(0);
 }
 
-CppTypeFor<TypeCategory::Integer, 8> RTNAME(SystemClockCountMax)() {
+CppTypeFor<Fortran::common::TypeCategory::Integer, 8> RTNAME(
+    SystemClockCountMax)() {
   return GetSystemClockCountMax(0);
 }
+
+void RTNAME(DateAndTime)(char *date, std::size_t dateChars, char *time,
+    std::size_t timeChars, char *zone, std::size_t zoneChars,
+    const char *source, int line, const Descriptor *values) {
+  Fortran::runtime::Terminator terminator{source, line};
+  return GetDateAndTime(
+      terminator, date, dateChars, time, timeChars, zone, zoneChars, values);
+}
+
 } // extern "C"
 } // namespace Fortran::runtime

flang/test/Runtime/no-cpp-dep.c

 /*
 This test makes sure that flang's runtime does not depend on the C++ runtime
 library. It tries to link this simple file against libFortranRuntime.a with
 a C compiler.
 
 REQUIRES: c-compiler
 
-RUN: %cc -std=c90 %s -I%runtimeincludes %libruntime -o /dev/null
+RUN: %cc -std=c90 %s -I%runtimeincludes %libruntime %libdecimal -o /dev/null
 */
 
 #include "entry-names.h"
 
 /*
 Manually add declarations for the runtime functions that we want to make sure
 we're testing. We can't include any headers directly since they likely contain
 C++ code that would explode here.
 */
 double RTNAME(CpuTime)();
 
 int main() {
   double x = RTNAME(CpuTime)();
   return x;
 }

flang/test/lit.cfg.py

tools = [
     ToolSubst('%flang_fc1', command=FindTool('flang-new'), extra_args=['-fc1'],
         unresolved='fatal')]
 
 # Define some variables to help us test that the flang runtime doesn't depend on
 # the C++ runtime libraries. For this we need a C compiler. If for some reason
 # we don't have one, we can just disable the test.
 if config.cc:
     libruntime = os.path.join(config.flang_lib_dir, 'libFortranRuntime.a')
+    libdecimal = os.path.join(config.flang_lib_dir, 'libFortranDecimal.a')
     includes = os.path.join(config.flang_src_dir, 'runtime')
 
-    if os.path.isfile(libruntime) and os.path.isdir(includes):
+    if os.path.isfile(libruntime) and os.path.isfile(libdecimal) and os.path.isdir(includes):
         config.available_features.add('c-compiler')
         tools.append(ToolSubst('%cc', command=config.cc, unresolved='fatal'))
         tools.append(ToolSubst('%libruntime', command=libruntime,
             unresolved='fatal'))
+        tools.append(ToolSubst('%libdecimal', command=libdecimal,
+            unresolved='fatal'))
         tools.append(ToolSubst('%runtimeincludes', command=includes,
             unresolved='fatal'))
 
 if config.flang_standalone_build:
     llvm_config.add_tool_substitutions(tools, [config.flang_llvm_tools_dir])
 else:
     llvm_config.add_tool_substitutions(tools, config.llvm_tools_dir)
 
 # Enable libpgmath testing
 result = lit_config.params.get("LIBPGMATH")
 if result:
     config.environment["LIBPGMATH"] = True

flang/unittests/Runtime/Time.cpp

 //===-- flang/unittests/RuntimeGTest/Time.cpp -----------------------===//
 //
 // 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 "../../runtime/time-intrinsic.h"
+#include <algorithm>
+#include <cctype>
+#include <charconv>
+#include <string>
 
 using namespace Fortran::runtime;
 
 TEST(TimeIntrinsics, CpuTime) {
   // We can't really test that we get the "right" result for CPU_TIME, but we
   // can have a smoke test to see that we get something reasonable on the
   // platforms where we expect to support it.
   double start{RTNAME(CpuTime)()};
TEST(TimeIntrinsics, SystemClock) {
   // for SystemClokcCount with a better timer resolution on this platform.
   for (count_t end = start; end == start; end = RTNAME(SystemClockCount)()) {
     EXPECT_GE(end, 0);
     EXPECT_LE(end, max);
 
     EXPECT_GE(end, start);
   }
 }
+
+TEST(TimeIntrinsics, DateAndTime) {
+  constexpr std::size_t bufferSize{16};
+  std::string date(bufferSize, 'Z'), time(bufferSize, 'Z'),
+      zone(bufferSize, 'Z');
+  RTNAME(DateAndTime)
+  (date.data(), date.size(), time.data(), time.size(), zone.data(), zone.size(),
+      /*source=*/nullptr, /*line=*/0, /*values=*/nullptr);
+  auto isBlank = [](const std::string &s) -> bool {
+    return std::all_of(
+        s.begin(), s.end(), [](char c) { return std::isblank(c); });
+  };
+  // Validate date is blank or YYYYMMDD.
+  if (isBlank(date)) {
+    EXPECT_TRUE(true);
+  } else {
+    count_t number{-1};
+    auto [_, ec]{
+        std::from_chars(date.data(), date.data() + date.size(), number)};
+    ASSERT_TRUE(ec != std::errc::invalid_argument &&
+        ec != std::errc::result_out_of_range);
+    EXPECT_GE(number, 0);
+    auto year = number / 10000;
+    auto month = (number - year * 10000) / 100;
+    auto day = number % 100;
+    // Do not assume anything about the year, the test could be
+    // run on system with fake/outdated dates.
+    EXPECT_LE(month, 12);
+    EXPECT_GT(month, 0);
+    EXPECT_LE(day, 31);
+    EXPECT_GT(day, 0);
+  }
+
+  // Validate time is hhmmss.sss or blank.
+  if (isBlank(time)) {
+    EXPECT_TRUE(true);
+  } else {
+    count_t number{-1};
+    auto [next, ec]{
+        std::from_chars(time.data(), time.data() + date.size(), number)};
+    ASSERT_TRUE(ec != std::errc::invalid_argument &&
+        ec != std::errc::result_out_of_range);
+    ASSERT_GE(number, 0);
+    auto hours = number / 10000;
+    auto minutes = (number - hours * 10000) / 100;
+    auto seconds = number % 100;
+    EXPECT_LE(hours, 23);
+    EXPECT_LE(minutes, 59);
+    // Accept 60 for leap seconds.
+    EXPECT_LE(seconds, 60);
+    ASSERT_TRUE(next != time.data() + time.size());
+    EXPECT_EQ(*next, '.');
+
+    count_t milliseconds{-1};
+    ASSERT_TRUE(next + 1 != time.data() + time.size());
+    auto [_, ec2]{
+        std::from_chars(next + 1, time.data() + date.size(), milliseconds)};
+    ASSERT_TRUE(ec2 != std::errc::invalid_argument &&
+        ec2 != std::errc::result_out_of_range);
+    EXPECT_GE(milliseconds, 0);
+    EXPECT_LE(milliseconds, 999);
+  }
+
+  // Validate zone is +hhmm or -hhmm or blank.
+  if (isBlank(zone)) {
+    EXPECT_TRUE(true);
+  } else {
+    ASSERT_TRUE(zone.size() > 1);
+    EXPECT_TRUE(zone[0] == '+' || zone[0] == '-');
+    count_t number{-1};
+    auto [next, ec]{
+        std::from_chars(zone.data() + 1, zone.data() + zone.size(), number)};
+    ASSERT_TRUE(ec != std::errc::invalid_argument &&
+        ec != std::errc::result_out_of_range);
+    ASSERT_GE(number, 0);
+    auto hours = number / 100;
+    auto minutes = number % 100;
+    EXPECT_LE(hours, 23);
+    EXPECT_LE(minutes, 59);
+  }
+}