[flang] FDATE extension implementation: get date and time in ctime format

flang/docs/Intrinsics.md

@@ -751,7 +751,7 @@ This phase currently supports all the intrinsic procedures listed above but the
 | Object characteristic inquiry functions | ALLOCATED, ASSOCIATED, EXTENDS_TYPE_OF, IS_CONTIGUOUS, PRESENT, RANK, SAME_TYPE, STORAGE_SIZE |
 | Type inquiry intrinsic functions | BIT_SIZE, DIGITS, EPSILON, HUGE, KIND, MAXEXPONENT, MINEXPONENT, NEW_LINE, PRECISION, RADIX, RANGE, TINY|
 | Non-standard intrinsic functions | AND, OR, XOR, SHIFT, ZEXT, IZEXT, COSD, SIND, TAND, ACOSD, ASIND, ATAND, ATAN2D, COMPL, EQV, NEQV, INT8, JINT, JNINT, KNINT, QCMPLX, DREAL, DFLOAT, QEXT, QFLOAT, QREAL, DNUM, NUM, JNUM, KNUM, QNUM, RNUM, RAN, RANF, ILEN, SIZEOF, MCLOCK, SECNDS, COTAN, IBCHNG, ISHA, ISHC, ISHL, IXOR, IARG, IARGC, NARGS, GETPID, NUMARG, BADDRESS, IADDR, CACHESIZE, EOF, FP_CLASS, INT_PTR_KIND, ISNAN, MALLOC |
-| Intrinsic subroutines |MVBITS (elemental), CPU_TIME, DATE_AND_TIME, EVENT_QUERY, EXECUTE_COMMAND_LINE, GET_COMMAND, GET_COMMAND_ARGUMENT, GET_ENVIRONMENT_VARIABLE, MOVE_ALLOC, RANDOM_INIT, RANDOM_NUMBER, RANDOM_SEED, SYSTEM_CLOCK |
+| Intrinsic subroutines |MVBITS (elemental), CPU_TIME, DATE_AND_TIME, EVENT_QUERY, EXECUTE_COMMAND_LINE, FDATE, GET_COMMAND, GET_COMMAND_ARGUMENT, GET_ENVIRONMENT_VARIABLE, MOVE_ALLOC, RANDOM_INIT, RANDOM_NUMBER, RANDOM_SEED, SYSTEM_CLOCK |
 | Atomic intrinsic subroutines | ATOMIC_ADD |
 | Collective intrinsic subroutines | CO_REDUCE |
 

flang/include/flang/Runtime/extensions.h

@@ -24,6 +24,8 @@ void FORTRAN_PROCEDURE_NAME(flush)(const int &unit);
 // GNU Fortran 77 compatibility function IARGC.
 std::int32_t FORTRAN_PROCEDURE_NAME(iargc)();
 
+void FORTRAN_PROCEDURE_NAME(fdate)(std::int8_t *string, std::int64_t length);
+
 // GNU Fortran 77 compatibility subroutine GETARG(N, ARG).
 void FORTRAN_PROCEDURE_NAME(getarg)(
     std::int32_t &n, std::int8_t *arg, std::int64_t length);

flang/include/flang/Runtime/time-intrinsic.h

@@ -9,6 +9,17 @@
 // Defines the API between compiled code and the implementations of time-related
 // intrinsic subroutines in the runtime library.
 
+// time-intrinsic.h
+#ifndef TIME_INTRINSIC_H
+#define TIME_INTRINSIC_H
+
+#include <cstddef>
+
+void copyBufferAndPad(
+    char *dest, std::size_t destChars, char *buffer, std::size_t len);
+
+#endif // TIME_INTRINSIC_H
+
 #ifndef FORTRAN_RUNTIME_TIME_INTRINSIC_H_
 #define FORTRAN_RUNTIME_TIME_INTRINSIC_H_
 

flang/runtime/extensions.cpp

@@ -10,9 +10,26 @@
 // extensions that will eventually be implemented in Fortran.
 
 #include "flang/Runtime/extensions.h"
+#include "terminator.h"
 #include "flang/Runtime/command.h"
 #include "flang/Runtime/descriptor.h"
 #include "flang/Runtime/io-api.h"
