From e16b6f7a9e629dfa86e60e6571ec1c7bc9b635ba Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Sun, 6 Jul 2025 05:04:40 +0530 Subject: [PATCH 01/10] add subroutines and C wrappers --- src/stdlib_system.F90 | 82 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 82 insertions(+) diff --git a/src/stdlib_system.F90 b/src/stdlib_system.F90 index bd6f9b001..0fcc3a79d 100644 --- a/src/stdlib_system.F90 +++ b/src/stdlib_system.F90 @@ -156,6 +156,32 @@ module stdlib_system !! public :: remove_directory +!! version: experimental +!! +!! Gets the current working directory of the process +!! ([Specification](../page/specs/stdlib_system.html#get_cwd)) +!! +!! ### Summary +!! Gets the current working directory. +!! +!! ### Description +!! This subroutine gets the current working directory of the process calling this function. +!! +public :: get_cwd + +!! version: experimental +!! +!! Sets the current working directory of the process +!! ([Specification](../page/specs/stdlib_system.html#set_cwd)) +!! +!! ### Summary +!! Changes the current working directory to the one specified. +!! +!! ### Description +!! This subroutine sets the current working directory of the process calling this function to the one specified. +!! +public :: set_cwd + !! version: experimental !! !! Deletes a specified file from the filesystem. @@ -1024,6 +1050,62 @@ end function stdlib_remove_directory end subroutine remove_directory +subroutine get_cwd(cwd, err) + character(:), allocatable, intent(out) :: cwd + type(state_type), intent(out) :: err + type(state_type) :: err0 + + interface + type(c_ptr) function stdlib_get_cwd(len, stat) bind(C, name='stdlib_get_cwd') + import c_ptr, c_size_t + integer(c_size_t), intent(out) :: len + integer :: stat + end function stdlib_get_cwd + end interface + + type(c_ptr) :: c_str_ptr + integer(c_size_t) :: len, i + integer :: stat + character(kind=c_char), pointer :: c_str(:) + + c_str_ptr = stdlib_get_cwd(len, stat) + + if (stat /= 0) then + err0 = state_type(STDLIB_FS_ERROR, "code: ", to_string(stat)//",", c_get_strerror()) + call err0%handle(err) + end if + + call c_f_pointer(c_str_ptr, c_str, [len]) + + allocate(character(len=len) :: cwd) + + do concurrent (i=1:len) + cwd(i:i) = c_str(i) + end do +end subroutine get_cwd + +subroutine set_cwd(path, err) + character(len=*), intent(in) :: path + type(state_type), intent(out) :: err + type(state_type) :: err0 + + interface + integer function stdlib_set_cwd(path) bind(C, name='stdlib_set_cwd') + import c_char + character(kind=c_char), intent(in) :: path(*) + end function stdlib_set_cwd + end interface + + integer :: code + + code = stdlib_set_cwd(to_c_char(trim(path))) + + if (code /= 0) then + err0 = state_type(STDLIB_FS_ERROR, "code: ", to_string(code)//",", c_get_strerror()) + call err0%handle(err) + end if +end subroutine set_cwd + !> Returns the file path of the null device for the current operating system. !> !> Version: Helper function. From 87af9a3e8d1b29e942614bed09fbe7d2ed359374 Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Sun, 6 Jul 2025 05:04:57 +0530 Subject: [PATCH 02/10] add C functions --- src/stdlib_system.c | 42 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 42 insertions(+) diff --git a/src/stdlib_system.c b/src/stdlib_system.c index 0bef82b8c..ed81bccfc 100644 --- a/src/stdlib_system.c +++ b/src/stdlib_system.c @@ -1,4 +1,6 @@ +#include #include +#include #include #include #include @@ -44,3 +46,43 @@ int stdlib_remove_directory(const char* path){ return (!code) ? 0 : errno; } + +char* stdlib_get_cwd(size_t* len, int* stat){ + *stat = 0; +#ifdef _WIN32 + char* buffer; + buffer = _getcwd(NULL, 0); + + if (buffer == NULL) { + *stat = errno; + return NULL; + } + + *len = strlen(buffer) + return buffer; +#else + char buffer[PATH_MAX + 1]; + if (!getcwd(buffer, sizeof(buffer))) { + *stat = errno; + } + + *len = strlen(buffer); + + char* res = malloc(*len); + strncpy(res, buffer, *len); + + return res; +#endif /* ifdef _WIN32 */ +} + +int stdlib_set_cwd(char* path) { + int code; +#ifdef _WIN32 + code = _chdir(path); +#else + code = chdir(path); +#endif /* ifdef _WIN32 */ + + if (code == -1) return errno; + return 0; +} From 462c443bc4e29e899117c3542ae809b898ce9230 Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Sun, 6 Jul 2025 05:05:21 +0530 Subject: [PATCH 03/10] add example --- example/system/CMakeLists.txt | 1 + example/system/example_cwd.f90 | 33 +++++++++++++++++++++++++++++++++ 2 files changed, 34 insertions(+) create mode 100644 example/system/example_cwd.f90 diff --git a/example/system/CMakeLists.txt b/example/system/CMakeLists.txt index 142dad22a..3ede9e3cf 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(cwd) diff --git a/example/system/example_cwd.f90 b/example/system/example_cwd.f90 new file mode 100644 index 000000000..367a6f97e --- /dev/null +++ b/example/system/example_cwd.f90 @@ -0,0 +1,33 @@ +! Illustrate the usage of get_cwd, set_cwd +program example_cwd + use stdlib_system, only: get_cwd, set_cwd + use stdlib_error, only: state_type + implicit none + + character(len=:), allocatable :: path + type(state_type) :: err + + call get_cwd(path, err) + + if (err%error()) then + print *, "Error getting current working directory: "//err%print() + end if + + print *, "CWD: "//path + + call set_cwd("./src", err) + + if (err%error()) then + print *, "Error setting current working directory: "//err%print() + end if + + call get_cwd(path, err) + + if (err%error()) then + print *, "Error getting current working directory after using set_cwd: "//err%print() + return + end if + + print *, "CWD: "//path +end program example_cwd + From e6fc551cb1a9299065e6880c1dbdb5a766658239 Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Sun, 6 Jul 2025 05:05:33 +0530 Subject: [PATCH 04/10] add docs --- doc/specs/stdlib_system.md | 84 ++++++++++++++++++++++++++++++++++++++ src/stdlib_system.c | 2 +- 2 files changed, 85 insertions(+), 1 deletion(-) diff --git a/doc/specs/stdlib_system.md b/doc/specs/stdlib_system.md index c6c79fcea..4ec4f3d14 100644 --- a/doc/specs/stdlib_system.md +++ b/doc/specs/stdlib_system.md @@ -646,6 +646,80 @@ Subroutine --- +## `get_cwd` - Gets the current working directory + +### Status + +Experimental + +### Description + +It gets the current working directory associated with the process calling this subroutine. +It is designed to work across multiple platforms. On Windows, paths with both forward `/` and backward `\` slashes are accepted. + +### Syntax + +`call [[stdlib_system(module):get_cwd(subroutine)]] (cwd, err)` + +### Class + +Subroutine + +### Arguments + +`cwd`: Shall be a character string containing the path of the current working directory (cwd). It is an `intent(out)` 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_cwd.f90!} +``` + +--- + +## `set_cwd` - Sets the current working directory + +### Status + +Experimental + +### Description + +It sets the current working directory associated with the process calling this subroutine. +It is designed to work across multiple platforms. On Windows, paths with both forward `/` and backward `\` slashes are accepted. + +### Syntax + +`call [[stdlib_system(module):set_cwd(subroutine)]] (path, err)` + +### Class + +Subroutine + +### Arguments + +`path`: Shall be a character string containing the path of the directory. 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_cwd.f90!} +``` + +--- + ## `null_device` - Return the null device file path ### Status @@ -682,6 +756,8 @@ None. {!example/system/example_null_device.f90!} ``` +--- + ## `delete_file` - Delete a file ### Status @@ -723,6 +799,8 @@ The file is removed from the filesystem if the operation is successful. If the o {!example/system/example_delete_file.f90!} ``` +--- + ## `join_path` - Joins the provided paths according to the OS ### Status @@ -785,6 +863,8 @@ The result is an `allocatable` character string or `type(string_type)` {!example/system/example_path_join.f90!} ``` +--- + ## `split_path` - splits a path immediately following the last separator ### Status @@ -825,6 +905,8 @@ The splitted path. `head` and `tail`. {!example/system/example_path_split_path.f90!} ``` +--- + ## `base_name` - The last part of a path ### Status @@ -860,6 +942,8 @@ A character string or `type(string_type)`. {!example/system/example_path_base_name.f90!} ``` +--- + ## `dir_name` - Everything except the last part of the path ### Status diff --git a/src/stdlib_system.c b/src/stdlib_system.c index ed81bccfc..f6350e159 100644 --- a/src/stdlib_system.c +++ b/src/stdlib_system.c @@ -58,7 +58,7 @@ char* stdlib_get_cwd(size_t* len, int* stat){ return NULL; } - *len = strlen(buffer) + *len = strlen(buffer); return buffer; #else char buffer[PATH_MAX + 1]; From 21de39416a11236ac912f609758b572137f02765 Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Wed, 30 Jul 2025 23:03:55 +0530 Subject: [PATCH 05/10] fix: `use` --- src/stdlib_system.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/stdlib_system.F90 b/src/stdlib_system.F90 index 0fcc3a79d..1bed3b816 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, find +use stdlib_strings, only: to_c_char, find, to_string use stdlib_string_type, only: string_type use stdlib_optval, only: optval use stdlib_error, only: state_type, STDLIB_SUCCESS, STDLIB_FS_ERROR From f2acfda8ad9c6ea14dd93d4a6b462e2d02ced82b Mon Sep 17 00:00:00 2001 From: Suprit S Jahagirdar Date: Fri, 1 Aug 2025 00:49:58 +0530 Subject: [PATCH 06/10] add a helper function `to_f_char` --- src/stdlib_system.F90 | 52 +++++++++++++++++++++---------------------- 1 file changed, 25 insertions(+), 27 deletions(-) diff --git a/src/stdlib_system.F90 b/src/stdlib_system.F90 index 1bed3b816..ca4b79ae0 100644 --- a/src/stdlib_system.F90 +++ b/src/stdlib_system.F90 @@ -922,6 +922,25 @@ end function stdlib_is_directory end function is_directory +! A Helper function to convert C character arrays to Fortran character strings +function to_f_char(c_str_ptr, len) result(f_str) + type(c_ptr), intent(in) :: c_str_ptr + ! length of the string excluding the null character + integer(kind=c_size_t), intent(in) :: len + character(:), allocatable :: f_str + + integer :: i + character(kind=c_char), pointer :: c_str(:) + + call c_f_pointer(c_str_ptr, c_str, [len]) + + allocate(character(len=len) :: f_str) + + do concurrent (i=1:len) + f_str(i:i) = c_str(i) + end do +end function to_f_char + ! A helper function to get the result of the C function `strerror`. ! `strerror` is a function provided by ``. ! It returns a string describing the meaning of `errno` in the C header `` @@ -937,18 +956,11 @@ end function strerror end interface type(c_ptr) :: c_str_ptr - integer(c_size_t) :: len, i - character(kind=c_char), pointer :: c_str(:) + integer(c_size_t) :: len 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 + str = to_f_char(c_str_ptr, len) end function c_get_strerror !! makes an empty directory @@ -1064,9 +1076,8 @@ end function stdlib_get_cwd end interface type(c_ptr) :: c_str_ptr - integer(c_size_t) :: len, i + integer(c_size_t) :: len integer :: stat - character(kind=c_char), pointer :: c_str(:) c_str_ptr = stdlib_get_cwd(len, stat) @@ -1075,13 +1086,8 @@ end function stdlib_get_cwd call err0%handle(err) end if - call c_f_pointer(c_str_ptr, c_str, [len]) - - allocate(character(len=len) :: cwd) + cwd = to_f_char(c_str_ptr, len) - do concurrent (i=1:len) - cwd(i:i) = c_str(i) - end do end subroutine get_cwd subroutine set_cwd(path, err) @@ -1124,21 +1130,13 @@ end function process_null_device end interface - integer(c_size_t) :: i, len + integer(c_size_t) :: len type(c_ptr) :: c_path_ptr - character(kind=c_char), pointer :: c_path(:) ! Call the C function to get the null device path and its length c_path_ptr = process_null_device(len) - call c_f_pointer(c_path_ptr,c_path,[len]) - ! Allocate the Fortran string with the length returned from C - allocate(character(len=len) :: path) - - do concurrent (i=1:len) - path(i:i) = c_path(i) - end do - + path = to_f_char(c_path_ptr, len) end function null_device !> Delete a file at the given path. From 20050654bdd5045359f75eb4c14465f6c29cd297 Mon Sep 17 00:00:00 2001 From: Suprit S Jahagirdar Date: Fri, 1 Aug 2025 01:12:16 +0530 Subject: [PATCH 07/10] improve docs --- doc/specs/stdlib_system.md | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/doc/specs/stdlib_system.md b/doc/specs/stdlib_system.md index 4ec4f3d14..4b9f9938c 100644 --- a/doc/specs/stdlib_system.md +++ b/doc/specs/stdlib_system.md @@ -654,12 +654,12 @@ Experimental ### Description -It gets the current working directory associated with the process calling this subroutine. +This subroutine retrieves the current working directory, the running process is executing from. It is designed to work across multiple platforms. On Windows, paths with both forward `/` and backward `\` slashes are accepted. ### Syntax -`call [[stdlib_system(module):get_cwd(subroutine)]] (cwd, err)` +`call [[stdlib_system(module):get_cwd(subroutine)]] (cwd [, err])` ### Class @@ -667,13 +667,13 @@ Subroutine ### Arguments -`cwd`: Shall be a character string containing the path of the current working directory (cwd). It is an `intent(out)` argument. +`cwd`: Shall be a character string for receiving the path of the current working directory (cwd). It is an `intent(out)` 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`, and is used 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, an `FS_ERROR` will trigger an error stop. ### Example @@ -691,12 +691,12 @@ Experimental ### Description -It sets the current working directory associated with the process calling this subroutine. +This subrotine sets the current working directory the process is executing from. It is designed to work across multiple platforms. On Windows, paths with both forward `/` and backward `\` slashes are accepted. ### Syntax -`call [[stdlib_system(module):set_cwd(subroutine)]] (path, err)` +`call [[stdlib_system(module):set_cwd(subroutine)]] (path [, err])` ### Class @@ -706,11 +706,11 @@ Subroutine `path`: Shall be a character string containing the path of the directory. 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`, and is used 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, an `FS_ERROR` will trigger an error stop. ### Example From b272c74f57db353e920fbc91a7fc1870c375e77a Mon Sep 17 00:00:00 2001 From: Suprit S Jahagirdar Date: Fri, 1 Aug 2025 01:48:05 +0530 Subject: [PATCH 08/10] make err optional --- doc/specs/stdlib_system.md | 2 +- example/system/example_cwd.f90 | 2 +- src/stdlib_system.F90 | 12 ++++++------ 3 files changed, 8 insertions(+), 8 deletions(-) diff --git a/doc/specs/stdlib_system.md b/doc/specs/stdlib_system.md index 4b9f9938c..95a7f8e41 100644 --- a/doc/specs/stdlib_system.md +++ b/doc/specs/stdlib_system.md @@ -654,7 +654,7 @@ Experimental ### Description -This subroutine retrieves the current working directory, the running process is executing from. +This subroutine retrieves the current working directory the running process is executing from. It is designed to work across multiple platforms. On Windows, paths with both forward `/` and backward `\` slashes are accepted. ### Syntax diff --git a/example/system/example_cwd.f90 b/example/system/example_cwd.f90 index 367a6f97e..e69449d71 100644 --- a/example/system/example_cwd.f90 +++ b/example/system/example_cwd.f90 @@ -1,4 +1,4 @@ -! Illustrate the usage of get_cwd, set_cwd +! Illustrate the usage of `get_cwd`, `set_cwd` program example_cwd use stdlib_system, only: get_cwd, set_cwd use stdlib_error, only: state_type diff --git a/src/stdlib_system.F90 b/src/stdlib_system.F90 index ca4b79ae0..90e61e05b 100644 --- a/src/stdlib_system.F90 +++ b/src/stdlib_system.F90 @@ -165,7 +165,7 @@ module stdlib_system !! Gets the current working directory. !! !! ### Description -!! This subroutine gets the current working directory of the process calling this function. +!! This subroutine gets the current working directory the process is executing from. !! public :: get_cwd @@ -178,7 +178,7 @@ module stdlib_system !! Changes the current working directory to the one specified. !! !! ### Description -!! This subroutine sets the current working directory of the process calling this function to the one specified. +!! This subroutine sets the current working directory the process is executing from. !! public :: set_cwd @@ -1064,7 +1064,7 @@ end subroutine remove_directory subroutine get_cwd(cwd, err) character(:), allocatable, intent(out) :: cwd - type(state_type), intent(out) :: err + type(state_type), optional, intent(out) :: err type(state_type) :: err0 interface @@ -1082,7 +1082,7 @@ end function stdlib_get_cwd c_str_ptr = stdlib_get_cwd(len, stat) if (stat /= 0) then - err0 = state_type(STDLIB_FS_ERROR, "code: ", to_string(stat)//",", c_get_strerror()) + err0 = FS_ERROR_CODE(stat, c_get_strerror()) call err0%handle(err) end if @@ -1092,7 +1092,7 @@ end subroutine get_cwd subroutine set_cwd(path, err) character(len=*), intent(in) :: path - type(state_type), intent(out) :: err + type(state_type), optional, intent(out) :: err type(state_type) :: err0 interface @@ -1107,7 +1107,7 @@ end function stdlib_set_cwd code = stdlib_set_cwd(to_c_char(trim(path))) if (code /= 0) then - err0 = state_type(STDLIB_FS_ERROR, "code: ", to_string(code)//",", c_get_strerror()) + err0 = FS_ERROR_CODE(code, c_get_strerror()) call err0%handle(err) end if end subroutine set_cwd From 41ac1fd5b961f1b9b071bf7942c3f526aa3714a3 Mon Sep 17 00:00:00 2001 From: Suprit S Jahagirdar Date: Fri, 1 Aug 2025 01:48:20 +0530 Subject: [PATCH 09/10] add test --- test/system/test_filesystem.f90 | 55 +++++++++++++++++++++++++++++++-- 1 file changed, 53 insertions(+), 2 deletions(-) diff --git a/test/system/test_filesystem.f90 b/test/system/test_filesystem.f90 index af4bbedb6..1d06297f5 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, get_cwd, set_cwd, operator(/) use stdlib_error, only: state_type, STDLIB_FS_ERROR implicit none @@ -25,7 +25,8 @@ subroutine collect_suite(testsuite) 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) & + new_unittest("fs_remove_dir_non_existent", test_remove_directory_nonexistent), & + new_unittest("fs_cwd", test_cwd) & ] end subroutine collect_suite @@ -279,6 +280,56 @@ subroutine test_remove_directory_nonexistent(error) if (allocated(error)) return end subroutine test_remove_directory_nonexistent + subroutine test_cwd(error) + type(error_type), allocatable, intent(out) :: error + type(state_type) :: err + character(len=256) :: dir_name + integer :: ios,iocmd + character(len=512) :: msg + + character(:), allocatable :: pwd1, pwd2, abs_dir_name + + ! get the initial cwd + call get_cwd(pwd1, err) + call check(error, err%ok(), 'Could not get current working directory: '//err%print()) + if (allocated(error)) return + + ! create a temporary directory for use by `set_cwd` + dir_name = "test_directory" + + call execute_command_line('mkdir ' // dir_name, exitstat=ios, cmdstat=iocmd, cmdmsg=msg) + call check(error, ios==0 .and. iocmd==0, 'Cannot init cwd test: '//trim(msg)) + if (allocated(error)) return + + abs_dir_name = pwd1 / dir_name + call set_cwd(abs_dir_name, err) + call check(error, err%ok(), 'Could not set current working directory: '//err%print()) + if (allocated(error)) return + + ! get the new cwd -> should be same as (pwd1 / dir_name) + call get_cwd(pwd2, err) + call check(error, err%ok(), 'Could not get current working directory: '//err%print()) + if (allocated(error)) return + + call check(error, pwd2 == abs_dir_name, 'Working directory is wrong, & + & expected: '//abs_dir_name//" got: "//pwd2) + if (allocated(error)) return + + ! cleanup: set the cwd back to the initial value + call set_cwd(pwd1, err) + call check(error, err%ok(), 'Could not clean up cwd test, could not set the cwd back: '//err%print()) + if (allocated(error)) then + ! our cwd now is `./test_directory` + ! there is no way of removing the empty test directory + return + end if + + ! cleanup: 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 cwd test, cannot remove empty dir: '//trim(msg)) + if (allocated(error)) return + end subroutine test_cwd + end module test_filesystem program tester From 607da8d44d6eab2bc4acfe0d03eec34c7cab0238 Mon Sep 17 00:00:00 2001 From: Suprit S Jahagirdar Date: Fri, 1 Aug 2025 02:01:44 +0530 Subject: [PATCH 10/10] in code comments --- example/system/example_cwd.f90 | 1 - src/stdlib_system.c | 9 +++++++-- 2 files changed, 7 insertions(+), 3 deletions(-) diff --git a/example/system/example_cwd.f90 b/example/system/example_cwd.f90 index e69449d71..b2f2817c0 100644 --- a/example/system/example_cwd.f90 +++ b/example/system/example_cwd.f90 @@ -25,7 +25,6 @@ program example_cwd if (err%error()) then print *, "Error getting current working directory after using set_cwd: "//err%print() - return end if print *, "CWD: "//path diff --git a/src/stdlib_system.c b/src/stdlib_system.c index f6350e159..81ff06a06 100644 --- a/src/stdlib_system.c +++ b/src/stdlib_system.c @@ -47,6 +47,9 @@ int stdlib_remove_directory(const char* path){ return (!code) ? 0 : errno; } +// Wrapper to the platform's `getcwd`(get current working directory) call. +// Uses `getcwd` on unix, `_getcwd` on windows. +// Returns the cwd, sets the length of cwd and the `stat` of the operation. char* stdlib_get_cwd(size_t* len, int* stat){ *stat = 0; #ifdef _WIN32 @@ -75,6 +78,9 @@ char* stdlib_get_cwd(size_t* len, int* stat){ #endif /* ifdef _WIN32 */ } +// Wrapper to the platform's `chdir`(change directory) call. +// Uses `chdir` on unix, `_chdir` on windows. +// Returns 0 if successful, otherwise returns the `errno`. int stdlib_set_cwd(char* path) { int code; #ifdef _WIN32 @@ -83,6 +89,5 @@ int stdlib_set_cwd(char* path) { code = chdir(path); #endif /* ifdef _WIN32 */ - if (code == -1) return errno; - return 0; + return (code == -1) ? errno : 0; }