diff --git a/doc/specs/stdlib_system.md b/doc/specs/stdlib_system.md index c6c79fcea..ffae420de 100644 --- a/doc/specs/stdlib_system.md +++ b/doc/specs/stdlib_system.md @@ -646,6 +646,51 @@ Subroutine --- +## `exists` - Checks if a path exists in the filesystem + +### Status + +Experimental + +### Description + +This function performs a system call (syscall) to the operating system, to retrieve the metadata +corresponding to the path, and identifies the type of path it is. +It can distinguish among the following path types + +- Regular File +- Directory +- Symbolic Link + +Returns a constant representing the path type or `type_unknown` if it cannot be determined. +If there has been an error, It is handled using `state_type`. + +### Syntax + +`res = [[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 + +`err` is an optional state return flag. On error if not requested, an `FS_ERROR` will trigger an error stop. + +### Example + +```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 142dad22a..d032d7996 100644 --- a/example/system/CMakeLists.txt +++ b/example/system/CMakeLists.txt @@ -18,3 +18,4 @@ ADD_EXAMPLE(path_base_name) ADD_EXAMPLE(path_dir_name) ADD_EXAMPLE(make_directory) ADD_EXAMPLE(remove_directory) +ADD_EXAMPLE(exists) diff --git a/example/system/example_exists.f90 b/example/system/example_exists.f90 new file mode 100644 index 000000000..6e9b70a43 --- /dev/null +++ b/example/system/example_exists.f90 @@ -0,0 +1,26 @@ +! Illustrate the usage of `exists` +program example_exists + use stdlib_system, only: exists, type_unknown, type_regular_file, & + type_directory, type_symlink + use stdlib_error, only: state_type + implicit none + + type(state_type) :: err + + character(*), parameter :: path = "path" + integer :: t + + t = exists(path, err) + + if (err%error()) then + print *, err%print() + end if + + select case (t) + case (type_unknown); print *, "Unknown type!" + case (type_regular_file); print *, "Regular File!" + case (type_directory); print *, "Directory!" + case (type_symlink); print *, "Symbolic Link!" + end select +end program example_exists + diff --git a/src/stdlib_system.F90 b/src/stdlib_system.F90 index bd6f9b001..59771f279 100644 --- a/src/stdlib_system.F90 +++ b/src/stdlib_system.F90 @@ -204,6 +204,44 @@ 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 + type_unknown = 0, & + !> Represents a regular file + type_regular_file = 1, & + !> Represents a directory + type_directory = 2, & + !> Represents a symbolic link + 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 +!! +!! The function performs a system call (syscall) to the operating system, to retrieve the metadata +!! corresponding to a path, and identifies the type of path it is. +!! It can distinguish among the following path types +!! +!! - Regular File +!! - Directory +!! - Symbolic Link +!! +!! Returns a constant representing the path type or `type_unknown` if it cannot be determined. +!! If there has been an error, It is handled using `state_type`. +!! +public :: exists ! CPU clock ticks storage integer, parameter, private :: TICKS = int64 @@ -899,22 +937,27 @@ end function is_directory ! 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) +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, 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_) call c_f_pointer(c_str_ptr, c_str, [len]) @@ -1134,6 +1177,31 @@ 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 +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(*) + 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) + + if (stat /= 0) then + err0 = FS_ERROR_CODE(stat, c_get_strerror()) + call err0%handle(err) + end if +end function exists + 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 0bef82b8c..18f7e2d5e 100644 --- a/src/stdlib_system.c +++ b/src/stdlib_system.c @@ -1,3 +1,4 @@ +#include #include #include #include @@ -5,12 +6,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. +// Uses `strerr` on unix. +// if `winapi` is `false`, uses the usual `strerr` on windows. +// If `winapi` is `false`, uses `FormatMessage`(from windows.h) on windows. +char* stdlib_strerror(size_t* len, bool winapi){ + + if (winapi) { +#ifdef _WIN32 + LPSTR err = NULL; + DWORD dw = GetLastError(); + + FormatMessage( + 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; @@ -44,3 +72,50 @@ int stdlib_remove_directory(const char* path){ return (!code) ? 0 : errno; } + +// 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 type_unknown = 0; + const int type_regular_file = 1; + const int type_directory = 2; + const int type_symlink = 3; + + int type = type_unknown; + *stat = 0; + +#ifdef _WIN32 + DWORD attrs = GetFileAttributesA(path); + + if (attrs == INVALID_FILE_ATTRIBUTES) { + *stat = (int) GetLastError(); + return type_unknown; + } + + // It is not a directory or a symlink + type = type_regular_file; + + if (attrs & FILE_ATTRIBUTE_REPARSE_POINT) type = type_symlink; + if (attrs & FILE_ATTRIBUTE_DIRECTORY) type = type_directory; +#else + struct stat buf = {0}; + int status; + status = lstat(path, &buf); + + if (status == -1) { + // `lstat` failed + *stat = errno; + return type_unknown; + } + + switch (buf.st_mode & S_IFMT) { + case S_IFREG: type = type_regular_file; break; + case S_IFDIR: type = type_directory; break; + case S_IFLNK: type = type_symlink; break; + default: type = type_unknown; break; + } +#endif /* ifdef _WIN32 */ + return type; +} diff --git a/test/system/test_filesystem.f90 b/test/system/test_filesystem.f90 index af4bbedb6..c01fbe625 100644 --- a/test/system/test_filesystem.f90 +++ b/test/system/test_filesystem.f90 @@ -2,8 +2,9 @@ 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 + OS_WINDOWS, exists, type_unknown, type_regular_file, type_directory, type_symlink use stdlib_error, only: state_type, STDLIB_FS_ERROR + use stdlib_strings, only: to_string implicit none @@ -16,6 +17,10 @@ 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_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), & @@ -49,6 +54,175 @@ 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, err%message// " and cannot delete test file: " // trim(msg)) + return + end if + + call check(error, t == 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, err%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_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, err%message // " and & + & cannot cleanup test_exists_dir: " // trim(msg)) + return + end if + + call check(error, t == 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, err%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, err%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, err%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, err%message // " and cannot delete target: " // trim(msg)) + return + end if + + call check(error, t == 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, err%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, err%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, err%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