@@ -2,8 +2,9 @@ module stdlib_system
2
2
use , intrinsic :: iso_c_binding, only : c_int, c_long, c_ptr, c_null_ptr, c_int64_t, c_size_t, &
3
3
c_f_pointer
4
4
use 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
6
6
use stdlib_string_type, only: string_type
7
+ use stdlib_optval, only: optval
7
8
use stdlib_error, only: state_type, STDLIB_SUCCESS, STDLIB_FS_ERROR
8
9
implicit none
9
10
private
@@ -109,6 +110,52 @@ module stdlib_system
109
110
! !
110
111
public :: is_directory
111
112
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
+
112
159
! ! version: experimental
113
160
! !
114
161
! ! Deletes a specified file from the filesystem.
@@ -849,6 +896,134 @@ end function stdlib_is_directory
849
896
850
897
end function is_directory
851
898
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
+
852
1027
! > Returns the file path of the null device for the current operating system.
853
1028
! >
854
1029
! > Version: Helper function.
0 commit comments