[flang-commits] [flang] GETLOG runtime and extension implementation: get login username (PR #70917)
via flang-commits
flang-commits at lists.llvm.org
Thu Nov 9 06:39:52 PST 2023
llvmbot wrote:
<!--LLVM PR SUMMARY COMMENT-->
@llvm/pr-subscribers-flang-runtime
Author: Yi Wu (PAX-12-WU)
<details>
<summary>Changes</summary>
Get login username, ussage:
```c++
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
---
Full diff: https://github.com/llvm/llvm-project/pull/70917.diff
7 Files Affected:
- (modified) flang/docs/Intrinsics.md (+1-1)
- (modified) flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h (+8)
- (modified) flang/include/flang/Runtime/command.h (+6)
- (modified) flang/include/flang/Runtime/extensions.h (+2)
- (modified) flang/runtime/command.cpp (+47)
- (modified) flang/runtime/extensions.cpp (+6)
- (modified) flang/unittests/Runtime/CommandTest.cpp (+13)
``````````diff
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 <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 {
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..c5171a1ef36f282 100644
--- a/flang/runtime/command.cpp
+++ b/flang/runtime/command.cpp
@@ -14,6 +14,37 @@
#include "flang/Runtime/descriptor.h"
#include <cstdlib>
#include <limits>
+#include <string.h>
+
+#ifdef _WIN32
+#define WIN32_LEAN_AND_MEAN
+#define NOMINMAX
+#include <windows.h>
+
+#include <lmcons.h> // UNLEN=256
+#include <wchar.h> // wchar_t cast to LPWSTR
+#pragma comment(lib, "Advapi32.lib") // Link Advapi32.lib for GetUserName
+
+static inline char *getlogin() {
+ static char username[UNLEN + 1];
+ wchar_t w_username[UNLEN + 1];
+ DWORD namelen = sizeof(w_username) / sizeof(w_username[0]);
+
+ if (GetUserName(w_username, &namelen)) {
+ // Convert the wchar_t string to a regular C string
+ if (wcstombs(username, w_username, UNLEN + 1) == -1) {
+ // Conversion failed
+ return NULL;
+ }
+ return (username[0] == 0 ? NULL : username);
+ } else {
+ return NULL;
+ }
+ return nullptr;
+}
+#else
+#include <unistd.h>
+#endif
namespace Fortran::runtime {
std::int32_t RTNAME(ArgumentCount)() {
@@ -222,6 +253,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) == ' ') {
diff --git a/flang/runtime/extensions.cpp b/flang/runtime/extensions.cpp
index b8e9b6eae132059..47b269d1e5b42af 100644
--- a/flang/runtime/extensions.cpp
+++ b/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"
diff --git a/flang/unittests/Runtime/CommandTest.cpp b/flang/unittests/Runtime/CommandTest.cpp
index c3571c9684e4b07..686dc273142badd 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, 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[]{
``````````
</details>
https://github.com/llvm/llvm-project/pull/70917
More information about the flang-commits
mailing list