[flang-commits] [flang] 959a430 - [flang] FDATE extension implementation: get date and time in ctime format (#71222)
via flang-commits
flang-commits at lists.llvm.org
Thu Jan 11 04:15:53 PST 2024
Author: Yi Wu
Date: 2024-01-11T12:15:48Z
New Revision: 959a430a8d5b7e77b3d88327f835d9f9b8a6842e
URL: https://github.com/llvm/llvm-project/commit/959a430a8d5b7e77b3d88327f835d9f9b8a6842e
DIFF: https://github.com/llvm/llvm-project/commit/959a430a8d5b7e77b3d88327f835d9f9b8a6842e.diff
LOG: [flang] FDATE extension implementation: get date and time in ctime format (#71222)
reference to gfortran fdate
https://gcc.gnu.org/onlinedocs/gfortran/FDATE.html
usage:
```fortran
CHARACTER(32) :: time
CALL fdate(time)
WRITE(*,*) time
```
fdate is used in the ECP proxy application
https://proxyapps.exascaleproject.org/app/minismac2d/
https://github.com/Mantevo/miniSMAC/blob/f90446714226eeef650b78bce06ca4967792e74d/ref/smac2d.f#L1570
`fdate` now produce the same result on flang, compare to gfortran, where
If the length is too short to fit completely, blank return.
```fortran
character(20) :: string
call fdate(string)
write(*, *) string, "X"
```
```bash
$ ../build-release/bin/flang-new test.f90
$ ./a.out
X
```
If length if larger than it requires(24), fill the rest of buffer space.
```fortran
character(30) :: string
call fdate(string)
write(*, *) string, "X"
```
```bash
$ ../build-release/bin/flang-new test.f90
$ ./a.out
Wed Nov 15 16:59:13 2023 X
```
The length value is hardcoded, because:
```c++
// Day Mon dd hh:mm:ss yyyy\n\0 is 26 characters, e.g.
// Tue May 26 21:51:03 2015\n\0
```
---------
Co-authored-by: Yi Wu <yiwu02 at wdev-yiwu02.arm.com>
Added:
Modified:
flang/docs/Intrinsics.md
flang/include/flang/Runtime/extensions.h
flang/runtime/extensions.cpp
flang/unittests/Runtime/CommandTest.cpp
Removed:
################################################################################
diff --git a/flang/docs/Intrinsics.md b/flang/docs/Intrinsics.md
index f5705eb440a750..190d98569c8656 100644
--- a/flang/docs/Intrinsics.md
+++ b/flang/docs/Intrinsics.md
@@ -697,6 +697,7 @@ MALLOC
### Library subroutine
```
+CALL FDATE(TIME)
CALL GETLOG(USRNAME)
```
@@ -759,7 +760,7 @@ This phase currently supports all the intrinsic procedures listed above but the
| Intrinsic subroutines |MVBITS (elemental), CPU_TIME, DATE_AND_TIME, EVENT_QUERY, EXECUTE_COMMAND_LINE, GET_COMMAND, GET_COMMAND_ARGUMENT, GET_ENVIRONMENT_VARIABLE, MOVE_ALLOC, RANDOM_INIT, RANDOM_NUMBER, RANDOM_SEED, SYSTEM_CLOCK |
| Atomic intrinsic subroutines | ATOMIC_ADD |
| Collective intrinsic subroutines | CO_REDUCE |
-| Library subroutines | GETLOG|
+| Library subroutines | FDATE, GETLOG |
### Intrinsic Function Folding
diff --git a/flang/include/flang/Runtime/extensions.h b/flang/include/flang/Runtime/extensions.h
index 175113c57ccb52..b34edb94ada43a 100644
--- a/flang/include/flang/Runtime/extensions.h
+++ b/flang/include/flang/Runtime/extensions.h
@@ -22,6 +22,9 @@ extern "C" {
// CALL FLUSH(n) antedates the Fortran 2003 FLUSH statement.
void FORTRAN_PROCEDURE_NAME(flush)(const int &unit);
+// GNU extension subroutine FDATE
+void FORTRAN_PROCEDURE_NAME(fdate)(char *string, std::int64_t length);
+
// GNU Fortran 77 compatibility function IARGC.
std::int32_t FORTRAN_PROCEDURE_NAME(iargc)();
diff --git a/flang/runtime/extensions.cpp b/flang/runtime/extensions.cpp
index 1c025d40b39524..8fc132aeff4ee1 100644
--- a/flang/runtime/extensions.cpp
+++ b/flang/runtime/extensions.cpp
@@ -10,10 +10,33 @@
// extensions that will eventually be implemented in Fortran.
#include "flang/Runtime/extensions.h"
+#include "terminator.h"
#include "tools.h"
#include "flang/Runtime/command.h"
#include "flang/Runtime/descriptor.h"
#include "flang/Runtime/io-api.h"
+#include <ctime>
+
+#ifdef _WIN32
+inline void CtimeBuffer(char *buffer, size_t bufsize, const time_t cur_time,
+ Fortran::runtime::Terminator terminator) {
+ int error{ctime_s(buffer, bufsize, &cur_time)};
+ RUNTIME_CHECK(terminator, error == 0);
+}
+#elif _POSIX_C_SOURCE >= 1 || _XOPEN_SOURCE || _BSD_SOURCE || _SVID_SOURCE || \
+ _POSIX_SOURCE
+inline void CtimeBuffer(char *buffer, size_t bufsize, const time_t cur_time,
+ Fortran::runtime::Terminator terminator) {
+ const char *res{ctime_r(&cur_time, buffer)};
+ RUNTIME_CHECK(terminator, res != nullptr);
+}
+#else
+inline void CtimeBuffer(char *buffer, size_t bufsize, const time_t cur_time,
+ Fortran::runtime::Terminator terminator) {
+ buffer[0] = '\0';
+ terminator.Crash("fdate is not supported.");
+}
+#endif
#if _REENTRANT || _POSIX_C_SOURCE >= 199506L
// System is posix-compliant and has getlogin_r
@@ -43,6 +66,26 @@ void FORTRAN_PROCEDURE_NAME(flush)(const int &unit) {
}
} // namespace io
+// CALL FDATE(DATE)
+void FORTRAN_PROCEDURE_NAME(fdate)(char *arg, std::int64_t length) {
+ // Day Mon dd hh:mm:ss yyyy\n\0 is 26 characters, e.g.
+ // Tue May 26 21:51:03 2015\n\0
+ char str[26];
+ // Insufficient space, fill with spaces and return.
+ if (length < 24) {
+ std::memset(arg, ' ', length);
+ return;
+ }
+
+ Terminator terminator{__FILE__, __LINE__};
+ std::time_t current_time;
+ std::time(¤t_time);
+ CtimeBuffer(str, sizeof(str), current_time, terminator);
+
+ // Pad space on the last two byte `\n\0`, start at index 24 included.
+ CopyAndPad(arg, str, length, 24);
+}
+
// RESULT = IARGC()
std::int32_t FORTRAN_PROCEDURE_NAME(iargc)() { return RTNAME(ArgumentCount)(); }
diff --git a/flang/unittests/Runtime/CommandTest.cpp b/flang/unittests/Runtime/CommandTest.cpp
index 50b11d7fe8a0d5..30574dcbdda19d 100644
--- a/flang/unittests/Runtime/CommandTest.cpp
+++ b/flang/unittests/Runtime/CommandTest.cpp
@@ -232,6 +232,62 @@ class NoArgv : public CommandFixture {
NoArgv() : CommandFixture(0, nullptr) {}
};
+#if _WIN32 || _POSIX_C_SOURCE >= 1 || _XOPEN_SOURCE || _BSD_SOURCE || \
+ _SVID_SOURCE || _POSIX_SOURCE
+TEST_F(NoArgv, FdateGetDate) {
+ char input[]{"24LengthCharIsJustRight"};
+ const std::size_t charLen = sizeof(input);
+
+ FORTRAN_PROCEDURE_NAME(fdate)(input, charLen);
+
+ // Tue May 26 21:51:03 2015\n\0
+ // index at 3, 7, 10, 19 should be space
+ // when date is less than two digit, index 8 would be space
+ // Tue May 6 21:51:03 2015\n\0
+ for (std::size_t i{0}; i < charLen; i++) {
+ if (i == 8)
+ continue;
+ if (i == 3 || i == 7 || i == 10 || i == 19) {
+ EXPECT_EQ(input[i], ' ');
+ continue;
+ }
+ EXPECT_NE(input[i], ' ');
+ }
+}
+
+TEST_F(NoArgv, FdateGetDateTooShort) {
+ char input[]{"TooShortAllPadSpace"};
+ const std::size_t charLen = sizeof(input);
+
+ FORTRAN_PROCEDURE_NAME(fdate)(input, charLen);
+
+ for (std::size_t i{0}; i < charLen; i++) {
+ EXPECT_EQ(input[i], ' ');
+ }
+}
+
+TEST_F(NoArgv, FdateGetDatePadSpace) {
+ char input[]{"All char after 23 pad spaces"};
+ const std::size_t charLen = sizeof(input);
+
+ FORTRAN_PROCEDURE_NAME(fdate)(input, charLen);
+
+ for (std::size_t i{24}; i < charLen; i++) {
+ EXPECT_EQ(input[i], ' ');
+ }
+}
+
+#else
+TEST_F(NoArgv, FdateNotSupported) {
+ char input[]{"No change due to crash"};
+
+ EXPECT_DEATH(FORTRAN_PROCEDURE_NAME(fdate)(input, sizeof(input)),
+ "fdate is not supported.");
+
+ CheckCharEqStr(input, "No change due to crash");
+}
+#endif
+
// TODO: Test other intrinsics with this fixture.
TEST_F(NoArgv, GetCommand) { CheckMissingCommandValue(); }
More information about the flang-commits
mailing list