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

Yi Wu via cfe-commits cfe-commits at lists.llvm.org
Thu Dec 7 09:19:07 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 01/10] 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 ab0a940e53e55..982be82081642 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 ec62893905454..07f6d8e169ead 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 ad592814e5acb..92b9907860121 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 b81a0791c5e57..da0803c39f49b 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 b8e9b6eae1320..0142cac1d929d 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 c3571c9684e4b..091870e4baf17 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 02/10] 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 da0803c39f49b..b999d04eec717 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 03/10] 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 b999d04eec717..4a8518b3d907b 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 04/10] 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 07f6d8e169ead..ec62893905454 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 4a8518b3d907b..b81a0791c5e57 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 0142cac1d929d..88dcc938caf63 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 091870e4baf17..a0f50084f2613 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 05/10] 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 88dcc938caf63..789bc6a33c6b9 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 06/10] 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 650c02436ee49..a0c863712131b 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 789bc6a33c6b9..447ff3b0962f2 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 68d63253139f1..252d4d727d157 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 fbabe5e077d80368747b2c52d7d9a31ef64b206a 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 07/10] 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 447ff3b0962f2..178f85e45f708 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" {

>From 091c6f923ffd4b3347b235dde9f36e8ae7fd1680 Mon Sep 17 00:00:00 2001
From: Yi Wu <yi.wu2 at arm.com>
Date: Thu, 23 Nov 2023 14:38:30 +0000
Subject: [PATCH 08/10] brace-initialization

---
 flang/runtime/extensions.cpp | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/flang/runtime/extensions.cpp b/flang/runtime/extensions.cpp
index 178f85e45f708..c567c0f143a97 100644
--- a/flang/runtime/extensions.cpp
+++ b/flang/runtime/extensions.cpp
@@ -20,14 +20,14 @@
 #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);
+  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 ctime_alloc(char *buffer, size_t bufsize, const time_t cur_time,
     Fortran::runtime::Terminator terminator) {
-  const char *res = ctime_r(&cur_time, buffer);
+  const char *res{ctime_r(&cur_time, buffer)};
   RUNTIME_CHECK(terminator, res != nullptr);
 }
 #else

>From 5ba4f6e95f479c80f840fd429fd1e3f4bcfaeaff Mon Sep 17 00:00:00 2001
From: Yi Wu <yi.wu2 at arm.com>
Date: Thu, 7 Dec 2023 17:03:03 +0000
Subject: [PATCH 09/10] add proper tests

---
 flang/include/flang/Runtime/extensions.h |  5 ++-
 flang/runtime/extensions.cpp             |  7 ++--
 flang/unittests/Runtime/CommandTest.cpp  | 50 ++++++++++++++++++------
 3 files changed, 44 insertions(+), 18 deletions(-)

diff --git a/flang/include/flang/Runtime/extensions.h b/flang/include/flang/Runtime/extensions.h
index 92b9907860121..ed2fdd0b5a25b 100644
--- a/flang/include/flang/Runtime/extensions.h
+++ b/flang/include/flang/Runtime/extensions.h
@@ -21,11 +21,12 @@ 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)(std::int8_t *string, std::int64_t length);
+
 // 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/extensions.cpp b/flang/runtime/extensions.cpp
index c567c0f143a97..9af810cdadf7c 100644
--- a/flang/runtime/extensions.cpp
+++ b/flang/runtime/extensions.cpp
@@ -51,9 +51,7 @@ void FORTRAN_PROCEDURE_NAME(flush)(const int &unit) {
 }
 } // namespace io
 
