[flang-commits] [flang] [flang] Implement CHDIR intrinsic (PR #124280)
Jean-Didier PAILLEUX via flang-commits
flang-commits at lists.llvm.org
Mon Jan 27 12:19:59 PST 2025
https://github.com/JDPailleux updated https://github.com/llvm/llvm-project/pull/124280
>From 986666291ef51efb61f23b050a810d32f9b3fd28 Mon Sep 17 00:00:00 2001
From: Jean-Didier Pailleux <jean-didier.pailleux at sipearl.com>
Date: Mon, 27 Jan 2025 21:19:24 +0100
Subject: [PATCH] [flang] Implement CHDIR intrinsic
---
flang/docs/Intrinsics.md | 34 ++++++-
.../flang/Optimizer/Builder/IntrinsicCall.h | 2 +
.../Optimizer/Builder/Runtime/Intrinsics.h | 4 +
flang/include/flang/Runtime/extensions.h | 3 +
flang/lib/Evaluate/intrinsics.cpp | 11 ++-
flang/lib/Optimizer/Builder/IntrinsicCall.cpp | 33 +++++++
.../Optimizer/Builder/Runtime/Intrinsics.cpp | 10 ++
flang/runtime/extensions.cpp | 14 ++-
flang/test/Lower/Intrinsics/chdir.f90 | 94 +++++++++++++++++++
9 files changed, 201 insertions(+), 4 deletions(-)
create mode 100644 flang/test/Lower/Intrinsics/chdir.f90
diff --git a/flang/docs/Intrinsics.md b/flang/docs/Intrinsics.md
index d0b7999fbd067e..e210191864bc0f 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,35 @@ 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.
+
+** and *STATUS* are `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) `INTEGER`status flag of the default kind. Returns 0 on success, and a system specific and nonzero error code otherwise. |
+
+#### Usage and Info
+
+- **Standard:** GNU extension
+- **Class:** Subroutine, function
+- **Syntax:** `CALL CHDIR(NAME[, STATUS])`, `STATUS = CHDIR(NAME)`
+
+#### Example
+```Fortran
+PROGRAM test_chdir
+ CHARACTER(len=255) :: path
+ CALL getcwd(path)
+ WRITE(*,*) TRIM(path)
+ CALL chdir("/tmp")
+ CALL getcwd(path)
+ WRITE(*,*) TRIM(path)
+END PROGRAM
+```
diff --git a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
index 9c9c0609f4fc3c..c04a5fcfef92b3 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>);
mlir::Value genCeiling(mlir::Type, llvm::ArrayRef<mlir::Value>);
fir::ExtendedValue genChar(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
+ fir::ExtendedValue genChdir(std::optional<mlir::Type> resultType,
+ llvm::ArrayRef<fir::ExtendedValue>);
template <mlir::arith::CmpIPredicate pred>
fir::ExtendedValue genCharacterCompare(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 02b9b68da0db4b..51d2dc82f98aee 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 a855c694e0090d..8c0de3f7354a15 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 f234241cfe14a6..9d3aee1521bce7 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}},
+ TypePattern{IntType, KindCode::greaterOrEqualToKind, 4}},
{"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 6a343645ab8786..22bb894ac1488c 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<mlir::arith::CmpIPredicate::ne>},
{"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<mlir::Type> resultType,
+ llvm::ArrayRef<fir::ExtendedValue> 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<mlir::Value> args) {
diff --git a/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp b/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp
index ded9579f2c1df0..40930890c87316 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<mkRTKey(Sleep)>(loc, builder)};
builder.create<fir::CallOp>(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<mkRTKey(Chdir)>(loc, builder)};
+ llvm::SmallVector<mlir::Value> args =
+ fir::runtime::createArguments(builder, loc, func.getFunctionType(), name);
+ return builder.create<fir::CallOp>(loc, func, args).getResult(0);
+}
diff --git a/flang/runtime/extensions.cpp b/flang/runtime/extensions.cpp
index 50d3c72fe650d0..fe71cd9d97fa39 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 <unistd.h>
+#include <unistd.h>
+#else
+#include <direct.h>
#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 00000000000000..3c47b41b95e8d9
--- /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<!fir.char<1,2>>
+! CHECK: %[[C_2:.*]] = arith.constant 2 : index
+! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] typeparams %[[C_2]] {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQclX2E2E"} : (!fir.ref<!fir.char<1,2>>, index) -> (!fir.ref<!fir.char<1,2>>, !fir.ref<!fir.char<1,2>>)
+! CHECK: %[[VAL_2:.*]] = fir.convert %[[VAL_1]]#1 : (!fir.ref<!fir.char<1,2>>) -> !fir.ref<i8>
+! CHECK: %[[VAL_3:.*]] = fir.call @_FortranAChdir(%[[VAL_2]]) fastmath<contract> : (!fir.ref<i8>) -> 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<i32>) ->
+! (!fir.ref<i32>, !fir.ref<i32>)
+! CHECK: %[[VAL_2:.*]] = fir.address_of(@_QQclX2E2E) : !fir.ref<!fir.char<1,2>>
+! CHECK: %[[C_2:.*]] = arith.constant 2 : index
+! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_2]] typeparams %[[C_2]] {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = {{.*}} : (!fir.ref<!fir.char<1,2>>, index) -> (!fir.ref<!fir.char<1,2>>, !fir.ref<!fir.char<1,2>>)
+! CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_3]]#1 : (!fir.ref<!fir.char<1,2>>) -> !fir.ref<i8>
+! CHECK: %[[VAL_5:.*]] = fir.call @_FortranAChdir(%[[VAL_4]]) fastmath<contract> : (!fir.ref<i8>) -> i32
+! CHECK: %[[VAL_6:.*]] = fir.convert %{{.*}} : (!fir.ref<i32>) -> 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<i32>
+! 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<i32>) ->
+! (!fir.ref<i32>, !fir.ref<i32>)
+! CHECK: %[[VAL_2:.*]] = fir.address_of(@_QQclX2E2E) : !fir.ref<!fir.char<1,2>>
+! CHECK: %[[C_2:.*]] = arith.constant 2 : index
+! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_2]] typeparams %[[C_2]] {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = {{.*}} : (!fir.ref<!fir.char<1,2>>, index) -> (!fir.ref<!fir.char<1,2>>, !fir.ref<!fir.char<1,2>>)
+! CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_3]]#1 : (!fir.ref<!fir.char<1,2>>) -> !fir.ref<i8>
+! CHECK: %[[VAL_5:.*]] = fir.call @_FortranAChdir(%[[VAL_4]]) fastmath<contract> : (!fir.ref<i8>) -> i32
+! CHECK: hlfir.assign %[[VAL_5]] to %[[VAL_1]]#0 : i32, !fir.ref<i32>
+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<i64>) ->
+! (!fir.ref<i64>, !fir.ref<i64>)
+! CHECK: %[[VAL_2:.*]] = fir.address_of(@_QQclX2E2E) : !fir.ref<!fir.char<1,2>>
+! CHECK: %[[C_2:.*]] = arith.constant 2 : index
+! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_2]] typeparams %[[C_2]] {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = {{.*}} : (!fir.ref<!fir.char<1,2>>, index) -> (!fir.ref<!fir.char<1,2>>, !fir.ref<!fir.char<1,2>>)
+! CHECK: %[[VAL_4:.*]] = fir.convert %{{.*}} : (!fir.ref<!fir.char<1,2>>) -> !fir.ref<i8>
+! CHECK: %[[VAL_5:.*]] = fir.call @_FortranAChdir(%[[VAL_4]]) fastmath<contract> : (!fir.ref<i8>) -> i32
+! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_1]]#1 : (!fir.ref<i64>) -> 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<i64>
+! 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<i64>) ->
+! (!fir.ref<i64>, !fir.ref<i64>)
+! CHECK: %[[VAL_2:.*]] = fir.address_of(@_QQclX2E2E) : !fir.ref<!fir.char<1,2>>
+! CHECK: %[[C_2:.*]] = arith.constant 2 : index
+! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_2]] typeparams %[[C_2]] {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = {{.*}} : (!fir.ref<!fir.char<1,2>>, index) -> (!fir.ref<!fir.char<1,2>>, !fir.ref<!fir.char<1,2>>)
+! CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_3]]#1 : (!fir.ref<!fir.char<1,2>>) -> !fir.ref<i8>
+! CHECK: %[[VAL_5:.*]] = fir.call @_FortranAChdir(%[[VAL_4]]) fastmath<contract> : (!fir.ref<i8>) -> i32
+! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (i32) -> i64
+! CHECK: hlfir.assign %[[VAL_6]] to %[[VAL_1]]#0 : i64, !fir.ref<i64>
+end subroutine
+
More information about the flang-commits
mailing list