From 8d00eea4291202f0f01bd67daef95aedb973e44b Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Wed, 2 Jul 2025 03:17:01 +0530 Subject: [PATCH 01/16] added functions and relevant wrappers --- src/CMakeLists.txt | 5 +- src/stdlib_system.F90 | 124 +++++++++++++++++++++++++++++++++++++++++- src/stdlib_system.c | 46 ++++++++++++++++ 3 files changed, 172 insertions(+), 3 deletions(-) create mode 100644 src/stdlib_system.c diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index c3cd99120..24fd9c56b 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -32,14 +32,14 @@ set(fppFiles stdlib_linalg_kronecker.fypp stdlib_linalg_cross_product.fypp stdlib_linalg_eigenvalues.fypp - stdlib_linalg_solve.fypp + stdlib_linalg_solve.fypp stdlib_linalg_determinant.fypp stdlib_linalg_qr.fypp stdlib_linalg_inverse.fypp stdlib_linalg_pinv.fypp stdlib_linalg_norms.fypp stdlib_linalg_state.fypp - stdlib_linalg_svd.fypp + stdlib_linalg_svd.fypp stdlib_linalg_cholesky.fypp stdlib_linalg_schur.fypp stdlib_optval.fypp @@ -116,6 +116,7 @@ set(SRC stdlib_sorting_radix_sort.f90 stdlib_system_subprocess.c stdlib_system_subprocess.F90 + stdlib_system.c stdlib_system.F90 stdlib_sparse.f90 stdlib_specialfunctions_legendre.f90 diff --git a/src/stdlib_system.F90 b/src/stdlib_system.F90 index a9c3e4d55..dd83f4bbb 100644 --- a/src/stdlib_system.F90 +++ b/src/stdlib_system.F90 @@ -2,7 +2,7 @@ module stdlib_system use, intrinsic :: iso_c_binding, only : c_int, c_long, c_ptr, c_null_ptr, c_int64_t, c_size_t, & c_f_pointer use stdlib_kinds, only: int64, dp, c_bool, c_char -use stdlib_strings, only: to_c_char +use stdlib_strings, only: to_c_char, to_string use stdlib_error, only: state_type, STDLIB_SUCCESS, STDLIB_FS_ERROR implicit none private @@ -100,6 +100,36 @@ module stdlib_system !! public :: is_directory +!! version: experimental +!! +!! Makes an empty directory. +!! ([Specification](../page/specs/stdlib_system.html#make_directory)) +!! +!! ### Summary +!! Creates an empty directory with particular permissions. +!! +!! ### Description +!! This function makes an empty directory according to the path provided. +!! Relative paths as well as on Windows paths involving either `/` or `\` are accepted +!! appropriate error message is returned whenever any error occur. +!! +public :: make_directory + +!! version: experimental +!! +!! Removes an empty directory. +!! ([Specification](../page/specs/stdlib_system.html#remove_directory)) +!! +!! ### Summary +!! Deletes an empty directory. +!! +!! ### Description +!! This function deletes an empty directory according to the path provided. +!! Relative paths as well as on Windows paths involving either `/` or `\` are accepted. +!! appropriate error message is returned whenever any error occur. +!! +public :: remove_directory + !! version: experimental !! !! Deletes a specified file from the filesystem. @@ -690,6 +720,98 @@ end function stdlib_is_directory end function is_directory +function c_get_strerror() result(str) + character(len=:), allocatable :: str + + interface + type(c_ptr) function strerror(len) bind(C, name='stdlib_strerror') + import c_size_t, c_ptr, c_int + implicit none + integer(c_size_t), intent(out) :: len + end function strerror + end interface + + type(c_ptr) :: c_str_ptr + integer(c_size_t) :: len, i + character(kind=c_char), pointer :: c_str(:) + + c_str_ptr = strerror(len) + + call c_f_pointer(c_str_ptr, c_str, [len]) + + allocate(character(len=len) :: str) + + do concurrent (i=1:len) + str(i:i) = c_str(i) + end do +end function c_get_strerror + +!! makes an empty directory +subroutine make_directory(path, mode, err) + character(len=*), intent(in) :: path + integer, intent(in), optional :: mode + character, allocatable :: err_msg + type(state_type), optional, intent(out) :: err + + integer :: code + type(state_type) :: err0 + + + interface + integer function stdlib_make_directory(cpath, cmode) bind(C, name='stdlib_make_directory') + import c_char + character(kind=c_char), intent(in) :: cpath(*) + integer, intent(in) :: cmode + end function stdlib_make_directory + end interface + + if (is_windows() .and. present(mode)) then + ! _mkdir() doesn't have a `mode` argument + err0 = state_type(STDLIB_FS_ERROR, "mode argument not present for Windows") + call err0%handle(err) + return + end if + + code = stdlib_make_directory(to_c_char(trim(path)), mode) + + select case (code) + case (0) + return + case default + ! error + err0 = state_type(STDLIB_FS_ERROR, "code:", to_string(code)//',', c_get_strerror()) + call err0%handle(err) + end select +end subroutine make_directory + +!! Removes an empty directory +subroutine remove_directory(path, err) + character(len=*), intent(in) :: path + character, allocatable :: err_msg + type(state_type), optional, intent(out) :: err + + integer :: code + type(state_type) :: err0 + + interface + integer function stdlib_remove_directory(cpath) bind(C, name='stdlib_remove_directory') + import c_char + character(kind=c_char), intent(in) :: cpath(*) + end function stdlib_remove_directory + end interface + + code = stdlib_remove_directory(to_c_char(trim(path))) + + select case (code) + case (0) + return + case default + ! error + err0 = state_type(STDLIB_FS_ERROR, "code:", to_string(code)//',', c_get_strerror()) + call err0%handle(err) + end select +end subroutine remove_directory + !> Returns the file path of the null device for the current operating system. !> !> Version: Helper function. diff --git a/src/stdlib_system.c b/src/stdlib_system.c new file mode 100644 index 000000000..2d9368cc3 --- /dev/null +++ b/src/stdlib_system.c @@ -0,0 +1,46 @@ +#include +#include +#include +#include +#include +#ifdef _WIN32 +#include +#else +#include +#endif /* ifdef _WIN32 */ + +char* stdlib_strerror(size_t* len){ + char* err = strerror(errno); + *len = strlen(err); + return err; +} + +int stdlib_make_directory(const char* path, mode_t mode){ + int code; +#ifdef _WIN32 + code = _mkdir(path); +#else + code = mkdir(path, mode); +#endif /* ifdef _WIN32 */ + + if (!code){ + return 0; + } + + return errno; +} + +int stdlib_remove_directory(const char* path){ + int code; +#ifdef _WIN32 + code = _rmdir(path); +#else + code = rmdir(path); +#endif /* ifdef _WIN32 */ + + if (!code){ + return 0; + } + + return errno; +} From c9345c1e1378e9d695f803442e1d2ccd9b223610 Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Wed, 2 Jul 2025 03:17:20 +0530 Subject: [PATCH 02/16] added tests --- test/system/test_filesystem.f90 | 80 ++++++++++++++++++++++++++++++++- 1 file changed, 78 insertions(+), 2 deletions(-) diff --git a/test/system/test_filesystem.f90 b/test/system/test_filesystem.f90 index 4cf1690e4..0f5e24ea1 100644 --- a/test/system/test_filesystem.f90 +++ b/test/system/test_filesystem.f90 @@ -1,6 +1,6 @@ module test_filesystem use testdrive, only : new_unittest, unittest_type, error_type, check, skip_test - use stdlib_system, only: is_directory, delete_file + use stdlib_system, only: is_directory, delete_file, make_directory, remove_directory use stdlib_error, only: state_type implicit none @@ -17,7 +17,11 @@ subroutine collect_suite(testsuite) 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) & + new_unittest("fs_delete_file_being_dir", test_delete_directory), & + new_unittest("fs_make_dir", test_make_directory), & + new_unittest("fs_make_dir_existing_dir", test_make_directory_existing), & + new_unittest("fs_remove_dir", test_remove_directory), & + new_unittest("fs_remove_dir_non_existent", test_remove_directory_nonexistent) & ] end subroutine collect_suite @@ -145,7 +149,79 @@ subroutine test_delete_directory(error) if (allocated(error)) return end subroutine test_delete_directory + + subroutine test_make_directory(error) + type(error_type), allocatable, intent(out) :: error + type(state_type) :: err + character(len=256) :: filename + integer :: ios,iocmd + character(len=512) :: msg + + filename = "test_directory" + call make_directory(filename, err=err) + call check(error, err%ok(), 'Could not make directory: '//err%print()) + 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 make_directory test: '//trim(msg)) + if (allocated(error)) return + end subroutine test_make_directory + + subroutine test_make_directory_existing(error) + type(error_type), allocatable, intent(out) :: error + type(state_type) :: err + character(len=256) :: filename + integer :: ios,iocmd + character(len=512) :: msg + + filename = "test_directory" + + call execute_command_line('mkdir ' // filename, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) + call check(error, ios==0 .and. iocmd==0, 'Cannot init make_directory_existing test: '//trim(msg)) + if (allocated(error)) return + + call make_directory(filename, err=err) + call check(error, err%error(), 'Made an already existing directory somehow') + + ! 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 make_directory test: '//trim(msg)) + if (allocated(error)) return + end subroutine test_make_directory_existing + + subroutine test_remove_directory(error) + type(error_type), allocatable, intent(out) :: error + type(state_type) :: err + character(len=256) :: filename + integer :: ios,iocmd + character(len=512) :: msg + + filename = "test_directory" + + call execute_command_line('mkdir ' // filename, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) + call check(error, ios==0 .and. iocmd==0, 'Cannot init remove_directory test: '//trim(msg)) + if (allocated(error)) return + + call remove_directory(filename, err) + call check(error, err%ok(), 'Could not remove directory: '//err%print()) + if (allocated(error)) then + ! 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 make_directory test: '//trim(msg)) + if (allocated(error)) return + end if + end subroutine test_remove_directory + + subroutine test_remove_directory_nonexistent(error) + type(error_type), allocatable, intent(out) :: error + type(state_type) :: err + + call remove_directory("random_name", err) + call check(error, err%error(), 'Somehow removed a non-existent directory!: ') + if (allocated(error)) return + end subroutine test_remove_directory_nonexistent end module test_filesystem From d94d7fb790e6bdfd431610e4befb19e7dfe1207c Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Wed, 2 Jul 2025 03:17:39 +0530 Subject: [PATCH 03/16] added specs --- doc/specs/stdlib_system.md | 76 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 76 insertions(+) diff --git a/doc/specs/stdlib_system.md b/doc/specs/stdlib_system.md index 96eebb2e8..bb5b1afa2 100644 --- a/doc/specs/stdlib_system.md +++ b/doc/specs/stdlib_system.md @@ -456,6 +456,82 @@ The function returns a `logical` value: --- +## `make_directory` - Creates an empty directory + +### Status + +Experimental + +### Description + +It creates an empty directory. +It is designed to work across multiple platforms. On Windows, paths with both forward `/` and backward `\` slashes are accepted. + +### Syntax + +`call [[stdlib_system(module):make_directory(subroutine)]] (path, mode, err)` + +### Class + +Subroutine + +### Arguments + +`path`: Shall be a character string containing the path of the directory to create. It is an `intent(in)` argument. + +`mode`: Shall be a scalar integer indicating the permission bits required (Not applicable to Windows). It is an `optional, intent(in)` argument. + +`err`: Shall be of type `state_type`, for error handling. It is an `optional, intent(out)` argument. + +### Return values + +The `err` is set accordingly. + +### Example + +```fortran +{!example/system/example_make_directory.f90!} +``` + +--- + +## `remove_directory` - Removes an empty directory + +### Status + +Experimental + +### Description + +It deletes an empty directory. +It is designed to work across multiple platforms. On Windows, paths with both forward `/` and backward `\` slashes are accepted. + +### Syntax + +`call [[stdlib_system(module):remove_directory(subroutine)]] (path, err)` + +### Class + +Subroutine + +### Arguments + +`path`: Shall be a character string containing the path of the directory to create. It is an `intent(in)` argument. + +`err`: Shall be of type `state_type`, for error handling. It is an `intent(out)` argument. + +### Return values + +The `err` is set accordingly. + +### Example + +```fortran +{!example/system/example_remove_directory.f90!} +``` + +--- + ## `null_device` - Return the null device file path ### Status From e1f68d833d55b0fdd141f9e1a2861ec76310200c Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Wed, 2 Jul 2025 03:18:04 +0530 Subject: [PATCH 04/16] added examples --- example/system/CMakeLists.txt | 2 ++ example/system/example_make_directory.f90 | 17 +++++++++++++++++ example/system/example_remove_directory.f90 | 17 +++++++++++++++++ 3 files changed, 36 insertions(+) create mode 100644 example/system/example_make_directory.f90 create mode 100644 example/system/example_remove_directory.f90 diff --git a/example/system/CMakeLists.txt b/example/system/CMakeLists.txt index a2a7525c9..8189d525b 100644 --- a/example/system/CMakeLists.txt +++ b/example/system/CMakeLists.txt @@ -11,3 +11,5 @@ ADD_EXAMPLE(process_5) ADD_EXAMPLE(process_6) ADD_EXAMPLE(process_7) ADD_EXAMPLE(sleep) +ADD_EXAMPLE(make_directory) +ADD_EXAMPLE(remove_directory) diff --git a/example/system/example_make_directory.f90 b/example/system/example_make_directory.f90 new file mode 100644 index 000000000..5e551b810 --- /dev/null +++ b/example/system/example_make_directory.f90 @@ -0,0 +1,17 @@ +! Illustrate the usage of make_directory +program example_make_directory + use stdlib_system, only: make_directory, is_directory + use stdlib_error, only: state_type + implicit none + + type(state_type) :: err + + call make_directory("test", err=err) + + if (err%error()) then + print *, err%print() + else + print *, "directory created sucessfully" + end if + +end program example_make_directory diff --git a/example/system/example_remove_directory.f90 b/example/system/example_remove_directory.f90 new file mode 100644 index 000000000..993adf4f9 --- /dev/null +++ b/example/system/example_remove_directory.f90 @@ -0,0 +1,17 @@ +! Illustrate the usage of remove_directory +program example_remove_directory + use stdlib_system, only: make_directory, is_directory, remove_directory + use stdlib_error, only: state_type + implicit none + + type(state_type) :: err + + call remove_directory("directory_to_be_removed", err) + + if (err%error()) then + print *, err%print() + else + print *, "directory removed successfully" + end if + +end program example_remove_directory From c3db3a65723cb3e5c45bc511d2e1ba0c567fc2d0 Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Wed, 2 Jul 2025 04:01:02 +0530 Subject: [PATCH 05/16] cleanup --- src/stdlib_system.F90 | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/src/stdlib_system.F90 b/src/stdlib_system.F90 index dd83f4bbb..2e0d3a1aa 100644 --- a/src/stdlib_system.F90 +++ b/src/stdlib_system.F90 @@ -725,7 +725,7 @@ function c_get_strerror() result(str) interface type(c_ptr) function strerror(len) bind(C, name='stdlib_strerror') - import c_size_t, c_ptr, c_int + import c_size_t, c_ptr implicit none integer(c_size_t), intent(out) :: len end function strerror @@ -750,7 +750,6 @@ end function c_get_strerror subroutine make_directory(path, mode, err) character(len=*), intent(in) :: path integer, intent(in), optional :: mode - character, allocatable :: err_msg type(state_type), optional, intent(out) :: err integer :: code @@ -787,7 +786,6 @@ end subroutine make_directory !! Removes an empty directory subroutine remove_directory(path, err) character(len=*), intent(in) :: path - character, allocatable :: err_msg type(state_type), optional, intent(out) :: err integer :: code From 8012ac8d0dd03b2a31aff345e08a93399f1a06df Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Sat, 5 Jul 2025 21:08:49 +0530 Subject: [PATCH 06/16] improve test flow a bit --- test/system/test_filesystem.f90 | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/test/system/test_filesystem.f90 b/test/system/test_filesystem.f90 index 0f5e24ea1..add6a9323 100644 --- a/test/system/test_filesystem.f90 +++ b/test/system/test_filesystem.f90 @@ -166,7 +166,6 @@ subroutine test_make_directory(error) ! 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 make_directory test: '//trim(msg)) - if (allocated(error)) return end subroutine test_make_directory subroutine test_make_directory_existing(error) @@ -187,8 +186,12 @@ subroutine test_make_directory_existing(error) ! Clean up: remove the empty directory call execute_command_line('rmdir ' // filename, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) + if (allocated(error)) then + ! if previous error is allocated as well + call check(error, ios==0 .and. iocmd==0, error%message // ' and cannot cleanup make_directory test: '//trim(msg)) + return + end if call check(error, ios==0 .and. iocmd==0, 'Cannot cleanup make_directory test: '//trim(msg)) - if (allocated(error)) return end subroutine test_make_directory_existing subroutine test_remove_directory(error) @@ -209,8 +212,7 @@ subroutine test_remove_directory(error) if (allocated(error)) then ! 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 make_directory test: '//trim(msg)) - if (allocated(error)) return + call check(error, ios==0 .and. iocmd==0, error%message // ' and cannot cleanup make_directory test: '//trim(msg)) end if end subroutine test_remove_directory From 9d6325e2dfbd3a123e89c146f28922abba7699ee Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Wed, 23 Jul 2025 01:03:26 +0530 Subject: [PATCH 07/16] remove `mode` argument, some minor changes --- doc/specs/stdlib_system.md | 14 +++--- example/system/example_make_directory.f90 | 6 +-- example/system/example_remove_directory.f90 | 4 +- src/stdlib_system.F90 | 56 ++++++++------------- src/stdlib_system.c | 17 ++----- test/system/test_filesystem.f90 | 8 ++- 6 files changed, 44 insertions(+), 61 deletions(-) diff --git a/doc/specs/stdlib_system.md b/doc/specs/stdlib_system.md index cedf39659..29716990a 100644 --- a/doc/specs/stdlib_system.md +++ b/doc/specs/stdlib_system.md @@ -543,12 +543,12 @@ Experimental ### Description -It creates an empty directory. +It creates an empty directory with default permissions. It is designed to work across multiple platforms. On Windows, paths with both forward `/` and backward `\` slashes are accepted. ### Syntax -`call [[stdlib_system(module):make_directory(subroutine)]] (path, mode, err)` +`call [[stdlib_system(module):make_directory(subroutine)]] (path [,err])` ### Class @@ -558,13 +558,11 @@ Subroutine `path`: Shall be a character string containing the path of the directory to create. It is an `intent(in)` argument. -`mode`: Shall be a scalar integer indicating the permission bits required (Not applicable to Windows). It is an `optional, intent(in)` argument. - -`err`: Shall be of type `state_type`, for error handling. It is an `optional, intent(out)` argument. +`err`(optional): Shall be of type `state_type`, for error handling. It is an `optional, intent(out)` argument. ### Return values -The `err` is set accordingly. +`err` is an optional state return flag. On error if not requested, a `FS_ERROR` will trigger an error stop. ### Example @@ -597,11 +595,11 @@ Subroutine `path`: Shall be a character string containing the path of the directory to create. It is an `intent(in)` argument. -`err`: Shall be of type `state_type`, for error handling. It is an `intent(out)` argument. +`err`(optional): Shall be of type `state_type`, for error handling. It is an `intent(out)` argument. ### Return values -The `err` is set accordingly. +`err` is an optional state return flag. On error if not requested, a `FS_ERROR` will trigger an error stop. ### Example diff --git a/example/system/example_make_directory.f90 b/example/system/example_make_directory.f90 index 5e551b810..456813c14 100644 --- a/example/system/example_make_directory.f90 +++ b/example/system/example_make_directory.f90 @@ -1,12 +1,12 @@ -! Illustrate the usage of make_directory +! Illustrate the usage of `make_directory` program example_make_directory - use stdlib_system, only: make_directory, is_directory + use stdlib_system, only: make_directory use stdlib_error, only: state_type implicit none type(state_type) :: err - call make_directory("test", err=err) + call make_directory("temp_dir", err) if (err%error()) then print *, err%print() diff --git a/example/system/example_remove_directory.f90 b/example/system/example_remove_directory.f90 index 993adf4f9..03465312d 100644 --- a/example/system/example_remove_directory.f90 +++ b/example/system/example_remove_directory.f90 @@ -1,6 +1,6 @@ -! Illustrate the usage of remove_directory +! Illustrate the usage of `remove_directory` program example_remove_directory - use stdlib_system, only: make_directory, is_directory, remove_directory + use stdlib_system, only: remove_directory use stdlib_error, only: state_type implicit none diff --git a/src/stdlib_system.F90 b/src/stdlib_system.F90 index ac36d58d7..14878145a 100644 --- a/src/stdlib_system.F90 +++ b/src/stdlib_system.F90 @@ -2,8 +2,9 @@ module stdlib_system use, intrinsic :: iso_c_binding, only : c_int, c_long, c_ptr, c_null_ptr, c_int64_t, c_size_t, & c_f_pointer use stdlib_kinds, only: int64, dp, c_bool, c_char -use stdlib_strings, only: to_c_char +use stdlib_strings, only: to_c_char, ends_with use stdlib_string_type, only: string_type +use stdlib_optval, only: optval use stdlib_error, only: state_type, STDLIB_SUCCESS, STDLIB_FS_ERROR implicit none private @@ -115,12 +116,12 @@ module stdlib_system !! ([Specification](../page/specs/stdlib_system.html#make_directory)) !! !! ### Summary -!! Creates an empty directory with particular permissions. +!! Creates an empty directory with default permissions. !! !! ### Description !! This function makes an empty directory according to the path provided. -!! Relative paths as well as on Windows paths involving either `/` or `\` are accepted -!! appropriate error message is returned whenever any error occur. +!! Relative paths as well as on Windows, paths involving either `/` or `\` are accepted. +!! Appropriate error message is returned whenever any error occurs. !! public :: make_directory @@ -130,12 +131,12 @@ module stdlib_system !! ([Specification](../page/specs/stdlib_system.html#remove_directory)) !! !! ### Summary -!! Deletes an empty directory. +!! Removes an empty directory. !! !! ### Description -!! This function deletes an empty directory according to the path provided. +!! This function Removes an empty directory according to the path provided. !! Relative paths as well as on Windows paths involving either `/` or `\` are accepted. -!! appropriate error message is returned whenever any error occur. +!! Appropriate error message is returned whenever any error occurs. !! public :: remove_directory @@ -879,6 +880,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 `` function c_get_strerror() result(str) character(len=:), allocatable :: str @@ -906,40 +910,27 @@ end function strerror end function c_get_strerror !! makes an empty directory -subroutine make_directory(path, mode, err) +subroutine make_directory(path, err) character(len=*), intent(in) :: path - integer, intent(in), optional :: mode type(state_type), optional, intent(out) :: err integer :: code type(state_type) :: err0 - interface - integer function stdlib_make_directory(cpath, cmode) bind(C, name='stdlib_make_directory') + integer function stdlib_make_directory(cpath) bind(C, name='stdlib_make_directory') import c_char character(kind=c_char), intent(in) :: cpath(*) - integer, intent(in) :: cmode end function stdlib_make_directory end interface - if (is_windows() .and. present(mode)) then - ! _mkdir() doesn't have a `mode` argument - err0 = state_type(STDLIB_FS_ERROR, "mode argument not present for Windows") + code = stdlib_make_directory(to_c_char(trim(path))) + + if (code /= 0) then + err0 = FS_ERROR_CODE(code, c_get_strerror()) call err0%handle(err) - return end if - code = stdlib_make_directory(to_c_char(trim(path)), mode) - - select case (code) - case (0) - return - case default - ! error - err0 = state_type(STDLIB_FS_ERROR, "code:", to_string(code)//',', c_get_strerror()) - call err0%handle(err) - end select end subroutine make_directory !! Removes an empty directory @@ -959,14 +950,11 @@ end function stdlib_remove_directory code = stdlib_remove_directory(to_c_char(trim(path))) - select case (code) - case (0) - return - case default - ! error - err0 = state_type(STDLIB_FS_ERROR, "code:", to_string(code)//',', c_get_strerror()) - call err0%handle(err) - end select + if (code /= 0) then + err0 = FS_ERROR_CODE(code, c_get_strerror()) + call err0%handle(err) + end if + end subroutine remove_directory !> Returns the file path of the null device for the current operating system. diff --git a/src/stdlib_system.c b/src/stdlib_system.c index 2d9368cc3..257fc22f2 100644 --- a/src/stdlib_system.c +++ b/src/stdlib_system.c @@ -15,19 +15,16 @@ char* stdlib_strerror(size_t* len){ return err; } -int stdlib_make_directory(const char* path, mode_t mode){ +int stdlib_make_directory(const char* path){ int code; #ifdef _WIN32 code = _mkdir(path); #else - code = mkdir(path, mode); + // Default mode 0777 + code = mkdir(path, 0777); #endif /* ifdef _WIN32 */ - if (!code){ - return 0; - } - - return errno; + return (!code) ? 0 : errno; } int stdlib_remove_directory(const char* path){ @@ -38,9 +35,5 @@ int stdlib_remove_directory(const char* path){ code = rmdir(path); #endif /* ifdef _WIN32 */ - if (!code){ - return 0; - } - - return errno; + return (!code) ? 0 : errno; } diff --git a/test/system/test_filesystem.f90 b/test/system/test_filesystem.f90 index 5b8c65e81..7f0a216cf 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, delete_file, FS_ERROR, FS_ERROR_CODE + use stdlib_system, only: is_directory, delete_file, FS_ERROR, FS_ERROR_CODE, & + make_directory, remove_directory use stdlib_error, only: state_type, STDLIB_FS_ERROR implicit none @@ -207,11 +208,13 @@ subroutine test_make_directory_existing(error) ! Clean up: remove the empty directory call execute_command_line('rmdir ' // filename, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) + if (allocated(error)) then ! if previous error is allocated as well call check(error, ios==0 .and. iocmd==0, error%message // ' and cannot cleanup make_directory test: '//trim(msg)) return end if + call check(error, ios==0 .and. iocmd==0, 'Cannot cleanup make_directory test: '//trim(msg)) end subroutine test_make_directory_existing @@ -230,6 +233,7 @@ subroutine test_remove_directory(error) call remove_directory(filename, err) call check(error, err%ok(), 'Could not remove directory: '//err%print()) + if (allocated(error)) then ! Clean up: remove the empty directory call execute_command_line('rmdir ' // filename, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) @@ -242,7 +246,7 @@ subroutine test_remove_directory_nonexistent(error) type(state_type) :: err call remove_directory("random_name", err) - call check(error, err%error(), 'Somehow removed a non-existent directory!: ') + call check(error, err%error(), 'Somehow removed a non-existent directory') if (allocated(error)) return end subroutine test_remove_directory_nonexistent From 3c8262556d9288b7bbc658ee9ece2038f17543b6 Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Wed, 23 Jul 2025 02:42:55 +0530 Subject: [PATCH 08/16] add make_directory_all --- src/stdlib_system.F90 | 63 +++++++++++++++++++++++++++++++++++++- src/stdlib_system_path.f90 | 2 +- 2 files changed, 63 insertions(+), 2 deletions(-) diff --git a/src/stdlib_system.F90 b/src/stdlib_system.F90 index 14878145a..813427f66 100644 --- a/src/stdlib_system.F90 +++ b/src/stdlib_system.F90 @@ -2,7 +2,7 @@ module stdlib_system use, intrinsic :: iso_c_binding, only : c_int, c_long, c_ptr, c_null_ptr, c_int64_t, c_size_t, & c_f_pointer use stdlib_kinds, only: int64, dp, c_bool, c_char -use stdlib_strings, only: to_c_char, ends_with +use stdlib_strings, only: to_c_char, find use stdlib_string_type, only: string_type use stdlib_optval, only: optval use stdlib_error, only: state_type, STDLIB_SUCCESS, STDLIB_FS_ERROR @@ -125,6 +125,22 @@ module stdlib_system !! public :: make_directory +!! version: experimental +!! +!! Makes an empty directory, also creating all the parent directories required. +!! ([Specification](../page/specs/stdlib_system.html#make_directory)) +!! +!! ### Summary +!! Creates an empty directory with all the parent directories required to do so. +!! +!! ### Description +!! This function makes an empty directory according to the path provided. +!! It also creates all the parent directories required in doing so. +!! Relative paths as well as on Windows, paths involving either `/` or `\` are accepted. +!! Appropriate error message is returned whenever any error occurs. +!! +public :: make_directory_all + !! version: experimental !! !! Removes an empty directory. @@ -933,6 +949,51 @@ end function stdlib_make_directory end subroutine make_directory +subroutine make_directory_all(path, err) + character(len=*), intent(in) :: path + type(state_type), optional, intent(out) :: err + + integer :: code, i, indx + type(state_type) :: err0 + character(len=1) :: sep + logical :: is_dir + + sep = path_sep() + i = 1 + indx = find(path, sep, i) + + do + ! Base case to exit the loop + if (indx == 0 .or. indx == len(trim(path))) then + is_dir = is_directory(path) + + if (.not. is_dir) then + call make_directory(path, err0) + + if (err0%error()) then + call err0%handle(err) + end if + + return + end if + end if + + is_dir = is_directory(path(1:indx)) + + if (.not. is_dir) then + call make_directory(path(1:indx), err0) + + if (err0%error()) then + call err0%handle(err) + return + end if + end if + + i = i + 1 + indx = find(path, sep, i) + end do +end subroutine make_directory_all + !! Removes an empty directory subroutine remove_directory(path, err) character(len=*), intent(in) :: path diff --git a/src/stdlib_system_path.f90 b/src/stdlib_system_path.f90 index c2ad1aec8..5ec7ef8c8 100644 --- a/src/stdlib_system_path.f90 +++ b/src/stdlib_system_path.f90 @@ -1,6 +1,6 @@ submodule(stdlib_system) stdlib_system_path use stdlib_ascii, only: reverse - use stdlib_strings, only: chomp, find, join + use stdlib_strings, only: chomp, join use stdlib_string_type, only: string_type, char, move contains module function join2_char_char(p1, p2) result(path) From 85b522ba042723b6d94b8a035bff4dd91a8b0525 Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Wed, 23 Jul 2025 02:43:10 +0530 Subject: [PATCH 09/16] add test --- test/system/test_filesystem.f90 | 54 ++++++++++++++++++++++++--------- 1 file changed, 39 insertions(+), 15 deletions(-) diff --git a/test/system/test_filesystem.f90 b/test/system/test_filesystem.f90 index 7f0a216cf..5c18f9bf8 100644 --- a/test/system/test_filesystem.f90 +++ b/test/system/test_filesystem.f90 @@ -1,7 +1,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, remove_directory, make_directory_all, is_windows use stdlib_error, only: state_type, STDLIB_FS_ERROR implicit none @@ -22,6 +22,7 @@ subroutine collect_suite(testsuite) new_unittest("fs_delete_file_being_dir", test_delete_directory), & new_unittest("fs_make_dir", test_make_directory), & new_unittest("fs_make_dir_existing_dir", test_make_directory_existing), & + new_unittest("fs_make_dir_all", test_make_directory_all), & new_unittest("fs_remove_dir", test_remove_directory), & new_unittest("fs_remove_dir_non_existent", test_remove_directory_nonexistent) & ] @@ -175,39 +176,39 @@ end subroutine test_delete_directory subroutine test_make_directory(error) type(error_type), allocatable, intent(out) :: error type(state_type) :: err - character(len=256) :: filename + character(len=256) :: dir_name integer :: ios,iocmd character(len=512) :: msg - filename = "test_directory" + dir_name = "test_directory" - call make_directory(filename, err=err) + call make_directory(dir_name, err=err) call check(error, err%ok(), 'Could not make directory: '//err%print()) if (allocated(error)) return ! Clean up: remove the empty directory - call execute_command_line('rmdir ' // filename, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) + call execute_command_line('rmdir ' // dir_name, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) call check(error, ios==0 .and. iocmd==0, 'Cannot cleanup make_directory test: '//trim(msg)) end subroutine test_make_directory subroutine test_make_directory_existing(error) type(error_type), allocatable, intent(out) :: error type(state_type) :: err - character(len=256) :: filename + character(len=256) :: dir_name integer :: ios,iocmd character(len=512) :: msg - filename = "test_directory" + dir_name = "test_directory" - call execute_command_line('mkdir ' // filename, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) + call execute_command_line('mkdir ' // dir_name, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) call check(error, ios==0 .and. iocmd==0, 'Cannot init make_directory_existing test: '//trim(msg)) if (allocated(error)) return - call make_directory(filename, err=err) + call make_directory(dir_name, err=err) call check(error, err%error(), 'Made an already existing directory somehow') ! Clean up: remove the empty directory - call execute_command_line('rmdir ' // filename, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) + call execute_command_line('rmdir ' // dir_name, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) if (allocated(error)) then ! if previous error is allocated as well @@ -218,25 +219,48 @@ subroutine test_make_directory_existing(error) call check(error, ios==0 .and. iocmd==0, 'Cannot cleanup make_directory test: '//trim(msg)) end subroutine test_make_directory_existing + subroutine test_make_directory_all(error) + type(error_type), allocatable, intent(out) :: error + type(state_type) :: err + character(len=256) :: dir_name + integer :: ios,iocmd + character(len=512) :: msg + + dir_name = "d1/d2/d3/d4/" + + call make_directory_all(dir_name, err=err) + call check(error, err%ok(), 'Could not make all directories: '//err%print()) + if (allocated(error)) return + + ! Clean up: remove the empty directory + if (is_windows()) then + call execute_command_line('rmdir /s /q ' // dir_name, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) + else + call execute_command_line('rm -rf ' // dir_name, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) + end if + + call check(error, ios==0 .and. iocmd==0, 'Cannot cleanup make_directory_all test: '//trim(msg)) + end subroutine test_make_directory_all + subroutine test_remove_directory(error) type(error_type), allocatable, intent(out) :: error type(state_type) :: err - character(len=256) :: filename + character(len=256) :: dir_name integer :: ios,iocmd character(len=512) :: msg - filename = "test_directory" + dir_name = "test_directory" - call execute_command_line('mkdir ' // filename, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) + call execute_command_line('mkdir ' // dir_name, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) call check(error, ios==0 .and. iocmd==0, 'Cannot init remove_directory test: '//trim(msg)) if (allocated(error)) return - call remove_directory(filename, err) + call remove_directory(dir_name, err) call check(error, err%ok(), 'Could not remove directory: '//err%print()) if (allocated(error)) then ! Clean up: remove the empty directory - call execute_command_line('rmdir ' // filename, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) + call execute_command_line('rmdir ' // dir_name, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) call check(error, ios==0 .and. iocmd==0, error%message // ' and cannot cleanup make_directory test: '//trim(msg)) end if end subroutine test_remove_directory From f6829c88e378ab5c77d69b4b086153cf4bbb61f7 Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Wed, 23 Jul 2025 02:43:21 +0530 Subject: [PATCH 10/16] add docs --- doc/specs/stdlib_system.md | 38 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 38 insertions(+) diff --git a/doc/specs/stdlib_system.md b/doc/specs/stdlib_system.md index 29716990a..035ab2034 100644 --- a/doc/specs/stdlib_system.md +++ b/doc/specs/stdlib_system.md @@ -572,6 +572,44 @@ Subroutine --- +## `make_directory_all` - Creates an empty directory with all its parent directories + +### Status + +Experimental + +### Description + +It creates an empty directory with default permissions. +It also creates all the parent directories required in doing so. +It is designed to work across multiple platforms. On Windows, paths with both forward `/` and backward `\` slashes are accepted. + +### Syntax + +`call [[stdlib_system(module):make_directory_all(subroutine)]] (path [,err])` + +### Class + +Subroutine + +### Arguments + +`path`: Shall be a character string containing the path of the directory to create. It is an `intent(in)` argument. + +`err`(optional): Shall be of type `state_type`, for error handling. It is an `optional, intent(out)` argument. + +### Return values + +`err` is an optional state return flag. On error if not requested, a `FS_ERROR` will trigger an error stop. + +### Example + +```fortran +{!example/system/example_make_directory.f90!} +``` + +--- + ## `remove_directory` - Removes an empty directory ### Status From 81339e70469c3067f1499f40f9801a50a9c69396 Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Wed, 23 Jul 2025 02:43:32 +0530 Subject: [PATCH 11/16] add example --- example/system/example_make_directory.f90 | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/example/system/example_make_directory.f90 b/example/system/example_make_directory.f90 index 456813c14..e33aab730 100644 --- a/example/system/example_make_directory.f90 +++ b/example/system/example_make_directory.f90 @@ -1,6 +1,6 @@ -! Illustrate the usage of `make_directory` +! Illustrate the usage of `make_directory`, `make_directory_all` program example_make_directory - use stdlib_system, only: make_directory + use stdlib_system, only: make_directory, make_directory_all use stdlib_error, only: state_type implicit none @@ -14,4 +14,12 @@ program example_make_directory print *, "directory created sucessfully" end if + call make_directory_all("d1/d2/d3/d4", err) + + if (err%error()) then + print *, err%print() + else + print *, "nested directories created sucessfully" + end if + end program example_make_directory From 1c4e5f7e0d1549c3e7e055527aac018b4b291a63 Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Wed, 23 Jul 2025 03:04:00 +0530 Subject: [PATCH 12/16] windows specific path for tests --- doc/specs/stdlib_system.md | 1 - test/system/test_filesystem.f90 | 9 +++++++-- 2 files changed, 7 insertions(+), 3 deletions(-) diff --git a/doc/specs/stdlib_system.md b/doc/specs/stdlib_system.md index 035ab2034..7da023c41 100644 --- a/doc/specs/stdlib_system.md +++ b/doc/specs/stdlib_system.md @@ -582,7 +582,6 @@ Experimental It creates an empty directory with default permissions. It also creates all the parent directories required in doing so. -It is designed to work across multiple platforms. On Windows, paths with both forward `/` and backward `\` slashes are accepted. ### Syntax diff --git a/test/system/test_filesystem.f90 b/test/system/test_filesystem.f90 index 5c18f9bf8..0c943d3f6 100644 --- a/test/system/test_filesystem.f90 +++ b/test/system/test_filesystem.f90 @@ -1,7 +1,8 @@ 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 + make_directory, remove_directory, make_directory_all, is_windows, OS_TYPE, & + OS_WINDOWS use stdlib_error, only: state_type, STDLIB_FS_ERROR implicit none @@ -226,7 +227,11 @@ subroutine test_make_directory_all(error) integer :: ios,iocmd character(len=512) :: msg - dir_name = "d1/d2/d3/d4/" + if (OS_TYPE() == OS_WINDOWS) then + dir_name = "d1\d2\d3\d4\" + else + dir_name = "d1/d2/d3/d4/" + end if call make_directory_all(dir_name, err=err) call check(error, err%ok(), 'Could not make all directories: '//err%print()) From ab27ae0a8decb2f3c74fcc3ebf2c54f535d5617d Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Wed, 23 Jul 2025 12:09:31 +0530 Subject: [PATCH 13/16] a little efficient --- src/stdlib_system.F90 | 20 +++++++++++++------- 1 file changed, 13 insertions(+), 7 deletions(-) diff --git a/src/stdlib_system.F90 b/src/stdlib_system.F90 index 813427f66..e085e9169 100644 --- a/src/stdlib_system.F90 +++ b/src/stdlib_system.F90 @@ -953,18 +953,19 @@ subroutine make_directory_all(path, err) character(len=*), intent(in) :: path type(state_type), optional, intent(out) :: err - integer :: code, i, indx + integer :: i, indx type(state_type) :: err0 character(len=1) :: sep - logical :: is_dir + logical :: is_dir, check_is_dir sep = path_sep() i = 1 indx = find(path, sep, i) + check_is_dir = .true. do ! Base case to exit the loop - if (indx == 0 .or. indx == len(trim(path))) then + if (indx == 0) then is_dir = is_directory(path) if (.not. is_dir) then @@ -973,14 +974,19 @@ subroutine make_directory_all(path, err) if (err0%error()) then call err0%handle(err) end if - - return end if + + return end if - is_dir = is_directory(path(1:indx)) + if (check_is_dir) then + is_dir = is_directory(path(1:indx)) + end if if (.not. is_dir) then + ! no need for further `is_dir` checks + ! all paths going forward need to be created + check_is_dir = .false. call make_directory(path(1:indx), err0) if (err0%error()) then @@ -989,7 +995,7 @@ subroutine make_directory_all(path, err) end if end if - i = i + 1 + i = i + 1 ! the next occurence of `sep` indx = find(path, sep, i) end do end subroutine make_directory_all From e16f19265ff26e3b7d12b30a609de84f1ab99a4e Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Wed, 23 Jul 2025 17:58:12 +0530 Subject: [PATCH 14/16] minor comments + doc changes --- doc/specs/stdlib_system.md | 12 ++++++------ src/stdlib_system.F90 | 16 ++++++++-------- test/system/test_filesystem.f90 | 8 ++++---- 3 files changed, 18 insertions(+), 18 deletions(-) diff --git a/doc/specs/stdlib_system.md b/doc/specs/stdlib_system.md index 7da023c41..f57646214 100644 --- a/doc/specs/stdlib_system.md +++ b/doc/specs/stdlib_system.md @@ -558,11 +558,11 @@ Subroutine `path`: Shall be a character string containing the path of the directory to create. It is an `intent(in)` argument. -`err`(optional): Shall be of type `state_type`, for error handling. It is an `optional, intent(out)` 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, a `FS_ERROR` will trigger an error stop. +`err` is an optional state return flag. If not requested and an error occurs, a `FS_ERROR` will trigger an error stop. ### Example @@ -581,7 +581,7 @@ Experimental ### Description It creates an empty directory with default permissions. -It also creates all the parent directories required in doing so. +It also creates all the necessary parent directories in the path if they do not exist already. ### Syntax @@ -595,11 +595,11 @@ Subroutine `path`: Shall be a character string containing the path of the directory to create. It is an `intent(in)` argument. -`err`(optional): Shall be of type `state_type`, for error handling. It is an `optional, intent(out)` 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, a `FS_ERROR` will trigger an error stop. +`err` is an optional state return flag. If not requested and an error occurs, a `FS_ERROR` will trigger an error stop. ### Example @@ -632,7 +632,7 @@ Subroutine `path`: Shall be a character string containing the path of the directory to create. It is an `intent(in)` argument. -`err`(optional): Shall be of type `state_type`, for error handling. It is an `intent(out)` argument. +`err`(optional): Shall be of type `state_type`, and is used for error handling. It is an `optional, intent(out)` argument. ### Return values diff --git a/src/stdlib_system.F90 b/src/stdlib_system.F90 index e085e9169..bd6f9b001 100644 --- a/src/stdlib_system.F90 +++ b/src/stdlib_system.F90 @@ -120,8 +120,8 @@ module stdlib_system !! !! ### Description !! This function makes an empty directory according to the path provided. -!! Relative paths as well as on Windows, paths involving either `/` or `\` are accepted. -!! Appropriate error message is returned whenever any error occurs. +!! Relative paths are supported. On Windows, paths involving either `/` or `\` are accepted. +!! An appropriate error message is returned whenever any error occurs. !! public :: make_directory @@ -135,9 +135,9 @@ module stdlib_system !! !! ### Description !! This function makes an empty directory according to the path provided. -!! It also creates all the parent directories required in doing so. -!! Relative paths as well as on Windows, paths involving either `/` or `\` are accepted. -!! Appropriate error message is returned whenever any error occurs. +!! It also creates all the necessary parent directories in the path if they do not exist already. +!! Relative paths are supported. +!! An appropriate error message is returned whenever any error occurs. !! public :: make_directory_all @@ -151,8 +151,8 @@ module stdlib_system !! !! ### Description !! This function Removes an empty directory according to the path provided. -!! Relative paths as well as on Windows paths involving either `/` or `\` are accepted. -!! Appropriate error message is returned whenever any error occurs. +!! Relative paths are supported. On Windows paths involving either `/` or `\` are accepted. +!! An appropriate error message is returned whenever any error occurs. !! public :: remove_directory @@ -1000,7 +1000,7 @@ subroutine make_directory_all(path, err) end do end subroutine make_directory_all -!! Removes an empty directory +!! removes an empty directory subroutine remove_directory(path, err) character(len=*), intent(in) :: path type(state_type), optional, intent(out) :: err diff --git a/test/system/test_filesystem.f90 b/test/system/test_filesystem.f90 index 0c943d3f6..fc9853b5b 100644 --- a/test/system/test_filesystem.f90 +++ b/test/system/test_filesystem.f90 @@ -187,7 +187,7 @@ subroutine test_make_directory(error) call check(error, err%ok(), 'Could not make directory: '//err%print()) if (allocated(error)) return - ! Clean up: remove the empty directory + ! clean up: remove the empty directory call execute_command_line('rmdir ' // dir_name, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) call check(error, ios==0 .and. iocmd==0, 'Cannot cleanup make_directory test: '//trim(msg)) end subroutine test_make_directory @@ -208,7 +208,7 @@ subroutine test_make_directory_existing(error) call make_directory(dir_name, err=err) call check(error, err%error(), 'Made an already existing directory somehow') - ! Clean up: remove the empty directory + ! clean up: remove the empty directory call execute_command_line('rmdir ' // dir_name, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) if (allocated(error)) then @@ -237,7 +237,7 @@ subroutine test_make_directory_all(error) call check(error, err%ok(), 'Could not make all directories: '//err%print()) if (allocated(error)) return - ! Clean up: remove the empty directory + ! clean up: remove the empty directory if (is_windows()) then call execute_command_line('rmdir /s /q ' // dir_name, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) else @@ -264,7 +264,7 @@ subroutine test_remove_directory(error) call check(error, err%ok(), 'Could not remove directory: '//err%print()) if (allocated(error)) then - ! Clean up: remove the empty directory + ! clean up: remove the empty directory call execute_command_line('rmdir ' // dir_name, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) call check(error, ios==0 .and. iocmd==0, error%message // ' and cannot cleanup make_directory test: '//trim(msg)) end if From 95e76be7571b736efe78501241e85dcc53020bf0 Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Wed, 23 Jul 2025 18:07:47 +0530 Subject: [PATCH 15/16] cleanup path make_directory_all + typo --- doc/specs/stdlib_system.md | 6 +++--- test/system/test_filesystem.f90 | 4 ++-- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/doc/specs/stdlib_system.md b/doc/specs/stdlib_system.md index f57646214..c6c79fcea 100644 --- a/doc/specs/stdlib_system.md +++ b/doc/specs/stdlib_system.md @@ -562,7 +562,7 @@ Subroutine ### Return values -`err` is an optional state return flag. If not requested and an error occurs, a `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 @@ -599,7 +599,7 @@ Subroutine ### Return values -`err` is an optional state return flag. If not requested and an error occurs, a `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 @@ -636,7 +636,7 @@ Subroutine ### Return values -`err` is an optional state return flag. On error if not requested, a `FS_ERROR` will trigger an error stop. +`err` is an optional state return flag. On error if not requested, an `FS_ERROR` will trigger an error stop. ### Example diff --git a/test/system/test_filesystem.f90 b/test/system/test_filesystem.f90 index fc9853b5b..af4bbedb6 100644 --- a/test/system/test_filesystem.f90 +++ b/test/system/test_filesystem.f90 @@ -239,9 +239,9 @@ subroutine test_make_directory_all(error) ! clean up: remove the empty directory if (is_windows()) then - call execute_command_line('rmdir /s /q ' // dir_name, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) + call execute_command_line('rmdir /s /q d1', exitstat=ios, cmdstat=iocmd, cmdmsg=msg) else - call execute_command_line('rm -rf ' // dir_name, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) + call execute_command_line('rm -rf d1', exitstat=ios, cmdstat=iocmd, cmdmsg=msg) end if call check(error, ios==0 .and. iocmd==0, 'Cannot cleanup make_directory_all test: '//trim(msg)) From b13edf5f305238e63bc39e3df465ee0288b89ed3 Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Thu, 24 Jul 2025 22:42:42 +0530 Subject: [PATCH 16/16] add in-code comments --- src/stdlib_system.c | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/src/stdlib_system.c b/src/stdlib_system.c index 257fc22f2..0bef82b8c 100644 --- a/src/stdlib_system.c +++ b/src/stdlib_system.c @@ -9,12 +9,16 @@ #include #endif /* ifdef _WIN32 */ +// Returns the string describing the meaning of `errno` code (by calling `strerror`). char* stdlib_strerror(size_t* len){ char* err = strerror(errno); *len = strlen(err); return err; } +// Wrapper to the platform's `mkdir`(make directory) call. +// Uses `mkdir` on unix, `_mkdir` on windows. +// Returns 0 if successful, otherwise returns the `errno`. int stdlib_make_directory(const char* path){ int code; #ifdef _WIN32 @@ -27,6 +31,9 @@ int stdlib_make_directory(const char* path){ return (!code) ? 0 : errno; } +// Wrapper to the platform's `rmdir`(remove directory) call. +// Uses `rmdir` on unix, `_rmdir` on windows. +// Returns 0 if successful, otherwise returns the `errno`. int stdlib_remove_directory(const char* path){ int code; #ifdef _WIN32