diff --git a/flang/runtime/time-intrinsic.h b/flang/runtime/time-intrinsic.h --- a/flang/runtime/time-intrinsic.h +++ b/flang/runtime/time-intrinsic.h @@ -16,6 +16,9 @@ #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 @@ -28,6 +31,13 @@ CppTypeFor RTNAME(SystemClockCount)(); CppTypeFor RTNAME(SystemClockCountRate)(); CppTypeFor 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_ diff --git a/flang/runtime/time-intrinsic.cpp b/flang/runtime/time-intrinsic.cpp --- a/flang/runtime/time-intrinsic.cpp +++ b/flang/runtime/time-intrinsic.cpp @@ -10,7 +10,18 @@ #include "time-intrinsic.h" +#include "descriptor.h" +#include "terminator.h" +#include "tools.h" +#include +#include +#include +#include +#include #include +#ifndef _WIN32 +#include // gettimeofday +#endif // CPU_TIME (Fortran 2018 16.9.57) // SYSTEM_CLOCK (Fortran 2018 16.9.168) @@ -163,6 +174,178 @@ count_t max_secs{std::numeric_limits::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 struct StoreIntegerAt { + void operator()(const Fortran::runtime::Descriptor &result, std::size_t at, + std::int64_t value) const { + *result.ZeroBasedIndexedElement>(at) = value; + } +}; + +// Helper to set an integer value to -HUGE +template struct StoreNegativeHugeAt { + void operator()( + const Fortran::runtime::Descriptor &result, std::size_t at) const { + *result.ZeroBasedIndexedElement>(at) = + -std::numeric_limits>::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(' '), dateChars); + } + if (time) { + std::memset(time, static_cast(' '), timeChars); + } + if (zone) { + std::memset(zone, static_cast(' '), 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( + kind, terminator, *values, i); + } + } +} + +#ifndef _WIN32 + +// SFINAE helper to return the struct tm.tm_gmtoff which is not a POSIX standard +// field. +template +Fortran::runtime::CppTypeFor +GetGmtOffset(const TM &tm, preferred_implementation, + decltype(tm.tm_gmtoff) *Enabled = nullptr) { + // Returns the GMT offset in minutes. + return tm.tm_gmtoff / 60; +} +template +Fortran::runtime::CppTypeFor +GetGmtOffset(const TM &tm, fallback_implementation) { + // tm.tm_gmtoff is not available, there may be platform dependent alternatives + // (such as using timezone from when available), but so far just + // return -HUGE to report that this information is not available. + return -std::numeric_limits>::max(); +} +template struct GmtOffsetHelper { + template struct StoreGmtOffset { + void operator()(const Fortran::runtime::Descriptor &result, std::size_t at, + TM &tm) const { + *result.ZeroBasedIndexedElement>(at) = + GetGmtOffset(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( + 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::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 { @@ -170,16 +353,28 @@ double RTNAME(CpuTime)() { return GetCpuTime(0); } -CppTypeFor RTNAME(SystemClockCount)() { +CppTypeFor RTNAME( + SystemClockCount)() { return GetSystemClockCount(0); } -CppTypeFor RTNAME(SystemClockCountRate)() { +CppTypeFor RTNAME( + SystemClockCountRate)() { return GetSystemClockCountRate(0); } -CppTypeFor RTNAME(SystemClockCountMax)() { +CppTypeFor 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 diff --git a/flang/test/Runtime/no-cpp-dep.c b/flang/test/Runtime/no-cpp-dep.c --- a/flang/test/Runtime/no-cpp-dep.c +++ b/flang/test/Runtime/no-cpp-dep.c @@ -5,7 +5,7 @@ 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" diff --git a/flang/test/lit.cfg.py b/flang/test/lit.cfg.py --- a/flang/test/lit.cfg.py +++ b/flang/test/lit.cfg.py @@ -77,13 +77,16 @@ # 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')) diff --git a/flang/unittests/Runtime/Time.cpp b/flang/unittests/Runtime/Time.cpp --- a/flang/unittests/Runtime/Time.cpp +++ b/flang/unittests/Runtime/Time.cpp @@ -8,6 +8,10 @@ #include "gtest/gtest.h" #include "../../runtime/time-intrinsic.h" +#include +#include +#include +#include using namespace Fortran::runtime; @@ -56,3 +60,84 @@ 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_GT(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_TRUE(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_GT(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_TRUE(number > 0); + auto hours = number / 100; + auto minutes = number % 100; + EXPECT_LE(hours, 23); + EXPECT_LE(minutes, 59); + } +}