+#include "flang/Runtime/time-intrinsic.h" // copyBufferAndPad
+#include <ctime>
+
+#ifdef _WIN32
+inline void ctime_alloc(char *buffer, size_t bufsize, const time_t cur_time,
+    Fortran::runtime::Terminator terminator) {
+  int error = ctime_s(buffer, bufsize, &cur_time);
+  RUNTIME_CHECK(terminator, error == 0);
+}
+#else
+inline void ctime_alloc(char *buffer, size_t bufsize, const time_t cur_time,
+    Fortran::runtime::Terminator terminator) {
+  const char *res = ctime_r(&cur_time, buffer);
+  RUNTIME_CHECK(terminator, res != nullptr);
+}
+#endif
 
 extern "C" {
 
@@ -30,6 +47,24 @@ void FORTRAN_PROCEDURE_NAME(flush)(const int &unit) {
 // RESULT = IARGC()
 std::int32_t FORTRAN_PROCEDURE_NAME(iargc)() { return RTNAME(ArgumentCount)(); }
 
+void FORTRAN_PROCEDURE_NAME(fdate)(std::int8_t *arg, std::int64_t length) {
+  // If the length is too short to fit completely, blank return.
+  if (length < 24) {
+    copyBufferAndPad(reinterpret_cast<char *>(arg), length, nullptr, 0);
+    return;
+  }
+
+  std::array<char, 26> str;
+  Terminator terminator{__FILE__, __LINE__};
+  std::time_t current_time;
+  std::time(&current_time);
+  // Day Mon dd hh:mm:ss yyyy\n\0 is 26 characters, e.g.
+  // Tue May 26 21:51:03 2015\n\0
+
+  ctime_alloc(str.data(), str.size(), current_time, terminator);
+  copyBufferAndPad(reinterpret_cast<char *>(arg), length, str.data(), 24);
+}
+
 // CALL GETARG(N, ARG)
 void FORTRAN_PROCEDURE_NAME(getarg)(
     std::int32_t &n, std::int8_t *arg, std::int64_t length) {

flang/runtime/time-intrinsic.cpp

@@ -39,6 +39,16 @@
 // overload will have a dummy parameter whose type indicates whether or not it
 // should be preferred. Any other parameters required for SFINAE should have
 // default values provided.
+
+void copyBufferAndPad(
+    char *dest, std::size_t destChars, char *buffer, std::size_t len) {
+  auto copyLen{std::min(len, destChars)};
+  std::memcpy(dest, buffer, copyLen);
+  for (auto i{copyLen}; i < destChars; ++i) {
+    dest[i] = ' ';
+  }
+}
+
 namespace {
 // Types for the dummy parameter indicating the priority of a given overload.
 // We will invoke our helper with an integer literal argument, so the overload
@@ -279,29 +289,21 @@ static void GetDateAndTime(Fortran::runtime::Terminator &terminator, char *date,
 
   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);
+    copyBufferAndPad(date, dateChars, buffer, 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);
+    copyBufferAndPad(time, timeChars, buffer, 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);
+    copyBufferAndPad(zone, zoneChars, buffer, len);
   }
   if (values) {
     auto typeCode{values->type().GetCategoryAndKind()};

flang/unittests/Runtime/CommandTest.cpp

@@ -225,6 +225,12 @@ TEST_F(ZeroArguments, GetCommandArgument) {
   CheckMissingArgumentValue(1);
 }
 
+TEST_F(ZeroArguments, FDate) {
+  CheckMissingArgumentValue(-1);
+  CheckArgumentValue(commandOnlyArgv[0], 0);
+  CheckMissingArgumentValue(1);
+}
+
 TEST_F(ZeroArguments, GetCommand) { CheckCommandValue(commandOnlyArgv, 1); }
 
 static const char *oneArgArgv[]{"aProgram", "anArgumentOfLength20"};
@@ -242,6 +248,13 @@ TEST_F(OneArgument, GetCommandArgument) {
   CheckMissingArgumentValue(2);
 }
 
+TEST_F(OneArgument, FDate) {
+  CheckMissingArgumentValue(-1);
+  CheckArgumentValue(oneArgArgv[0], 0);
+  CheckArgumentValue(oneArgArgv[1], 1);
+  CheckMissingArgumentValue(2);
+}
+
 TEST_F(OneArgument, GetCommand) { CheckCommandValue(oneArgArgv, 2); }
 
 static const char *severalArgsArgv[]{