diff --git a/doc/specs/stdlib_system.md b/doc/specs/stdlib_system.md index 95a7f8e41..243db8224 100644 --- a/doc/specs/stdlib_system.md +++ b/doc/specs/stdlib_system.md @@ -497,6 +497,45 @@ Formats all the arguments into a nice error message, utilizing the constructor o --- +## `is_regular_file` - Test if a path is a regular file + +### Status + +Experimental + +### Description + +This function checks if a specified file system path is a regular file. +It follows symbolic links and returns the status of the `target`. +It is designed to work across multiple platforms. On Windows, paths with both forward `/` and backward `\` slashes are accepted. + +### Syntax + +`result = ` [[stdlib_system(module):is_regular_file(function)]]`(path)` + +### Class + +Function + +### Arguments + +`path`: Shall be a character string containing the file system path to evaluate. It is an `intent(in)` argument. + +### Return values + +The function returns a `logical` value: + +- `.true.` if the path matches an existing regular file. +- `.false.` otherwise, or if path does not exist. + +### Example + +```fortran +{!example/system/example_is_regular_file.f90!} +``` + +--- + ## `is_directory` - Test if a path is a directory ### Status @@ -506,6 +545,7 @@ Experimental ### Description This function checks if a specified file system path is a directory. +It follows symbolic links and returns the status of the `target`. It is designed to work across multiple platforms. On Windows, paths with both forward `/` and backward `\` slashes are accepted. ### Syntax @@ -535,6 +575,46 @@ The function returns a `logical` value: --- +## `is_symlink` - Test if a path is a symbolic link. + +### Status + +Experimental + +### Description + +This function checks if a specified file system path is a symbolic link to either a file or a directory. +Use [[stdlib_system(module):is_regular_file(function)]] and [[stdlib_system(module):is_directory(function)]] functions +to check further if the link is to a file or a directory respectively. +It is designed to work across multiple platforms. On Windows, paths with both forward `/` and backward `\` slashes are accepted. + +### Syntax + +`result = ` [[stdlib_system(module):is_symlink(function)]]`(path)` + +### Class + +Function + +### Arguments + +`path`: Shall be a character string containing the file system path to evaluate. It is an `intent(in)` argument. + +### Return values + +The function returns a `logical` value: + +- `.true.` if the path matches an existing regular file. +- `.false.` otherwise, or if the path does not exist. + +### Example + +```fortran +{!example/system/example_is_symlink.f90!} +``` + +--- + ## `make_directory` - Creates an empty directory ### Status @@ -720,6 +800,54 @@ Subroutine --- +## `exists` - Checks if a path exists in the filesystem + +### Status + +Experimental + +### Description + +This function makes a system call (syscall) to retrieve metadata for the specified path and determines its type. +It can distinguish between the following path types: + +- Regular File +- Directory +- Symbolic Link + +It returns a constant representing the detected path type, or `type_unknown` if the type cannot be determined. +Any encountered errors are handled using `state_type`. + +### Syntax + +`fs_type = [[stdlib_system(module):exists(function)]] (path [, err])` + +### Class + +Function + +### Arguments + +`path`: Shall be a character string containing the path. It is an `intent(in)` argument. + +`err`(optional): Shall be of type `state_type`, and is used for error handling. It is an `optional, intent(out)` argument. + +### Return values + +`fs_type`: An `intent(out), integer` parameter indicating the type. The possible values are: +- `fs_type_unknown`: 0 => an unknown type +- `fs_type_regular_file`: 1 => a regular file +- `fs_type_directory`: 2 => a directory +- `fs_type_symlink`: 3 => a symbolic link + +`err`(optional): It is an optional state return flag. If not requested and an error occurs, an `FS_ERROR` will trigger an error stop. + +```fortran +{!example/system/example_exists.f90!} +``` + +--- + ## `null_device` - Return the null device file path ### Status diff --git a/example/system/CMakeLists.txt b/example/system/CMakeLists.txt index 3ede9e3cf..e744108e1 100644 --- a/example/system/CMakeLists.txt +++ b/example/system/CMakeLists.txt @@ -1,6 +1,5 @@ ADD_EXAMPLE(get_runtime_os) ADD_EXAMPLE(delete_file) -ADD_EXAMPLE(is_directory) ADD_EXAMPLE(null_device) ADD_EXAMPLE(os_type) ADD_EXAMPLE(process_1) @@ -19,3 +18,7 @@ ADD_EXAMPLE(path_dir_name) ADD_EXAMPLE(make_directory) ADD_EXAMPLE(remove_directory) ADD_EXAMPLE(cwd) +ADD_EXAMPLE(exists) +ADD_EXAMPLE(is_regular_file) +ADD_EXAMPLE(is_directory) +ADD_EXAMPLE(is_symlink) \ No newline at end of file diff --git a/example/system/example_exists.f90 b/example/system/example_exists.f90 new file mode 100644 index 000000000..d1c8976a8 --- /dev/null +++ b/example/system/example_exists.f90 @@ -0,0 +1,30 @@ +! Illustrate the usage of `exists` +program example_exists + use stdlib_system, only: exists, fs_type_unknown, fs_type_regular_file, & + fs_type_directory, fs_type_symlink + use stdlib_error, only: state_type + implicit none + + type(state_type) :: err + + ! Path to check + character(*), parameter :: path = "path/to/check" + ! To get the type of the path + integer :: t + + t = exists(path, err) + + if (err%error()) then + ! An error occured, print it + print *, err%print() + end if + + ! switching on the type returned by `exists` + select case (t) + case (fs_type_unknown); print *, "Unknown type!" + case (fs_type_regular_file); print *, "Regular File!" + case (fs_type_directory); print *, "Directory!" + case (fs_type_symlink); print *, "Symbolic Link!" + end select +end program example_exists + diff --git a/example/system/example_is_regular_file.f90 b/example/system/example_is_regular_file.f90 new file mode 100644 index 000000000..d705b1e5d --- /dev/null +++ b/example/system/example_is_regular_file.f90 @@ -0,0 +1,14 @@ +! Demonstrate usage of `is_regular_file` +program example_is_regular_file + use stdlib_system, only: is_regular_file + implicit none + + character(*), parameter :: path = "path/to/check" + + ! Test if path is a regular file + if (is_regular_file(path)) then + print *, "The specified path is a regular file." + else + print *, "The specified path is not a regular file." + end if +end program example_is_regular_file diff --git a/example/system/example_is_symlink.f90 b/example/system/example_is_symlink.f90 new file mode 100644 index 000000000..8a243bd03 --- /dev/null +++ b/example/system/example_is_symlink.f90 @@ -0,0 +1,20 @@ +! Demonstrate usage of `is_symlink` +program example_is_symlink + use stdlib_system, only: is_symlink, is_directory + implicit none + + character(*), parameter :: path = "path/to/check" + + ! Test if path is a symbolic link + if (is_symlink(path)) then + print *, "The specified path is a symlink." + ! Further check if it is linked to a file or a directory + if (is_directory(path)) then + print *, "Further, it is a link to a directory." + else + print *, "Further, it is a link to a file." + end if + else + print *, "The specified path is not a symlink." + end if +end program example_is_symlink diff --git a/src/stdlib_system.F90 b/src/stdlib_system.F90 index 90e61e05b..ac7feba5a 100644 --- a/src/stdlib_system.F90 +++ b/src/stdlib_system.F90 @@ -104,9 +104,12 @@ module stdlib_system !! !!### Description !! -!! This function checks if a given file system path is a directory. It is cross-platform and utilizes -!! native system calls. It supports common operating systems such as Linux, macOS, -!! Windows, and various UNIX-like environments. On unsupported operating systems, the function will return `.false.`. +!! This function checks if a given file system path is a directory. +!! It follows symbolic links to return the status of the `target`. +!! +!! It is cross-platform and utilizes native system calls. +!! It supports common operating systems such as Linux, macOS, Windows, and various UNIX-like environments. +!! On unsupported operating systems, the function will return `.false.`. !! public :: is_directory @@ -230,6 +233,78 @@ module stdlib_system !! ([Specification](../page/specs/stdlib_system.html#FS_ERROR_CODE)) !! public :: FS_ERROR_CODE + +!> Version: experimental +!> +!> Integer constants representing the most common path types. +!> ([Specification](../page/specs/stdlib_system.html)) +integer, parameter, public :: & + !> Represents an unknown path type + fs_type_unknown = 0, & + !> Represents a regular file + fs_type_regular_file = 1, & + !> Represents a directory + fs_type_directory = 2, & + !> Represents a symbolic link + fs_type_symlink = 3 + +!! version: experimental +!! +!! Checks if a path exists in the filesystem. +!! ([Specification](../page/specs/stdlib_system.html#exists)) +!! +!!### Summary +!! Function to check whether the path exists in the fileystem at all. +!! If the path does exist, returns the type of the path. +!! +!!### Description +!! +!! This function makes a system call (syscall) to retrieve metadata for the specified path and determines its type. +!! It can distinguish between the following path types: +!! +!! - Regular File +!! - Directory +!! - Symbolic Link +!! +!! It does not follow symbolic links. +!! +!! It returns a constant representing the detected path type, or `type_unknown` if the type cannot be determined. +!! Any encountered errors are handled using `state_type`. +!! +public :: exists + +!! version: experimental +!! +!! Tests if a given path is a symbolic link. +!! ([Specification](../page/specs/stdlib_system.html#is_symlink)) +!! +!!### Summary +!! Function to evaluate whether a specified path corresponds to a symbolic link. +!! +!!### Description +!! +!! This function checks if a given file system path is a symbolic link either to a +!! file or a directory. It is cross-platform and utilizes native system calls. +!! It supports common operating systems such as Linux, macOS, Windows, and various UNIX-like environments. +!! +public :: is_symlink + +!! version: experimental +!! +!! Tests if a given path is a regular file. +!! ([Specification](../page/specs/stdlib_system.html#is_regular_file)) +!! +!!### Summary +!! Function to evaluate whether a specified path corresponds to a regular file. +!! +!!### Description +!! +!! This function checks if a given file system path is a regular file. +!! It follows symbolic links to return the status of the `target`. +!! It is cross-platform and utilizes native system calls. +!! It supports common operating systems such as Linux, macOS, Windows, and various UNIX-like environments. +!! +public :: is_regular_file ! CPU clock ticks storage integer, parameter, private :: TICKS = int64 @@ -941,24 +1016,30 @@ function to_f_char(c_str_ptr, len) result(f_str) end do end function to_f_char -! A helper function to get the result of the C function `strerror`. -! `strerror` is a function provided by ``. -! It returns a string describing the meaning of `errno` in the C header `` -function c_get_strerror() result(str) +! A helper function to get the string describing an error from C functions. +! If `winapi` is false or not present, uses `strerror` provided by `` +! Otherwise, uses `strerror` on unix and `FormatMessageA` on windows. +function c_get_strerror(winapi) result(str) character(len=:), allocatable :: str + logical, optional, intent(in) :: winapi interface - type(c_ptr) function strerror(len) bind(C, name='stdlib_strerror') - import c_size_t, c_ptr + type(c_ptr) function strerror(len, winapi) bind(C, name='stdlib_strerror') + import c_size_t, c_ptr, c_bool implicit none integer(c_size_t), intent(out) :: len + logical, intent(in) :: winapi end function strerror end interface type(c_ptr) :: c_str_ptr - integer(c_size_t) :: len + integer(c_size_t) :: len, i + character(kind=c_char), pointer :: c_str(:) + logical :: winapi_ - c_str_ptr = strerror(len) + winapi_ = optval(winapi, .false.) + + c_str_ptr = strerror(len, winapi_) str = to_f_char(c_str_ptr, len) end function c_get_strerror @@ -1214,6 +1295,57 @@ pure function FS_ERROR(a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,& a13,a14,a15,a16,a17,a18,a19,a20) end function FS_ERROR +! checks if a path exists and returns its type +function exists(path, err) result(fs_type) + character(*), intent(in) :: path + type(state_type), optional, intent(out) :: err + integer :: fs_type + + type(state_type) :: err0 + + interface + integer function stdlib_exists(path, stat) bind(C, name='stdlib_exists') + import c_char, c_int + character(kind=c_char), intent(in) :: path(*) + ! to return the error code if any + integer(kind=c_int), intent(out) :: stat + end function stdlib_exists + end interface + + integer(kind=c_int) :: stat + + fs_type = stdlib_exists(to_c_char(trim(path)), stat) + + ! an error occurred + if (stat /= 0) then + err0 = FS_ERROR_CODE(stat, c_get_strerror()) + call err0%handle(err) + end if +end function exists + +! public convenience wrapper to check if path is a symbolic link +logical function is_symlink(path) + character(len=*), intent(in) :: path + type(state_type) :: err + + is_symlink = exists(path, err) == fs_type_symlink +end function is_symlink + +! checks if path is a regular file. +! It follows symbolic links and returns the status of the `target`. +logical function is_regular_file(path) + character(len=*), intent(in) :: path + + interface + logical(c_bool) function stdlib_is_regular_file(path) bind(C, name='stdlib_is_regular_file') + import c_char, c_bool + character(kind=c_char) :: path(*) + end function stdlib_is_regular_file + end interface + + is_regular_file = logical(stdlib_is_regular_file(to_c_char(trim(path)))) +end function is_regular_file + character function path_sep() if (OS_TYPE() == OS_WINDOWS) then path_sep = '\' diff --git a/src/stdlib_system.c b/src/stdlib_system.c index 81ff06a06..f8bd2fe0f 100644 --- a/src/stdlib_system.c +++ b/src/stdlib_system.c @@ -1,3 +1,4 @@ +#include #include #include #include @@ -7,12 +8,39 @@ #include #ifdef _WIN32 #include +#include #else #include #endif /* ifdef _WIN32 */ -// Returns the string describing the meaning of `errno` code (by calling `strerror`). -char* stdlib_strerror(size_t* len){ +// Wrapper to get the string describing a system syscall error. +// Always Uses `strerr` on unix. +// if `winapi` is `false`, uses the usual `strerr` on windows. +// If `winapi` is `true`, uses `FormatMessageA`(from windows.h) on windows. +char* stdlib_strerror(size_t* len, bool winapi){ + + if (winapi) { +#ifdef _WIN32 + LPSTR err = NULL; + DWORD dw = GetLastError(); + + FormatMessageA( + FORMAT_MESSAGE_ALLOCATE_BUFFER | + FORMAT_MESSAGE_FROM_SYSTEM | + FORMAT_MESSAGE_IGNORE_INSERTS, + NULL, + dw, + MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), + (LPSTR) &err, + 0, + NULL); + + *len = strlen(err); + return (char*) err; + +#endif /* ifdef _WIN32 */ + } + char* err = strerror(errno); *len = strlen(err); return err; @@ -46,7 +74,6 @@ int stdlib_remove_directory(const char* path){ return (!code) ? 0 : errno; } - // Wrapper to the platform's `getcwd`(get current working directory) call. // Uses `getcwd` on unix, `_getcwd` on windows. // Returns the cwd, sets the length of cwd and the `stat` of the operation. @@ -91,3 +118,62 @@ int stdlib_set_cwd(char* path) { return (code == -1) ? errno : 0; } + +// Wrapper to the platform's `stat`(status of path) call. +// Uses `lstat` on unix, `GetFileAttributesA` on windows. +// Returns the `type` of the path, and sets the `stat`(if any errors). +int stdlib_exists(const char* path, int* stat){ + // All the valid types + const int fs_type_unknown = 0; + const int fs_type_regular_file = 1; + const int fs_type_directory = 2; + const int fs_type_symlink = 3; + + int type = fs_type_unknown; + *stat = 0; + +#ifdef _WIN32 + DWORD attrs = GetFileAttributesA(path); + + if (attrs == INVALID_FILE_ATTRIBUTES) { + *stat = (int) GetLastError(); + return fs_type_unknown; + } + + // Let's assume it is a regular file + type = fs_type_regular_file; + + if (attrs & FILE_ATTRIBUTE_REPARSE_POINT) type = fs_type_symlink; + if (attrs & FILE_ATTRIBUTE_DIRECTORY) type = fs_type_directory; +#else + struct stat buf = {0}; + int status; + status = lstat(path, &buf); + + if (status == -1) { + // `lstat` failed + *stat = errno; + return fs_type_unknown; + } + + switch (buf.st_mode & S_IFMT) { + case S_IFREG: type = fs_type_regular_file; break; + case S_IFDIR: type = fs_type_directory; break; + case S_IFLNK: type = fs_type_symlink; break; + default: type = fs_type_unknown; break; + } +#endif /* ifdef _WIN32 */ + return type; +} + +// `stat` and `_stat` follow symlinks automatically. +// so no need for winapi functions. +bool stdlib_is_regular_file(const char* path) { +#ifdef _WIN32 + struct _stat buf = {0}; + return _stat(path, &buf) == 0 && S_ISREG(buf.st_mode); +#else + struct stat buf = {0}; + return stat(path, &buf) == 0 && S_ISREG(buf.st_mode); +#endif /* ifdef _WIN32 */ +} diff --git a/test/system/test_filesystem.f90 b/test/system/test_filesystem.f90 index 1d06297f5..63639c6d1 100644 --- a/test/system/test_filesystem.f90 +++ b/test/system/test_filesystem.f90 @@ -2,8 +2,10 @@ module test_filesystem use testdrive, only : new_unittest, unittest_type, error_type, check, skip_test use stdlib_system, only: is_directory, delete_file, FS_ERROR, FS_ERROR_CODE, & make_directory, remove_directory, make_directory_all, is_windows, OS_TYPE, & - OS_WINDOWS, get_cwd, set_cwd, operator(/) + OS_WINDOWS, get_cwd, set_cwd, operator(/), exists, fs_type_unknown, & + fs_type_regular_file, fs_type_directory, fs_type_symlink, is_regular_file use stdlib_error, only: state_type, STDLIB_FS_ERROR + use stdlib_strings, only: to_string implicit none @@ -16,6 +18,11 @@ subroutine collect_suite(testsuite) testsuite = [ & new_unittest("fs_error", test_fs_error), & + new_unittest("fs_exists_not_exists", test_exists_not_exists), & + new_unittest("fs_exists_reg_file", test_exists_reg_file), & + new_unittest("fs_exists_dir", test_exists_dir), & + new_unittest("fs_exists_symlink", test_exists_symlink), & + new_unittest("fs_is_regular_file", test_is_regular_file), & new_unittest("fs_is_directory_dir", test_is_directory_dir), & new_unittest("fs_is_directory_file", test_is_directory_file), & new_unittest("fs_delete_non_existent", test_delete_file_non_existent), & @@ -50,6 +57,206 @@ subroutine test_fs_error(error) if (allocated(error)) return end subroutine test_fs_error + subroutine test_exists_not_exists(error) + type(error_type), allocatable, intent(out) :: error + type(state_type) :: err + + character(*), parameter :: path = "rand_name" + integer :: t + + t = exists(path, err) + call check(error, err%error(), "False positive for a non-existent path!") + end subroutine test_exists_not_exists + + subroutine test_exists_reg_file(error) + type(error_type), allocatable, intent(out) :: error + type(state_type) :: err + character(len=256) :: filename + integer :: ios, iunit, t + character(len=512) :: msg + + filename = "test_file.txt" + + ! Create a file + open(newunit=iunit, file=filename, status="replace", iostat=ios, iomsg=msg) + call check(error, ios == 0, "Cannot init test_exists_reg_file: " // trim(msg)) + if (allocated(error)) return + + t = exists(filename, err) + call check(error, err%ok(), "exists failed for reg file: " // err%print()) + + if (allocated(error)) then + ! Clean up: remove the file + close(iunit,status='delete',iostat=ios,iomsg=msg) + call check(error, ios == 0, error%message// " and cannot delete test file: " // trim(msg)) + return + end if + + call check(error, t == fs_type_regular_file, "exists incorrectly identifies type of & + reg files!: type=" // to_string(t)) + + if (allocated(error)) then + ! Clean up: remove the file + close(iunit,status='delete',iostat=ios,iomsg=msg) + call check(error, ios == 0, error%message// " and cannot delete test file: " // trim(msg)) + return + end if + + ! Clean up: remove the file + close(iunit,status='delete',iostat=ios,iomsg=msg) + call check(error, ios == 0, "Cannot delete test file: " // trim(msg)) + if (allocated(error)) return + end subroutine test_exists_reg_file + + subroutine test_is_regular_file(error) + type(error_type), allocatable, intent(out) :: error + character(len=256) :: filename + integer :: ios, iunit + character(len=512) :: msg + + logical :: is_file + + filename = "test_file.txt" + + ! Create a file + open(newunit=iunit, file=filename, status="replace", iostat=ios, iomsg=msg) + call check(error, ios == 0, "Cannot init test_is_regular_file: " // trim(msg)) + if (allocated(error)) return + + is_file = is_regular_file(filename) + call check(error, is_file, "is_regular_file could not identify a file") + + if (allocated(error)) then + ! Clean up: remove the file + close(iunit,status='delete',iostat=ios,iomsg=msg) + call check(error, ios == 0, error%message// " and cannot delete test file: " // trim(msg)) + return + end if + + ! Clean up: remove the file + close(iunit,status='delete',iostat=ios,iomsg=msg) + call check(error, ios == 0, "Cannot delete test file: " // trim(msg)) + if (allocated(error)) return + end subroutine test_is_regular_file + + subroutine test_exists_dir(error) + type(error_type), allocatable, intent(out) :: error + type(state_type) :: err + character(len=256) :: dirname + integer :: ios, iocmd, t + character(len=512) :: msg + + dirname = "temp_dir" + + ! Create a directory + call execute_command_line("mkdir " // dirname, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) + call check(error, ios == 0 .and. iocmd == 0, "Cannot int test_exists_dir: " // trim(msg)) + if (allocated(error)) return + + t = exists(dirname, err) + call check(error, err%ok(), "exists failed for directory: " // err%print()) + + if (allocated(error)) then + ! Clean up: remove the directory + call execute_command_line("rmdir " // dirname, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) + call check(error, ios == 0 .and. iocmd == 0, error%message // " and & + & cannot cleanup test_exists_dir: " // trim(msg)) + return + end if + + call check(error, t == fs_type_directory, "exists incorrectly identifies type of & + directories!: type=" // to_string(t)) + + if (allocated(error)) then + ! Clean up: remove the directory + call execute_command_line("rmdir " // dirname, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) + call check(error, ios == 0 .and. iocmd == 0, error%message // " and & + & cannot cleanup test_exists_dir: " // trim(msg)) + return + end if + + ! Clean up: remove the directory + call execute_command_line("rmdir " // dirname, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) + call check(error, ios == 0 .and. iocmd == 0, "Cannot cleanup test_exists_dir: " // trim(msg)) + end subroutine test_exists_dir + + subroutine test_exists_symlink(error) + type(error_type), allocatable, intent(out) :: error + type(state_type) :: err + character(len=128) :: target_name, link_name + integer :: ios, iunit, iocmd, t + character(len=512) :: msg, cmd + + target_name = "test_file.txt" + link_name = "symlink.txt" + + ! Create a file + open(newunit=iunit, file=target_name, status="replace", iostat=ios, iomsg=msg) + call check(error, ios == 0, "Cannot init test_exists_symlink: " // trim(msg)) + if (allocated(error)) return + + if (is_windows()) then + cmd = 'mklink '//link_name//' '//target_name + call execute_command_line(cmd, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) + else + cmd = 'ln -s '//target_name//' '//link_name + call execute_command_line(cmd, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) + end if + + call check(error, ios == 0 .and. iocmd == 0, "Cannot create symlink!: " // trim(msg)) + + if (allocated(error)) then + ! Clean up: remove the target + close(iunit,status='delete',iostat=ios,iomsg=msg) + call check(error, ios == 0, error%message // " and cannot delete target: " // trim(msg)) + return + end if + + t = exists(link_name, err) + call check(error, err%ok(), "exists failed for symlink: " // err%print()) + + if (allocated(error)) then + ! Clean up: remove the link + call execute_command_line("rm " // link_name, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) + call check(error, ios == 0 .and. iocmd == 0, error%message // " and & + & cannot delete link: " // trim(msg)) + + ! Clean up: remove the target + close(iunit,status='delete',iostat=ios,iomsg=msg) + call check(error, ios == 0, error%message // " and cannot delete target: " // trim(msg)) + return + end if + + call check(error, t == fs_type_symlink, "exists incorrectly identifies type of & + symlinks!: type=" // to_string(t)) + + if (allocated(error)) then + ! Clean up: remove the link + call execute_command_line("rm " // link_name, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) + call check(error, ios == 0 .and. iocmd == 0, error%message // " and & + & cannot delete link: " // trim(msg)) + + ! Clean up: remove the target + close(iunit,status='delete',iostat=ios,iomsg=msg) + call check(error, ios == 0, error%message // " and cannot delete target: " // trim(msg)) + return + end if + + ! Clean up: remove the link + call execute_command_line("rm " // link_name, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) + call check(error, ios == 0 .and. iocmd == 0, "Cannot delete link: " // trim(msg)) + + if (allocated(error)) then + ! Clean up: remove the target + close(iunit,status='delete',iostat=ios,iomsg=msg) + call check(error, ios == 0, error%message // " and cannot delete target: " // trim(msg)) + end if + + ! Clean up: remove the target + close(iunit,status='delete',iostat=ios,iomsg=msg) + call check(error, ios == 0, "Cannot delete target: " // trim(msg)) + end subroutine test_exists_symlink + ! Test `is_directory` for a directory subroutine test_is_directory_dir(error) type(error_type), allocatable, intent(out) :: error