Skip to content

Commit 959a430

Browse files
yiwu0b11Yi Wu
and
Yi Wu
authored
[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@wdev-yiwu02.arm.com>
1 parent cc53ec8 commit 959a430

File tree

4 files changed

+104
-1
lines changed

4 files changed

+104
-1
lines changed

flang/docs/Intrinsics.md

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -697,6 +697,7 @@ MALLOC
697697

698698
### Library subroutine
699699
```
700+
CALL FDATE(TIME)
700701
CALL GETLOG(USRNAME)
701702
```
702703

@@ -759,7 +760,7 @@ This phase currently supports all the intrinsic procedures listed above but the
759760
| 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 |
760761
| Atomic intrinsic subroutines | ATOMIC_ADD |
761762
| Collective intrinsic subroutines | CO_REDUCE |
762-
| Library subroutines | GETLOG|
763+
| Library subroutines | FDATE, GETLOG |
763764

764765

765766
### Intrinsic Function Folding

flang/include/flang/Runtime/extensions.h

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -22,6 +22,9 @@ extern "C" {
2222
// CALL FLUSH(n) antedates the Fortran 2003 FLUSH statement.
2323
void FORTRAN_PROCEDURE_NAME(flush)(const int &unit);
2424

25+
// GNU extension subroutine FDATE
26+
void FORTRAN_PROCEDURE_NAME(fdate)(char *string, std::int64_t length);
27+
2528
// GNU Fortran 77 compatibility function IARGC.
2629
std::int32_t FORTRAN_PROCEDURE_NAME(iargc)();
2730

flang/runtime/extensions.cpp

Lines changed: 43 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -10,10 +10,33 @@
1010
// extensions that will eventually be implemented in Fortran.
1111

1212
#include "flang/Runtime/extensions.h"
13+
#include "terminator.h"
1314
#include "tools.h"
1415
#include "flang/Runtime/command.h"
1516
#include "flang/Runtime/descriptor.h"
1617
#include "flang/Runtime/io-api.h"
18+
#include <ctime>
19+
20+
#ifdef _WIN32
21+
inline void CtimeBuffer(char *buffer, size_t bufsize, const time_t cur_time,
22+
Fortran::runtime::Terminator terminator) {
23+
int error{ctime_s(buffer, bufsize, &cur_time)};
24+
RUNTIME_CHECK(terminator, error == 0);
25+
}
26+
#elif _POSIX_C_SOURCE >= 1 || _XOPEN_SOURCE || _BSD_SOURCE || _SVID_SOURCE || \
27+
_POSIX_SOURCE
28+
inline void CtimeBuffer(char *buffer, size_t bufsize, const time_t cur_time,
29+
Fortran::runtime::Terminator terminator) {
30+
const char *res{ctime_r(&cur_time, buffer)};
31+
RUNTIME_CHECK(terminator, res != nullptr);
32+
}
33+
#else
34+
inline void CtimeBuffer(char *buffer, size_t bufsize, const time_t cur_time,
35+
Fortran::runtime::Terminator terminator) {
36+
buffer[0] = '\0';
37+
terminator.Crash("fdate is not supported.");
38+
}
39+
#endif
1740

1841
#if _REENTRANT || _POSIX_C_SOURCE >= 199506L
1942
// System is posix-compliant and has getlogin_r
@@ -43,6 +66,26 @@ void FORTRAN_PROCEDURE_NAME(flush)(const int &unit) {
4366
}
4467
} // namespace io
4568

69+
// CALL FDATE(DATE)
70+
void FORTRAN_PROCEDURE_NAME(fdate)(char *arg, std::int64_t length) {
71+
// Day Mon dd hh:mm:ss yyyy\n\0 is 26 characters, e.g.
72+
// Tue May 26 21:51:03 2015\n\0
73+
char str[26];
74+
// Insufficient space, fill with spaces and return.
75+
if (length < 24) {
76+
std::memset(arg, ' ', length);
77+
return;
78+
}
79+
80+
Terminator terminator{__FILE__, __LINE__};
81+
std::time_t current_time;
82+
std::time(&current_time);
83+
CtimeBuffer(str, sizeof(str), current_time, terminator);
84+
85+
// Pad space on the last two byte `\n\0`, start at index 24 included.
86+
CopyAndPad(arg, str, length, 24);
87+
}
88+
4689
// RESULT = IARGC()
4790
std::int32_t FORTRAN_PROCEDURE_NAME(iargc)() { return RTNAME(ArgumentCount)(); }
4891

flang/unittests/Runtime/CommandTest.cpp

Lines changed: 56 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -232,6 +232,62 @@ class NoArgv : public CommandFixture {
232232
NoArgv() : CommandFixture(0, nullptr) {}
233233
};
234234

235+
#if _WIN32 || _POSIX_C_SOURCE >= 1 || _XOPEN_SOURCE || _BSD_SOURCE || \
236+
_SVID_SOURCE || _POSIX_SOURCE
237+
TEST_F(NoArgv, FdateGetDate) {
238+
char input[]{"24LengthCharIsJustRight"};
239+
const std::size_t charLen = sizeof(input);
240+
241+
FORTRAN_PROCEDURE_NAME(fdate)(input, charLen);
242+
243+
// Tue May 26 21:51:03 2015\n\0
244+
// index at 3, 7, 10, 19 should be space
245+
// when date is less than two digit, index 8 would be space
246+
// Tue May 6 21:51:03 2015\n\0
247+
for (std::size_t i{0}; i < charLen; i++) {
248+
if (i == 8)
249+
continue;
250+
if (i == 3 || i == 7 || i == 10 || i == 19) {
251+
EXPECT_EQ(input[i], ' ');
252+
continue;
253+
}
254+
EXPECT_NE(input[i], ' ');
255+
}
256+
}
257+
258+
TEST_F(NoArgv, FdateGetDateTooShort) {
259+
char input[]{"TooShortAllPadSpace"};
260+
const std::size_t charLen = sizeof(input);
261+
262+
FORTRAN_PROCEDURE_NAME(fdate)(input, charLen);
263+
264+
for (std::size_t i{0}; i < charLen; i++) {
265+
EXPECT_EQ(input[i], ' ');
266+
}
267+
}
268+
269+
TEST_F(NoArgv, FdateGetDatePadSpace) {
270+
char input[]{"All char after 23 pad spaces"};
271+
const std::size_t charLen = sizeof(input);
272+
273+
FORTRAN_PROCEDURE_NAME(fdate)(input, charLen);
274+
275+
for (std::size_t i{24}; i < charLen; i++) {
276+
EXPECT_EQ(input[i], ' ');
277+
}
278+
}
279+
280+
#else
281+
TEST_F(NoArgv, FdateNotSupported) {
282+
char input[]{"No change due to crash"};
283+
284+
EXPECT_DEATH(FORTRAN_PROCEDURE_NAME(fdate)(input, sizeof(input)),
285+
"fdate is not supported.");
286+
287+
CheckCharEqStr(input, "No change due to crash");
288+
}
289+
#endif
290+
235291
// TODO: Test other intrinsics with this fixture.
236292

237293
TEST_F(NoArgv, GetCommand) { CheckMissingCommandValue(); }

0 commit comments

Comments
 (0)