[flang] [llvm] [flang][intrinsic] add nonstandard intrinsic unlink (PR #134162)
via llvm-commits
llvm-commits at lists.llvm.org
Wed Apr 2 15:03:10 PDT 2025
llvmbot wrote:
<!--LLVM PR SUMMARY COMMENT-->
@llvm/pr-subscribers-flang-semantics
Author: Andre Kuhlenschmidt (akuhlens)
<details>
<summary>Changes</summary>
This PR adds the intrinsic `unlink` to flang.
## Test plan
- Added two codegen unit tests and ensured flang-check continues to pass.
- Manually compiled and ran the example from the documentation.
---
Full diff: https://github.com/llvm/llvm-project/pull/134162.diff
10 Files Affected:
- (modified) flang-rt/lib/runtime/command.cpp (+18-1)
- (modified) flang/docs/Intrinsics.md (+42)
- (modified) flang/include/flang/Optimizer/Builder/IntrinsicCall.h (+2)
- (modified) flang/include/flang/Optimizer/Builder/Runtime/Command.h (+5)
- (modified) flang/include/flang/Runtime/command.h (+6-1)
- (modified) flang/lib/Evaluate/intrinsics.cpp (+9-1)
- (modified) flang/lib/Optimizer/Builder/IntrinsicCall.cpp (+36)
- (modified) flang/lib/Optimizer/Builder/Runtime/Command.cpp (+14)
- (added) flang/test/Lower/Intrinsics/unlink-func.f90 (+24)
- (added) flang/test/Lower/Intrinsics/unlink-sub.f90 (+54)
``````````diff
diff --git a/flang-rt/lib/runtime/command.cpp b/flang-rt/lib/runtime/command.cpp
index d2e09639fdb59..0dda8cb226815 100644
--- a/flang-rt/lib/runtime/command.cpp
+++ b/flang-rt/lib/runtime/command.cpp
@@ -13,12 +13,14 @@
#include "flang-rt/runtime/terminator.h"
#include "flang-rt/runtime/tools.h"
#include <cstdlib>
+#include <cerrno>
#include <limits>
#ifdef _WIN32
#include "flang/Common/windows-include.h"
#include <direct.h>
#define getcwd _getcwd
+#define unlink _unlink
#define PATH_MAX MAX_PATH
#ifdef _MSC_VER
@@ -27,7 +29,7 @@
inline pid_t getpid() { return GetCurrentProcessId(); }
#endif
#else
-#include <unistd.h> //getpid()
+#include <unistd.h> //getpid() unlink()
#ifndef PATH_MAX
#define PATH_MAX 4096
@@ -307,4 +309,19 @@ std::int32_t RTNAME(Hostnm)(
return status;
}
+std::int32_t RTNAME(Unlink)(
+ const char *str, std::size_t strLength, const char *sourceFile, int line) {
+ Terminator terminator{sourceFile, line};
+
+ auto pathLength = TrimTrailingSpaces(str, strLength);
+ auto path = SaveDefaultCharacter(str, pathLength, terminator);
+
+ std::int32_t status{0};
+
+ if (unlink(path.get()) != 0) {
+ status = errno;
+ }
+
+ return status;
+}
} // namespace Fortran::runtime
diff --git a/flang/docs/Intrinsics.md b/flang/docs/Intrinsics.md
index ddb053d7a3d0b..e885ceca25aad 100644
--- a/flang/docs/Intrinsics.md
+++ b/flang/docs/Intrinsics.md
@@ -1091,6 +1091,48 @@ end program rename_proc
This intrinsic is an alias for `CPU_TIME`: supporting both a subroutine and a
function form.
+### Non-Standard Intrinsics: UNLINK
+
+#### Description
+`UNLINK(PATH [, STATUS])` deletes a link to a file.
+
+This intrinsic is provided in both subroutine and function forms; however, only
+one form can be used in any given program unit.
+
+| ARGUMENT | INTENT | TYPE | KIND | Description |
+|----------|--------|-------------|---------|---------------------------------|
+| `PATH` | `IN` | `CHARACTER` | default | The path of the file to unlink. |
+| `STATUS` | `OUT` | `INTEGER` | default | Optional. Returns 0 on success, C's `errno` on failure. |
+
+#### Usage and Info
+
+- **Standard:** GNU extension
+- **Class:** Subroutine, function
+- **Syntax:** `CALL UNLINK(PATH [, STATUS])`, `STATUS = UNLINK(PATH)`
+
+#### Example
+The following example just prints "hello.txt doesn't exist".
+```Fortran
+SUBROUTINE try_unlink_hello_again()
+ INTEGER :: status
+ CALL UNLINK("hello.txt", status)
+ IF (status .NE. 0) PRINT *, "hello.txt doesn't exist"
+END SUBROUTINE
+
+PROGRAM example_unlink
+ INTEGER :: hello
+ ! Create ./hello.txt
+ OPEN(newunit=hello, file="hello.txt")
+ WRITE (hello, *), "Hello!"
+ CLOSE(hello)
+
+ ! Delete ./hello.txt
+ IF (UNLINK("hello.txt") .NE. 0) PRINT *, "didn't create a file"
+
+ CALL try_unlink_hello_again()
+END PROGRAM
+```
+
### Non-standard Intrinsics: LNBLNK
This intrinsic is an alias for `LEN_TRIM`, without the optional KIND argument.
diff --git a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
index a31bbd0a1bd88..335d318e164c2 100644
--- a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
+++ b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
@@ -439,6 +439,8 @@ struct IntrinsicLibrary {
void genThreadFenceSystem(llvm::ArrayRef<fir::ExtendedValue>);
fir::ExtendedValue genTrim(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
fir::ExtendedValue genUbound(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
+ fir::ExtendedValue genUnlink(std::optional<mlir::Type> resultType,
+ llvm::ArrayRef<fir::ExtendedValue> args);
fir::ExtendedValue genUnpack(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
fir::ExtendedValue genVerify(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
mlir::Value genVoteAllSync(mlir::Type, llvm::ArrayRef<mlir::Value>);
diff --git a/flang/include/flang/Optimizer/Builder/Runtime/Command.h b/flang/include/flang/Optimizer/Builder/Runtime/Command.h
index ba0d3b094f40c..5880a703ed92e 100644
--- a/flang/include/flang/Optimizer/Builder/Runtime/Command.h
+++ b/flang/include/flang/Optimizer/Builder/Runtime/Command.h
@@ -68,5 +68,10 @@ mlir::Value genHostnm(fir::FirOpBuilder &builder, mlir::Location loc,
void genPerror(fir::FirOpBuilder &builder, mlir::Location loc,
mlir::Value string);
+/// Generate a call to the Unlink runtime function which implements
+/// the UNLINK intrinsic.
+mlir::Value genUnlink(fir::FirOpBuilder &builder, mlir::Location loc,
+ mlir::Value path, mlir::Value pathLength);
+
} // namespace fir::runtime
#endif // FORTRAN_OPTIMIZER_BUILDER_RUNTIME_COMMAND_H
diff --git a/flang/include/flang/Runtime/command.h b/flang/include/flang/Runtime/command.h
index e0069a9bc0321..089fdba2e66f6 100644
--- a/flang/include/flang/Runtime/command.h
+++ b/flang/include/flang/Runtime/command.h
@@ -63,7 +63,12 @@ std::int32_t RTNAME(GetCwd)(
// Calls hostnm()
std::int32_t RTNAME(Hostnm)(
const Descriptor &res, const char *sourceFile, int line);
-}
+
+// Calls unlink()
+std::int32_t RTNAME(Unlink)(
+ const char *str, const std::size_t strLength, const char *sourceFile, int line);
+
+} // extern "C"
} // namespace Fortran::runtime
#endif // FORTRAN_RUNTIME_COMMAND_H_
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index 0c15ec5473965..9537d5176d715 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -1010,6 +1010,8 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
KINDUnsigned},
{"umaskl", {{"i", AnyInt}, DefaultingKIND}, KINDUnsigned},
{"umaskr", {{"i", AnyInt}, DefaultingKIND}, KINDUnsigned},
+ {"unlink", {{"path", DefaultChar, Rank::scalar}}, DefaultInt,
+ Rank::scalar, IntrinsicClass::transformationalFunction},
{"unpack",
{{"vector", SameType, Rank::vector}, {"mask", AnyLogical, Rank::array},
{"field", SameType, Rank::conformable}},
@@ -1319,6 +1321,8 @@ static const SpecificIntrinsicInterface specificIntrinsicFunction[]{
"abs"},
};
+// Must be sorted by name. The rank of the return value is ignored since
+// subroutines are do not have a return value.
static const IntrinsicInterface intrinsicSubroutine[]{
{"abort", {}, {}, Rank::elemental, IntrinsicClass::impureSubroutine},
{"atomic_add",
@@ -1631,6 +1635,10 @@ static const IntrinsicInterface intrinsicSubroutine[]{
{{"seconds", AnyInt, Rank::scalar, Optionality::required,
common::Intent::In}},
{}, Rank::elemental, IntrinsicClass::impureSubroutine},
+ {"unlink",
+ {{"path", DefaultChar, Rank::scalar, Optionality::required, common::Intent::In},
+ {"status", DefaultInt, Rank::scalar, Optionality::optional, common::Intent::Out}},
+ {}, Rank::elemental, IntrinsicClass::impureSubroutine},
};
// Finds a built-in derived type and returns it as a DynamicType.
@@ -2800,7 +2808,7 @@ bool IntrinsicProcTable::Implementation::IsDualIntrinsic(
// Collection for some intrinsics with function and subroutine form,
// in order to pass the semantic check.
static const std::string dualIntrinsic[]{{"chdir"s}, {"etime"s}, {"getcwd"s},
- {"hostnm"s}, {"rename"s}, {"second"s}, {"system"s}};
+ {"hostnm"s}, {"rename"s}, {"second"s}, {"system"s}, {"unlink"s}};
return llvm::is_contained(dualIntrinsic, name);
}
diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
index 9029ea69dd5c4..94892d0512816 100644
--- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
+++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
@@ -928,6 +928,10 @@ static constexpr IntrinsicHandler handlers[]{
/*isElemental=*/false},
{"umaskl", &I::genMask<mlir::arith::ShLIOp>},
{"umaskr", &I::genMask<mlir::arith::ShRUIOp>},
+ {"unlink",
+ &I::genUnlink,
+ {{{"path", asAddr}, {"status", asAddr, handleDynamicOptional}}},
+ /*isElemental=*/false},
{"unpack",
&I::genUnpack,
{{{"vector", asBox}, {"mask", asBox}, {"field", asBox}}},
@@ -8494,6 +8498,38 @@ static mlir::Value createExtremumCompare(mlir::Location loc,
return result;
}
+// UNLINK
+fir::ExtendedValue
+IntrinsicLibrary::genUnlink(std::optional<mlir::Type> resultType,
+ llvm::ArrayRef<fir::ExtendedValue> args) {
+ assert((resultType.has_value() && args.size() == 1) ||
+ (!resultType.has_value() && args.size() >= 1 && args.size() <= 2));
+
+ mlir::Value path = fir::getBase(args[0]);
+ mlir::Value pathLength = fir::getLen(args[0]);
+ mlir::Value statusValue = fir::runtime::genUnlink(builder, loc, path, pathLength);
+
+ if (resultType.has_value()) {
+ // Function form, return status.
+ return builder.createConvert(loc, *resultType, statusValue);
+ }
+
+ // Subroutine form, store status and return none.
+ const fir::ExtendedValue &status = args[1];
+ if (!isStaticallyAbsent(status)) {
+ mlir::Value statusAddr = fir::getBase(status);
+ mlir::Value statusIsPresentAtRuntime =
+ builder.genIsNotNullAddr(loc, statusAddr);
+ builder.genIfThen(loc, statusIsPresentAtRuntime)
+ .genThen([&]() {
+ builder.createStoreWithConvert(loc, statusValue, statusAddr);
+ })
+ .end();
+ }
+
+ return {};
+}
+
// UNPACK
fir::ExtendedValue
IntrinsicLibrary::genUnpack(mlir::Type resultType,
diff --git a/flang/lib/Optimizer/Builder/Runtime/Command.cpp b/flang/lib/Optimizer/Builder/Runtime/Command.cpp
index 9b814c3395aa1..76c7a6e2af770 100644
--- a/flang/lib/Optimizer/Builder/Runtime/Command.cpp
+++ b/flang/lib/Optimizer/Builder/Runtime/Command.cpp
@@ -125,3 +125,17 @@ void fir::runtime::genPerror(fir::FirOpBuilder &builder, mlir::Location loc,
fir::runtime::createArguments(builder, loc, runtimeFuncTy, string);
builder.create<fir::CallOp>(loc, runtimeFunc, args);
}
+
+mlir::Value fir::runtime::genUnlink(fir::FirOpBuilder &builder,
+ mlir::Location loc,
+ mlir::Value path, mlir::Value pathLength) {
+ mlir::func::FuncOp func =
+ fir::runtime::getRuntimeFunc<mkRTKey(Unlink)>(loc, builder);
+ auto runtimeFuncTy = func.getFunctionType();
+ mlir::Value sourceFile = fir::factory::locationToFilename(builder, loc);
+ mlir::Value sourceLine =
+ fir::factory::locationToLineNo(builder, loc, runtimeFuncTy.getInput(1));
+ llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments(
+ builder, loc, runtimeFuncTy, path, pathLength, sourceFile, sourceLine);
+ return builder.create<fir::CallOp>(loc, func, args).getResult(0);
+}
diff --git a/flang/test/Lower/Intrinsics/unlink-func.f90 b/flang/test/Lower/Intrinsics/unlink-func.f90
new file mode 100644
index 0000000000000..9f1ac51116e55
--- /dev/null
+++ b/flang/test/Lower/Intrinsics/unlink-func.f90
@@ -0,0 +1,24 @@
+!RUN: %flang_fc1 -emit-hlfir %s -o - | FileCheck %s
+
+!CHECK-LABEL: func.func @_QPunlink_test
+!CHECK-SAME: %[[dummyPath:.*]]: !fir.boxchar<1> {fir.bindc_name = "path"}) -> i32 {
+integer function unlink_test(path)
+CHARACTER(len=255) :: path
+
+!CHECK-DAG: %[[func_result:.*]] = fir.alloca i32 {bindc_name = "unlink_test", uniq_name = "_QFunlink_testEunlink_test"}
+!CHECK-DAG: %[[func_result_decl:.*]]:{{.*}} = hlfir.declare %[[func_result]] {uniq_name = "_QFunlink_testEunlink_test"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
+!CHECK-DAG: %[[src_path_addr:.*]] = fir.address_of(@_{{.*}}) : !fir.ref<!fir.char<1,{{.*}}>
+!CHECK-DAG: %[[line_value:.*]] = arith.constant {{.*}} : i64
+!CHECK-DAG: %[[path:.*]] = fir.convert {{.*}} (!fir.ref<!fir.char<1,{{.*}}>>) -> !fir.ref<i8>
+!CHECK-DAG: %[[path_len:.*]] = fir.convert {{.*}} : (index) -> i64
+!CHECK-DAG: %[[src_path:.*]] = fir.convert %[[src_path_addr]] : (!fir.ref<!fir.char<1,{{.*}}>) -> !fir.ref<i8>
+!CHECK-DAG: %[[line:.*]] = fir.convert %[[line_value]] : (i64) -> i32
+!CHECK: %[[unlink_result:.*]] = fir.call @_FortranAUnlink(%[[path]], %[[path_len]], %[[src_path]], %[[line]])
+!CHECK-SAME: -> i32
+
+! Check _FortranAUnlink result code handling
+!CHECK-DAG: hlfir.assign %[[unlink_result]] to %[[func_result_decl]]#0 : i32, !fir.ref<i32>
+!CHECK-DAG: %[[load_result:.*]] = fir.load %[[func_result_decl]]#0 : !fir.ref<i32>
+!CHECK: return %[[load_result]] : i32
+unlink_test = unlink(path)
+end function unlink_test
\ No newline at end of file
diff --git a/flang/test/Lower/Intrinsics/unlink-sub.f90 b/flang/test/Lower/Intrinsics/unlink-sub.f90
new file mode 100644
index 0000000000000..9aaff68be139b
--- /dev/null
+++ b/flang/test/Lower/Intrinsics/unlink-sub.f90
@@ -0,0 +1,54 @@
+!RUN: %flang_fc1 -emit-hlfir %s -o - | FileCheck %s
+
+!CHECK-LABEL: func.func @_QPpath_only
+!CHECK-SAME: %[[dummyPath:.*]]: !fir.boxchar<1> {fir.bindc_name = "path"}) {
+subroutine path_only(path)
+ CHARACTER(len=*) :: path
+ !CHECK-DAG: %[[scope:.*]] = fir.dummy_scope : !fir.dscope
+ !CHECK-DAG: %[[unbox_path:.*]]:2 = fir.unboxchar %[[dummyPath]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+ !CHECK-DAG: %[[path_decl:.*]]:2 = hlfir.declare %[[unbox_path]]#0 typeparams %[[unbox_path]]#1 dummy_scope %[[scope]] {uniq_name = "_QFpath_onlyEpath"} : (!fir.ref<!fir.char<1,?>>, index, !fir.dscope) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)
+ !CHECK-DAG: %[[src_path_addr:.*]] = fir.address_of(@_{{.*}}) : !fir.ref<!fir.char<1,{{.*}}>>
+ !CHECK-DAG: %[[line_value:.*]] = arith.constant {{.*}} : i64
+ !CHECK-DAG: %[[path:.*]] = fir.convert %[[path_decl]]#1 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<i8>
+ !CHECK-DAG: %[[path_len:.*]] = fir.convert %[[unbox_path]]#1 : (index) -> i64
+ !CHECK-DAG: %[[src_path:.*]] = fir.convert %[[src_path_addr]] : (!fir.ref<!fir.char<1,{{.*}}>) -> !fir.ref<i8>
+ !CHECK-DAG: %[[line:.*]] = fir.convert %[[line_value]] : (i64) -> i32
+ !CHECK: fir.call @_FortranAUnlink(%[[path]], %[[path_len]], %[[src_path]], %[[line]])
+ !CHECK-SAME: : (!fir.ref<i8>, i64, !fir.ref<i8>, i32)
+ !CHECK-SAME: -> i32
+ call unlink(path)
+ !CHECK: return
+end subroutine path_only
+ !CHECK: }
+
+ !CHECK-LABEL: func.func @_QPall_arguments
+ !CHECK-SAME: %[[dummyPath:.*]]: !fir.boxchar<1> {fir.bindc_name = "path"}
+ !CHECK-SAME: %[[dummyStat:.*]]: !fir.ref<i32> {fir.bindc_name = "status"}
+ !CHECK-SAME: ) {
+subroutine all_arguments(path, status)
+ CHARACTER(len=*) :: path
+ INTEGER :: status
+ !CHECK-DAG: %[[scope:.*]] = fir.dummy_scope : !fir.dscope
+ !CHECK-DAG: %[[unbox_path:.*]]:2 = fir.unboxchar %[[dummyPath]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+ !CHECK-DAG: %[[path_decl:.*]]:2 = hlfir.declare %[[unbox_path]]#0 typeparams %[[unbox_path]]#1 dummy_scope %[[scope]] {uniq_name = "_QFall_argumentsEpath"} : (!fir.ref<!fir.char<1,?>>, index, !fir.dscope) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)
+ !CHECK-DAG: %[[status_decl:.*]]:2 = hlfir.declare %[[dummyStat]] dummy_scope %[[scope]] {uniq_name = "_QFall_argumentsEstatus"} : (!fir.ref<i32>, !fir.dscope) -> (!fir.ref<i32>, !fir.ref<i32>)
+ !CHECK-DAG: %[[src_path_addr:.*]] = fir.address_of(@_{{.*}}) : !fir.ref<!fir.char<1,{{.*}}>>
+ !CHECK-DAG: %[[line_value:.*]] = arith.constant {{.*}} : i64
+ !CHECK-DAG: %[[path:.*]] = fir.convert %[[path_decl]]#1 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<i8>
+ !CHECK-DAG: %[[path_len:.*]] = fir.convert %[[unbox_path]]#1 : (index) -> i64
+ !CHECK-DAG: %[[src_path:.*]] = fir.convert %[[src_path_addr]] : (!fir.ref<!fir.char<1,{{.*}}>) -> !fir.ref<i8>
+ !CHECK-DAG: %[[line:.*]] = fir.convert %[[line_value]] : (i64) -> i32
+ !CHECK: %[[unlink_result:.*]] = fir.call @_FortranAUnlink(%[[path]], %[[path_len]], %[[src_path]], %[[line]])
+ !CHECK-SAME: : (!fir.ref<i8>, i64, !fir.ref<i8>, i32)
+ !CHECK-SAME: -> i32
+
+ !CHECK-DAG: %[[status_i64:.*]] = fir.convert %[[status_decl]]#0 : (!fir.ref<i32>) -> i64
+ !CHECK-DAG: %[[c_null:.*]] = arith.constant 0 : i64
+ !CHECK-DAG: %[[cmp_result:.*]] = arith.cmpi ne, %[[status_i64]], %[[c_null]] : i64
+ !CHECK: fir.if %[[cmp_result]] {
+ !CHECK-NEXT: fir.store %[[unlink_result]] to %[[status_decl]]#0 : !fir.ref<i32>
+ !CHECK-NEXT: }
+ call unlink(path, status)
+ !CHECK: return
+end subroutine all_arguments
+ !CHECK: }
\ No newline at end of file
``````````
</details>
https://github.com/llvm/llvm-project/pull/134162
More information about the llvm-commits
mailing list