[lldb] [libc] [flang] [clang-tools-extra] [compiler-rt] [llvm] [libcxx] [clang] [flang] FDATE extension implementation: get date and time in ctime format (PR #71222)

Yi Wu via cfe-commits cfe-commits at lists.llvm.org
Tue Nov 21 05:13:00 PST 2023 

https://github.com/yi-wu-arm 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/7] 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/7] 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/7] 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/7] 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);

>From 510ada5eff103d19ec01b3725d8ddcd2901d728b Mon Sep 17 00:00:00 2001
From: Yi Wu <yi.wu2 at arm.com>
Date: Wed, 15 Nov 2023 16:54:11 +0000
Subject: [PATCH 5/7] emit fortran runtime error on failure, fill in spac

If the length is too short to fit completely, blank return.
If length if larger than it requires(24), fill the rest of buffer space.
hange the return type of `ctime_alloc` from char * to void, because we
don't need the return value.
---
 flang/runtime/extensions.cpp | 29 ++++++++++++++++++-----------
 1 file changed, 18 insertions(+), 11 deletions(-)

diff --git a/flang/runtime/extensions.cpp b/flang/runtime/extensions.cpp
index 88dcc938caf636f..789bc6a33c6b9ac 100644
--- a/flang/runtime/extensions.cpp
+++ b/flang/runtime/extensions.cpp
@@ -10,24 +10,23 @@
 // 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 <ctime>
 
 #ifdef _WIN32
-inline const char *ctime_alloc(
-    char *buffer, size_t bufsize, const time_t cur_time) {
+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);
-  assert(error == 0 && "ctime_s returned an error");
-  return buffer;
+  RUNTIME_CHECK(terminator, error == 0);
 }
 #else
-inline const char *ctime_alloc(
-    char *buffer, size_t bufsize, const time_t cur_time) {
+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);
-  assert(res != nullptr && "ctime_s returned an error");
-  return res;
+  RUNTIME_CHECK(terminator, res != nullptr);
 }
 #endif
 
@@ -48,15 +47,23 @@ 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) {
+  std::array<char, 26> str;
+  // If the length is too short to fit completely, blank return.
+  if (length < 24) {
+    str.fill(' ');
+    strncpy(reinterpret_cast<char *>(arg), str.data(), length);
+    return;
+  }
+
+  Terminator terminator{__FILE__, __LINE__};
   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
+  ctime_alloc(str.data(), str.size(), current_time, terminator);
 
+  std::fill(str.begin() + 24, str.begin() + length, ' ');
   strncpy(reinterpret_cast<char *>(arg), str.data(), length);
 }
 

>From 344cbdc99ffef78702c11fb6c0c76ef35d198524 Mon Sep 17 00:00:00 2001
From: Yi Wu <yiwu02 at wdev-yiwu02.arm.com>
Date: Thu, 16 Nov 2023 13:20:07 +0000
Subject: [PATCH 6/7] use copyBufferAndPad instead of str.fill and std::memcpy

Take copyBufferAndPad out of anonymous namespace and declear
in header file.
---
 flang/include/flang/Runtime/time-intrinsic.h | 11 +++++++++
 flang/runtime/extensions.cpp                 | 10 ++++----
 flang/runtime/time-intrinsic.cpp             | 24 +++++++++++---------
 3 files changed, 28 insertions(+), 17 deletions(-)

diff --git a/flang/include/flang/Runtime/time-intrinsic.h b/flang/include/flang/Runtime/time-intrinsic.h
index 650c02436ee49ea..a0c863712131b5c 100644
--- a/flang/include/flang/Runtime/time-intrinsic.h
+++ b/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_
 
diff --git a/flang/runtime/extensions.cpp b/flang/runtime/extensions.cpp
index 789bc6a33c6b9ac..447ff3b0962f272 100644
--- a/flang/runtime/extensions.cpp
+++ b/flang/runtime/extensions.cpp
@@ -14,6 +14,7 @@
 #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
@@ -47,14 +48,13 @@ 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) {
-  std::array<char, 26> str;
   // If the length is too short to fit completely, blank return.
   if (length < 24) {
-    str.fill(' ');
-    strncpy(reinterpret_cast<char *>(arg), str.data(), length);
+    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);
@@ -62,9 +62,7 @@ void FORTRAN_PROCEDURE_NAME(fdate)(std::int8_t *arg, std::int64_t length) {
   // Tue May 26 21:51:03 2015\n\0
 
   ctime_alloc(str.data(), str.size(), current_time, terminator);
-
-  std::fill(str.begin() + 24, str.begin() + length, ' ');
-  strncpy(reinterpret_cast<char *>(arg), str.data(), length);
+  copyBufferAndPad(reinterpret_cast<char *>(arg), length, str.data(), 24);
 }
 
 // CALL GETARG(N, ARG)
diff --git a/flang/runtime/time-intrinsic.cpp b/flang/runtime/time-intrinsic.cpp
index 68d63253139f18a..252d4d727d157da 100644
--- a/flang/runtime/time-intrinsic.cpp
+++ b/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()};

>From 76cbd981a9d8cf5fc0ef6a5e14cc04937de3ff32 Mon Sep 17 00:00:00 2001
From: Yi Wu <yi.wu2 at arm.com>
Date: Tue, 21 Nov 2023 13:12:06 +0000
Subject: [PATCH 7/7] add POSIX macros check and fallback

---
 flang/runtime/extensions.cpp | 9 ++++++++-
 1 file changed, 8 insertions(+), 1 deletion(-)

diff --git a/flang/runtime/extensions.cpp b/flang/runtime/extensions.cpp
index 447ff3b0962f272..178f85e45f708d5 100644
--- a/flang/runtime/extensions.cpp
+++ b/flang/runtime/extensions.cpp
@@ -23,12 +23,19 @@ inline void ctime_alloc(char *buffer, size_t bufsize, const time_t cur_time,
   int error = ctime_s(buffer, bufsize, &cur_time);
   RUNTIME_CHECK(terminator, error == 0);
 }
-#else
+#elif _POSIX_C_SOURCE >= 1 || _XOPEN_SOURCE || _BSD_SOURCE || _SVID_SOURCE || \
+    _POSIX_SOURCE
 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);
 }
+#else
+inline void ctime_alloc(char *buffer, size_t bufsize, const time_t cur_time,
+    Fortran::runtime::Terminator terminator) {
+  buffer[0] = '\0';
+  terminator.Crash("fdate is not supported.");
+}
 #endif
 
 extern "C" {

More information about the cfe-commits mailing list