diff --git a/doc/specs/stdlib_io.md b/doc/specs/stdlib_io.md index 0ae2b11b3..9986223b6 100644 --- a/doc/specs/stdlib_io.md +++ b/doc/specs/stdlib_io.md @@ -301,3 +301,4 @@ Exceptions trigger an `error stop` unless the optional `err` argument is provide ```fortran {!example/io/example_get_file.f90!} ``` + diff --git a/doc/specs/stdlib_system.md b/doc/specs/stdlib_system.md index 22b705f1c..96eebb2e8 100644 --- a/doc/specs/stdlib_system.md +++ b/doc/specs/stdlib_system.md @@ -24,7 +24,7 @@ Additionally, a callback function can be specified to execute upon process compl ### Syntax -`process = ` [[stdlib_subprocess(module):run(interface)]] `(args [, stdin] [, want_stdout] [, want_stderr] [, callback] [, payload])` +`process = ` [[stdlib_system(module):run(interface)]] `(args [, stdin] [, want_stdout] [, want_stderr] [, callback] [, payload])` ### Arguments @@ -69,7 +69,7 @@ Additionally, a callback function can be specified to execute upon process compl ### Syntax -`process = ` [[stdlib_subprocess(module):runasync(interface)]] `(args [, stdin] [, want_stdout] [, want_stderr] [, callback] [, payload])` +`process = ` [[stdlib_system(module):runasync(interface)]] `(args [, stdin] [, want_stdout] [, want_stderr] [, callback] [, payload])` ### Arguments @@ -108,7 +108,7 @@ This is useful for monitoring the status of asynchronous processes created with ### Syntax -`status = ` [[stdlib_subprocess(module):is_running(interface)]] `(process)` +`status = ` [[stdlib_system(module):is_running(interface)]] `(process)` ### Arguments @@ -139,7 +139,7 @@ This is useful for determining whether asynchronous processes created with the ` ### Syntax -`status = ` [[stdlib_subprocess(module):is_completed(interface)]] `(process)` +`status = ` [[stdlib_system(module):is_completed(interface)]] `(process)` ### Arguments @@ -174,7 +174,7 @@ The result is a real value representing the elapsed time in seconds, measured fr ### Syntax -`delta_t = ` [[stdlib_subprocess(module):elapsed(subroutine)]] `(process)` +`delta_t = ` [[stdlib_system(module):elapsed(subroutine)]] `(process)` ### Arguments @@ -212,7 +212,7 @@ in case of process hang or delay. ### Syntax -`call ` [[stdlib_subprocess(module):wait(subroutine)]] `(process [, max_wait_time])` +`call ` [[stdlib_system(module):wait(subroutine)]] `(process [, max_wait_time])` ### Arguments @@ -243,7 +243,7 @@ This is especially useful for monitoring asynchronous processes and retrieving t ### Syntax -`call ` [[stdlib_subprocess(module):update(subroutine)]] `(process)` +`call ` [[stdlib_system(module):update(subroutine)]] `(process)` ### Arguments @@ -269,7 +269,7 @@ This interface is useful when a process needs to be forcefully stopped, for exam ### Syntax -`call ` [[stdlib_subprocess(module):kill(subroutine)]] `(process, success)` +`call ` [[stdlib_system(module):kill(subroutine)]] `(process, success)` ### Arguments @@ -431,7 +431,7 @@ It is designed to work across multiple platforms. On Windows, paths with both fo ### Syntax -`result = [[stdlib_io(module):is_directory(function)]] (path)` +`result = [[stdlib_system(module):is_directory(function)]] (path)` ### Class @@ -492,3 +492,43 @@ None. {!example/system/example_null_device.f90!} ``` +## `delete_file` - Delete a file + +### Status + +Experimental + +### Description + +This subroutine deletes a specified file from the filesystem. It ensures that the file exists and is not a directory before attempting deletion. +If the file cannot be deleted due to permissions, being a directory, or other issues, an error is raised. +The function provides an optional error-handling mechanism via the `state_type` class. If the `err` argument is not provided, exceptions will trigger an `error stop`. + +### Syntax + +`call [[stdlib_system(module):delete_file(subroutine)]] (path [, err])` + +### Class +Subroutine + +### Arguments + +`path`: Shall be a character string containing the path to the file to be deleted. It is an `intent(in)` argument. + +`err` (optional): Shall be a `type(state_type)` variable for error handling. If provided, errors are returned as a state object. If not provided, the program stops execution on error. + +### Behavior + +- Checks if the file exists. If not, an error is raised. +- Ensures the path is not a directory before deletion. +- Attempts to delete the file, raising an error if unsuccessful. + +### Return values + +The file is removed from the filesystem if the operation is successful. If the operation fails, an error is raised. + +### Example + +```fortran +{!example/system/example_delete_file.f90!} +``` diff --git a/example/system/CMakeLists.txt b/example/system/CMakeLists.txt index 28474ea4d..a2a7525c9 100644 --- a/example/system/CMakeLists.txt +++ b/example/system/CMakeLists.txt @@ -1,4 +1,5 @@ ADD_EXAMPLE(get_runtime_os) +ADD_EXAMPLE(delete_file) ADD_EXAMPLE(is_directory) ADD_EXAMPLE(null_device) ADD_EXAMPLE(os_type) diff --git a/example/system/example_delete_file.f90 b/example/system/example_delete_file.f90 new file mode 100644 index 000000000..9494044c1 --- /dev/null +++ b/example/system/example_delete_file.f90 @@ -0,0 +1,18 @@ +! Demonstrate usage of `delete_file` +program example_delete_file + use stdlib_system, only: delete_file + use stdlib_error, only: state_type + implicit none + + type(state_type) :: err + character(*), parameter :: filename = "example.txt" + + ! Delete a file with error handling + call delete_file(filename, err) + + if (err%error()) then + print *, err%print() + else + print *, "File "//filename//" deleted successfully." + end if +end program example_delete_file diff --git a/src/stdlib_system.F90 b/src/stdlib_system.F90 index 5dade255a..a9c3e4d55 100644 --- a/src/stdlib_system.F90 +++ b/src/stdlib_system.F90 @@ -3,6 +3,7 @@ module stdlib_system c_f_pointer use stdlib_kinds, only: int64, dp, c_bool, c_char use stdlib_strings, only: to_c_char +use stdlib_error, only: state_type, STDLIB_SUCCESS, STDLIB_FS_ERROR implicit none private public :: sleep @@ -86,7 +87,7 @@ module stdlib_system !! version: experimental !! !! Tests if a given path matches an existing directory. -!! ([Specification](../page/specs/stdlib_io.html#is_directory-test-if-a-path-is-a-directory)) +!! ([Specification](../page/specs/stdlib_system.html#is_directory-test-if-a-path-is-a-directory)) !! !!### Summary !! Function to evaluate whether a specified path corresponds to an existing directory. @@ -98,7 +99,24 @@ module stdlib_system !! Windows, and various UNIX-like environments. On unsupported operating systems, the function will return `.false.`. !! public :: is_directory - + +!! version: experimental +!! +!! Deletes a specified file from the filesystem. +!! ([Specification](../page/specs/stdlib_system.html#delete_file-delete-a-file)) +!! +!!### Summary +!! Subroutine to safely delete a file from the filesystem. It handles errors gracefully using the library's `state_type`. +!! +!!### Description +!! +!! This subroutine deletes a specified file. If the file is a directory or inaccessible, an error is raised. +!! If the file does not exist, a warning is returned, but no error state. Errors are handled using the +!! library's `state_type` mechanism. If the optional `err` argument is not provided, exceptions trigger +!! an `error stop`. +!! +public :: delete_file + !! version: experimental !! !! Returns the file path of the null device, which discards all data written to it. @@ -707,4 +725,49 @@ end function process_null_device end function null_device +!> Delete a file at the given path. +subroutine delete_file(path, err) + character(*), intent(in) :: path + type(state_type), optional, intent(out) :: err + + !> Local variables + integer :: file_unit, ios + type(state_type) :: err0 + character(len=512) :: msg + logical :: file_exists + + ! Verify the file is not a directory. + if (is_directory(path)) then + ! If unable to open, assume it's a directory or inaccessible + err0 = state_type(STDLIB_FS_ERROR,'Cannot delete',path,'- is a directory') + call err0%handle(err) + return + end if + + ! Check if the path exists + ! Because Intel compilers return .false. if path is a directory, this must be tested + ! _after_ the directory test + inquire(file=path, exist=file_exists) + if (.not. file_exists) then + ! File does not exist, return non-error status + err0 = state_type(STDLIB_SUCCESS,path,' not deleted: file does not exist') + call err0%handle(err) + return + endif + + ! Close and delete the file + open(newunit=file_unit, file=path, status='old', iostat=ios, iomsg=msg) + if (ios /= 0) then + err0 = state_type(STDLIB_FS_ERROR,'Cannot delete',path,'-',msg) + call err0%handle(err) + return + end if + close(unit=file_unit, status='delete', iostat=ios, iomsg=msg) + if (ios /= 0) then + err0 = state_type(STDLIB_FS_ERROR,'Cannot delete',path,'-',msg) + call err0%handle(err) + return + end if +end subroutine delete_file + end module stdlib_system diff --git a/test/system/test_filesystem.f90 b/test/system/test_filesystem.f90 index 843763af9..4cf1690e4 100644 --- a/test/system/test_filesystem.f90 +++ b/test/system/test_filesystem.f90 @@ -1,6 +1,7 @@ module test_filesystem use testdrive, only : new_unittest, unittest_type, error_type, check, skip_test - use stdlib_system, only: is_directory + use stdlib_system, only: is_directory, delete_file + use stdlib_error, only: state_type implicit none @@ -13,7 +14,10 @@ subroutine collect_suite(testsuite) testsuite = [ & new_unittest("fs_is_directory_dir", test_is_directory_dir), & - new_unittest("fs_is_directory_file", test_is_directory_file) & + new_unittest("fs_is_directory_file", test_is_directory_file), & + new_unittest("fs_delete_non_existent", test_delete_file_non_existent), & + new_unittest("fs_delete_existing_file", test_delete_file_existing), & + new_unittest("fs_delete_file_being_dir", test_delete_directory) & ] end subroutine collect_suite @@ -67,6 +71,81 @@ subroutine test_is_directory_file(error) end subroutine test_is_directory_file + subroutine test_delete_file_non_existent(error) + !> Error handling + type(error_type), allocatable, intent(out) :: error + type(state_type) :: state + + ! Attempt to delete a file that doesn't exist + call delete_file('non_existent_file.txt', state) + + call check(error, state%ok(), 'Error should not be triggered for non-existent file') + if (allocated(error)) return + + end subroutine test_delete_file_non_existent + + subroutine test_delete_file_existing(error) + !> Error handling + type(error_type), allocatable, intent(out) :: error + + character(len=256) :: filename + type(state_type) :: state + integer :: ios,iunit + logical :: is_present + character(len=512) :: msg + + filename = 'existing_file.txt' + + ! Create a file to be deleted + open(newunit=iunit, file=filename, status='replace', iostat=ios, iomsg=msg) + call check(error, ios==0, 'Failed to create test file') + if (allocated(error)) return + close(iunit) + + ! Attempt to delete the existing file + call delete_file(filename, state) + + ! Check deletion successful + call check(error, state%ok(), 'delete_file returned '//state%print()) + if (allocated(error)) return + + ! Check if the file was successfully deleted (should no longer exist) + inquire(file=filename, exist=is_present) + + call check(error, .not.is_present, 'File still present after delete') + if (allocated(error)) return + + end subroutine test_delete_file_existing + + subroutine test_delete_directory(error) + !> Error handling + type(error_type), allocatable, intent(out) :: error + character(len=256) :: filename + type(state_type) :: state + integer :: ios,iocmd + character(len=512) :: msg + + filename = 'test_directory' + + ! The directory is not nested: it should be cross-platform to just call `mkdir` + call execute_command_line('mkdir ' // filename, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) + call check(error, ios==0 .and. iocmd==0, 'Cannot init delete_directory test: '//trim(msg)) + if (allocated(error)) return + + ! Attempt to delete a directory (which should fail) + call delete_file(filename, state) + + ! Check that an error was raised since the target is a directory + call check(error, state%error(), 'Error was not triggered trying to delete directory') + if (allocated(error)) return + + ! Clean up: remove the empty directory + call execute_command_line('rmdir ' // filename, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) + call check(error, ios==0 .and. iocmd==0, 'Cannot cleanup delete_directory test: '//trim(msg)) + if (allocated(error)) return + + end subroutine test_delete_directory + end module test_filesystem