@@ -2,8 +2,9 @@ module stdlib_system
22use , intrinsic :: iso_c_binding, only : c_int, c_long, c_ptr, c_null_ptr, c_int64_t, c_size_t, &
33 c_f_pointer
44use stdlib_kinds, only: int64, dp, c_bool, c_char
5- use stdlib_strings, only: to_c_char, to_string
5+ use stdlib_strings, only: to_c_char, find
66use stdlib_string_type, only: string_type
7+ use stdlib_optval, only: optval
78use stdlib_error, only: state_type, STDLIB_SUCCESS, STDLIB_FS_ERROR
89implicit none
910private
@@ -109,6 +110,52 @@ module stdlib_system
109110! !
110111public :: is_directory
111112
113+ ! ! version: experimental
114+ ! !
115+ ! ! Makes an empty directory.
116+ ! ! ([Specification](../page/specs/stdlib_system.html#make_directory))
117+ ! !
118+ ! ! ### Summary
119+ ! ! Creates an empty directory with default permissions.
120+ ! !
121+ ! ! ### Description
122+ ! ! This function makes an empty directory according to the path provided.
123+ ! ! Relative paths are supported. On Windows, paths involving either `/` or `\` are accepted.
124+ ! ! An appropriate error message is returned whenever any error occurs.
125+ ! !
126+ public :: make_directory
127+
128+ ! ! version: experimental
129+ ! !
130+ ! ! Makes an empty directory, also creating all the parent directories required.
131+ ! ! ([Specification](../page/specs/stdlib_system.html#make_directory))
132+ ! !
133+ ! ! ### Summary
134+ ! ! Creates an empty directory with all the parent directories required to do so.
135+ ! !
136+ ! ! ### Description
137+ ! ! This function makes an empty directory according to the path provided.
138+ ! ! It also creates all the necessary parent directories in the path if they do not exist already.
139+ ! ! Relative paths are supported.
140+ ! ! An appropriate error message is returned whenever any error occurs.
141+ ! !
142+ public :: make_directory_all
143+
144+ ! ! version: experimental
145+ ! !
146+ ! ! Removes an empty directory.
147+ ! ! ([Specification](../page/specs/stdlib_system.html#remove_directory))
148+ ! !
149+ ! ! ### Summary
150+ ! ! Removes an empty directory.
151+ ! !
152+ ! ! ### Description
153+ ! ! This function Removes an empty directory according to the path provided.
154+ ! ! Relative paths are supported. On Windows paths involving either `/` or `\` are accepted.
155+ ! ! An appropriate error message is returned whenever any error occurs.
156+ ! !
157+ public :: remove_directory
158+
112159! ! version: experimental
113160! !
114161! ! Deletes a specified file from the filesystem.
@@ -849,6 +896,134 @@ end function stdlib_is_directory
849896
850897end function is_directory
851898
899+ ! A helper function to get the result of the C function `strerror`.
900+ ! `strerror` is a function provided by `<string.h>`.
901+ ! It returns a string describing the meaning of `errno` in the C header `<errno.h>`
902+ function c_get_strerror () result(str)
903+ character (len= :), allocatable :: str
904+
905+ interface
906+ type (c_ptr) function strerror(len) bind(C, name= ' stdlib_strerror' )
907+ import c_size_t, c_ptr
908+ implicit none
909+ integer (c_size_t), intent (out ) :: len
910+ end function strerror
911+ end interface
912+
913+ type (c_ptr) :: c_str_ptr
914+ integer (c_size_t) :: len, i
915+ character (kind= c_char), pointer :: c_str(:)
916+
917+ c_str_ptr = strerror(len)
918+
919+ call c_f_pointer(c_str_ptr, c_str, [len])
920+
921+ allocate (character (len= len) :: str)
922+
923+ do concurrent (i= 1 :len)
924+ str(i:i) = c_str(i)
925+ end do
926+ end function c_get_strerror
927+
928+ ! ! makes an empty directory
929+ subroutine make_directory (path , err )
930+ character (len=* ), intent (in ) :: path
931+ type (state_type), optional , intent (out ) :: err
932+
933+ integer :: code
934+ type (state_type) :: err0
935+
936+ interface
937+ integer function stdlib_make_directory (cpath ) bind(C, name= ' stdlib_make_directory' )
938+ import c_char
939+ character (kind= c_char), intent (in ) :: cpath(* )
940+ end function stdlib_make_directory
941+ end interface
942+
943+ code = stdlib_make_directory(to_c_char(trim (path)))
944+
945+ if (code /= 0 ) then
946+ err0 = FS_ERROR_CODE(code, c_get_strerror())
947+ call err0% handle(err)
948+ end if
949+
950+ end subroutine make_directory
951+
952+ subroutine make_directory_all (path , err )
953+ character (len=* ), intent (in ) :: path
954+ type (state_type), optional , intent (out ) :: err
955+
956+ integer :: i, indx
957+ type (state_type) :: err0
958+ character (len= 1 ) :: sep
959+ logical :: is_dir, check_is_dir
960+
961+ sep = path_sep()
962+ i = 1
963+ indx = find(path, sep, i)
964+ check_is_dir = .true.
965+
966+ do
967+ ! Base case to exit the loop
968+ if (indx == 0 ) then
969+ is_dir = is_directory(path)
970+
971+ if (.not. is_dir) then
972+ call make_directory(path, err0)
973+
974+ if (err0% error()) then
975+ call err0% handle(err)
976+ end if
977+ end if
978+
979+ return
980+ end if
981+
982+ if (check_is_dir) then
983+ is_dir = is_directory(path(1 :indx))
984+ end if
985+
986+ if (.not. is_dir) then
987+ ! no need for further `is_dir` checks
988+ ! all paths going forward need to be created
989+ check_is_dir = .false.
990+ call make_directory(path(1 :indx), err0)
991+
992+ if (err0% error()) then
993+ call err0% handle(err)
994+ return
995+ end if
996+ end if
997+
998+ i = i + 1 ! the next occurence of `sep`
999+ indx = find(path, sep, i)
1000+ end do
1001+ end subroutine make_directory_all
1002+
1003+ ! ! removes an empty directory
1004+ subroutine remove_directory (path , err )
1005+ character (len=* ), intent (in ) :: path
1006+ type (state_type), optional , intent (out ) :: err
1007+
1008+ integer :: code
1009+ type (state_type) :: err0
1010+
1011+ interface
1012+ integer function stdlib_remove_directory (cpath ) bind(C, name= ' stdlib_remove_directory' )
1013+ import c_char
1014+ character (kind= c_char), intent (in ) :: cpath(* )
1015+ end function stdlib_remove_directory
1016+ end interface
1017+
1018+ code = stdlib_remove_directory(to_c_char(trim (path)))
1019+
1020+ if (code /= 0 ) then
1021+ err0 = FS_ERROR_CODE(code, c_get_strerror())
1022+ call err0% handle(err)
1023+ end if
1024+
1025+ end subroutine remove_directory
1026+
8521027! > Returns the file path of the null device for the current operating system.
8531028! >
8541029! > Version: Helper function.
0 commit comments