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

flang/docs/Intrinsics.md

@@ -697,6 +697,7 @@ MALLOC
 
 ### Library subroutine 
 ```
+CALL FDATE(TIME)
 CALL GETLOG(USRNAME)
 ```
 
@@ -759,7 +760,7 @@ This phase currently supports all the intrinsic procedures listed above but the
 | 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 |
 | Atomic intrinsic subroutines | ATOMIC_ADD |
 | Collective intrinsic subroutines | CO_REDUCE |
-| Library subroutines | GETLOG|
+| Library subroutines | FDATE, GETLOG |
 
 
 ### Intrinsic Function Folding

flang/include/flang/Runtime/extensions.h

@@ -22,6 +22,9 @@ extern "C" {
 // CALL FLUSH(n) antedates the Fortran 2003 FLUSH statement.
 void FORTRAN_PROCEDURE_NAME(flush)(const int &unit);
 
+// GNU extension subroutine FDATE
+void FORTRAN_PROCEDURE_NAME(fdate)(char *string, std::int64_t length);
+
 // GNU Fortran 77 compatibility function IARGC.
 std::int32_t FORTRAN_PROCEDURE_NAME(iargc)();
 

flang/runtime/extensions.cpp

@@ -10,10 +10,33 @@
 // extensions that will eventually be implemented in Fortran.
 
 #include "flang/Runtime/extensions.h"
+#include "terminator.h"
 #include "tools.h"
 #include "flang/Runtime/command.h"
 #include "flang/Runtime/descriptor.h"
 #include "flang/Runtime/io-api.h"
+#include <ctime>
+
+#ifdef _WIN32
+inline void CtimeBuffer(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);
+}
+#elif _POSIX_C_SOURCE >= 1 || _XOPEN_SOURCE || _BSD_SOURCE || _SVID_SOURCE || \
+    _POSIX_SOURCE
+inline void CtimeBuffer(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);
+}
+#else
+inline void CtimeBuffer(char *buffer, size_t bufsize, const time_t cur_time,
+    Fortran::runtime::Terminator terminator) {
+  buffer[0] = '\0';
+  terminator.Crash("fdate is not supported.");
+}
+#endif
 
 #if _REENTRANT || _POSIX_C_SOURCE >= 199506L
 // System is posix-compliant and has getlogin_r
@@ -43,6 +66,26 @@ void FORTRAN_PROCEDURE_NAME(flush)(const int &unit) {
 }
 } // namespace io
 
+// CALL FDATE(DATE)
+void FORTRAN_PROCEDURE_NAME(fdate)(char *arg, std::int64_t length) {
+  // Day Mon dd hh:mm:ss yyyy\n\0 is 26 characters, e.g.
+  // Tue May 26 21:51:03 2015\n\0
+  char str[26];
+  // Insufficient space, fill with spaces and return.
+  if (length < 24) {
+    std::memset(arg, ' ', length);
+    return;
+  }
+
+  Terminator terminator{__FILE__, __LINE__};
+  std::time_t current_time;
+  std::time(&current_time);
+  CtimeBuffer(str, sizeof(str), current_time, terminator);
+
+  // Pad space on the last two byte `\n\0`, start at index 24 included.
+  CopyAndPad(arg, str, length, 24);
+}
+
 // RESULT = IARGC()
 std::int32_t FORTRAN_PROCEDURE_NAME(iargc)() { return RTNAME(ArgumentCount)(); }
 

flang/unittests/Runtime/CommandTest.cpp

@@ -220,6 +220,62 @@ class NoArgv : public CommandFixture {
   NoArgv() : CommandFixture(0, nullptr) {}
 };
 
+#if _WIN32 || _POSIX_C_SOURCE >= 1 || _XOPEN_SOURCE || _BSD_SOURCE || \
+    _SVID_SOURCE || _POSIX_SOURCE
+TEST_F(NoArgv, FdateGetDate) {
+  char input[]{"24LengthCharIsJustRight"};
+  const std::size_t charLen = sizeof(input);
+
+  FORTRAN_PROCEDURE_NAME(fdate)(input, charLen);
+
+  // Tue May 26 21:51:03 2015\n\0
+  // index at 3, 7, 10, 19 should be space
+  // when date is less than two digit, index 8 would be space
+  // Tue May  6 21:51:03 2015\n\0
+  for (std::size_t i{0}; i < charLen; i++) {
+    if (i == 8)
+      continue;
+    if (i == 3 || i == 7 || i == 10 || i == 19) {
+      EXPECT_EQ(input[i], ' ');
+      continue;
+    }
+    EXPECT_NE(input[i], ' ');
+  }
+}
+
+TEST_F(NoArgv, FdateGetDateTooShort) {
+  char input[]{"TooShortAllPadSpace"};
+  const std::size_t charLen = sizeof(input);
+
+  FORTRAN_PROCEDURE_NAME(fdate)(input, charLen);
+
+  for (std::size_t i{0}; i < charLen; i++) {
+    EXPECT_EQ(input[i], ' ');
+  }
+}
+
+TEST_F(NoArgv, FdateGetDatePadSpace) {
+  char input[]{"All char after 23 pad spaces"};
+  const std::size_t charLen = sizeof(input);
+
+  FORTRAN_PROCEDURE_NAME(fdate)(input, charLen);
+
+  for (std::size_t i{24}; i < charLen; i++) {
+    EXPECT_EQ(input[i], ' ');
+  }
+}
+
+#else
+TEST_F(NoArgv, FdateNotSupported) {
+  char input[]{"No change due to crash"};
+
+  EXPECT_DEATH(FORTRAN_PROCEDURE_NAME(fdate)(input, sizeof(input)),
+      "fdate is not supported.");
+
+  CheckCharEqStr(input, "No change due to crash");
+}
+#endif
+
 // TODO: Test other intrinsics with this fixture.
 
 TEST_F(NoArgv, GetCommand) { CheckMissingCommandValue(); }