[flang][intrinsic] add nonstandard intrinsic unlink #134162

akuhlens · 2025-04-02T22:02:26Z

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.

llvmbot · 2025-04-02T22:03:03Z

@llvm/pr-subscribers-flang-semantics

Author: Andre Kuhlenschmidt (akuhlens)

Changes

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

llvmbot · 2025-04-02T22:03:04Z

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

Author: Andre Kuhlenschmidt (akuhlens)

Changes

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

clementval

LGTM

flang/test/Lower/Intrinsics/unlink-func.f90

flang/test/Lower/Intrinsics/unlink-sub.f90

initial commit

c839407

akuhlens requested review from clementval, klausler and eugeneepshteyn April 2, 2025 22:02

llvmbot added flang Flang issues not falling into any other category flang:fir-hlfir flang:semantics labels Apr 2, 2025

This comment was marked as resolved.

Sign in to view

akuhlens added 2 commits April 2, 2025 15:30

run clang-format

d4c9170

remove std namespace qualifier on size_t

1e2892e

clementval approved these changes Apr 3, 2025

View reviewed changes

flang/test/Lower/Intrinsics/unlink-func.f90 Outdated Show resolved Hide resolved

flang/test/Lower/Intrinsics/unlink-sub.f90 Outdated Show resolved Hide resolved

add newline to the end of unit test files

31c3f3d

akuhlens merged commit 85fdab3 into llvm:main Apr 3, 2025
12 checks passed

Provide feedback

Saved searches

Use saved searches to filter your results more quickly

[flang][intrinsic] add nonstandard intrinsic unlink #134162

[flang][intrinsic] add nonstandard intrinsic unlink #134162

akuhlens commented Apr 2, 2025

llvmbot commented Apr 2, 2025

Test plan

llvmbot commented Apr 2, 2025

Test plan

This comment was marked as resolved.

clementval left a comment

[flang][intrinsic] add nonstandard intrinsic unlink #134162

[flang][intrinsic] add nonstandard intrinsic unlink #134162

Conversation

akuhlens commented Apr 2, 2025

Test plan

llvmbot commented Apr 2, 2025

Test plan

llvmbot commented Apr 2, 2025

Test plan

This comment was marked as resolved.

clementval left a comment

Choose a reason for hiding this comment