[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 <[email protected]>

Author: DavidTruby

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 |
+| 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, 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 |

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};

flang/include/flang/Optimizer/Builder/IntrinsicCall.h

@@ -256,6 +256,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>);

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

@@ -58,5 +58,8 @@ mlir::Value genGetEnvVariable(fir::FirOpBuilder &, mlir::Location,
 mlir::Value genGetCwd(fir::FirOpBuilder &builder, mlir::Location loc,
                       mlir::Value c);
 
+mlir::Value genGetUID(fir::FirOpBuilder &, mlir::Location);
+mlir::Value genGetGID(fir::FirOpBuilder &, mlir::Location);
+
 } // namespace fir::runtime
 #endif // FORTRAN_OPTIMIZER_BUILDER_RUNTIME_COMMAND_H

flang/include/flang/Runtime/command.h

@@ -15,6 +15,9 @@
 #ifdef _WIN32
 // On Windows* OS GetCurrentProcessId returns DWORD aka uint32_t
 typedef std::uint32_t pid_t;
+// 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
@@ -29,9 +32,15 @@ extern "C" {
 // integer kind.
 std::int32_t RTNAME(ArgumentCount)();
 
+// Calls getgid()
+gid_t RTNAME(GetGID)();
+
 // Calls getpid()
 pid_t RTNAME(GetPID)();
 
+// Calls getuid()
+uid_t RTNAME(GetUID)();
+
 // 16.9.82 GET_COMMAND
 // Try to get the value of the whole command. All of the parameters are
 // optional.

flang/include/flang/Tools/TargetSetup.h

@@ -58,6 +58,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.
 }

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}}},

flang/lib/Optimizer/Builder/IntrinsicCall.cpp

@@ -293,7 +293,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,
@@ -3650,6 +3652,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) {
@@ -3658,6 +3668,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) {

flang/lib/Optimizer/Builder/Runtime/Command.cpp

@@ -48,6 +48,14 @@ mlir::Value fir::runtime::genGetCommand(fir::FirOpBuilder &builder,
   return builder.create<fir::CallOp>(loc, runtimeFunc, args).getResult(0);
 }
 
+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::genGetPID(fir::FirOpBuilder &builder,
                                     mlir::Location loc) {
   auto runtimeFunc =
@@ -56,6 +64,14 @@ mlir::Value fir::runtime::genGetPID(fir::FirOpBuilder &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::genGetCommandArgument(
     fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value number,
     mlir::Value value, mlir::Value length, mlir::Value errmsg) {

flang/lib/Semantics/check-call.cpp

@@ -2020,6 +2020,20 @@ bool CheckPPCIntrinsic(const Symbol &generic, const Symbol &specific,
   return false;
 }
 
+bool CheckWindowsIntrinsic(
+    const Symbol &intrinsic, evaluate::FoldingContext &foldingContext) {
+  parser::ContextualMessages &messages{foldingContext.messages()};
+  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,

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);

flang/lib/Semantics/expression.cpp

@@ -2905,6 +2905,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(

flang/runtime/command.cpp

@@ -42,8 +42,26 @@ std::int32_t RTNAME(ArgumentCount)() {
   return 0;
 }
 
+gid_t RTNAME(GetGID)() {
+#ifdef _WIN32
+  // Group IDs don't exist on Windows, return 1 to avoid errors
+  return 1;
+#else
+  return getgid();
+#endif
+}
+
 pid_t RTNAME(GetPID)() { return getpid(); }
 
+uid_t RTNAME(GetUID)() {
+#ifdef _WIN32
+  // User IDs don't exist on Windows, return 1 to avoid errors
+  return 1;
+#else
+  return getuid();
+#endif
+}
+
 // Returns the length of the \p string. Assumes \p string is valid.
 static std::int64_t StringLength(const char *string) {
   std::size_t length{std::strlen(string)};

flang/test/Semantics/windows.f90

@@ -0,0 +1,12 @@
+! RUN: %python %S/test_errors.py %s %flang --target=x86_64-pc-windows-msvc -Werror
+! RUN: %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

flang/unittests/Optimizer/Builder/Runtime/CommandTest.cpp

@@ -45,9 +45,23 @@ TEST_F(RuntimeCallTest, genGetEnvVariable) {
       /*addLocArgs=*/true);
 }
 
+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, genGetPID) {
   mlir::Location loc = firBuilder->getUnknownLoc();
   mlir::Value result = fir::runtime::genGetPID(*firBuilder, loc);
   checkCallOp(result.getDefiningOp(), "_FortranAGetPID", /*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);
+}

flang/unittests/Runtime/CommandTest.cpp

@@ -689,11 +689,21 @@ TEST_F(OnlyValidArguments, GetCommandShortLength) {
   CheckDescriptorEqInt<short>(length.get(), 51);
 }
 
+TEST_F(ZeroArguments, GetGID) {
+  // gid cannot be negative
+  EXPECT_GE(RTNAME(GetGID)(), 0u);
+}
+
 TEST_F(ZeroArguments, GetPID) {
   // pid should always greater than 0, in both linux and windows
   EXPECT_GT(RTNAME(GetPID)(), 0);
 }
 
+TEST_F(ZeroArguments, GetUID) {
+  // uid cannot be negative
+  EXPECT_GE(RTNAME(GetUID)(), 0u);
+}
+
 class EnvironmentVariables : public CommandFixture {
 protected:
   EnvironmentVariables() : CommandFixture(0, nullptr) {