[flang-commits] [llvm] [flang] [clang-tools-extra] [clang] [flang] FDATE extension implementation: get date and time in ctime format (PR #71222)
Yi Wu via flang-commits
flang-commits at lists.llvm.org
Wed Nov 15 09:56:01 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/5] 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(¤t_time);
+
+ char *time_string = ctime(¤t_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/5] 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(¤t_time);
+ std::time_t current_time;
+ std::time(¤t_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(¤t_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/5] 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(¤t_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/5] 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(¤t_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(¤t_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/5] 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(¤t_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);
}
More information about the flang-commits
mailing list