[flang-commits] [flang] [flang] Implement CHDIR intrinsic (PR #124280)

via flang-commits flang-commits at lists.llvm.org
Fri Jan 24 06:58:54 PST 2025


llvmbot wrote:


<!--LLVM PR SUMMARY COMMENT-->

@llvm/pr-subscribers-flang-fir-hlfir

Author: Jean-Didier PAILLEUX (JDPailleux)

<details>
<summary>Changes</summary>

This intrinsic is a gnu extension (https://gcc.gnu.org/onlinedocs/gfortran/CHDIR.html) and is used in FLEUR (https://github.com/JuDFTteam/FLEUR).

---
Full diff: https://github.com/llvm/llvm-project/pull/124280.diff


8 Files Affected:

- (modified) flang/include/flang/Optimizer/Builder/IntrinsicCall.h (+1) 
- (modified) flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h (+4) 
- (modified) flang/include/flang/Runtime/extensions.h (+3) 
- (modified) flang/lib/Evaluate/intrinsics.cpp (+5) 
- (modified) flang/lib/Optimizer/Builder/IntrinsicCall.cpp (+17) 
- (modified) flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp (+10) 
- (modified) flang/runtime/extensions.cpp (+8) 
- (added) flang/test/Lower/Intrinsics/chdir.f90 (+15) 


``````````diff
diff --git a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
index 9c9c0609f4fc3c..9b6da461e18549 100644
--- a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
+++ b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
@@ -202,6 +202,7 @@ 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>);
+  void genChdir(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..34a2edb5b0971d 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
+void genChdir(fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value dir,
+              mlir::Value status);
+
 } // namespace runtime
 } // namespace fir
 
diff --git a/flang/include/flang/Runtime/extensions.h b/flang/include/flang/Runtime/extensions.h
index a855c694e0090d..929dbeeafd8fd6 100644
--- a/flang/include/flang/Runtime/extensions.h
+++ b/flang/include/flang/Runtime/extensions.h
@@ -62,6 +62,9 @@ std::int64_t RTNAME(Signal)(std::int64_t number, void (*handler)(int));
 // GNU extension subroutine SLEEP(SECONDS)
 void RTNAME(Sleep)(std::int64_t seconds);
 
+// GNU extension subroutine CHDIR(DIR, [STATUS])
+void RTNAME(Chdir)(const char *dir, int *status);
+
 // GNU extension function ACCESS(NAME, MODE)
 // TODO: not supported on Windows
 #ifndef _WIN32
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index f234241cfe14a6..e65af98f266e80 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -1403,6 +1403,11 @@ static const IntrinsicInterface intrinsicSubroutine[]{
             {"stat", AnyInt, Rank::scalar, Optionality::optional,
                 common::Intent::Out}},
         {}, Rank::elemental, IntrinsicClass::atomicSubroutine},
+    {"chdir",
+        {{"dir", AnyChar, Rank::anyOrAssumedRank},
+            {"stat", AnyInt, Rank::scalar, Optionality::optional,
+                common::Intent::Out}},
+        {}, Rank::elemental, IntrinsicClass::impureSubroutine},
     {"co_broadcast",
         {{"a", AnyData, Rank::anyOrAssumedRank, Optionality::required,
              common::Intent::InOut},
diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
index 6a343645ab8786..a512439308a2df 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,
+     {{{"dir", asValue}, {"status", asAddr, handleDynamicOptional}}},
+     /*isElemental=*/false},
     {"cmplx",
      &I::genCmplx,
      {{{"x", asValue}, {"y", asValue, handleDynamicOptional}}}},
@@ -3075,6 +3079,19 @@ IntrinsicLibrary::genChar(mlir::Type type,
   return fir::CharBoxValue{cast, len};
 }
 
+// CHDIR
+void IntrinsicLibrary::genChdir(llvm::ArrayRef<fir::ExtendedValue> args) {
+  assert(args.size() == 2);
+  mlir::Value status =
+      isStaticallyAbsent(args[1])
+          ? builder
+                .create<fir::AbsentOp>(
+                    loc, builder.getRefType(builder.getNoneType()))
+                .getResult()
+          : fir::getBase(args[1]);
+  fir::runtime::genChdir(builder, loc, fir::getBase(args[0]), status);
+}
+
 // 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..66aa04d25c4ece 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
+void fir::runtime::genChdir(fir::FirOpBuilder &builder, mlir::Location loc,
+                            mlir::Value dir, mlir::Value status) {
+  mlir::func::FuncOp func{
+      fir::runtime::getRuntimeFunc<mkRTKey(Chdir)>(loc, builder)};
+  llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments(
+      builder, loc, func.getFunctionType(), dir, status);
+  builder.create<fir::CallOp>(loc, func, args);
+}
diff --git a/flang/runtime/extensions.cpp b/flang/runtime/extensions.cpp
index 50d3c72fe650d0..7426072d324f91 100644
--- a/flang/runtime/extensions.cpp
+++ b/flang/runtime/extensions.cpp
@@ -21,6 +21,7 @@
 #include <ctime>
 #include <signal.h>
 #include <thread>
+#include <unistd.h>
 
 #ifdef _WIN32
 #define WIN32_LEAN_AND_MEAN
@@ -248,5 +249,12 @@ std::int64_t FORTRAN_PROCEDURE_NAME(access)(const char *name,
 }
 #endif
 
+// CHDIR(DIR)
+void RTNAME(Chdir)(const char *dir, int *status) {
+  int stat = chdir(dir);
+  if (status)
+    *status = stat;
+}
+
 } // 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..6194f831d8003e
--- /dev/null
+++ b/flang/test/Lower/Intrinsics/chdir.f90
@@ -0,0 +1,15 @@
+! 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:.*]] = 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.absent !fir.ref<none>
+! CHECK:  %[[VAL_3:.*]] = fir.convert %{{.*}} : (!fir.ref<!fir.char<1,2>>) -> !fir.ref<i8>
+! CHECK:  %[[VAL_4:.*]] = fir.convert %{{.*}} : (!fir.ref<none>) -> !fir.ref<i32>
+! CHECK:  %[[VAL_5:.*]] = fir.call @_FortranAChdir(%[[VAL_3]], %[[VAL_4]]) fastmath<contract> : (!fir.ref<i8>, !fir.ref<i32>) -> none
+end subroutine

``````````

</details>


https://github.com/llvm/llvm-project/pull/124280


More information about the flang-commits mailing list