@@ -2,7 +2,7 @@ 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
5+ use stdlib_strings, only: to_c_char, to_string
66use stdlib_error, only: state_type, STDLIB_SUCCESS, STDLIB_FS_ERROR
77implicit none
88private
@@ -100,6 +100,36 @@ module stdlib_system
100100! !
101101public :: 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
691721end 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.
0 commit comments