[flang] Implement CHDIR intrinsic

Author: JDPailleux

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

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
 

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

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

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

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

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"

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