diff --git a/flang/docs/Intrinsics.md b/flang/docs/Intrinsics.md index fef2b4ea4dd8c..189920a0881b2 100644 --- a/flang/docs/Intrinsics.md +++ b/flang/docs/Intrinsics.md @@ -695,6 +695,11 @@ CACHESIZE, EOF, FP_CLASS, INT_PTR_KIND, ISNAN, LOC MALLOC ``` +### Library subroutine +``` +CALL GETLOG(USRNAME) +``` + ## Intrinsic Procedure Name Resolution When the name of a procedure in a program is the same as the one of an intrinsic @@ -754,6 +759,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| ### Intrinsic Function Folding diff --git a/flang/include/flang/Runtime/extensions.h b/flang/include/flang/Runtime/extensions.h index ad592814e5acb..175113c57ccb5 100644 --- a/flang/include/flang/Runtime/extensions.h +++ b/flang/include/flang/Runtime/extensions.h @@ -14,6 +14,7 @@ #define FORTRAN_PROCEDURE_NAME(name) name##_ +#include #include extern "C" { @@ -28,5 +29,8 @@ std::int32_t FORTRAN_PROCEDURE_NAME(iargc)(); void FORTRAN_PROCEDURE_NAME(getarg)( std::int32_t &n, std::int8_t *arg, std::int64_t length); +// GNU extension subroutine GETLOG(C). +void FORTRAN_PROCEDURE_NAME(getlog)(std::byte *name, std::int64_t length); + } // extern "C" #endif // FORTRAN_RUNTIME_EXTENSIONS_H_ diff --git a/flang/runtime/character.cpp b/flang/runtime/character.cpp index 2afde7cd5e833..084aa0c9c8b64 100644 --- a/flang/runtime/character.cpp +++ b/flang/runtime/character.cpp @@ -11,6 +11,7 @@ #include "tools.h" #include "flang/Common/bit-population-count.h" #include "flang/Common/uint128.h" +#include "flang/Runtime/character.h" #include "flang/Runtime/cpp-type.h" #include "flang/Runtime/descriptor.h" #include @@ -464,27 +465,6 @@ static void GeneralCharFuncKind(Descriptor &result, const Descriptor &string, } } -template -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(' '); - } - } 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(' '); - } - } -} - template static void MaxMinHelper(Descriptor &accumulator, const Descriptor &x, const Terminator &terminator) { diff --git a/flang/runtime/extensions.cpp b/flang/runtime/extensions.cpp index b8e9b6eae1320..1c025d40b3952 100644 --- a/flang/runtime/extensions.cpp +++ b/flang/runtime/extensions.cpp @@ -10,13 +10,29 @@ // extensions that will eventually be implemented in Fortran. #include "flang/Runtime/extensions.h" +#include "tools.h" #include "flang/Runtime/command.h" #include "flang/Runtime/descriptor.h" #include "flang/Runtime/io-api.h" +#if _REENTRANT || _POSIX_C_SOURCE >= 199506L +// System is posix-compliant and has getlogin_r +#include +#endif + extern "C" { namespace Fortran::runtime { + +void GetUsernameEnvVar( + const char *envName, std::byte *arg, std::int64_t length) { + Descriptor name{*Descriptor::Create( + 1, std::strlen(envName) + 1, const_cast(envName), 0)}; + Descriptor value{*Descriptor::Create(1, length, arg, 0)}; + + RTNAME(GetEnvVariable) + (name, &value, nullptr, false, nullptr, __FILE__, __LINE__); +} namespace io { // SUBROUTINE FLUSH(N) // FLUSH N @@ -37,5 +53,28 @@ void FORTRAN_PROCEDURE_NAME(getarg)( (void)RTNAME(GetCommandArgument)( n, &value, nullptr, nullptr, __FILE__, __LINE__); } + +// CALL GETLOG(USRNAME) +void FORTRAN_PROCEDURE_NAME(getlog)(std::byte *arg, std::int64_t length) { +#if _REENTRANT || _POSIX_C_SOURCE >= 199506L + const int nameMaxLen{LOGIN_NAME_MAX + 1}; + char str[nameMaxLen]; + + int error{getlogin_r(str, nameMaxLen)}; + if (error == 0) { + // no error: find first \0 in string then pad from there + CopyAndPad(reinterpret_cast(arg), str, length, std::strlen(str)); + } else { + // error occur: get username from environment variable + GetUsernameEnvVar("LOGNAME", arg, length); + } +#elif _WIN32 + // Get username from environment to avoid link to Advapi32.lib + GetUsernameEnvVar("USERNAME", arg, length); +#else + GetUsernameEnvVar("LOGNAME", arg, length); +#endif +} + } // namespace Fortran::runtime } // extern "C" diff --git a/flang/runtime/tools.h b/flang/runtime/tools.h index ea659190e1439..9811bce25acd3 100644 --- a/flang/runtime/tools.h +++ b/flang/runtime/tools.h @@ -411,5 +411,27 @@ RT_API_ATTRS void ShallowCopy(const Descriptor &to, const Descriptor &from, bool toIsContiguous, bool fromIsContiguous); RT_API_ATTRS void ShallowCopy(const Descriptor &to, const Descriptor &from); +// Defines a utility function for copying and padding characters +template +RT_API_ATTRS 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(' '); + } + } 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(' '); + } + } +} + } // namespace Fortran::runtime #endif // FORTRAN_RUNTIME_TOOLS_H_ diff --git a/flang/unittests/Runtime/CommandTest.cpp b/flang/unittests/Runtime/CommandTest.cpp index 2b648b31666ae..dfc3ad68b3ab9 100644 --- a/flang/unittests/Runtime/CommandTest.cpp +++ b/flang/unittests/Runtime/CommandTest.cpp @@ -10,9 +10,15 @@ #include "gmock/gmock.h" #include "gtest/gtest.h" #include "flang/Runtime/descriptor.h" +#include "flang/Runtime/extensions.h" #include "flang/Runtime/main.h" +#include #include +#if _REENTRANT || _POSIX_C_SOURCE >= 199506L +#include // LOGIN_NAME_MAX used in getlog test +#endif + using namespace Fortran::runtime; template @@ -59,6 +65,13 @@ class CommandFixture : public ::testing::Test { return res; } + void CheckCharEqStr(const char *value, const std::string &expected) const { + ASSERT_NE(value, nullptr); + EXPECT_EQ(std::strncmp(value, expected.c_str(), expected.size()), 0) + << "expected: " << expected << "\n" + << "value: " << value; + } + void CheckDescriptorEqStr( const Descriptor *value, const std::string &expected) const { ASSERT_NE(value, nullptr); @@ -397,6 +410,11 @@ class EnvironmentVariables : public CommandFixture { protected: EnvironmentVariables() : CommandFixture(0, nullptr) { SetEnv("NAME", "VALUE"); +#ifdef _WIN32 + SetEnv("USERNAME", "loginName"); +#else + SetEnv("LOGNAME", "loginName"); +#endif SetEnv("EMPTY", ""); } @@ -494,3 +512,68 @@ TEST_F(EnvironmentVariables, ErrMsgTooShort) { 1); CheckDescriptorEqStr(errMsg.get(), "Mis"); } + +// username first char must not be null +TEST_F(EnvironmentVariables, GetlogGetName) { + const int charLen{3}; + char input[charLen]{"\0\0"}; + + FORTRAN_PROCEDURE_NAME(getlog) + (reinterpret_cast(input), charLen); + + EXPECT_NE(input[0], '\0'); +} + +#if _REENTRANT || _POSIX_C_SOURCE >= 199506L +TEST_F(EnvironmentVariables, GetlogPadSpace) { + // guarantee 1 char longer than max, last char should be pad space + const int charLen{LOGIN_NAME_MAX + 2}; + char input[charLen]; + + FORTRAN_PROCEDURE_NAME(getlog) + (reinterpret_cast(input), charLen); + + EXPECT_EQ(input[charLen - 1], ' '); +} +#endif + +#ifdef _WIN32 // Test ability to get name from environment variable +TEST_F(EnvironmentVariables, GetlogEnvGetName) { + if (EnableFineGrainedTests()) { + ASSERT_NE(std::getenv("USERNAME"), nullptr) + << "Environment variable USERNAME does not exist"; + + char input[]{"XXXXXXXXX"}; + FORTRAN_PROCEDURE_NAME(getlog) + (reinterpret_cast(input), sizeof(input)); + + CheckCharEqStr(input, "loginName"); + } +} + +TEST_F(EnvironmentVariables, GetlogEnvBufferShort) { + if (EnableFineGrainedTests()) { + ASSERT_NE(std::getenv("USERNAME"), nullptr) + << "Environment variable USERNAME does not exist"; + + char input[]{"XXXXXX"}; + FORTRAN_PROCEDURE_NAME(getlog) + (reinterpret_cast(input), sizeof(input)); + + CheckCharEqStr(input, "loginN"); + } +} + +TEST_F(EnvironmentVariables, GetlogEnvPadSpace) { + if (EnableFineGrainedTests()) { + ASSERT_NE(std::getenv("USERNAME"), nullptr) + << "Environment variable USERNAME does not exist"; + + char input[]{"XXXXXXXXXX"}; + FORTRAN_PROCEDURE_NAME(getlog) + (reinterpret_cast(input), sizeof(input)); + + CheckCharEqStr(input, "loginName "); + } +} +#endif