[flang-commits] [flang] [Flang] Implement RENAME intrinsic (code-gen + runtime entry point) (PR #98359)

Michael Klemm via flang-commits flang-commits at lists.llvm.org
Wed Jul 10 21:56:23 PDT 2024


https://github.com/mjklemm updated https://github.com/llvm/llvm-project/pull/98359

>From 58638d6e3ebaf39373d69143e464df8566e6e376 Mon Sep 17 00:00:00 2001
From: Michael Klemm <michael.klemm at amd.com>
Date: Wed, 10 Jul 2024 14:13:37 +0200
Subject: [PATCH 1/7] Implement code-gen for RENAME intrinsic

---
 .../flang/Optimizer/Builder/IntrinsicCall.h   |  2 +
 .../Optimizer/Builder/Runtime/Intrinsics.h    |  4 ++
 flang/include/flang/Runtime/misc-intrinsic.h  |  2 +
 flang/lib/Evaluate/intrinsics.cpp             | 15 +++++++-
 flang/lib/Optimizer/Builder/IntrinsicCall.cpp | 37 +++++++++++++++++++
 .../Optimizer/Builder/Runtime/Intrinsics.cpp  | 18 +++++++++
 flang/runtime/misc-intrinsic.cpp              |  4 ++
 7 files changed, 81 insertions(+), 1 deletion(-)

diff --git a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
index 53168a920e3c6..a5f701bee5120 100644
--- a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
+++ b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
@@ -347,6 +347,8 @@ struct IntrinsicLibrary {
   fir::ExtendedValue genReduce(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genReduceDim(mlir::Type,
                                   llvm::ArrayRef<fir::ExtendedValue>);
+  fir::ExtendedValue genRename(std::optional<mlir::Type>,
+                               mlir::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genRepeat(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genReshape(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   mlir::Value genRRSpacing(mlir::Type resultType,
diff --git a/flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h b/flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h
index 7497a4bc35646..240de5a899d37 100644
--- a/flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h
+++ b/flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h
@@ -53,6 +53,10 @@ void genRandomNumber(fir::FirOpBuilder &, mlir::Location, mlir::Value harvest);
 void genRandomSeed(fir::FirOpBuilder &, mlir::Location, mlir::Value size,
                    mlir::Value put, mlir::Value get);
 
+/// generate rename runtime call
+void genRename(fir::FirOpBuilder &builder, mlir::Location loc,
+               mlir::Value path1, mlir::Value path2, mlir::Value status);
+
 /// generate runtime call to transfer intrinsic with no size argument
 void genTransfer(fir::FirOpBuilder &builder, mlir::Location loc,
                  mlir::Value resultBox, mlir::Value sourceBox,
diff --git a/flang/include/flang/Runtime/misc-intrinsic.h b/flang/include/flang/Runtime/misc-intrinsic.h
index 73cc9e2023d97..3fb3aaed49c0f 100644
--- a/flang/include/flang/Runtime/misc-intrinsic.h
+++ b/flang/include/flang/Runtime/misc-intrinsic.h
@@ -19,6 +19,8 @@ namespace Fortran::runtime {
 class Descriptor;
 
 extern "C" {
+void RTDECL(Rename)(const Descriptor &path1, const Descriptor &path2,
+    const Descriptor *status, const char *sourceFile, int line);
 void RTDECL(Transfer)(Descriptor &result, const Descriptor &source,
     const Descriptor &mold, const char *sourceFile, int line);
 void RTDECL(TransferSize)(Descriptor &result, const Descriptor &source,
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index 80752d02b5baf..59fe1ad523094 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -795,6 +795,11 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
             {"identity", SameType, Rank::scalar, Optionality::optional},
             {"ordered", AnyLogical, Rank::scalar, Optionality::optional}},
         SameType, Rank::scalar, IntrinsicClass::transformationalFunction},
+    {"rename",
+        {{"path1", DefaultChar, Rank::scalar},
+         {"path2", DefaultChar, Rank::scalar}},
+        DefaultInt, Rank::scalar
+    },
     {"repeat",
         {{"string", SameCharNoLen, Rank::scalar},
             {"ncopies", AnyInt, Rank::scalar}},
@@ -1463,6 +1468,14 @@ static const IntrinsicInterface intrinsicSubroutine[]{
             {"get", DefaultInt, Rank::vector, Optionality::optional,
                 common::Intent::Out}},
         {}, Rank::elemental, IntrinsicClass::impureSubroutine},
+    {
+        "rename",
+        {{"path1", DefaultChar, Rank::scalar},
+         {"path2", DefaultChar, Rank::scalar},
+         {"status", DefaultInt, Rank::scalar,
+             Optionality::optional, common::Intent::Out}},
+        {}, Rank::scalar, IntrinsicClass::impureSubroutine
+    },
     {"system",
         {{"command", DefaultChar, Rank::scalar},
             {"exitstat", DefaultInt, Rank::scalar, Optionality::optional,
@@ -2610,7 +2623,7 @@ 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"}, {"getcwd"}};
+  static const std::string dualIntrinsic[]{{"etime"}, {"getcwd"}, {"rename"}};
 
   return std::find_if(std::begin(dualIntrinsic), std::end(dualIntrinsic),
              [&name](const std::string &dualName) {
diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
index f4541bf30676a..71cc60fc2ec9b 100644
--- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
+++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
@@ -550,6 +550,12 @@ static constexpr IntrinsicHandler handlers[]{
        {"identity", asAddr, handleDynamicOptional},
        {"ordered", asValue, handleDynamicOptional}}},
      /*isElemental=*/false},
+    {"rename",
+     &I::genRename,
+     {{{"path1", asBox},
+       {"path2", asBox},
+       {"status", asBox, handleDynamicOptional}}},
+     /*isElemental=*/false},
     {"repeat",
      &I::genRepeat,
      {{{"string", asAddr}, {"ncopies", asValue}}},
@@ -5911,6 +5917,37 @@ IntrinsicLibrary::genReduce(mlir::Type resultType,
   return readAndAddCleanUp(resultMutableBox, resultType, "REDUCE");
 }
 
+// RENAME
+fir::ExtendedValue
+IntrinsicLibrary::genRename(std::optional<mlir::Type> resultType,
+                            mlir::ArrayRef<fir::ExtendedValue> args) {
+  assert((args.size() == 3 && !resultType.has_value()) ||
+         (args.size() == 2 && resultType.has_value()));
+
+  mlir::Value path1 = fir::getBase(args[0]);
+  mlir::Value path2 = fir::getBase(args[1]);
+  if (!path1 || !path2)
+    fir::emitFatalError(loc, "Expected at least two dummy arguments");
+
+  if (resultType.has_value()) {
+    // code-gen for the function form of RENAME
+    auto statusAddr = builder.createTemporary(loc, *resultType);
+    auto statusBox = builder.createBox(loc, statusAddr);
+    fir::runtime::genRename(builder, loc, path1, path2, statusBox);
+    return builder.create<fir::LoadOp>(loc, statusAddr);
+  } else {
+    // code-gen for the procedure form of RENAME
+    mlir::Type boxNoneTy = fir::BoxType::get(builder.getNoneType());
+    auto status = args[2];
+    mlir::Value statusBox =
+        isStaticallyPresent(status)
+            ? fir::getBase(status)
+            : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
+    fir::runtime::genRename(builder, loc, path1, path2, statusBox);
+    return {};
+  }
+}
+
 // REPEAT
 fir::ExtendedValue
 IntrinsicLibrary::genRepeat(mlir::Type resultType,
diff --git a/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp b/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp
index 3f36d639861b1..5bff375f998b4 100644
--- a/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp
+++ b/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp
@@ -199,6 +199,24 @@ void fir::runtime::genRandomSeed(fir::FirOpBuilder &builder, mlir::Location loc,
   builder.create<fir::CallOp>(loc, func, args);
 }
 
+
+/// generate rename runtime call
+void fir::runtime::genRename(fir::FirOpBuilder &builder, mlir::Location loc,
+               mlir::Value path1, mlir::Value path2, mlir::Value status) {
+  auto runtimeFunc = fir::runtime::getRuntimeFunc<mkRTKey(Rename)>(loc, builder);
+  mlir::FunctionType runtimeFuncTy = runtimeFunc.getFunctionType();
+
+  mlir::Value sourceFile = fir::factory::locationToFilename(builder, loc);
+  mlir::Value sourceLine =
+      fir::factory::locationToLineNo(builder, loc, runtimeFuncTy.getInput(4));
+
+  llvm::SmallVector<mlir::Value> args =
+      fir::runtime::createArguments(builder, loc, runtimeFuncTy,
+                                    path1, path2, status,
+                                    sourceFile, sourceLine);
+  builder.create<fir::CallOp>(loc, runtimeFunc, args);
+}
+
 /// generate runtime call to transfer intrinsic with no size argument
 void fir::runtime::genTransfer(fir::FirOpBuilder &builder, mlir::Location loc,
                                mlir::Value resultBox, mlir::Value sourceBox,
diff --git a/flang/runtime/misc-intrinsic.cpp b/flang/runtime/misc-intrinsic.cpp
index f5b292a1f3d32..1b86c00107153 100644
--- a/flang/runtime/misc-intrinsic.cpp
+++ b/flang/runtime/misc-intrinsic.cpp
@@ -55,6 +55,10 @@ static RT_API_ATTRS void TransferImpl(Descriptor &result,
 extern "C" {
 RT_EXT_API_GROUP_BEGIN
 
+void RTDECL(Rename)(const Descriptor &path1, const Descriptor &path2,
+    const Descriptor *status, const char *sourceFile, int line) {
+}
+
 void RTDEF(Transfer)(Descriptor &result, const Descriptor &source,
     const Descriptor &mold, const char *sourceFile, int line) {
   Fortran::common::optional<std::int64_t> elements;

>From 2fe5659ea7c7bd7682442714f8ea25df0156e0fb Mon Sep 17 00:00:00 2001
From: Michael Klemm <michael.klemm at amd.com>
Date: Wed, 10 Jul 2024 14:55:59 +0200
Subject: [PATCH 2/7] Add runtime implementation for non-Windows systems

---
 flang/runtime/misc-intrinsic.cpp | 22 ++++++++++++++++++++++
 1 file changed, 22 insertions(+)

diff --git a/flang/runtime/misc-intrinsic.cpp b/flang/runtime/misc-intrinsic.cpp
index 1b86c00107153..950606d7454fd 100644
--- a/flang/runtime/misc-intrinsic.cpp
+++ b/flang/runtime/misc-intrinsic.cpp
@@ -57,6 +57,28 @@ RT_EXT_API_GROUP_BEGIN
 
 void RTDECL(Rename)(const Descriptor &path1, const Descriptor &path2,
     const Descriptor *status, const char *sourceFile, int line) {
+  Terminator terminator{sourceFile, line};
+
+  char * pathSrc{EnsureNullTerminated(path1.OffsetElement(), path1.ElementBytes(), terminator)};
+  char * pathDst{EnsureNullTerminated(path2.OffsetElement(), path2.ElementBytes(), terminator)};
+
+#ifdef _WIN32
+  terminator.crash("RENAME intrinsic not implemented on Windows");
+#else // _WIN32
+  // We simply call rename(2) on a non-Windows system
+  int result = rename(pathSrc, pathDst);
+  if (status) {
+    StoreIntToDescriptor(status, result, terminator);
+  }
+#endif // WIN32
+
+  // Deallocate memory if EnsureNullTerminated dynamically allocated memory
+  if (pathSrc != path1.OffsetElement()) {
+    FreeMemory(pathSrc);
+  }
+  if (pathDst != path2.OffsetElement()) {
+    FreeMemory(pathDst);
+  }
 }
 
 void RTDEF(Transfer)(Descriptor &result, const Descriptor &source,

>From 961db92213349dbea6a0859ac2d0f07c9c8199db Mon Sep 17 00:00:00 2001
From: Michael Klemm <michael at dontknow.de>
Date: Wed, 10 Jul 2024 16:27:40 +0200
Subject: [PATCH 3/7] Also use the POSIX API in Windows

---
 flang/runtime/misc-intrinsic.cpp | 6 +-----
 1 file changed, 1 insertion(+), 5 deletions(-)

diff --git a/flang/runtime/misc-intrinsic.cpp b/flang/runtime/misc-intrinsic.cpp
index 950606d7454fd..54f249992c03e 100644
--- a/flang/runtime/misc-intrinsic.cpp
+++ b/flang/runtime/misc-intrinsic.cpp
@@ -62,15 +62,11 @@ void RTDECL(Rename)(const Descriptor &path1, const Descriptor &path2,
   char * pathSrc{EnsureNullTerminated(path1.OffsetElement(), path1.ElementBytes(), terminator)};
   char * pathDst{EnsureNullTerminated(path2.OffsetElement(), path2.ElementBytes(), terminator)};
 
-#ifdef _WIN32
-  terminator.crash("RENAME intrinsic not implemented on Windows");
-#else // _WIN32
-  // We simply call rename(2) on a non-Windows system
+  // We simply call rename(2) from POSIX
   int result = rename(pathSrc, pathDst);
   if (status) {
     StoreIntToDescriptor(status, result, terminator);
   }
-#endif // WIN32
 
   // Deallocate memory if EnsureNullTerminated dynamically allocated memory
   if (pathSrc != path1.OffsetElement()) {

>From 9096b192e48f4383cd40458bbf7e101fae097dff Mon Sep 17 00:00:00 2001
From: Michael Klemm <michael.klemm at amd.com>
Date: Wed, 10 Jul 2024 16:40:18 +0200
Subject: [PATCH 4/7] Format source code

---
 flang/lib/Evaluate/intrinsics.cpp               | 17 +++++++----------
 .../Optimizer/Builder/Runtime/Intrinsics.cpp    | 12 ++++++------
 flang/runtime/misc-intrinsic.cpp                |  6 ++++--
 3 files changed, 17 insertions(+), 18 deletions(-)

diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index 59fe1ad523094..02afe5406b02b 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -797,9 +797,8 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
         SameType, Rank::scalar, IntrinsicClass::transformationalFunction},
     {"rename",
         {{"path1", DefaultChar, Rank::scalar},
-         {"path2", DefaultChar, Rank::scalar}},
-        DefaultInt, Rank::scalar
-    },
+            {"path2", DefaultChar, Rank::scalar}},
+        DefaultInt, Rank::scalar},
     {"repeat",
         {{"string", SameCharNoLen, Rank::scalar},
             {"ncopies", AnyInt, Rank::scalar}},
@@ -1468,14 +1467,12 @@ static const IntrinsicInterface intrinsicSubroutine[]{
             {"get", DefaultInt, Rank::vector, Optionality::optional,
                 common::Intent::Out}},
         {}, Rank::elemental, IntrinsicClass::impureSubroutine},
-    {
-        "rename",
+    {"rename",
         {{"path1", DefaultChar, Rank::scalar},
-         {"path2", DefaultChar, Rank::scalar},
-         {"status", DefaultInt, Rank::scalar,
-             Optionality::optional, common::Intent::Out}},
-        {}, Rank::scalar, IntrinsicClass::impureSubroutine
-    },
+            {"path2", DefaultChar, Rank::scalar},
+            {"status", DefaultInt, Rank::scalar, Optionality::optional,
+                common::Intent::Out}},
+        {}, Rank::scalar, IntrinsicClass::impureSubroutine},
     {"system",
         {{"command", DefaultChar, Rank::scalar},
             {"exitstat", DefaultInt, Rank::scalar, Optionality::optional,
diff --git a/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp b/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp
index 5bff375f998b4..aff3cadc3c300 100644
--- a/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp
+++ b/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp
@@ -199,11 +199,12 @@ void fir::runtime::genRandomSeed(fir::FirOpBuilder &builder, mlir::Location loc,
   builder.create<fir::CallOp>(loc, func, args);
 }
 
-
 /// generate rename runtime call
 void fir::runtime::genRename(fir::FirOpBuilder &builder, mlir::Location loc,
-               mlir::Value path1, mlir::Value path2, mlir::Value status) {
-  auto runtimeFunc = fir::runtime::getRuntimeFunc<mkRTKey(Rename)>(loc, builder);
+                             mlir::Value path1, mlir::Value path2,
+                             mlir::Value status) {
+  auto runtimeFunc =
+      fir::runtime::getRuntimeFunc<mkRTKey(Rename)>(loc, builder);
   mlir::FunctionType runtimeFuncTy = runtimeFunc.getFunctionType();
 
   mlir::Value sourceFile = fir::factory::locationToFilename(builder, loc);
@@ -211,9 +212,8 @@ void fir::runtime::genRename(fir::FirOpBuilder &builder, mlir::Location loc,
       fir::factory::locationToLineNo(builder, loc, runtimeFuncTy.getInput(4));
 
   llvm::SmallVector<mlir::Value> args =
-      fir::runtime::createArguments(builder, loc, runtimeFuncTy,
-                                    path1, path2, status,
-                                    sourceFile, sourceLine);
+      fir::runtime::createArguments(builder, loc, runtimeFuncTy, path1, path2,
+                                    status, sourceFile, sourceLine);
   builder.create<fir::CallOp>(loc, runtimeFunc, args);
 }
 
diff --git a/flang/runtime/misc-intrinsic.cpp b/flang/runtime/misc-intrinsic.cpp
index 54f249992c03e..d6d96cc784c0d 100644
--- a/flang/runtime/misc-intrinsic.cpp
+++ b/flang/runtime/misc-intrinsic.cpp
@@ -59,8 +59,10 @@ void RTDECL(Rename)(const Descriptor &path1, const Descriptor &path2,
     const Descriptor *status, const char *sourceFile, int line) {
   Terminator terminator{sourceFile, line};
 
-  char * pathSrc{EnsureNullTerminated(path1.OffsetElement(), path1.ElementBytes(), terminator)};
-  char * pathDst{EnsureNullTerminated(path2.OffsetElement(), path2.ElementBytes(), terminator)};
+  char *pathSrc{EnsureNullTerminated(
+      path1.OffsetElement(), path1.ElementBytes(), terminator)};
+  char *pathDst{EnsureNullTerminated(
+      path2.OffsetElement(), path2.ElementBytes(), terminator)};
 
   // We simply call rename(2) from POSIX
   int result = rename(pathSrc, pathDst);

>From 15cf3e2fac333eea5df174cea362f8b57b738497 Mon Sep 17 00:00:00 2001
From: Michael Klemm <michael.klemm at amd.com>
Date: Wed, 10 Jul 2024 19:42:19 +0200
Subject: [PATCH 5/7] Add test for RENAME code-gen

---
 flang/test/Lower/Intrinsics/rename.f90 | 51 ++++++++++++++++++++++++++
 1 file changed, 51 insertions(+)
 create mode 100644 flang/test/Lower/Intrinsics/rename.f90

diff --git a/flang/test/Lower/Intrinsics/rename.f90 b/flang/test/Lower/Intrinsics/rename.f90
new file mode 100644
index 0000000000000..75042217c6202
--- /dev/null
+++ b/flang/test/Lower/Intrinsics/rename.f90
@@ -0,0 +1,51 @@
+!RUN: %flang_fc1 -emit-hlfir %s -o - | FileCheck %s
+
+!CHECK-LABEL: func.func @_QPtest_rename
+!CHECK-SAME:    %[[dummySrc:.*]]: !fir.boxchar<1> {fir.bindc_name = "src"},
+!CHECK-SAME:    %[[dummyDst:.*]]: !fir.boxchar<1> {fir.bindc_name = "dst"}) {
+subroutine test_rename(src, dst)
+    implicit none
+    character(*) :: src, dst
+
+    call rename(src, dst)
+    !CHECK:      %[[dstUnbox:.*]]:2 = fir.unboxchar %[[dummyDst]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+    !CHECK-NEXT: %[[dstDecl:.*]]:2 = hlfir.declare %[[dstUnbox]]#0 typeparams %[[dstUnbox]]#1 dummy_scope %0 {uniq_name = "_QFtest_renameEdst"} : (!fir.ref<!fir.char<1,?>>, index, !fir.dscope) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)
+    !CHECK-NEXT: %[[srcUnbox:.*]]:2 = fir.unboxchar %[[dummySrc]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+    !CHECK-NEXT: %[[srcDecl:.*]]:2 = hlfir.declare %3#0 typeparams %[[srcUnbox]]#1 dummy_scope %0 {uniq_name = "_QFtest_renameEsrc"} : (!fir.ref<!fir.char<1,?>>, index, !fir.dscope) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)
+    !CHECK-NEXT: %[[srcBox:.*]] = fir.embox %[[srcDecl]]#1 typeparams %[[srcUnbox]]#1 : (!fir.ref<!fir.char<1,?>>, index) -> !fir.box<!fir.char<1,?>>
+    !CHECK-NEXT: %[[dstBox:.*]] = fir.embox %[[dstDecl]]#1 typeparams %[[dstUnbox]]#1 : (!fir.ref<!fir.char<1,?>>, index) -> !fir.box<!fir.char<1,?>>
+    !CHECK-NEXT: %[[statusBox:.*]] = fir.absent !fir.box<none>
+    !CHECK-NEXT: %[[sourceFile:.*]] = fir.address_of(@[[someString:.*]]) : !fir.ref<!fir.char<1,[[len:.*]]>>
+    !CHECK-NEXT: %[[c10_i32:.*]] = arith.constant [[line:.*]] : i32
+    !CHECK-NEXT: %[[src:.*]] = fir.convert %[[srcBox]] : (!fir.box<!fir.char<1,?>>) -> !fir.box<none>
+    !CHECK-NEXT: %[[dst:.*]] = fir.convert %[[dstBox]] : (!fir.box<!fir.char<1,?>>) -> !fir.box<none>
+    !CHECK-NEXT: %[[loc:.*]] = fir.convert %[[sourceFileConv:.*]]: (!fir.ref<!fir.char<1,[[len:.*]]>>) -> !fir.ref<i8>
+    !CHECK-NEXT: %[[result:.*]] = fir.call @_FortranARename(%[[src]], %[[dst]], %[[statusBox]], %[[loc]], %[[c10_i32]]) fastmath<contract> : (!fir.box<none>, !fir.box<none>, !fir.box<none>, !fir.ref<i8>, i32) -> none
+end subroutine test_rename
+
+!CHECK-LABEL: func.func @_QPtest_rename_status
+!CHECK-SAME:    %[[dummySrc:.*]]: !fir.boxchar<1> {fir.bindc_name = "src"},
+!CHECK-SAME:    %[[dummyDst:.*]]: !fir.boxchar<1> {fir.bindc_name = "dst"}) {
+subroutine test_rename_status(src, dst)
+    implicit none
+    character(*) :: src, dst
+    integer :: status
+
+    call rename(src, dst, status)
+    !CHECK:      %[[dstUnbox:.*]]:2 = fir.unboxchar %[[dummyDst]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+    !CHECK-NEXT: %[[dstDecl:.*]]:2 = hlfir.declare %[[dstUnbox]]#0 typeparams %[[dstUnbox]]#1 dummy_scope %0 {uniq_name = "_QFtest_rename_statusEdst"} : (!fir.ref<!fir.char<1,?>>, index, !fir.dscope) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)
+    !CHECK-NEXT: %[[srcUnbox:.*]]:2 = fir.unboxchar %[[dummySrc]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+    !CHECK-NEXT: %[[srcDecl:.*]]:2 = hlfir.declare %3#0 typeparams %[[srcUnbox]]#1 dummy_scope %0 {uniq_name = "_QFtest_rename_statusEsrc"} : (!fir.ref<!fir.char<1,?>>, index, !fir.dscope) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)
+    !CHECK-NEXT: %[[statusAlloc:.*]] = fir.alloca i32 {bindc_name = "status", uniq_name = "_QFtest_rename_statusEstatus"}
+    !CHECK-NEXT: %[[statusDecl:.*]]:2 = hlfir.declare %[[statusAlloc]] {uniq_name = "_QFtest_rename_statusEstatus"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
+    !CHECK-NEXT: %[[srcBox:.*]] = fir.embox %[[srcDecl]]#1 typeparams %[[srcUnbox]]#1 : (!fir.ref<!fir.char<1,?>>, index) -> !fir.box<!fir.char<1,?>>
+    !CHECK-NEXT: %[[dstBox:.*]] = fir.embox %[[dstDecl]]#1 typeparams %[[dstUnbox]]#1 : (!fir.ref<!fir.char<1,?>>, index) -> !fir.box<!fir.char<1,?>>
+    !CHECK-NEXT: %[[statusBox:.*]] = fir.embox %[[statusDecl]]#1 : (!fir.ref<i32>) -> !fir.box<i32>
+    !CHECK-NEXT: %[[sourceFile:.*]] = fir.address_of(@[[someString:.*]]) : !fir.ref<!fir.char<1,[[len:.*]]>>
+    !CHECK-NEXT: %[[c10_i32:.*]] = arith.constant [[line:.*]] : i32
+    !CHECK-NEXT: %[[src:.*]] = fir.convert %[[srcBox]] : (!fir.box<!fir.char<1,?>>) -> !fir.box<none>
+    !CHECK-NEXT: %[[dst:.*]] = fir.convert %[[dstBox]] : (!fir.box<!fir.char<1,?>>) -> !fir.box<none>
+    !CHECK-NEXT: %[[status:.*]] = fir.convert %[[statusBox]] : (!fir.box<i32>) -> !fir.box<none>
+    !CHECK-NEXT: %[[loc:.*]] = fir.convert %[[sourceFileConv:.*]]: (!fir.ref<!fir.char<1,[[len:.*]]>>) -> !fir.ref<i8>
+    !CHECK-NEXT: %[[result:.*]] = fir.call @_FortranARename(%[[src]], %[[dst]], %[[status]], %[[loc]], %[[c10_i32]]) fastmath<contract> : (!fir.box<none>, !fir.box<none>, !fir.box<none>, !fir.ref<i8>, i32) -> none
+end subroutine test_rename_status

>From ced6d53034e5094d56384117cd11f3aef39a9abe Mon Sep 17 00:00:00 2001
From: Michael Klemm <michael.klemm at amd.com>
Date: Wed, 10 Jul 2024 20:05:22 +0200
Subject: [PATCH 6/7] Update flang/docs/Intrinsics.md

---
 flang/docs/Intrinsics.md | 46 +++++++++++++++++++++++++++++++++++++++-
 1 file changed, 45 insertions(+), 1 deletion(-)

diff --git a/flang/docs/Intrinsics.md b/flang/docs/Intrinsics.md
index d1f7cd8372e24..48840e9d4213d 100644
--- a/flang/docs/Intrinsics.md
+++ b/flang/docs/Intrinsics.md
@@ -999,4 +999,48 @@ PROGRAM example_getcwd
   PRINT *, cwd
   PRINT *, status
 END PROGRAM
-```
\ No newline at end of file
+```
+
+### Non-standard Intrinsics: RENAME
+`RENAME(OLD, NEW[, STATUS])` renames/moves a file on the filesystem.
+
+This intrinsic is provided in both subroutine and function form; however, only one form can be used in any given program unit.
+
+#### Usage and Info
+
+- **Standard:** GNU extension
+- **Class:** Subroutine, function
+- **Syntax:** `CALL RENAME(SRC, DST[, STATUS])`
+- **Arguments:**
+- **Return value** status code (0: success, -1: error)
+
+| Argument | Description                       |
+|----------|-----------------------------------|
+| `SRC`    | Source path                       |
+| `DST`    | Destination path                  |
+| `STATUS` | Status code (for subroutine form) |
+
+#### Example
+
+Function form:
+```
+program rename_func
+    implicit none
+    integer :: status
+    status = rename('src', 'dst')
+    print *, 'status:', status
+    status = rename('dst', 'src')
+    print *, 'status:', status
+end program rename_func
+```
+
+Subroutine form:
+```
+program rename_proc
+    implicit none
+    integer :: status
+    call rename('src', 'dst', status)
+    print *, 'status:', status
+    call rename('dst', 'src')
+end program rename_proc
+```

>From df2530d153eafed4e773852dca42eb41cff6c32f Mon Sep 17 00:00:00 2001
From: Michael Klemm <michael.klemm at amd.com>
Date: Thu, 11 Jul 2024 06:56:10 +0200
Subject: [PATCH 7/7] Fix namelist.f90 test to not use RENAME

---
 flang/test/Lower/namelist.f90 | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/flang/test/Lower/namelist.f90 b/flang/test/Lower/namelist.f90
index 9fdd8a2c8f613..a96bbbfad0cd6 100644
--- a/flang/test/Lower/namelist.f90
+++ b/flang/test/Lower/namelist.f90
@@ -71,7 +71,7 @@ program p
   ! CHECK:     %[[V_70:[0-9]+]] = fir.call @_FortranAioEndIoStatement(%[[V_58]]) fastmath<contract> : (!fir.ref<i8>) -> i32
   write(*, nnn)
 
-  call rename
+  call rename_sub
 end
 
 ! CHECK-LABEL: c.func @_QPsss
@@ -128,8 +128,8 @@ module mmm
   namelist /aaa/ rrr
 end
 
-! CHECK-LABEL: c.func @_QPrename
-subroutine rename
+! CHECK-LABEL: c.func @_QPrename_sub
+subroutine rename_sub
   use mmm, bbb => aaa
   rrr = 3.
   ! CHECK:     %[[V_4:[0-9]+]] = fir.call @_FortranAioBeginExternalListOutput



More information about the flang-commits mailing list