Skip to content

Commit 8d00eea

Browse files
committed
added functions and relevant wrappers
1 parent ae8398c commit 8d00eea

File tree

3 files changed

+172
-3
lines changed

3 files changed

+172
-3
lines changed

src/CMakeLists.txt

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -32,14 +32,14 @@ set(fppFiles
3232
stdlib_linalg_kronecker.fypp
3333
stdlib_linalg_cross_product.fypp
3434
stdlib_linalg_eigenvalues.fypp
35-
stdlib_linalg_solve.fypp
35+
stdlib_linalg_solve.fypp
3636
stdlib_linalg_determinant.fypp
3737
stdlib_linalg_qr.fypp
3838
stdlib_linalg_inverse.fypp
3939
stdlib_linalg_pinv.fypp
4040
stdlib_linalg_norms.fypp
4141
stdlib_linalg_state.fypp
42-
stdlib_linalg_svd.fypp
42+
stdlib_linalg_svd.fypp
4343
stdlib_linalg_cholesky.fypp
4444
stdlib_linalg_schur.fypp
4545
stdlib_optval.fypp
@@ -116,6 +116,7 @@ set(SRC
116116
stdlib_sorting_radix_sort.f90
117117
stdlib_system_subprocess.c
118118
stdlib_system_subprocess.F90
119+
stdlib_system.c
119120
stdlib_system.F90
120121
stdlib_sparse.f90
121122
stdlib_specialfunctions_legendre.f90

src/stdlib_system.F90

Lines changed: 123 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,7 @@ module stdlib_system
22
use, intrinsic :: iso_c_binding, only : c_int, c_long, c_ptr, c_null_ptr, c_int64_t, c_size_t, &
33
c_f_pointer
44
use stdlib_kinds, only: int64, dp, c_bool, c_char
5-
use stdlib_strings, only: to_c_char
5+
use stdlib_strings, only: to_c_char, to_string
66
use stdlib_error, only: state_type, STDLIB_SUCCESS, STDLIB_FS_ERROR
77
implicit none
88
private
@@ -100,6 +100,36 @@ module stdlib_system
100100
!!
101101
public :: is_directory
102102

103+
!! version: experimental
104+
!!
105+
!! Makes an empty directory.
106+
!! ([Specification](../page/specs/stdlib_system.html#make_directory))
107+
!!
108+
!! ### Summary
109+
!! Creates an empty directory with particular permissions.
110+
!!
111+
!! ### Description
112+
!! This function makes an empty directory according to the path provided.
113+
!! Relative paths as well as on Windows paths involving either `/` or `\` are accepted
114+
!! appropriate error message is returned whenever any error occur.
115+
!!
116+
public :: make_directory
117+
118+
!! version: experimental
119+
!!
120+
!! Removes an empty directory.
121+
!! ([Specification](../page/specs/stdlib_system.html#remove_directory))
122+
!!
123+
!! ### Summary
124+
!! Deletes an empty directory.
125+
!!
126+
!! ### Description
127+
!! This function deletes an empty directory according to the path provided.
128+
!! Relative paths as well as on Windows paths involving either `/` or `\` are accepted.
129+
!! appropriate error message is returned whenever any error occur.
130+
!!
131+
public :: remove_directory
132+
103133
!! version: experimental
104134
!!
105135
!! Deletes a specified file from the filesystem.
@@ -690,6 +720,98 @@ end function stdlib_is_directory
690720

691721
end function is_directory
692722

723+
function c_get_strerror() result(str)
724+
character(len=:), allocatable :: str
725+
726+
interface
727+
type(c_ptr) function strerror(len) bind(C, name='stdlib_strerror')
728+
import c_size_t, c_ptr, c_int
729+
implicit none
730+
integer(c_size_t), intent(out) :: len
731+
end function strerror
732+
end interface
733+
734+
type(c_ptr) :: c_str_ptr
735+
integer(c_size_t) :: len, i
736+
character(kind=c_char), pointer :: c_str(:)
737+
738+
c_str_ptr = strerror(len)
739+
740+
call c_f_pointer(c_str_ptr, c_str, [len])
741+
742+
allocate(character(len=len) :: str)
743+
744+
do concurrent (i=1:len)
745+
str(i:i) = c_str(i)
746+
end do
747+
end function c_get_strerror
748+
749+
!! makes an empty directory
750+
subroutine make_directory(path, mode, err)
751+
character(len=*), intent(in) :: path
752+
integer, intent(in), optional :: mode
753+
character, allocatable :: err_msg
754+
type(state_type), optional, intent(out) :: err
755+
756+
integer :: code
757+
type(state_type) :: err0
758+
759+
760+
interface
761+
integer function stdlib_make_directory(cpath, cmode) bind(C, name='stdlib_make_directory')
762+
import c_char
763+
character(kind=c_char), intent(in) :: cpath(*)
764+
integer, intent(in) :: cmode
765+
end function stdlib_make_directory
766+
end interface
767+
768+
if (is_windows() .and. present(mode)) then
769+
! _mkdir() doesn't have a `mode` argument
770+
err0 = state_type(STDLIB_FS_ERROR, "mode argument not present for Windows")
771+
call err0%handle(err)
772+
return
773+
end if
774+
775+
code = stdlib_make_directory(to_c_char(trim(path)), mode)
776+
777+
select case (code)
778+
case (0)
779+
return
780+
case default
781+
! error
782+
err0 = state_type(STDLIB_FS_ERROR, "code:", to_string(code)//',', c_get_strerror())
783+
call err0%handle(err)
784+
end select
785+
end subroutine make_directory
786+
787+
!! Removes an empty directory
788+
subroutine remove_directory(path, err)
789+
character(len=*), intent(in) :: path
790+
character, allocatable :: err_msg
791+
type(state_type), optional, intent(out) :: err
792+
793+
integer :: code
794+
type(state_type) :: err0
795+
796+
interface
797+
integer function stdlib_remove_directory(cpath) bind(C, name='stdlib_remove_directory')
798+
import c_char
799+
character(kind=c_char), intent(in) :: cpath(*)
800+
end function stdlib_remove_directory
801+
end interface
802+
803+
code = stdlib_remove_directory(to_c_char(trim(path)))
804+
805+
select case (code)
806+
case (0)
807+
return
808+
case default
809+
! error
810+
err0 = state_type(STDLIB_FS_ERROR, "code:", to_string(code)//',', c_get_strerror())
811+
call err0%handle(err)
812+
end select
813+
end subroutine remove_directory
814+
693815
!> Returns the file path of the null device for the current operating system.
694816
!>
695817
!> Version: Helper function.

src/stdlib_system.c

Lines changed: 46 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,46 @@
1+
#include <stddef.h>
2+
#include <sys/stat.h>
3+
#include <sys/types.h>
4+
#include <string.h>
5+
#include <errno.h>
6+
#ifdef _WIN32
7+
#include <direct.h>
8+
#else
9+
#include <unistd.h>
10+
#endif /* ifdef _WIN32 */
11+
12+
char* stdlib_strerror(size_t* len){
13+
char* err = strerror(errno);
14+
*len = strlen(err);
15+
return err;
16+
}
17+
18+
int stdlib_make_directory(const char* path, mode_t mode){
19+
int code;
20+
#ifdef _WIN32
21+
code = _mkdir(path);
22+
#else
23+
code = mkdir(path, mode);
24+
#endif /* ifdef _WIN32 */
25+
26+
if (!code){
27+
return 0;
28+
}
29+
30+
return errno;
31+
}
32+
33+
int stdlib_remove_directory(const char* path){
34+
int code;
35+
#ifdef _WIN32
36+
code = _rmdir(path);
37+
#else
38+
code = rmdir(path);
39+
#endif /* ifdef _WIN32 */
40+
41+
if (!code){
42+
return 0;
43+
}
44+
45+
return errno;
46+
}

0 commit comments

Comments
 (0)