[flang] add GETLOG runtime and extension implementation: get login username (#74628)

Get login username, ussage:
```
CHARACTER(32) :: login
CALL getlog(login)
WRITE(*,*) login
```
getlog is required for an exascale proxyapp.
https://proxyapps.exascaleproject.org/app/minismac2d/

https://github.com/Mantevo/miniSMAC/blob/f90446714226eeef650b78bce06ca4967792e74d/ref/smac2d.f#L615

https://github.com/Mantevo/miniSMAC/blob/f90446714226eeef650b78bce06ca4967792e74d/ref/smac2d.f#L1570

---------

Co-authored-by: Yi Wu <[email protected]>
Co-authored-by: Yi Wu <[email protected]>
Co-authored-by: Kiran Chandramohan <[email protected]>

Author: 3 people

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

flang/include/flang/Runtime/extensions.h

@@ -14,6 +14,7 @@
 
 #define FORTRAN_PROCEDURE_NAME(name) name##_
 
+#include <cstddef>
 #include <cstdint>
 
 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_

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 <algorithm>
@@ -464,27 +465,6 @@ static void GeneralCharFuncKind(Descriptor &result, const Descriptor &string,
   }
 }
 
-template <typename TO, typename FROM>
-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<TO>(' ');
-    }
-  } 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<TO>(' ');
-    }
-  }
-}
-
 template <typename CHAR, bool ISMIN>
 static void MaxMinHelper(Descriptor &accumulator, const Descriptor &x,
     const Terminator &terminator) {

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 <unistd.h>
+#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<char *>(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<char *>(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"

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 <typename TO, typename FROM>
+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<TO>(' ');
+    }
+  } 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<TO>(' ');
+    }
+  }
+}
+
 } // namespace Fortran::runtime
 #endif // FORTRAN_RUNTIME_TOOLS_H_

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 <cstddef>
 #include <cstdlib>
 
+#if _REENTRANT || _POSIX_C_SOURCE >= 199506L
+#include <limits.h> // LOGIN_NAME_MAX used in getlog test
+#endif
+
 using namespace Fortran::runtime;
 
 template <std::size_t n = 64>
@@ -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<std::byte *>(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<std::byte *>(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<std::byte *>(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<std::byte *>(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<std::byte *>(input), sizeof(input));
+
+    CheckCharEqStr(input, "loginName ");
+  }
+}
+#endif