@@ -2,7 +2,7 @@ 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
5
+ use stdlib_strings, only: to_c_char, to_string
6
6
use stdlib_error, only: state_type, STDLIB_SUCCESS, STDLIB_FS_ERROR
7
7
implicit none
8
8
private
@@ -100,6 +100,36 @@ module stdlib_system
100
100
! !
101
101
public :: is_directory
102
102
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
+
103
133
! ! version: experimental
104
134
! !
105
135
! ! Deletes a specified file from the filesystem.
@@ -690,6 +720,98 @@ end function stdlib_is_directory
690
720
691
721
end function is_directory
692
722
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
+
693
815
! > Returns the file path of the null device for the current operating system.
694
816
! >
695
817
! > Version: Helper function.
0 commit comments