[flang-commits] [flang] FDATE extension implementation: get date and time in ctime format (PR #71222)

Yi Wu via flang-commits flang-commits at lists.llvm.org
Fri Nov 10 08:24:10 PST 2023


https://github.com/PAX-12-WU updated https://github.com/llvm/llvm-project/pull/71222

>From e0d99fb5baa4231ab351f7fd5abf0a1ffe589547 Mon Sep 17 00:00:00 2001
From: Yi Wu <yi.wu2 at arm.com>
Date: Mon, 6 Nov 2023 19:55:06 +0000
Subject: [PATCH 1/4] FDATE extension implementation: get date and time in
 ctime format

reference to gfortran fdate https://gcc.gnu.org/onlinedocs/gfortran/FDATE.html
usage:
CHARACTER(32) :: time
CALL fdate(time)
WRITE(*,*) time
---
 flang/docs/Intrinsics.md                 |  2 +-
 flang/include/flang/Runtime/command.h    |  5 +++++
 flang/include/flang/Runtime/extensions.h |  2 ++
 flang/runtime/command.cpp                | 28 ++++++++++++++++++++++++
 flang/runtime/extensions.cpp             |  5 +++++
 flang/unittests/Runtime/CommandTest.cpp  | 14 ++++++++++++
 6 files changed, 55 insertions(+), 1 deletion(-)

diff --git a/flang/docs/Intrinsics.md b/flang/docs/Intrinsics.md
index ab0a940e53e5538..982be8208164296 100644
--- a/flang/docs/Intrinsics.md
+++ b/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, 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 |
 
diff --git a/flang/include/flang/Runtime/command.h b/flang/include/flang/Runtime/command.h
index ec6289390545479..07f6d8e169ead6c 100644
--- a/flang/include/flang/Runtime/command.h
+++ b/flang/include/flang/Runtime/command.h
@@ -23,6 +23,11 @@ extern "C" {
 // integer kind.
 std::int32_t RTNAME(ArgumentCount)();
 
+// Try to get the the current date (same format as CTIME: convert to a string)
+// Return a STATUS as described in the standard.
+std::int32_t RTNAME(FDate)(
+    const Descriptor *argument = nullptr, const Descriptor *errmsg = nullptr);
+
 // 16.9.82 GET_COMMAND
 // Try to get the value of the whole command. All of the parameters are
 // optional.
diff --git a/flang/include/flang/Runtime/extensions.h b/flang/include/flang/Runtime/extensions.h
index ad592814e5acb79..92b9907860121aa 100644
--- a/flang/include/flang/Runtime/extensions.h
+++ b/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);
diff --git a/flang/runtime/command.cpp b/flang/runtime/command.cpp
index b81a0791c5e571b..da0803c39f49b6d 100644
--- a/flang/runtime/command.cpp
+++ b/flang/runtime/command.cpp
@@ -14,6 +14,7 @@
 #include "flang/Runtime/descriptor.h"
 #include <cstdlib>
 #include <limits>
+#include <time.h>
 
 namespace Fortran::runtime {
 std::int32_t RTNAME(ArgumentCount)() {
@@ -125,6 +126,33 @@ static bool FitsInDescriptor(
       kind, terminator, value);
 }
 
+void removeNewLine(char *str) {
+  char *newlinePos = strchr(str, '\n');
+  if (newlinePos != NULL) {
+    *newlinePos = '\0'; // Replace with null terminator
+  }
+}
+
+std::int32_t RTNAME(FDate)(const Descriptor *value, const Descriptor *errmsg) {
+  FillWithSpaces(*value);
+
+  time_t current_time;
+  time(&current_time);
+
+  char *time_string = ctime(&current_time);
+  removeNewLine(time_string);
+  std::int64_t stringLen{StringLength(time_string)};
+  if (stringLen <= 0) {
+    return ToErrmsg(errmsg, StatMissingArgument);
+  }
+
+  if (value) {
+    return CopyToDescriptor(*value, time_string, stringLen, errmsg);
+  }
+
+  return StatOk;
+}
+
 std::int32_t RTNAME(GetCommandArgument)(std::int32_t n, const Descriptor *value,
     const Descriptor *length, const Descriptor *errmsg, const char *sourceFile,
     int line) {
diff --git a/flang/runtime/extensions.cpp b/flang/runtime/extensions.cpp
index b8e9b6eae132059..0142cac1d929d4d 100644
--- a/flang/runtime/extensions.cpp
+++ b/flang/runtime/extensions.cpp
@@ -30,6 +30,11 @@ 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) {
+  Descriptor value{*Descriptor::Create(1, length, arg, 0)};
+  (void)RTNAME(FDate)(&value, nullptr);
+}
+
 // CALL GETARG(N, ARG)
 void FORTRAN_PROCEDURE_NAME(getarg)(
     std::int32_t &n, std::int8_t *arg, std::int64_t length) {
diff --git a/flang/unittests/Runtime/CommandTest.cpp b/flang/unittests/Runtime/CommandTest.cpp
index c3571c9684e4b07..091870e4baf1730 100644
--- a/flang/unittests/Runtime/CommandTest.cpp
+++ b/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[]{
@@ -284,6 +297,7 @@ TEST_F(SeveralArguments, ArgValueTooShort) {
   ASSERT_NE(tooShort, nullptr);
   EXPECT_EQ(RTNAME(GetCommandArgument)(1, tooShort.get()), -1);
   CheckDescriptorEqStr(tooShort.get(), severalArgsArgv[1]);
+  EXPECT_EQ(RTNAME(FDate)(tooShort.get()), -1);
 
   OwningPtr<Descriptor> length{EmptyIntDescriptor()};
   ASSERT_NE(length, nullptr);

>From b1032049028e51d7713bf6ad1525b24f4cef8237 Mon Sep 17 00:00:00 2001
From: Yi Wu <yi.wu2 at arm.com>
Date: Fri, 10 Nov 2023 12:44:53 +0000
Subject: [PATCH 2/4] make fdate thread safe ctime_s is defined in MS, ctime_r
 is defined in linux/macos

---
 flang/runtime/command.cpp | 37 ++++++++++++++++++++++++++++---------
 1 file changed, 28 insertions(+), 9 deletions(-)

diff --git a/flang/runtime/command.cpp b/flang/runtime/command.cpp
index da0803c39f49b6d..b999d04eec7172c 100644
--- a/flang/runtime/command.cpp
+++ b/flang/runtime/command.cpp
@@ -13,8 +13,24 @@
 #include "tools.h"
 #include "flang/Runtime/descriptor.h"
 #include <cstdlib>
+#include <ctime>
 #include <limits>
-#include <time.h>
+
+#ifdef _WIN32
+inline const char *ctime_alloc(
+    char *buffer, size_t bufsize, const time_t cur_time) {
+  int error = ctime_s(buffer, bufsize, &cur_time);
+  assert(error == 0 && "ctime_s returned an error");
+  return buffer;
+}
+#else
+inline const char *ctime_alloc(
+    char *buffer, size_t bufsize, const time_t cur_time) {
+  const char *res = ctime_r(&cur_time, buffer);
+  assert(res != nullptr && "ctime_s returned an error");
+  return res;
+}
+#endif
 
 namespace Fortran::runtime {
 std::int32_t RTNAME(ArgumentCount)() {
@@ -127,8 +143,8 @@ static bool FitsInDescriptor(
 }
 
 void removeNewLine(char *str) {
-  char *newlinePos = strchr(str, '\n');
-  if (newlinePos != NULL) {
+  char *newlinePos = std::strchr(str, '\n');
+  if (newlinePos) {
     *newlinePos = '\0'; // Replace with null terminator
   }
 }
@@ -136,18 +152,21 @@ void removeNewLine(char *str) {
 std::int32_t RTNAME(FDate)(const Descriptor *value, const Descriptor *errmsg) {
   FillWithSpaces(*value);
 
-  time_t current_time;
-  time(&current_time);
+  std::time_t current_time;
+  std::time(&current_time);
+  std::array<char, 26> str;
+  // Day Mon dd hh:mm:ss yyyy\n is 26 character,
+  // e.g. Tue May 26 21:51:03 2015\n\0
 
-  char *time_string = ctime(&current_time);
-  removeNewLine(time_string);
-  std::int64_t stringLen{StringLength(time_string)};
+  ctime_alloc(str.data(), str.size(), current_time);
+  removeNewLine(str.data());
+  std::int64_t stringLen{StringLength(str.data())};
   if (stringLen <= 0) {
     return ToErrmsg(errmsg, StatMissingArgument);
   }
 
   if (value) {
-    return CopyToDescriptor(*value, time_string, stringLen, errmsg);
+    return CopyToDescriptor(*value, str.data(), stringLen, errmsg);
   }
 
   return StatOk;

>From 64f18c615cfb00198408d736cd0543953dbc2a90 Mon Sep 17 00:00:00 2001
From: Yi Wu <yi.wu2 at arm.com>
Date: Fri, 10 Nov 2023 15:52:20 +0000
Subject: [PATCH 3/4] remove new line can be hardcoded, since we know where it
 is

---
 flang/runtime/command.cpp | 20 ++++----------------
 1 file changed, 4 insertions(+), 16 deletions(-)

diff --git a/flang/runtime/command.cpp b/flang/runtime/command.cpp
index b999d04eec7172c..4a8518b3d907b95 100644
--- a/flang/runtime/command.cpp
+++ b/flang/runtime/command.cpp
@@ -142,31 +142,19 @@ static bool FitsInDescriptor(
       kind, terminator, value);
 }
 
-void removeNewLine(char *str) {
-  char *newlinePos = std::strchr(str, '\n');
-  if (newlinePos) {
-    *newlinePos = '\0'; // Replace with null terminator
-  }
-}
-
 std::int32_t RTNAME(FDate)(const Descriptor *value, const Descriptor *errmsg) {
   FillWithSpaces(*value);
-
   std::time_t current_time;
   std::time(&current_time);
   std::array<char, 26> str;
-  // Day Mon dd hh:mm:ss yyyy\n is 26 character,
-  // e.g. Tue May 26 21:51:03 2015\n\0
+  // 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);
-  removeNewLine(str.data());
-  std::int64_t stringLen{StringLength(str.data())};
-  if (stringLen <= 0) {
-    return ToErrmsg(errmsg, StatMissingArgument);
-  }
+  str[24] = '\0'; // remove new line
 
   if (value) {
-    return CopyToDescriptor(*value, str.data(), stringLen, errmsg);
+    return CopyToDescriptor(*value, str.data(), 24, errmsg);
   }
 
   return StatOk;

>From 9589699dfa2b7472e566ab37eadee39446ea0d75 Mon Sep 17 00:00:00 2001
From: Yi Wu <yi.wu2 at arm.com>
Date: Fri, 10 Nov 2023 16:13:34 +0000
Subject: [PATCH 4/4] move to extension.cpp

---
 flang/include/flang/Runtime/command.h   |  5 ----
 flang/runtime/command.cpp               | 35 -------------------------
 flang/runtime/extensions.cpp            | 29 ++++++++++++++++++--
 flang/unittests/Runtime/CommandTest.cpp |  1 -
 4 files changed, 27 insertions(+), 43 deletions(-)

diff --git a/flang/include/flang/Runtime/command.h b/flang/include/flang/Runtime/command.h
index 07f6d8e169ead6c..ec6289390545479 100644
--- a/flang/include/flang/Runtime/command.h
+++ b/flang/include/flang/Runtime/command.h
@@ -23,11 +23,6 @@ extern "C" {
 // integer kind.
 std::int32_t RTNAME(ArgumentCount)();
 
-// Try to get the the current date (same format as CTIME: convert to a string)
-// Return a STATUS as described in the standard.
-std::int32_t RTNAME(FDate)(
-    const Descriptor *argument = nullptr, const Descriptor *errmsg = nullptr);
-
 // 16.9.82 GET_COMMAND
 // Try to get the value of the whole command. All of the parameters are
 // optional.
diff --git a/flang/runtime/command.cpp b/flang/runtime/command.cpp
index 4a8518b3d907b95..b81a0791c5e571b 100644
--- a/flang/runtime/command.cpp
+++ b/flang/runtime/command.cpp
@@ -13,25 +13,8 @@
 #include "tools.h"
 #include "flang/Runtime/descriptor.h"
 #include <cstdlib>
-#include <ctime>
 #include <limits>
 
-#ifdef _WIN32
-inline const char *ctime_alloc(
-    char *buffer, size_t bufsize, const time_t cur_time) {
-  int error = ctime_s(buffer, bufsize, &cur_time);
-  assert(error == 0 && "ctime_s returned an error");
-  return buffer;
-}
-#else
-inline const char *ctime_alloc(
-    char *buffer, size_t bufsize, const time_t cur_time) {
-  const char *res = ctime_r(&cur_time, buffer);
-  assert(res != nullptr && "ctime_s returned an error");
-  return res;
-}
-#endif
-
 namespace Fortran::runtime {
 std::int32_t RTNAME(ArgumentCount)() {
   int argc{executionEnvironment.argc};
@@ -142,24 +125,6 @@ static bool FitsInDescriptor(
       kind, terminator, value);
 }
 
-std::int32_t RTNAME(FDate)(const Descriptor *value, const Descriptor *errmsg) {
-  FillWithSpaces(*value);
-  std::time_t current_time;
-  std::time(&current_time);
-  std::array<char, 26> str;
-  // 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);
-  str[24] = '\0'; // remove new line
-
-  if (value) {
-    return CopyToDescriptor(*value, str.data(), 24, errmsg);
-  }
-
-  return StatOk;
-}
-
 std::int32_t RTNAME(GetCommandArgument)(std::int32_t n, const Descriptor *value,
     const Descriptor *length, const Descriptor *errmsg, const char *sourceFile,
     int line) {
diff --git a/flang/runtime/extensions.cpp b/flang/runtime/extensions.cpp
index 0142cac1d929d4d..88dcc938caf636f 100644
--- a/flang/runtime/extensions.cpp
+++ b/flang/runtime/extensions.cpp
@@ -13,6 +13,23 @@
 #include "flang/Runtime/command.h"
 #include "flang/Runtime/descriptor.h"
 #include "flang/Runtime/io-api.h"
+#include <ctime>
+
+#ifdef _WIN32
+inline const char *ctime_alloc(
+    char *buffer, size_t bufsize, const time_t cur_time) {
+  int error = ctime_s(buffer, bufsize, &cur_time);
+  assert(error == 0 && "ctime_s returned an error");
+  return buffer;
+}
+#else
+inline const char *ctime_alloc(
+    char *buffer, size_t bufsize, const time_t cur_time) {
+  const char *res = ctime_r(&cur_time, buffer);
+  assert(res != nullptr && "ctime_s returned an error");
+  return res;
+}
+#endif
 
 extern "C" {
 
@@ -31,8 +48,16 @@ void FORTRAN_PROCEDURE_NAME(flush)(const int &unit) {
 std::int32_t FORTRAN_PROCEDURE_NAME(iargc)() { return RTNAME(ArgumentCount)(); }
 
 void FORTRAN_PROCEDURE_NAME(fdate)(std::int8_t *arg, std::int64_t length) {
-  Descriptor value{*Descriptor::Create(1, length, arg, 0)};
-  (void)RTNAME(FDate)(&value, nullptr);
+  std::time_t current_time;
+  std::time(&current_time);
+  std::array<char, 26> str;
+  // 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);
+  str[24] = '\0'; // remove new line
+
+  strncpy(reinterpret_cast<char *>(arg), str.data(), length);
 }
 
 // CALL GETARG(N, ARG)
diff --git a/flang/unittests/Runtime/CommandTest.cpp b/flang/unittests/Runtime/CommandTest.cpp
index 091870e4baf1730..a0f50084f261338 100644
--- a/flang/unittests/Runtime/CommandTest.cpp
+++ b/flang/unittests/Runtime/CommandTest.cpp
@@ -297,7 +297,6 @@ TEST_F(SeveralArguments, ArgValueTooShort) {
   ASSERT_NE(tooShort, nullptr);
   EXPECT_EQ(RTNAME(GetCommandArgument)(1, tooShort.get()), -1);
   CheckDescriptorEqStr(tooShort.get(), severalArgsArgv[1]);
-  EXPECT_EQ(RTNAME(FDate)(tooShort.get()), -1);
 
   OwningPtr<Descriptor> length{EmptyIntDescriptor()};
   ASSERT_NE(length, nullptr);



More information about the flang-commits mailing list