[flang-commits] [flang] [flang] Implement GETUID and GETGID intrinsics (PR #110679)
David Truby via flang-commits
flang-commits at lists.llvm.org
Tue Oct 1 07:08:53 PDT 2024
https://github.com/DavidTruby created https://github.com/llvm/llvm-project/pull/110679
GETUID and GETGID are non-standard intrinsics supported by a number of
other Fortran compilers. On supported platforms these intrinsics simply
call the POSIX getuid() and getgid() functions and return the result.
The only platform we support that does not have these is Windows.
Windows does not have the same concept of UIDs and GIDs, so on Windows
we issue a warning indicating this and return 1 from both functions.
Co-authored-by: Yi Wu <yi.wu2 at arm.com>
>From 778d37259001fbdf1ee050357878b9d81d16cdc7 Mon Sep 17 00:00:00 2001
From: David Truby <david.truby at arm.com>
Date: Tue, 10 Sep 2024 13:55:27 +0100
Subject: [PATCH] [flang] Implement GETUID and GETGID intrinsics
GETUID and GETGID are non-standard intrinsics supported by a number of
other Fortran compilers. On supported platforms these intrinsics simply
call the POSIX getuid() and getgid() functions and return the result.
The only platform we support that does not have these is Windows.
Windows does not have the same concept of UIDs and GIDs, so on Windows
we issue a warning indicating this and return 1 from both functions.
Co-authored-by: Yi Wu <yi.wu2 at arm.com>
---
flang/docs/Intrinsics.md | 2 +-
flang/include/flang/Evaluate/target.h | 6 ++++++
.../flang/Optimizer/Builder/IntrinsicCall.h | 4 ++++
.../Optimizer/Builder/Runtime/Intrinsics.h | 4 ++++
flang/include/flang/Runtime/extensions.h | 14 ++++++++++++++
flang/include/flang/Tools/TargetSetup.h | 3 +++
flang/lib/Evaluate/intrinsics.cpp | 2 ++
flang/lib/Optimizer/Builder/IntrinsicCall.cpp | 18 ++++++++++++++++++
.../Optimizer/Builder/Runtime/Intrinsics.cpp | 16 ++++++++++++++++
flang/lib/Semantics/check-call.cpp | 16 ++++++++++++++++
flang/lib/Semantics/check-call.h | 2 ++
flang/lib/Semantics/expression.cpp | 3 +++
flang/runtime/extensions.cpp | 19 +++++++++++++++++++
flang/test/Semantics/windows.f90 | 12 ++++++++++++
.../Optimizer/Builder/Runtime/CommandTest.cpp | 2 +-
.../Builder/Runtime/IntrinsicsTest.cpp | 17 +++++++++++++++++
flang/unittests/Optimizer/CMakeLists.txt | 1 +
17 files changed, 139 insertions(+), 2 deletions(-)
create mode 100644 flang/test/Semantics/windows.f90
create mode 100644 flang/unittests/Optimizer/Builder/Runtime/IntrinsicsTest.cpp
diff --git a/flang/docs/Intrinsics.md b/flang/docs/Intrinsics.md
index d6f48a7fd87d7b..0196be10d86556 100644
--- a/flang/docs/Intrinsics.md
+++ b/flang/docs/Intrinsics.md
@@ -765,7 +765,7 @@ This phase currently supports all the intrinsic procedures listed above but the
| Coarray intrinsic functions | COSHAPE |
| 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, GETPID, NUMARG, BADDRESS, IADDR, CACHESIZE, EOF, FP_CLASS, INT_PTR_KIND, ISNAN, MALLOC, FREE |
+| 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, GETPID, NUMARG, BADDRESS, IADDR, CACHESIZE, EOF, FP_CLASS, INT_PTR_KIND, ISNAN, MALLOC, FREE, GETUID, GETGID |
| 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, SIGNAL, SLEEP, SYSTEM, SYSTEM_CLOCK |
| Atomic intrinsic subroutines | ATOMIC_ADD |
| Collective intrinsic subroutines | CO_REDUCE |
diff --git a/flang/include/flang/Evaluate/target.h b/flang/include/flang/Evaluate/target.h
index d076fcbf083078..b347c549e012da 100644
--- a/flang/include/flang/Evaluate/target.h
+++ b/flang/include/flang/Evaluate/target.h
@@ -102,6 +102,11 @@ class TargetCharacteristics {
bool isPPC() const { return isPPC_; }
void set_isPPC(bool isPPC = false);
+ bool isOSWindows() const { return isOSWindows_; }
+ void set_isOSWindows(bool isOSWindows = false) {
+ isOSWindows_ = isOSWindows;
+ };
+
IeeeFeatures &ieeeFeatures() { return ieeeFeatures_; }
const IeeeFeatures &ieeeFeatures() const { return ieeeFeatures_; }
@@ -111,6 +116,7 @@ class TargetCharacteristics {
std::uint8_t align_[common::TypeCategory_enumSize][maxKind]{};
bool isBigEndian_{false};
bool isPPC_{false};
+ bool isOSWindows_{false};
bool areSubnormalsFlushedToZero_{false};
Rounding roundingMode_{defaultRounding};
std::size_t procedurePointerByteSize_{8};
diff --git a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
index ca4030816b1a09..f491f11b688997 100644
--- a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
+++ b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
@@ -257,6 +257,10 @@ struct IntrinsicLibrary {
llvm::ArrayRef<mlir::Value> args);
void genGetCommandArgument(mlir::ArrayRef<fir::ExtendedValue> args);
void genGetEnvironmentVariable(llvm::ArrayRef<fir::ExtendedValue>);
+ mlir::Value genGetGID(mlir::Type resultType,
+ llvm::ArrayRef<mlir::Value> args);
+ mlir::Value genGetUID(mlir::Type resultType,
+ llvm::ArrayRef<mlir::Value> args);
fir::ExtendedValue genIall(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
mlir::Value genIand(mlir::Type, llvm::ArrayRef<mlir::Value>);
fir::ExtendedValue genIany(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
diff --git a/flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h b/flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h
index f62071a49e3bf6..02b9b68da0db4b 100644
--- a/flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h
+++ b/flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h
@@ -48,6 +48,10 @@ void genEtime(fir::FirOpBuilder &builder, mlir::Location loc,
mlir::Value values, mlir::Value time);
void genFree(fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value ptr);
+
+mlir::Value genGetUID(fir::FirOpBuilder &, mlir::Location);
+mlir::Value genGetGID(fir::FirOpBuilder &, mlir::Location);
+
mlir::Value genMalloc(fir::FirOpBuilder &builder, mlir::Location loc,
mlir::Value size);
diff --git a/flang/include/flang/Runtime/extensions.h b/flang/include/flang/Runtime/extensions.h
index 8b7607be7e999a..a855c694e0090d 100644
--- a/flang/include/flang/Runtime/extensions.h
+++ b/flang/include/flang/Runtime/extensions.h
@@ -20,6 +20,14 @@
#include <cstddef>
#include <cstdint>
+#ifdef _WIN32
+// UID and GID don't exist on Windows, these exist to avoid errors.
+typedef std::uint32_t uid_t;
+typedef std::uint32_t gid_t;
+#else
+#include "sys/types.h" //pid_t
+#endif
+
extern "C" {
// CALL FLUSH(n) antedates the Fortran 2003 FLUSH statement.
@@ -37,6 +45,12 @@ std::int32_t FORTRAN_PROCEDURE_NAME(iargc)();
void FORTRAN_PROCEDURE_NAME(getarg)(
std::int32_t &n, char *arg, std::int64_t length);
+// Calls getgid()
+gid_t RTNAME(GetGID)();
+
+// Calls getuid()
+uid_t RTNAME(GetUID)();
+
// GNU extension subroutine GETLOG(C).
void FORTRAN_PROCEDURE_NAME(getlog)(char *name, std::int64_t length);
diff --git a/flang/include/flang/Tools/TargetSetup.h b/flang/include/flang/Tools/TargetSetup.h
index c8d32e8e87cf1e..f52b5ddaa8d49a 100644
--- a/flang/include/flang/Tools/TargetSetup.h
+++ b/flang/include/flang/Tools/TargetSetup.h
@@ -59,6 +59,9 @@ namespace Fortran::tools {
if (targetTriple.isPPC())
targetCharacteristics.set_isPPC(true);
+ if (targetTriple.isOSWindows())
+ targetCharacteristics.set_isOSWindows(true);
+
// TODO: use target machine data layout to set-up the target characteristics
// type size and alignment info.
}
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index a89e9732228cbc..3734cc6814f97f 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -523,7 +523,9 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
{{"c", DefaultChar, Rank::scalar, Optionality::required,
common::Intent::Out}},
TypePattern{IntType, KindCode::greaterOrEqualToKind, 4}},
+ {"getgid", {}, DefaultInt},
{"getpid", {}, DefaultInt},
+ {"getuid", {}, DefaultInt},
{"huge",
{{"x", SameIntOrReal, Rank::anyOrAssumedRank, Optionality::required,
common::Intent::In, {ArgFlag::canBeMoldNull}}},
diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
index 86f7d14c6592b4..678f2cedae17f1 100644
--- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
+++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
@@ -294,7 +294,9 @@ static constexpr IntrinsicHandler handlers[]{
&I::genGetCwd,
{{{"c", asBox}, {"status", asAddr, handleDynamicOptional}}},
/*isElemental=*/false},
+ {"getgid", &I::genGetGID},
{"getpid", &I::genGetPID},
+ {"getuid", &I::genGetUID},
{"iachar", &I::genIchar},
{"iall",
&I::genIall,
@@ -3658,6 +3660,14 @@ void IntrinsicLibrary::genGetCommand(llvm::ArrayRef<fir::ExtendedValue> args) {
}
}
+// GETGID
+mlir::Value IntrinsicLibrary::genGetGID(mlir::Type resultType,
+ llvm::ArrayRef<mlir::Value> args) {
+ assert(args.size() == 0 && "getgid takes no input");
+ return builder.createConvert(loc, resultType,
+ fir::runtime::genGetGID(builder, loc));
+}
+
// GETPID
mlir::Value IntrinsicLibrary::genGetPID(mlir::Type resultType,
llvm::ArrayRef<mlir::Value> args) {
@@ -3666,6 +3676,14 @@ mlir::Value IntrinsicLibrary::genGetPID(mlir::Type resultType,
fir::runtime::genGetPID(builder, loc));
}
+// GETUID
+mlir::Value IntrinsicLibrary::genGetUID(mlir::Type resultType,
+ llvm::ArrayRef<mlir::Value> args) {
+ assert(args.size() == 0 && "getgid takes no input");
+ return builder.createConvert(loc, resultType,
+ fir::runtime::genGetUID(builder, loc));
+}
+
// GET_COMMAND_ARGUMENT
void IntrinsicLibrary::genGetCommandArgument(
llvm::ArrayRef<fir::ExtendedValue> args) {
diff --git a/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp b/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp
index cf2483d36c0274..ded9579f2c1df0 100644
--- a/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp
+++ b/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp
@@ -129,6 +129,22 @@ void fir::runtime::genFree(fir::FirOpBuilder &builder, mlir::Location loc,
builder.createConvert(loc, intPtrTy, ptr));
}
+mlir::Value fir::runtime::genGetGID(fir::FirOpBuilder &builder,
+ mlir::Location loc) {
+ auto runtimeFunc =
+ fir::runtime::getRuntimeFunc<mkRTKey(GetGID)>(loc, builder);
+
+ return builder.create<fir::CallOp>(loc, runtimeFunc).getResult(0);
+}
+
+mlir::Value fir::runtime::genGetUID(fir::FirOpBuilder &builder,
+ mlir::Location loc) {
+ auto runtimeFunc =
+ fir::runtime::getRuntimeFunc<mkRTKey(GetUID)>(loc, builder);
+
+ return builder.create<fir::CallOp>(loc, runtimeFunc).getResult(0);
+}
+
mlir::Value fir::runtime::genMalloc(fir::FirOpBuilder &builder,
mlir::Location loc, mlir::Value size) {
auto runtimeFunc =
diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index 31079174239c24..28903304f622e6 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -2042,6 +2042,22 @@ bool CheckPPCIntrinsic(const Symbol &generic, const Symbol &specific,
return false;
}
+bool CheckWindowsIntrinsic(
+ const Symbol &intrinsic, evaluate::FoldingContext &foldingContext) {
+ parser::ContextualMessages &messages{foldingContext.messages()};
+ // TODO: there are other intrinsics that are unsupported on Windows that
+ // should be added here.
+ if (intrinsic.name() == "getuid") {
+ messages.Say(
+ "User IDs do not exist on Windows. This function will always return 1"_warn_en_US);
+ }
+ if (intrinsic.name() == "getgid") {
+ messages.Say(
+ "Group IDs do not exist on Windows. This function will always return 1"_warn_en_US);
+ }
+ return true;
+}
+
bool CheckArguments(const characteristics::Procedure &proc,
evaluate::ActualArguments &actuals, SemanticsContext &context,
const Scope &scope, bool treatingExternalAsImplicit,
diff --git a/flang/lib/Semantics/check-call.h b/flang/lib/Semantics/check-call.h
index 8553f3a31efb52..46bc61a601bd34 100644
--- a/flang/lib/Semantics/check-call.h
+++ b/flang/lib/Semantics/check-call.h
@@ -41,6 +41,8 @@ bool CheckArguments(const evaluate::characteristics::Procedure &,
bool CheckPPCIntrinsic(const Symbol &generic, const Symbol &specific,
const evaluate::ActualArguments &actuals,
evaluate::FoldingContext &context);
+bool CheckWindowsIntrinsic(
+ const Symbol &intrinsic, evaluate::FoldingContext &context);
bool CheckArgumentIsConstantExprInRange(
const evaluate::ActualArguments &actuals, int index, int lowerBound,
int upperBound, parser::ContextualMessages &messages);
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 182ea5d441956c..364f99d73f5cc8 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -2916,6 +2916,9 @@ auto ExpressionAnalyzer::GetCalleeAndArguments(const parser::Name &name,
} else {
resolution = symbol;
}
+ if (resolution && context_.targetCharacteristics().isOSWindows()) {
+ semantics::CheckWindowsIntrinsic(*resolution, GetFoldingContext());
+ }
if (!resolution || resolution->attrs().test(semantics::Attr::INTRINSIC)) {
auto name{resolution ? resolution->name() : ultimate.name()};
if (std::optional<SpecificCall> specificCall{context_.intrinsics().Probe(
diff --git a/flang/runtime/extensions.cpp b/flang/runtime/extensions.cpp
index 4412a9cbeb6d21..50d3c72fe650d0 100644
--- a/flang/runtime/extensions.cpp
+++ b/flang/runtime/extensions.cpp
@@ -58,6 +58,24 @@ extern "C" {
namespace Fortran::runtime {
+gid_t RTNAME(GetGID)() {
+#ifdef _WIN32
+ // Group IDs don't exist on Windows, return 1 to avoid errors
+ return 1;
+#else
+ return getgid();
+#endif
+}
+
+uid_t RTNAME(GetUID)() {
+#ifdef _WIN32
+ // User IDs don't exist on Windows, return 1 to avoid errors
+ return 1;
+#else
+ return getuid();
+#endif
+}
+
void GetUsernameEnvVar(const char *envName, char *arg, std::int64_t length) {
Descriptor name{*Descriptor::Create(
1, std::strlen(envName) + 1, const_cast<char *>(envName), 0)};
@@ -66,6 +84,7 @@ void GetUsernameEnvVar(const char *envName, char *arg, std::int64_t length) {
RTNAME(GetEnvVariable)
(name, &value, nullptr, false, nullptr, __FILE__, __LINE__);
}
+
namespace io {
// SUBROUTINE FLUSH(N)
// FLUSH N
diff --git a/flang/test/Semantics/windows.f90 b/flang/test/Semantics/windows.f90
new file mode 100644
index 00000000000000..705fb1b8168951
--- /dev/null
+++ b/flang/test/Semantics/windows.f90
@@ -0,0 +1,12 @@
+! RUN: %if x86_64-registered-target %{ %python %S/test_errors.py %s %flang --target=x86_64-pc-windows-msvc -Werror %}
+! RUN: %if aarch64-registered-target %{ %python %S/test_errors.py %s %flang --target=aarch64-pc-windows-msvc -Werror %}
+
+subroutine uid
+ !WARNING: User IDs do not exist on Windows. This function will always return 1
+ i = getuid()
+end subroutine uid
+
+subroutine gid
+ !WARNING: Group IDs do not exist on Windows. This function will always return 1
+ i = getgid()
+end subroutine gid
diff --git a/flang/unittests/Optimizer/Builder/Runtime/CommandTest.cpp b/flang/unittests/Optimizer/Builder/Runtime/CommandTest.cpp
index 58a151447d5b4f..8bc1e87814a98c 100644
--- a/flang/unittests/Optimizer/Builder/Runtime/CommandTest.cpp
+++ b/flang/unittests/Optimizer/Builder/Runtime/CommandTest.cpp
@@ -50,4 +50,4 @@ TEST_F(RuntimeCallTest, genGetPID) {
mlir::Value result = fir::runtime::genGetPID(*firBuilder, loc);
checkCallOp(result.getDefiningOp(), "_FortranAGetPID", /*nbArgs=*/0,
/*addLocArgs=*/false);
-}
\ No newline at end of file
+}
diff --git a/flang/unittests/Optimizer/Builder/Runtime/IntrinsicsTest.cpp b/flang/unittests/Optimizer/Builder/Runtime/IntrinsicsTest.cpp
new file mode 100644
index 00000000000000..1440a5fd01c2b1
--- /dev/null
+++ b/flang/unittests/Optimizer/Builder/Runtime/IntrinsicsTest.cpp
@@ -0,0 +1,17 @@
+#include "flang/Optimizer/Builder/Runtime/Intrinsics.h"
+#include "RuntimeCallTestBase.h"
+#include "gtest/gtest.h"
+
+TEST_F(RuntimeCallTest, genGetGID) {
+ mlir::Location loc = firBuilder->getUnknownLoc();
+ mlir::Value result = fir::runtime::genGetGID(*firBuilder, loc);
+ checkCallOp(result.getDefiningOp(), "_FortranAGetGID", /*nbArgs=*/0,
+ /*addLocArgs=*/false);
+}
+
+TEST_F(RuntimeCallTest, genGetUID) {
+ mlir::Location loc = firBuilder->getUnknownLoc();
+ mlir::Value result = fir::runtime::genGetUID(*firBuilder, loc);
+ checkCallOp(result.getDefiningOp(), "_FortranAGetUID", /*nbArgs=*/0,
+ /*addLocArgs=*/false);
+}
diff --git a/flang/unittests/Optimizer/CMakeLists.txt b/flang/unittests/Optimizer/CMakeLists.txt
index 7299e3ee0529a9..c58fb226a175c9 100644
--- a/flang/unittests/Optimizer/CMakeLists.txt
+++ b/flang/unittests/Optimizer/CMakeLists.txt
@@ -25,6 +25,7 @@ add_flang_unittest(FlangOptimizerTests
Builder/Runtime/CommandTest.cpp
Builder/Runtime/CharacterTest.cpp
Builder/Runtime/DerivedTest.cpp
+ Builder/Runtime/IntrinsicsTest.cpp
Builder/Runtime/NumericTest.cpp
Builder/Runtime/RaggedTest.cpp
Builder/Runtime/ReductionTest.cpp
More information about the flang-commits
mailing list