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....@arm.com> Date: Mon, 6 Nov 2023 19:55:06 +0000 Subject: [PATCH 1/4] 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....@arm.com> Date: Fri, 10 Nov 2023 12:44:53 +0000 Subject: [PATCH 2/4] 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....@arm.com> Date: Fri, 10 Nov 2023 15:52:20 +0000 Subject: [PATCH 3/4] 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....@arm.com> Date: Fri, 10 Nov 2023 16:13:34 +0000 Subject: [PATCH 4/4] 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); _______________________________________________ cfe-commits mailing list cfe-commits@lists.llvm.org https://lists.llvm.org/cgi-bin/mailman/listinfo/cfe-commits
