diff --git a/flang/docs/Intrinsics.md b/flang/docs/Intrinsics.md index 87716731ead85..e288fdeec6cd2 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 | +| 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 | diff --git a/flang/include/flang/Evaluate/target.h b/flang/include/flang/Evaluate/target.h index d076fcbf08307..b347c549e012d 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 78bb82b17d405..b2da6138fc9d8 100644 --- a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h +++ b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h @@ -256,6 +256,10 @@ struct IntrinsicLibrary { llvm::ArrayRef args); void genGetCommandArgument(mlir::ArrayRef args); void genGetEnvironmentVariable(llvm::ArrayRef); + mlir::Value genGetGID(mlir::Type resultType, + llvm::ArrayRef args); + mlir::Value genGetUID(mlir::Type resultType, + llvm::ArrayRef args); fir::ExtendedValue genIall(mlir::Type, llvm::ArrayRef); mlir::Value genIand(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genIany(mlir::Type, llvm::ArrayRef); diff --git a/flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h b/flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h index 240de5a899d37..49d8249d6bcbc 100644 --- a/flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h +++ b/flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h @@ -47,6 +47,9 @@ void genDateAndTime(fir::FirOpBuilder &, mlir::Location, void genEtime(fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value values, mlir::Value time); +mlir::Value genGetUID(fir::FirOpBuilder &, mlir::Location); +mlir::Value genGetGID(fir::FirOpBuilder &, mlir::Location); + void genRandomInit(fir::FirOpBuilder &, mlir::Location, mlir::Value repeatable, mlir::Value imageDistinct); void genRandomNumber(fir::FirOpBuilder &, mlir::Location, mlir::Value harvest); diff --git a/flang/include/flang/Runtime/extensions.h b/flang/include/flang/Runtime/extensions.h index fef651f3b2eed..6a842bafc155f 100644 --- a/flang/include/flang/Runtime/extensions.h +++ b/flang/include/flang/Runtime/extensions.h @@ -20,6 +20,14 @@ #include #include +#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. @@ -35,6 +43,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 ee89249441c17..278a7edb0ea72 100644 --- a/flang/include/flang/Tools/TargetSetup.h +++ b/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. } diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp index fcedf5ec3ddf8..7eea3848d7355 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 dc0dc47bda9a9..7f47423813866 100644 --- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp +++ b/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 args) { } } +// GETGID +mlir::Value IntrinsicLibrary::genGetGID(mlir::Type resultType, + llvm::ArrayRef 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 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 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 args) { diff --git a/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp b/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp index aff3cadc3c300..6bdc7d8c6bc82 100644 --- a/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp +++ b/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp @@ -120,6 +120,22 @@ void fir::runtime::genEtime(fir::FirOpBuilder &builder, mlir::Location loc, builder.create(loc, runtimeFunc, args); } +mlir::Value fir::runtime::genGetGID(fir::FirOpBuilder &builder, + mlir::Location loc) { + auto runtimeFunc = + fir::runtime::getRuntimeFunc(loc, builder); + + return builder.create(loc, runtimeFunc).getResult(0); +} + +mlir::Value fir::runtime::genGetUID(fir::FirOpBuilder &builder, + mlir::Location loc) { + auto runtimeFunc = + fir::runtime::getRuntimeFunc(loc, builder); + + return builder.create(loc, runtimeFunc).getResult(0); +} + void fir::runtime::genRandomInit(fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value repeatable, mlir::Value imageDistinct) { diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp index c7ec873365564..e77a2eca7d3b5 100644 --- a/flang/lib/Semantics/check-call.cpp +++ b/flang/lib/Semantics/check-call.cpp @@ -2020,6 +2020,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 8553f3a31efb5..46bc61a601bd3 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 3684839c187e6..e1484bfd0ff8f 100644 --- a/flang/lib/Semantics/expression.cpp +++ b/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{context_.intrinsics().Probe( diff --git a/flang/runtime/extensions.cpp b/flang/runtime/extensions.cpp index be3833db88b07..f2823ca770bc5 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(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 0000000000000..8f9d1aa606c0a --- /dev/null +++ b/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 diff --git a/flang/unittests/Optimizer/Builder/Runtime/CommandTest.cpp b/flang/unittests/Optimizer/Builder/Runtime/CommandTest.cpp index 58a151447d5b4..8bc1e87814a98 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 0000000000000..1440a5fd01c2b --- /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 7299e3ee0529a..c58fb226a175c 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