From 42c839c4a15888b2fcf02c50c288a9c1afd4ea92 Mon Sep 17 00:00:00 2001 From: Suprit S Jahagirdar Date: Sun, 3 Aug 2025 00:29:25 +0530 Subject: [PATCH 01/13] add functions, parameters --- src/stdlib_system.F90 | 76 ++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 72 insertions(+), 4 deletions(-) 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 = '\' From 8510867f7bf47cba149a4522280330ab64a6394d Mon Sep 17 00:00:00 2001 From: Suprit S Jahagirdar Date: Sun, 3 Aug 2025 00:29:37 +0530 Subject: [PATCH 02/13] add C interfaces --- src/stdlib_system.c | 77 +++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 75 insertions(+), 2 deletions(-) diff --git a/src/stdlib_system.c b/src/stdlib_system.c index 0bef82b8c..e9b9fca9f 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,48 @@ 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; + } + + if (attrs & FILE_ATTRIBUTE_NORMAL) 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; +} From 866fddbae949ec97095e0fcca79b7d7247343b52 Mon Sep 17 00:00:00 2001 From: Suprit S Jahagirdar Date: Sun, 3 Aug 2025 00:29:58 +0530 Subject: [PATCH 03/13] added examples --- example/system/CMakeLists.txt | 1 + example/system/example_exists.f90 | 26 ++++++++++++++++++++++++++ 2 files changed, 27 insertions(+) create mode 100644 example/system/example_exists.f90 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 + From aebb3357ae8e92b5bf8a4b9c50e6d1c198f4fa28 Mon Sep 17 00:00:00 2001 From: Suprit S Jahagirdar Date: Sun, 3 Aug 2025 00:30:09 +0530 Subject: [PATCH 04/13] added tests --- test/system/test_filesystem.f90 | 162 +++++++++++++++++++++++++++++++- 1 file changed, 161 insertions(+), 1 deletion(-) diff --git a/test/system/test_filesystem.f90 b/test/system/test_filesystem.f90 index af4bbedb6..2df3101c8 100644 --- a/test/system/test_filesystem.f90 +++ b/test/system/test_filesystem.f90 @@ -2,7 +2,7 @@ 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 implicit none @@ -16,6 +16,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 +53,162 @@ 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!") + + 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!") + + 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=256) :: target_name, link_name, cmd + integer :: ios, iunit, iocmd, t + character(len=512) :: msg + + 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 '//link_name//' '//target_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)) return + + 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!") + + 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 + end subroutine test_exists_symlink + ! Test `is_directory` for a directory subroutine test_is_directory_dir(error) type(error_type), allocatable, intent(out) :: error From cd612741093e1f95bc6bc33f8e2080c8be397312 Mon Sep 17 00:00:00 2001 From: Suprit S Jahagirdar Date: Sun, 3 Aug 2025 00:30:18 +0530 Subject: [PATCH 05/13] added docs --- doc/specs/stdlib_system.md | 45 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 45 insertions(+) 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 From 4ec80976d2510004274d3fa80ae2410d068cdbac Mon Sep 17 00:00:00 2001 From: Suprit S Jahagirdar Date: Sun, 3 Aug 2025 00:59:40 +0530 Subject: [PATCH 06/13] better test fail messages --- test/system/test_filesystem.f90 | 20 ++++++++++++-------- 1 file changed, 12 insertions(+), 8 deletions(-) diff --git a/test/system/test_filesystem.f90 b/test/system/test_filesystem.f90 index 2df3101c8..294d4cbc1 100644 --- a/test/system/test_filesystem.f90 +++ b/test/system/test_filesystem.f90 @@ -4,6 +4,7 @@ module test_filesystem make_directory, remove_directory, make_directory_all, is_windows, OS_TYPE, & 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 @@ -88,7 +89,8 @@ subroutine test_exists_reg_file(error) return end if - call check(error, t == type_regular_file, "exists incorrectly identifies type of reg files!") + 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 @@ -123,17 +125,18 @@ subroutine test_exists_dir(error) 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 & + 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!") + 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 & + call check(error, ios == 0 .and. iocmd == 0, err%message // " and & & cannot cleanup test_exists_dir: " // trim(msg)) return end if @@ -184,17 +187,18 @@ subroutine test_exists_symlink(error) return end if - call check(error, t == type_symlink, "exists incorrectly identifies type of symlinks!") + 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 & + 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)) + call check(error, ios == 0, err%message // " and cannot delete target: " // trim(msg)) return end if @@ -205,7 +209,7 @@ subroutine test_exists_symlink(error) 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)) + call check(error, ios == 0, err%message // " and cannot delete target: " // trim(msg)) end if end subroutine test_exists_symlink From 661ec55576e2d9e25bef0c5232099976a880ac23 Mon Sep 17 00:00:00 2001 From: Suprit S Jahagirdar Date: Sun, 3 Aug 2025 01:18:47 +0530 Subject: [PATCH 07/13] fix windows reg file --- src/stdlib_system.c | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/stdlib_system.c b/src/stdlib_system.c index e9b9fca9f..18f7e2d5e 100644 --- a/src/stdlib_system.c +++ b/src/stdlib_system.c @@ -94,7 +94,9 @@ int stdlib_exists(const char* path, int* stat){ return type_unknown; } - if (attrs & FILE_ATTRIBUTE_NORMAL) type = type_regular_file; + // 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 From dd10b5a27237035be275274d568244f7bc91b82f Mon Sep 17 00:00:00 2001 From: Suprit S Jahagirdar Date: Sun, 3 Aug 2025 01:50:52 +0530 Subject: [PATCH 08/13] fix test commands --- test/system/test_filesystem.f90 | 17 +++++++++++++---- 1 file changed, 13 insertions(+), 4 deletions(-) diff --git a/test/system/test_filesystem.f90 b/test/system/test_filesystem.f90 index 294d4cbc1..b12044b06 100644 --- a/test/system/test_filesystem.f90 +++ b/test/system/test_filesystem.f90 @@ -149,9 +149,9 @@ end subroutine test_exists_dir subroutine test_exists_symlink(error) type(error_type), allocatable, intent(out) :: error type(state_type) :: err - character(len=256) :: target_name, link_name, cmd + character(len=128) :: target_name, link_name integer :: ios, iunit, iocmd, t - character(len=512) :: msg + character(len=512) :: msg, cmd target_name = "test_file.txt" link_name = "symlink.txt" @@ -165,12 +165,21 @@ subroutine test_exists_symlink(error) cmd = 'mklink '//link_name//' '//target_name call execute_command_line(cmd, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) else - cmd = 'ln -s '//link_name//' '//target_name + cmd = 'ln -s '//target_name//' '//link_name + print *, cmd call execute_command_line(cmd, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) + cmd = 'mklink '//link_name//' '//target_name + print *, cmd end if call check(error, ios == 0 .and. iocmd == 0, "Cannot create symlink!: " // trim(msg)) - if (allocated(error)) return + + 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()) From 5be9e94f638dc48075d8b7c6ecc1855e0eddc032 Mon Sep 17 00:00:00 2001 From: Suprit S Jahagirdar Date: Sun, 3 Aug 2025 02:05:25 +0530 Subject: [PATCH 09/13] improve test --- test/system/test_filesystem.f90 | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/test/system/test_filesystem.f90 b/test/system/test_filesystem.f90 index b12044b06..c01fbe625 100644 --- a/test/system/test_filesystem.f90 +++ b/test/system/test_filesystem.f90 @@ -166,10 +166,7 @@ subroutine test_exists_symlink(error) call execute_command_line(cmd, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) else cmd = 'ln -s '//target_name//' '//link_name - print *, cmd call execute_command_line(cmd, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) - cmd = 'mklink '//link_name//' '//target_name - print *, cmd end if call check(error, ios == 0 .and. iocmd == 0, "Cannot create symlink!: " // trim(msg)) @@ -177,7 +174,7 @@ subroutine test_exists_symlink(error) 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)) + call check(error, ios == 0, err%message // " and cannot delete target: " // trim(msg)) return end if @@ -187,12 +184,12 @@ subroutine test_exists_symlink(error) 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 & + 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)) + call check(error, ios == 0, err%message // " and cannot delete target: " // trim(msg)) return end if @@ -220,6 +217,10 @@ subroutine test_exists_symlink(error) 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 From 1aa265d5769f2b1b271f4cb851de72f24dff3596 Mon Sep 17 00:00:00 2001 From: Suprit S Jahagirdar Date: Tue, 5 Aug 2025 20:27:51 +0530 Subject: [PATCH 10/13] typos + small changes --- src/stdlib_system.F90 | 6 +++--- src/stdlib_system.c | 6 +++--- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/src/stdlib_system.F90 b/src/stdlib_system.F90 index 59771f279..4c4cd3ad0 100644 --- a/src/stdlib_system.F90 +++ b/src/stdlib_system.F90 @@ -934,9 +934,9 @@ end function stdlib_is_directory 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 `` +! 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 diff --git a/src/stdlib_system.c b/src/stdlib_system.c index 18f7e2d5e..4c2264927 100644 --- a/src/stdlib_system.c +++ b/src/stdlib_system.c @@ -12,9 +12,9 @@ #endif /* ifdef _WIN32 */ // Wrapper to get the string describing a system syscall error. -// Uses `strerr` on unix. +// Always 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. +// If `winapi` is `true`, uses `FormatMessageA`(from windows.h) on windows. char* stdlib_strerror(size_t* len, bool winapi){ if (winapi) { @@ -22,7 +22,7 @@ char* stdlib_strerror(size_t* len, bool winapi){ LPSTR err = NULL; DWORD dw = GetLastError(); - FormatMessage( + FormatMessageA( FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS, From 306bc8626a3af59a1810f70e7141cdb66ec0d68a Mon Sep 17 00:00:00 2001 From: Suprit S Jahagirdar Date: Tue, 5 Aug 2025 23:27:53 +0530 Subject: [PATCH 11/13] better docs --- doc/specs/stdlib_system.md | 11 +++++------ example/system/example_exists.f90 | 4 ++++ src/stdlib_system.F90 | 14 ++++++++------ src/stdlib_system.c | 2 +- 4 files changed, 18 insertions(+), 13 deletions(-) diff --git a/doc/specs/stdlib_system.md b/doc/specs/stdlib_system.md index ffae420de..b60efc2b8 100644 --- a/doc/specs/stdlib_system.md +++ b/doc/specs/stdlib_system.md @@ -654,16 +654,15 @@ 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 +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 -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`. +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 @@ -681,7 +680,7 @@ Function ### Return values -`err` is an optional state return flag. On error if not requested, an `FS_ERROR` will trigger an error stop. +`err` is an optional state return flag. If not requested and an error occurs, an `FS_ERROR` will trigger an error stop. ### Example diff --git a/example/system/example_exists.f90 b/example/system/example_exists.f90 index 6e9b70a43..102a37bd7 100644 --- a/example/system/example_exists.f90 +++ b/example/system/example_exists.f90 @@ -7,15 +7,19 @@ program example_exists type(state_type) :: err + ! Path to check character(*), parameter :: path = "path" + ! 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 types returned by `exists` select case (t) case (type_unknown); print *, "Unknown type!" case (type_regular_file); print *, "Regular File!" diff --git a/src/stdlib_system.F90 b/src/stdlib_system.F90 index 4c4cd3ad0..71674522f 100644 --- a/src/stdlib_system.F90 +++ b/src/stdlib_system.F90 @@ -229,17 +229,16 @@ module stdlib_system !! 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 +!! +!! 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 !! -!! 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`. +!! 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 @@ -1177,6 +1176,7 @@ 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 @@ -1188,6 +1188,7 @@ function exists(path, err) result(fs_type) 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 @@ -1196,6 +1197,7 @@ end function stdlib_exists 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) diff --git a/src/stdlib_system.c b/src/stdlib_system.c index 4c2264927..629e90618 100644 --- a/src/stdlib_system.c +++ b/src/stdlib_system.c @@ -94,7 +94,7 @@ int stdlib_exists(const char* path, int* stat){ return type_unknown; } - // It is not a directory or a symlink + // Let's assume it is a regular file type = type_regular_file; if (attrs & FILE_ATTRIBUTE_REPARSE_POINT) type = type_symlink; From a5a340ef2d4629bddfb90bcef4a868eba333831a Mon Sep 17 00:00:00 2001 From: Suprit S Jahagirdar Date: Wed, 6 Aug 2025 14:32:40 +0530 Subject: [PATCH 12/13] type renaming + docs --- doc/specs/stdlib_system.md | 10 ++++++++-- example/system/example_exists.f90 | 14 +++++++------- src/stdlib_system.F90 | 8 ++++---- src/stdlib_system.c | 28 ++++++++++++++-------------- test/system/test_filesystem.f90 | 8 ++++---- 5 files changed, 37 insertions(+), 31 deletions(-) diff --git a/doc/specs/stdlib_system.md b/doc/specs/stdlib_system.md index b60efc2b8..33c45bb91 100644 --- a/doc/specs/stdlib_system.md +++ b/doc/specs/stdlib_system.md @@ -666,7 +666,7 @@ Any encountered errors are handled using `state_type`. ### Syntax -`res = [[stdlib_system(module):exists(function)]] (path [, err])` +`fs_type = [[stdlib_system(module):exists(function)]] (path [, err])` ### Class @@ -680,7 +680,13 @@ Function ### Return values -`err` is an optional state return flag. If not requested and an error occurs, an `FS_ERROR` will trigger an error stop. +`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. ### Example diff --git a/example/system/example_exists.f90 b/example/system/example_exists.f90 index 102a37bd7..27680ab33 100644 --- a/example/system/example_exists.f90 +++ b/example/system/example_exists.f90 @@ -1,7 +1,7 @@ ! Illustrate the usage of `exists` program example_exists - use stdlib_system, only: exists, type_unknown, type_regular_file, & - type_directory, type_symlink + 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 @@ -19,12 +19,12 @@ program example_exists print *, err%print() end if - ! switching on the types returned by `exists` + ! switching on the type returned by `exists` 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!" + 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/src/stdlib_system.F90 b/src/stdlib_system.F90 index 71674522f..164afb113 100644 --- a/src/stdlib_system.F90 +++ b/src/stdlib_system.F90 @@ -211,13 +211,13 @@ module stdlib_system !> ([Specification](../page/specs/stdlib_system.html)) integer, parameter, public :: & !> Represents an unknown path type - type_unknown = 0, & + fs_type_unknown = 0, & !> Represents a regular file - type_regular_file = 1, & + fs_type_regular_file = 1, & !> Represents a directory - type_directory = 2, & + fs_type_directory = 2, & !> Represents a symbolic link - type_symlink = 3 + fs_type_symlink = 3 !! version: experimental !! diff --git a/src/stdlib_system.c b/src/stdlib_system.c index 629e90618..b5c857892 100644 --- a/src/stdlib_system.c +++ b/src/stdlib_system.c @@ -78,12 +78,12 @@ int stdlib_remove_directory(const char* path){ // 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; + 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 = type_unknown; + int type = fs_type_unknown; *stat = 0; #ifdef _WIN32 @@ -91,14 +91,14 @@ int stdlib_exists(const char* path, int* stat){ if (attrs == INVALID_FILE_ATTRIBUTES) { *stat = (int) GetLastError(); - return type_unknown; + return fs_type_unknown; } // Let's assume it is a regular file - type = type_regular_file; + type = fs_type_regular_file; - if (attrs & FILE_ATTRIBUTE_REPARSE_POINT) type = type_symlink; - if (attrs & FILE_ATTRIBUTE_DIRECTORY) type = type_directory; + 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; @@ -107,14 +107,14 @@ int stdlib_exists(const char* path, int* stat){ if (status == -1) { // `lstat` failed *stat = errno; - return type_unknown; + return fs_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; + 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; diff --git a/test/system/test_filesystem.f90 b/test/system/test_filesystem.f90 index c01fbe625..c366c2a3f 100644 --- a/test/system/test_filesystem.f90 +++ b/test/system/test_filesystem.f90 @@ -2,7 +2,7 @@ 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, exists, type_unknown, type_regular_file, type_directory, type_symlink + OS_WINDOWS, exists, fs_type_unknown, fs_type_regular_file, fs_type_directory, fs_type_symlink use stdlib_error, only: state_type, STDLIB_FS_ERROR use stdlib_strings, only: to_string @@ -89,7 +89,7 @@ subroutine test_exists_reg_file(error) return end if - call check(error, t == type_regular_file, "exists incorrectly identifies type of & + call check(error, t == fs_type_regular_file, "exists incorrectly identifies type of & reg files!: type=" // to_string(t)) if (allocated(error)) then @@ -130,7 +130,7 @@ subroutine test_exists_dir(error) return end if - call check(error, t == type_directory, "exists incorrectly identifies type of & + call check(error, t == fs_type_directory, "exists incorrectly identifies type of & directories!: type=" // to_string(t)) if (allocated(error)) then @@ -193,7 +193,7 @@ subroutine test_exists_symlink(error) return end if - call check(error, t == type_symlink, "exists incorrectly identifies type of & + call check(error, t == fs_type_symlink, "exists incorrectly identifies type of & symlinks!: type=" // to_string(t)) if (allocated(error)) then From 2c738a896fcf65a30dc6b0634db0f014525b86d0 Mon Sep 17 00:00:00 2001 From: Suprit S Jahagirdar Date: Wed, 6 Aug 2025 19:00:13 +0530 Subject: [PATCH 13/13] add `is_regular_file` and `is_symlink` --- src/stdlib_system.F90 | 22 ++++++++++++++++++++++ src/stdlib_system.c | 12 ++++++++++++ 2 files changed, 34 insertions(+) diff --git a/src/stdlib_system.F90 b/src/stdlib_system.F90 index 164afb113..3fa753c8d 100644 --- a/src/stdlib_system.F90 +++ b/src/stdlib_system.F90 @@ -241,6 +241,9 @@ module stdlib_system !! Any encountered errors are handled using `state_type`. !! public :: exists + +public :: is_symlink +public :: is_regular_file ! CPU clock ticks storage integer, parameter, private :: TICKS = int64 @@ -1204,6 +1207,25 @@ end function stdlib_exists end if end function exists +logical function is_symlink(path) + character(len=*), intent(in) :: path + + is_symlink = exists(path) == fs_type_symlink +end function is_symlink + +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(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 b5c857892..ab21e3db0 100644 --- a/src/stdlib_system.c +++ b/src/stdlib_system.c @@ -119,3 +119,15 @@ int stdlib_exists(const char* path, int* stat){ #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 */ +}