diff --git a/doc/specs/stdlib_system.md b/doc/specs/stdlib_system.md index 56c6f70e6..c6c79fcea 100644 --- a/doc/specs/stdlib_system.md +++ b/doc/specs/stdlib_system.md @@ -535,6 +535,117 @@ The function returns a `logical` value: --- +## `make_directory` - Creates an empty directory + +### Status + +Experimental + +### Description + +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 [,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`, and is used for error handling. It is an `optional, intent(out)` argument. + +### Return values + +`err` is an optional state return flag. If not requested and an error occurs, an `FS_ERROR` will trigger an error stop. + +### Example + +```fortran +{!example/system/example_make_directory.f90!} +``` + +--- + +## `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 necessary parent directories in the path if they do not exist already. + +### 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`, and is used for error handling. It is an `optional, intent(out)` argument. + +### Return values + +`err` is an optional state return flag. If not requested and an error occurs, an `FS_ERROR` will trigger an error stop. + +### 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`(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_remove_directory.f90!} +``` + +--- + ## `null_device` - Return the null device file path ### Status diff --git a/example/system/CMakeLists.txt b/example/system/CMakeLists.txt index 57ec0c737..142dad22a 100644 --- a/example/system/CMakeLists.txt +++ b/example/system/CMakeLists.txt @@ -16,4 +16,5 @@ ADD_EXAMPLE(path_join) ADD_EXAMPLE(path_split_path) ADD_EXAMPLE(path_base_name) ADD_EXAMPLE(path_dir_name) - +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..e33aab730 --- /dev/null +++ b/example/system/example_make_directory.f90 @@ -0,0 +1,25 @@ +! Illustrate the usage of `make_directory`, `make_directory_all` +program example_make_directory + use stdlib_system, only: make_directory, make_directory_all + use stdlib_error, only: state_type + implicit none + + type(state_type) :: err + + call make_directory("temp_dir", err) + + if (err%error()) then + print *, err%print() + else + 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 diff --git a/example/system/example_remove_directory.f90 b/example/system/example_remove_directory.f90 new file mode 100644 index 000000000..03465312d --- /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: 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 diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 3f5ab161b..98c43a1ff 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -56,7 +56,7 @@ set(fppFiles stdlib_specialfunctions_gamma.fypp stdlib_specialfunctions.fypp stdlib_specialmatrices.fypp - stdlib_specialmatrices_tridiagonal.fypp + stdlib_specialmatrices_tridiagonal.fypp stdlib_stats.fypp stdlib_stats_corr.fypp stdlib_stats_cov.fypp @@ -118,6 +118,7 @@ set(SRC stdlib_system_subprocess.c stdlib_system_subprocess.F90 stdlib_system_path.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 bf8c9f0c7..bd6f9b001 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, to_string +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 implicit none private @@ -109,6 +110,52 @@ 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 default permissions. +!! +!! ### Description +!! This function makes an empty directory according to the path provided. +!! 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 + +!! 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 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 + +!! version: experimental +!! +!! Removes an empty directory. +!! ([Specification](../page/specs/stdlib_system.html#remove_directory)) +!! +!! ### Summary +!! Removes an empty directory. +!! +!! ### Description +!! This function Removes an empty directory according to the path provided. +!! 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 + !! version: experimental !! !! Deletes a specified file from the filesystem. @@ -849,6 +896,134 @@ 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 + + interface + type(c_ptr) function strerror(len) bind(C, name='stdlib_strerror') + import c_size_t, c_ptr + 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, err) + character(len=*), intent(in) :: path + type(state_type), optional, intent(out) :: err + + integer :: code + type(state_type) :: err0 + + interface + integer function stdlib_make_directory(cpath) bind(C, name='stdlib_make_directory') + import c_char + character(kind=c_char), intent(in) :: cpath(*) + end function stdlib_make_directory + end interface + + 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) + end if + +end subroutine make_directory + +subroutine make_directory_all(path, err) + character(len=*), intent(in) :: path + type(state_type), optional, intent(out) :: err + + integer :: i, indx + type(state_type) :: err0 + character(len=1) :: sep + 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) 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 + end if + + return + end if + + 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 + call err0%handle(err) + return + end if + end if + + i = i + 1 ! the next occurence of `sep` + 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 + 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))) + + 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. !> !> Version: Helper function. diff --git a/src/stdlib_system.c b/src/stdlib_system.c new file mode 100644 index 000000000..0bef82b8c --- /dev/null +++ b/src/stdlib_system.c @@ -0,0 +1,46 @@ +#include +#include +#include +#include +#include +#ifdef _WIN32 +#include +#else +#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 + code = _mkdir(path); +#else + // Default mode 0777 + code = mkdir(path, 0777); +#endif /* ifdef _WIN32 */ + + 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 + code = _rmdir(path); +#else + code = rmdir(path); +#endif /* ifdef _WIN32 */ + + return (!code) ? 0 : errno; +} 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) diff --git a/test/system/test_filesystem.f90 b/test/system/test_filesystem.f90 index 838ced263..af4bbedb6 100644 --- a/test/system/test_filesystem.f90 +++ b/test/system/test_filesystem.f90 @@ -1,6 +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 + 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 use stdlib_error, only: state_type, STDLIB_FS_ERROR implicit none @@ -18,7 +20,12 @@ 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_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) & ] end subroutine collect_suite @@ -166,7 +173,111 @@ 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) :: dir_name + integer :: ios,iocmd + character(len=512) :: msg + + dir_name = "test_directory" + + 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 ' // 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) :: dir_name + integer :: ios,iocmd + character(len=512) :: msg + + 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 make_directory_existing test: '//trim(msg)) + if (allocated(error)) return + + 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 ' // dir_name, 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 + + 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 + + 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()) + if (allocated(error)) return + + ! clean up: remove the empty directory + if (is_windows()) then + call execute_command_line('rmdir /s /q d1', exitstat=ios, cmdstat=iocmd, cmdmsg=msg) + else + 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)) + 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) :: dir_name + integer :: ios,iocmd + character(len=512) :: msg + + 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 remove_directory test: '//trim(msg)) + if (allocated(error)) return + + 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 ' // 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 + + 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