https://github.com/PAX-12-WU updated
https://github.com/llvm/llvm-project/pull/70917
>From 0e98aa7ca15b05b91813eaeeb6ae1305e5f5384d Mon Sep 17 00:00:00 2001
From: Yi Wu
Date: Mon, 6 Nov 2023 19:49:13 +
Subject: [PATCH 1/4] GETLOG runtime and extension implementation: get login
username
Get login username, ussage:
CHARACTER(32) :: login
CALL getlog(login)
WRITE(*,*) login
---
flang/docs/Intrinsics.md | 2 +-
.../Optimizer/Builder/Runtime/RTBuilder.h | 8
flang/include/flang/Runtime/command.h | 6 +++
flang/include/flang/Runtime/extensions.h | 2 +
flang/runtime/command.cpp | 40 +++
flang/runtime/extensions.cpp | 6 +++
flang/unittests/Runtime/CommandTest.cpp | 15 ++-
7 files changed, 77 insertions(+), 2 deletions(-)
diff --git a/flang/docs/Intrinsics.md b/flang/docs/Intrinsics.md
index ab0a940e53e5538..cfe5dcd141e9821 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, 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 |
diff --git a/flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h
b/flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h
index b2774263e7a31a4..830df7ad006b54a 100644
--- a/flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h
+++ b/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
static constexpr TypeBuilderFunc getModel();
+
+template <>
+constexpr TypeBuilderFunc getModel() {
+ return [](mlir::MLIRContext *context) -> mlir::Type {
+return mlir::IntegerType::get(context, 8 * sizeof(unsigned int));
+ };
+}
+
template <>
constexpr TypeBuilderFunc getModel() {
return [](mlir::MLIRContext *context) -> mlir::Type {
diff --git a/flang/include/flang/Runtime/command.h
b/flang/include/flang/Runtime/command.h
index ec6289390545479..1c212ef61697cd5 100644
--- a/flang/include/flang/Runtime/command.h
+++ b/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_
diff --git a/flang/include/flang/Runtime/extensions.h
b/flang/include/flang/Runtime/extensions.h
index ad592814e5acb79..d199d5e387b8648 100644
--- a/flang/include/flang/Runtime/extensions.h
+++ b/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_
diff --git a/flang/runtime/command.cpp b/flang/runtime/command.cpp
index b81a0791c5e571b..6b2f313e227a196 100644
--- a/flang/runtime/command.cpp
+++ b/flang/runtime/command.cpp
@@ -15,6 +15,30 @@
#include
#include
+#ifdef _WIN32
+#define WIN32_LEAN_AND_MEAN
+#define NOMINMAX
+#include
+
+#include // 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)) {