Skip to content

Commit 7056a36

Browse files
committed
add subroutines and C wrappers
1 parent 8012ac8 commit 7056a36

File tree

1 file changed

+82
-0
lines changed

1 file changed

+82
-0
lines changed

src/stdlib_system.F90

Lines changed: 82 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -130,6 +130,32 @@ module stdlib_system
130130
!!
131131
public :: remove_directory
132132

133+
!! version: experimental
134+
!!
135+
!! Gets the current working directory of the process
136+
!! ([Specification](../page/specs/stdlib_system.html#get_cwd))
137+
!!
138+
!! ### Summary
139+
!! Gets the current working directory.
140+
!!
141+
!! ### Description
142+
!! This subroutine gets the current working directory of the process calling this function.
143+
!!
144+
public :: get_cwd
145+
146+
!! version: experimental
147+
!!
148+
!! Sets the current working directory of the process
149+
!! ([Specification](../page/specs/stdlib_system.html#set_cwd))
150+
!!
151+
!! ### Summary
152+
!! Changes the current working directory to the one specified.
153+
!!
154+
!! ### Description
155+
!! This subroutine sets the current working directory of the process calling this function to the one specified.
156+
!!
157+
public :: set_cwd
158+
133159
!! version: experimental
134160
!!
135161
!! Deletes a specified file from the filesystem.
@@ -810,6 +836,62 @@ end function stdlib_remove_directory
810836
end select
811837
end subroutine remove_directory
812838

839+
subroutine get_cwd(cwd, err)
840+
character(:), allocatable, intent(out) :: cwd
841+
type(state_type), intent(out) :: err
842+
type(state_type) :: err0
843+
844+
interface
845+
type(c_ptr) function stdlib_get_cwd(len, stat) bind(C, name='stdlib_get_cwd')
846+
import c_ptr, c_size_t
847+
integer(c_size_t), intent(out) :: len
848+
integer :: stat
849+
end function stdlib_get_cwd
850+
end interface
851+
852+
type(c_ptr) :: c_str_ptr
853+
integer(c_size_t) :: len, i
854+
integer :: stat
855+
character(kind=c_char), pointer :: c_str(:)
856+
857+
c_str_ptr = stdlib_get_cwd(len, stat)
858+
859+
if (stat /= 0) then
860+
err0 = state_type(STDLIB_FS_ERROR, "code: ", to_string(stat)//",", c_get_strerror())
861+
call err0%handle(err)
862+
end if
863+
864+
call c_f_pointer(c_str_ptr, c_str, [len])
865+
866+
allocate(character(len=len) :: cwd)
867+
868+
do concurrent (i=1:len)
869+
cwd(i:i) = c_str(i)
870+
end do
871+
end subroutine get_cwd
872+
873+
subroutine set_cwd(path, err)
874+
character(len=*), intent(in) :: path
875+
type(state_type), intent(out) :: err
876+
type(state_type) :: err0
877+
878+
interface
879+
integer function stdlib_set_cwd(path) bind(C, name='stdlib_set_cwd')
880+
import c_char
881+
character(kind=c_char), intent(in) :: path(*)
882+
end function stdlib_set_cwd
883+
end interface
884+
885+
integer :: code
886+
887+
code = stdlib_set_cwd(to_c_char(trim(path)))
888+
889+
if (code /= 0) then
890+
err0 = state_type(STDLIB_FS_ERROR, "code: ", to_string(code)//",", c_get_strerror())
891+
call err0%handle(err)
892+
end if
893+
end subroutine set_cwd
894+
813895
!> Returns the file path of the null device for the current operating system.
814896
!>
815897
!> Version: Helper function.

0 commit comments

Comments
 (0)