Skip to content
Merged
Show file tree
Hide file tree
Changes from 1 commit
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
5 changes: 3 additions & 2 deletions src/CMakeLists.txt
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
124 changes: 123 additions & 1 deletion src/stdlib_system.F90
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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.
Expand Down Expand Up @@ -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.
Expand Down
46 changes: 46 additions & 0 deletions src/stdlib_system.c
Original file line number Diff line number Diff line change
@@ -0,0 +1,46 @@
#include <stddef.h>
#include <sys/stat.h>
#include <sys/types.h>
#include <string.h>
#include <errno.h>
#ifdef _WIN32
#include <direct.h>
#else
#include <unistd.h>
#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;
}