diff --git a/flang/docs/Intrinsics.md b/flang/docs/Intrinsics.md index d0b7999fbd067..f908a9d661fbf 100644 --- a/flang/docs/Intrinsics.md +++ b/flang/docs/Intrinsics.md @@ -767,7 +767,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, 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 | +| Intrinsic subroutines |MVBITS (elemental), CHDIR, 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 | | Library subroutines | BACKTRACE, FDATE, GETLOG, GETENV | @@ -1064,3 +1064,34 @@ This intrinsic is an alias for `LEN_TRIM`, without the optional KIND argument. - **Arguments:** `TIME` - a REAL value into which the elapsed CPU time in seconds is written - **RETURN value:** same as TIME argument + +### Non-Standard Intrinsics: CHDIR + +#### Description +`CHDIR(NAME[, STATUS])` Change current working directory to a specified path. + +This intrinsic is provided in both subroutine and function forms; however, only one form can be used in any given program unit. +*STATUS* is `INTENT(OUT)` and provide the following: + +| | | +|------------|---------------------------------------------------------------------------------------------------| +| `NAME` | The type shall be `CHARACTER` of default kind and shall specify a valid path within the file system. | +| `STATUS` | (Optional) Status flag. Returns 0 on success, a system specific and nonzero error code otherwise. The type shall be `INTEGER` and of the default kind. | + +#### Usage and Info + +- **Standard:** GNU extension +- **Class:** Subroutine, function +- **Syntax:** `CALL CHDIR(NAME[, STATUS])` and `STATUS = CHDIR(NAME)` + +#### Example +```Fortran +program chdir_func + character(len=) :: path + integer :: status + + call chdir("/tmp") + status = chdir("..") + print *, "status: ", status +end program chdir_func +``` diff --git a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h index 9c9c0609f4fc3..c04a5fcfef92b 100644 --- a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h +++ b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h @@ -202,6 +202,8 @@ struct IntrinsicLibrary { mlir::Value genBtest(mlir::Type, llvm::ArrayRef); mlir::Value genCeiling(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genChar(mlir::Type, llvm::ArrayRef); + fir::ExtendedValue genChdir(std::optional resultType, + llvm::ArrayRef); template fir::ExtendedValue genCharacterCompare(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 02b9b68da0db4..51d2dc82f98ae 100644 --- a/flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h +++ b/flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h @@ -90,6 +90,10 @@ void genSignal(fir::FirOpBuilder &builder, mlir::Location loc, void genSleep(fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value seconds); +/// generate chdir runtime call +mlir::Value genChdir(fir::FirOpBuilder &builder, mlir::Location loc, + mlir::Value name); + } // namespace runtime } // namespace fir diff --git a/flang/include/flang/Runtime/extensions.h b/flang/include/flang/Runtime/extensions.h index a855c694e0090..8c0de3f7354a1 100644 --- a/flang/include/flang/Runtime/extensions.h +++ b/flang/include/flang/Runtime/extensions.h @@ -69,5 +69,8 @@ std::int64_t FORTRAN_PROCEDURE_NAME(access)(const char *name, std::int64_t nameLength, const char *mode, std::int64_t modeLength); #endif +// GNU extension subroutine CHDIR(NAME, [STATUS]) +int RTNAME(Chdir)(const char *name); + } // extern "C" #endif // FORTRAN_RUNTIME_EXTENSIONS_H_ diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp index f234241cfe14a..c357e345a4106 100644 --- a/flang/lib/Evaluate/intrinsics.cpp +++ b/flang/lib/Evaluate/intrinsics.cpp @@ -404,6 +404,8 @@ static const IntrinsicInterface genericIntrinsicFunction[]{ DefaultLogical}, {"ceiling", {{"a", AnyReal}, DefaultingKIND}, KINDInt}, {"char", {{"i", AnyInt, Rank::elementalOrBOZ}, DefaultingKIND}, KINDChar}, + {"chdir", {{"name", DefaultChar, Rank::scalar, Optionality::required}}, + DefaultInt}, {"cmplx", {{"x", AnyComplex}, DefaultingKIND}, KINDComplex}, {"cmplx", {{"x", AnyIntUnsignedOrReal, Rank::elementalOrBOZ}, @@ -1403,6 +1405,11 @@ static const IntrinsicInterface intrinsicSubroutine[]{ {"stat", AnyInt, Rank::scalar, Optionality::optional, common::Intent::Out}}, {}, Rank::elemental, IntrinsicClass::atomicSubroutine}, + {"chdir", + {{"name", DefaultChar, Rank::scalar, Optionality::required}, + {"status", AnyInt, Rank::scalar, Optionality::optional, + common::Intent::Out}}, + {}, Rank::elemental, IntrinsicClass::impureSubroutine}, {"co_broadcast", {{"a", AnyData, Rank::anyOrAssumedRank, Optionality::required, common::Intent::InOut}, @@ -2719,8 +2726,8 @@ bool IntrinsicProcTable::Implementation::IsDualIntrinsic( const std::string &name) const { // Collection for some intrinsics with function and subroutine form, // in order to pass the semantic check. - static const std::string dualIntrinsic[]{ - {"etime"s}, {"getcwd"s}, {"rename"s}, {"second"s}, {"system"s}}; + static const std::string dualIntrinsic[]{{"chdir"s}, {"etime"s}, {"getcwd"s}, + {"rename"s}, {"second"s}, {"system"s}}; return llvm::is_contained(dualIntrinsic, name); } diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp index 6a343645ab878..22bb894ac1488 100644 --- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp +++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp @@ -185,6 +185,10 @@ static constexpr IntrinsicHandler handlers[]{ {"c_ptr_ne", &I::genCPtrCompare}, {"ceiling", &I::genCeiling}, {"char", &I::genChar}, + {"chdir", + &I::genChdir, + {{{"name", asAddr}, {"status", asAddr, handleDynamicOptional}}}, + /*isElemental=*/false}, {"cmplx", &I::genCmplx, {{{"x", asValue}, {"y", asValue, handleDynamicOptional}}}}, @@ -3075,6 +3079,35 @@ IntrinsicLibrary::genChar(mlir::Type type, return fir::CharBoxValue{cast, len}; } +// CHDIR +fir::ExtendedValue +IntrinsicLibrary::genChdir(std::optional resultType, + llvm::ArrayRef args) { + assert((args.size() == 1 && resultType.has_value()) || + (args.size() >= 1 && !resultType.has_value())); + mlir::Value name = fir::getBase(args[0]); + mlir::Value status = fir::runtime::genChdir(builder, loc, name); + + if (resultType.has_value()) { + return status; + } else { + // Subroutine form, store status and return none. + if (!isStaticallyAbsent(args[1])) { + mlir::Value statusAddr = fir::getBase(args[1]); + statusAddr.dump(); + mlir::Value statusIsPresentAtRuntime = + builder.genIsNotNullAddr(loc, statusAddr); + builder.genIfThen(loc, statusIsPresentAtRuntime) + .genThen([&]() { + builder.createStoreWithConvert(loc, status, statusAddr); + }) + .end(); + } + } + + return {}; +} + // CMPLX mlir::Value IntrinsicLibrary::genCmplx(mlir::Type resultType, llvm::ArrayRef args) { diff --git a/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp b/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp index ded9579f2c1df..40930890c8731 100644 --- a/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp +++ b/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp @@ -385,3 +385,13 @@ void fir::runtime::genSleep(fir::FirOpBuilder &builder, mlir::Location loc, fir::runtime::getRuntimeFunc(loc, builder)}; builder.create(loc, func, seconds); } + +/// generate chdir runtime call +mlir::Value fir::runtime::genChdir(fir::FirOpBuilder &builder, + mlir::Location loc, mlir::Value name) { + mlir::func::FuncOp func{ + fir::runtime::getRuntimeFunc(loc, builder)}; + llvm::SmallVector args = + fir::runtime::createArguments(builder, loc, func.getFunctionType(), name); + return builder.create(loc, func, args).getResult(0); +} diff --git a/flang/runtime/extensions.cpp b/flang/runtime/extensions.cpp index 50d3c72fe650d..fe71cd9d97fa3 100644 --- a/flang/runtime/extensions.cpp +++ b/flang/runtime/extensions.cpp @@ -51,7 +51,9 @@ inline void CtimeBuffer(char *buffer, size_t bufsize, const time_t cur_time, #ifndef _WIN32 // posix-compliant and has getlogin_r and F_OK -#include +#include +#else +#include #endif extern "C" { @@ -248,5 +250,15 @@ std::int64_t FORTRAN_PROCEDURE_NAME(access)(const char *name, } #endif +// CHDIR(DIR) +int RTNAME(Chdir)(const char *name) { +// chdir alias seems to be deprecated on Windows. +#ifndef _WIN32 + return chdir(name); +#else + return _chdir(name); +#endif +} + } // namespace Fortran::runtime } // extern "C" diff --git a/flang/test/Lower/Intrinsics/chdir.f90 b/flang/test/Lower/Intrinsics/chdir.f90 new file mode 100644 index 0000000000000..3c47b41b95e8d --- /dev/null +++ b/flang/test/Lower/Intrinsics/chdir.f90 @@ -0,0 +1,94 @@ +! RUN: bbc -emit-hlfir %s -o - | FileCheck %s + +subroutine test_chdir() + implicit none +! CHECK-LABEL: func.func @_QPtest_chdir() { + + call chdir("..") +! CHECK: %[[VAL_0:.*]] = fir.address_of(@_QQclX2E2E) : !fir.ref> +! CHECK: %[[C_2:.*]] = arith.constant 2 : index +! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] typeparams %[[C_2]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QQclX2E2E"} : (!fir.ref>, index) -> (!fir.ref>, !fir.ref>) +! CHECK: %[[VAL_2:.*]] = fir.convert %[[VAL_1]]#1 : (!fir.ref>) -> !fir.ref +! CHECK: %[[VAL_3:.*]] = fir.call @_FortranAChdir(%[[VAL_2]]) fastmath : (!fir.ref) -> i32 +end subroutine + +subroutine test_chdir_subroutine_status_i4() + implicit none + integer(4) :: stat +! CHECK-LABEL: func.func @_QPtest_chdir_subroutine_status_i4() { + + call chdir("..", STATUS=stat) +! CHECK: %[[VAL_0:.*]] = fir.alloca i32 {bindc_name = "stat", uniq_name = "_QFtest_chdir_subroutine_status_i4Estat"} +! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = "_QFtest_chdir_subroutine_status_i4Estat"} : (!fir.ref) -> +! (!fir.ref, !fir.ref) +! CHECK: %[[VAL_2:.*]] = fir.address_of(@_QQclX2E2E) : !fir.ref> +! CHECK: %[[C_2:.*]] = arith.constant 2 : index +! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_2]] typeparams %[[C_2]] {fortran_attrs = #fir.var_attrs, uniq_name = {{.*}} : (!fir.ref>, index) -> (!fir.ref>, !fir.ref>) +! CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_3]]#1 : (!fir.ref>) -> !fir.ref +! CHECK: %[[VAL_5:.*]] = fir.call @_FortranAChdir(%[[VAL_4]]) fastmath : (!fir.ref) -> i32 +! CHECK: %[[VAL_6:.*]] = fir.convert %{{.*}} : (!fir.ref) -> i64 +! CHECK: %[[C_0_I64:.*]] = arith.constant 0 : i64 +! CHECK: %[[VAL_7:.*]] = arith.cmpi ne, %[[VAL_6]], %[[C_0_I64]] : i64 +! CHECK: fir.if %[[VAL_7]] { +! CHECK: fir.store %[[VAL_5]] to %[[VAL_1]]#1 : !fir.ref +! CHECK: } +end subroutine + +subroutine test_chdir_function_status_i4() + implicit none + integer(4) :: stat +! CHECK-LABEL: func.func @_QPtest_chdir_function_status_i4() { + + stat = chdir("..") +! CHECK: %[[VAL_0:.*]] = fir.alloca i32 {bindc_name = "stat", uniq_name = "_QFtest_chdir_function_status_i4Estat"} +! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = "_QFtest_chdir_function_status_i4Estat"} : (!fir.ref) -> +! (!fir.ref, !fir.ref) +! CHECK: %[[VAL_2:.*]] = fir.address_of(@_QQclX2E2E) : !fir.ref> +! CHECK: %[[C_2:.*]] = arith.constant 2 : index +! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_2]] typeparams %[[C_2]] {fortran_attrs = #fir.var_attrs, uniq_name = {{.*}} : (!fir.ref>, index) -> (!fir.ref>, !fir.ref>) +! CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_3]]#1 : (!fir.ref>) -> !fir.ref +! CHECK: %[[VAL_5:.*]] = fir.call @_FortranAChdir(%[[VAL_4]]) fastmath : (!fir.ref) -> i32 +! CHECK: hlfir.assign %[[VAL_5]] to %[[VAL_1]]#0 : i32, !fir.ref +end subroutine + +subroutine test_chdir_subroutine_status_i8() + implicit none + integer(8) :: stat +! CHECK-LABEL: func.func @_QPtest_chdir_subroutine_status_i8() { + + call chdir("..", STATUS=stat) +! CHECK: %[[VAL_0:.*]] = fir.alloca i64 {bindc_name = "stat", uniq_name = "_QFtest_chdir_subroutine_status_i8Estat"} +! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = "_QFtest_chdir_subroutine_status_i8Estat"} : (!fir.ref) -> +! (!fir.ref, !fir.ref) +! CHECK: %[[VAL_2:.*]] = fir.address_of(@_QQclX2E2E) : !fir.ref> +! CHECK: %[[C_2:.*]] = arith.constant 2 : index +! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_2]] typeparams %[[C_2]] {fortran_attrs = #fir.var_attrs, uniq_name = {{.*}} : (!fir.ref>, index) -> (!fir.ref>, !fir.ref>) +! CHECK: %[[VAL_4:.*]] = fir.convert %{{.*}} : (!fir.ref>) -> !fir.ref +! CHECK: %[[VAL_5:.*]] = fir.call @_FortranAChdir(%[[VAL_4]]) fastmath : (!fir.ref) -> i32 +! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_1]]#1 : (!fir.ref) -> i64 +! CHECK: %[[C_0_I64:.*]] = arith.constant 0 : i64 +! CHECK: %[[VAL_7:.*]] = arith.cmpi ne, %[[VAL_6]], %[[C_0_I64]] : i64 +! CHECK: fir.if %[[VAL_7]] { +! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_5]] : (i32) -> i64 +! CHECK: fir.store %[[VAL_8]] to %[[VAL_1]]#1 : !fir.ref +! CHECK: } +end subroutine + +subroutine test_chdir_function_status_i8() + implicit none + integer(8) :: stat +! CHECK-LABEL: func.func @_QPtest_chdir_function_status_i8() { + + stat = chdir("..") +! CHECK: %[[VAL_0:.*]] = fir.alloca i64 {bindc_name = "stat", uniq_name = "_QFtest_chdir_function_status_i8Estat"} +! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = "_QFtest_chdir_function_status_i8Estat"} : (!fir.ref) -> +! (!fir.ref, !fir.ref) +! CHECK: %[[VAL_2:.*]] = fir.address_of(@_QQclX2E2E) : !fir.ref> +! CHECK: %[[C_2:.*]] = arith.constant 2 : index +! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_2]] typeparams %[[C_2]] {fortran_attrs = #fir.var_attrs, uniq_name = {{.*}} : (!fir.ref>, index) -> (!fir.ref>, !fir.ref>) +! CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_3]]#1 : (!fir.ref>) -> !fir.ref +! CHECK: %[[VAL_5:.*]] = fir.call @_FortranAChdir(%[[VAL_4]]) fastmath : (!fir.ref) -> i32 +! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (i32) -> i64 +! CHECK: hlfir.assign %[[VAL_6]] to %[[VAL_1]]#0 : i64, !fir.ref +end subroutine +