-// RESULT = IARGC()
-std::int32_t FORTRAN_PROCEDURE_NAME(iargc)() { return RTNAME(ArgumentCount)(); }
-
+// CALL FDATE(DATE)
 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) {
@@ -72,6 +70,9 @@ void FORTRAN_PROCEDURE_NAME(fdate)(std::int8_t *arg, std::int64_t length) {
   copyBufferAndPad(reinterpret_cast<char *>(arg), length, str.data(), 24);
 }
 
+// RESULT = IARGC()
+std::int32_t FORTRAN_PROCEDURE_NAME(iargc)() { return RTNAME(ArgumentCount)(); }
+
 // 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 aac65faf8c42c..88b13dc66d8ca 100644
--- a/flang/unittests/Runtime/CommandTest.cpp
+++ b/flang/unittests/Runtime/CommandTest.cpp
@@ -10,6 +10,7 @@
 #include "gmock/gmock.h"
 #include "gtest/gtest.h"
 #include "flang/Runtime/descriptor.h"
+#include "flang/Runtime/extensions.h"
 #include "flang/Runtime/main.h"
 #include <cstdlib>
 
@@ -207,6 +208,42 @@ class NoArgv : public CommandFixture {
   NoArgv() : CommandFixture(0, nullptr) {}
 };
 
+TEST_F(NoArgv, FdateGetDate) {
+  const int charLen{24};
+  char input[charLen]{"24LengthCharIsJustRight"};
+
+  FORTRAN_PROCEDURE_NAME(fdate)
+  (reinterpret_cast<std::int8_t *>(input), charLen);
+
+  for (int i{0}; i < charLen; i++) {
+    EXPECT_NE(input[i], '\n');
+  }
+}
+
+TEST_F(NoArgv, FdateGetDateTooShort) {
+  const int charLen{23};
+  char input[charLen]{"TooShortAllPadSpace"};
+
+  FORTRAN_PROCEDURE_NAME(fdate)
+  (reinterpret_cast<std::int8_t *>(input), charLen);
+
+  for (int i{0}; i < charLen; i++) {
+    EXPECT_EQ(input[i], ' ');
+  }
+}
+
+TEST_F(NoArgv, FdateGetDatePadSpace) {
+  const int charLen{29};
+  char input[charLen]{"All char after 23 pad spaces"};
+
+  FORTRAN_PROCEDURE_NAME(fdate)
+  (reinterpret_cast<std::int8_t *>(input), charLen);
+
+  for (int i{24}; i < charLen; i++) {
+    EXPECT_EQ(input[i], ' ');
+  }
+}
+
 // TODO: Test other intrinsics with this fixture.
 
 TEST_F(NoArgv, GetCommand) { CheckMissingCommandValue(); }
@@ -225,12 +262,6 @@ 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"};
@@ -248,13 +279,6 @@ 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[]{

>From 8f15c8c5ae0adf0c8dfd7d7769fe2e38e4f7877b Mon Sep 17 00:00:00 2001
From: Yi Wu <yi.wu2 at arm.com>
Date: Thu, 7 Dec 2023 17:03:21 +0000
Subject: [PATCH 10/10] Revert "use copyBufferAndPad instead of str.fill and
 std::memcpy" and use CopyAndPad from character.h instead

This reverts commit 344cbdc99ffef78702c11fb6c0c76ef35d198524.
---
 flang/include/flang/Runtime/character.h      | 31 ++++++++++++++++++++
 flang/include/flang/Runtime/time-intrinsic.h | 11 -------
 flang/runtime/character.cpp                  | 21 -------------
 flang/runtime/extensions.cpp                 |  8 ++---
 flang/runtime/time-intrinsic.cpp             | 24 +++++++--------
 5 files changed, 46 insertions(+), 49 deletions(-)

diff --git a/flang/include/flang/Runtime/character.h b/flang/include/flang/Runtime/character.h
index 24f26920bdd2c..43dfb518f6f58 100644
--- a/flang/include/flang/Runtime/character.h
+++ b/flang/include/flang/Runtime/character.h
@@ -6,6 +6,37 @@
 //
 //===----------------------------------------------------------------------===//
 
+// character.h
+#ifndef CHARACTER_H
+#define CHARACTER_H
+
+#include <cstddef>
+#include <algorithm>
+#include <cstring>
+
+template <typename TO, typename FROM>
+void CopyAndPad(
+    TO *to, const FROM *from, std::size_t toChars, std::size_t fromChars) {
+  if constexpr (sizeof(TO) != sizeof(FROM)) {
+    std::size_t copyChars{std::min(toChars, fromChars)};
+    for (std::size_t j{0}; j < copyChars; ++j) {
+      to[j] = from[j];
+    }
+    for (std::size_t j{copyChars}; j < toChars; ++j) {
+      to[j] = static_cast<TO>(' ');
+    }
+  } else if (toChars <= fromChars) {
+    std::memcpy(to, from, toChars * sizeof(TO));
+  } else {
+    std::memcpy(to, from, std::min(toChars,fromChars) * sizeof(TO));
+    for (std::size_t j{fromChars}; j < toChars; ++j) {
+      to[j] = static_cast<TO>(' ');
+    }
+  }
+}
+
+#endif // CHARACTER_H
+
 // Defines API between compiled code and the CHARACTER
 // support functions in the runtime library.
 
diff --git a/flang/include/flang/Runtime/time-intrinsic.h b/flang/include/flang/Runtime/time-intrinsic.h
index a0c863712131b..650c02436ee49 100644
--- a/flang/include/flang/Runtime/time-intrinsic.h
+++ b/flang/include/flang/Runtime/time-intrinsic.h
@@ -9,17 +9,6 @@
 // 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/character.cpp b/flang/runtime/character.cpp
index dd522f19a7ede..90d68553354a7 100644
--- a/flang/runtime/character.cpp
+++ b/flang/runtime/character.cpp
@@ -461,27 +461,6 @@ static void GeneralCharFuncKind(Descriptor &result, const Descriptor &string,
   }
 }
 
-template <typename TO, typename FROM>
-static void CopyAndPad(
-    TO *to, const FROM *from, std::size_t toChars, std::size_t fromChars) {
-  if constexpr (sizeof(TO) != sizeof(FROM)) {
-    std::size_t copyChars{std::min(toChars, fromChars)};
-    for (std::size_t j{0}; j < copyChars; ++j) {
-      to[j] = from[j];
-    }
-    for (std::size_t j{copyChars}; j < toChars; ++j) {
-      to[j] = static_cast<TO>(' ');
-    }
-  } else if (toChars <= fromChars) {
-    std::memcpy(to, from, toChars * sizeof(TO));
-  } else {
-    std::memcpy(to, from, fromChars * sizeof(TO));
-    for (std::size_t j{fromChars}; j < toChars; ++j) {
-      to[j] = static_cast<TO>(' ');
-    }
-  }
-}
-
 template <typename CHAR, bool ISMIN>
 static void MaxMinHelper(Descriptor &accumulator, const Descriptor &x,
     const Terminator &terminator) {
diff --git a/flang/runtime/extensions.cpp b/flang/runtime/extensions.cpp
index 9af810cdadf7c..f2430ffaa906e 100644
--- a/flang/runtime/extensions.cpp
+++ b/flang/runtime/extensions.cpp
@@ -11,10 +11,10 @@
 
 #include "flang/Runtime/extensions.h"
 #include "terminator.h"
+#include "flang/Runtime/character.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
@@ -53,13 +53,13 @@ void FORTRAN_PROCEDURE_NAME(flush)(const int &unit) {
 
 // CALL FDATE(DATE)
 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) {
-    copyBufferAndPad(reinterpret_cast<char *>(arg), length, nullptr, 0);
+    std::memset(reinterpret_cast<char *>(arg), ' ', length);
     return;
   }
 
-  std::array<char, 26> str;
   Terminator terminator{__FILE__, __LINE__};
   std::time_t current_time;
   std::time(&current_time);
@@ -67,7 +67,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);
-  copyBufferAndPad(reinterpret_cast<char *>(arg), length, str.data(), 24);
+  CopyAndPad(reinterpret_cast<char *>(arg), str.data(), length, 24);
 }
 
 // RESULT = IARGC()
diff --git a/flang/runtime/time-intrinsic.cpp b/flang/runtime/time-intrinsic.cpp
index 252d4d727d157..68d63253139f1 100644
--- a/flang/runtime/time-intrinsic.cpp
+++ b/flang/runtime/time-intrinsic.cpp
@@ -39,16 +39,6 @@
 // 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
@@ -289,21 +279,29 @@ 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, buffer, len);
+    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, buffer, len);
+    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, buffer, len);
+    copyBufferAndPad(zone, zoneChars, len);
   }
   if (values) {
     auto typeCode{values->type().GetCategoryAndKind()};



More information about the cfe-commits mailing list