GETLOG runtime and extension implementation: get login username

Get login username, ussage:
CHARACTER(32) :: login
CALL getlog(login)
WRITE(*,*) login

Author: yiwu0b11

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, GET_COMMAND, GET_COMMAND_ARGUMENT, GET_ENVIRONMENT_VARIABLE, GETLOG, MOVE_ALLOC, RANDOM_INIT, RANDOM_NUMBER, RANDOM_SEED, SYSTEM_CLOCK |
 | Atomic intrinsic subroutines | ATOMIC_ADD |
 | Collective intrinsic subroutines | CO_REDUCE |
 

flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h

@@ -62,6 +62,14 @@ using FuncTypeBuilderFunc = mlir::FunctionType (*)(mlir::MLIRContext *);
 /// standard type `i32` when `sizeof(int)` is 4.
 template <typename T>
 static constexpr TypeBuilderFunc getModel();
+
+template <>
+constexpr TypeBuilderFunc getModel<unsigned int>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    return mlir::IntegerType::get(context, 8 * sizeof(unsigned int));
+  };
+}
+
 template <>
 constexpr TypeBuilderFunc getModel<short int>() {
   return [](mlir::MLIRContext *context) -> mlir::Type {

flang/include/flang/Runtime/command.h

@@ -47,6 +47,12 @@ std::int32_t RTNAME(GetEnvVariable)(const Descriptor &name,
     bool trim_name = true, const Descriptor *errmsg = nullptr,
     const char *sourceFile = nullptr, int line = 0);
 }
+
+// Try to get the name of current user
+// Returns a STATUS as described in the standard.
+std::int32_t RTNAME(GetLog)(
+    const Descriptor *argument = nullptr, const Descriptor *errmsg = nullptr);
+
 } // namespace Fortran::runtime
 
 #endif // FORTRAN_RUNTIME_COMMAND_H_

flang/include/flang/Runtime/extensions.h

@@ -28,5 +28,7 @@ std::int32_t FORTRAN_PROCEDURE_NAME(iargc)();
 void FORTRAN_PROCEDURE_NAME(getarg)(
     std::int32_t &n, std::int8_t *arg, std::int64_t length);
 
+void FORTRAN_PROCEDURE_NAME(getlog)(std::int8_t *name, std::int64_t length);
+
 } // extern "C"
 #endif // FORTRAN_RUNTIME_EXTENSIONS_H_

flang/runtime/command.cpp

@@ -15,6 +15,30 @@
 #include <cstdlib>
 #include <limits>
 
+#ifdef _WIN32
+#define WIN32_LEAN_AND_MEAN
+#define NOMINMAX
+#include <windows.h>
+
+#include <Lmcons.h> // UNLEN=256
+
+inline char *getlogin() {
+  char *username = NULL;
+  DWORD size = UNLEN + 1; // Constant for the maximum username length
+  username = (char *)malloc(size);
+
+  if (GetUserName(username, &size)) {
+    // Username retrieved successfully
+    return username;
+  } else {
+    free(username);
+    return NULL;
+  }
+}
+#else
+#include <unistd.h>
+#endif
+
 namespace Fortran::runtime {
 std::int32_t RTNAME(ArgumentCount)() {
   int argc{executionEnvironment.argc};
@@ -222,6 +246,22 @@ std::int32_t RTNAME(GetCommand)(const Descriptor *value,
   return stat;
 }
 
+std::int32_t RTNAME(GetLog)(const Descriptor *value, const Descriptor *errmsg) {
+  FillWithSpaces(*value);
+
+  const char *arg = getlogin();
+  std::int64_t argLen{StringLength(arg)};
+  if (argLen <= 0) {
+    return ToErrmsg(errmsg, StatMissingArgument);
+  }
+
+  if (value) {
+    return CopyToDescriptor(*value, arg, argLen, errmsg);
+  }
+
+  return StatOk;
+}
+
 static std::size_t LengthWithoutTrailingSpaces(const Descriptor &d) {
   std::size_t s{d.ElementBytes() - 1};
   while (*d.OffsetElement(s) == ' ') {

flang/runtime/extensions.cpp

@@ -37,5 +37,11 @@ void FORTRAN_PROCEDURE_NAME(getarg)(
   (void)RTNAME(GetCommandArgument)(
       n, &value, nullptr, nullptr, __FILE__, __LINE__);
 }
+
+void FORTRAN_PROCEDURE_NAME(getlog)(std::int8_t *arg, std::int64_t length) {
+  Descriptor value{*Descriptor::Create(1, length, arg, 0)};
+  (void)RTNAME(GetLog)(&value, nullptr);
+}
+
 } // namespace Fortran::runtime
 } // extern "C"

flang/unittests/Runtime/CommandTest.cpp

@@ -225,6 +225,12 @@ TEST_F(ZeroArguments, GetCommandArgument) {
   CheckMissingArgumentValue(1);
 }
 
+TEST_F(ZeroArguments, GetLog) {
+  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, GetLog) {
+  CheckMissingArgumentValue(-1);
+  CheckArgumentValue(oneArgArgv[0], 0);
+  CheckArgumentValue(oneArgArgv[1], 1);
+  CheckMissingArgumentValue(2);
+}
+
 TEST_F(OneArgument, GetCommand) { CheckCommandValue(oneArgArgv, 2); }
 
 static const char *severalArgsArgv[]{
@@ -284,7 +297,7 @@ TEST_F(SeveralArguments, ArgValueTooShort) {
   ASSERT_NE(tooShort, nullptr);
   EXPECT_EQ(RTNAME(GetCommandArgument)(1, tooShort.get()), -1);
   CheckDescriptorEqStr(tooShort.get(), severalArgsArgv[1]);
-
+  
   OwningPtr<Descriptor> length{EmptyIntDescriptor()};
   ASSERT_NE(length, nullptr);
   OwningPtr<Descriptor> errMsg{CreateEmptyCharDescriptor()};