[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
Thu Jul 11 06:05:39 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 01/10] 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 02/10] 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 03/10] 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 04/10] 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 05/10] 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 06/10] 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 07/10] 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
>From b2a0078c560da5c70a2543fde1f0c77b94883ee3 Mon Sep 17 00:00:00 2001
From: Michael Klemm <michael.klemm at amd.com>
Date: Thu, 11 Jul 2024 12:24:00 +0200
Subject: [PATCH 08/10] Report same error code as GFortran
---
flang/docs/Intrinsics.md | 4 +++-
flang/runtime/misc-intrinsic.cpp | 9 ++++++++-
2 files changed, 11 insertions(+), 2 deletions(-)
diff --git a/flang/docs/Intrinsics.md b/flang/docs/Intrinsics.md
index 48840e9d4213d..d82b9c4596e67 100644
--- a/flang/docs/Intrinsics.md
+++ b/flang/docs/Intrinsics.md
@@ -1012,7 +1012,7 @@ This intrinsic is provided in both subroutine and function form; however, only o
- **Class:** Subroutine, function
- **Syntax:** `CALL RENAME(SRC, DST[, STATUS])`
- **Arguments:**
-- **Return value** status code (0: success, -1: error)
+- **Return value** status code (0: success, non-zero for errors)
| Argument | Description |
|----------|-----------------------------------|
@@ -1020,6 +1020,8 @@ This intrinsic is provided in both subroutine and function form; however, only o
| `DST` | Destination path |
| `STATUS` | Status code (for subroutine form) |
+The status code return by both the subroutine and function form correspond to the value of `errno` if the invocation of `rename(2)` was not successful.
+
#### Example
Function form:
diff --git a/flang/runtime/misc-intrinsic.cpp b/flang/runtime/misc-intrinsic.cpp
index d6d96cc784c0d..b4248203266f8 100644
--- a/flang/runtime/misc-intrinsic.cpp
+++ b/flang/runtime/misc-intrinsic.cpp
@@ -13,6 +13,7 @@
#include "flang/Runtime/descriptor.h"
#include <algorithm>
#include <cstring>
+#include <cstdio>
namespace Fortran::runtime {
@@ -67,7 +68,13 @@ void RTDECL(Rename)(const Descriptor &path1, const Descriptor &path2,
// We simply call rename(2) from POSIX
int result = rename(pathSrc, pathDst);
if (status) {
- StoreIntToDescriptor(status, result, terminator);
+ // When an error has happened,
+ int errorCode = 0; // Assume success
+ if (result < 0) {
+ // The rename operation has failed, so return the error code as status.
+ errorCode = errno;
+ }
+ StoreIntToDescriptor(status, errorCode, terminator);
}
// Deallocate memory if EnsureNullTerminated dynamically allocated memory
>From 480ffc60ff52e616f326d84ae3e74f481ba9aea7 Mon Sep 17 00:00:00 2001
From: Michael Klemm <michael.klemm at amd.com>
Date: Thu, 11 Jul 2024 14:28:04 +0200
Subject: [PATCH 09/10] Fix a few typos
---
flang/docs/Intrinsics.md | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/flang/docs/Intrinsics.md b/flang/docs/Intrinsics.md
index d82b9c4596e67..51dd6e055d247 100644
--- a/flang/docs/Intrinsics.md
+++ b/flang/docs/Intrinsics.md
@@ -1020,7 +1020,7 @@ This intrinsic is provided in both subroutine and function form; however, only o
| `DST` | Destination path |
| `STATUS` | Status code (for subroutine form) |
-The status code return by both the subroutine and function form correspond to the value of `errno` if the invocation of `rename(2)` was not successful.
+The status code returned by both the subroutine and function form corresponds to the value of `errno` if the invocation of `rename(2)` was not successful.
#### Example
>From 45b1dcdb2077142540605d459bcdff9e532be3f6 Mon Sep 17 00:00:00 2001
From: Michael Klemm <michael.klemm at amd.com>
Date: Thu, 11 Jul 2024 15:04:31 +0200
Subject: [PATCH 10/10] Make this piece work on both Windows and Linux
Windows says it only reports a non-zero error code. Effectively,
it is -1, but let's rather be save than sorry.
---
flang/runtime/misc-intrinsic.cpp | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/flang/runtime/misc-intrinsic.cpp b/flang/runtime/misc-intrinsic.cpp
index b4248203266f8..9008944608e2e 100644
--- a/flang/runtime/misc-intrinsic.cpp
+++ b/flang/runtime/misc-intrinsic.cpp
@@ -70,7 +70,7 @@ void RTDECL(Rename)(const Descriptor &path1, const Descriptor &path2,
if (status) {
// When an error has happened,
int errorCode = 0; // Assume success
- if (result < 0) {
+ if (result != 0) {
// The rename operation has failed, so return the error code as status.
errorCode = errno;
}
More information about the flang-commits
mailing list