Skip to content

Navigation Menu

Sign in
Appearance settings

Search code, repositories, users, issues, pull requests...

Provide feedback

We read every piece of feedback, and take your input very seriously.

Saved searches

Use saved searches to filter your results more quickly
Sign up
Appearance settings

Commit a8519b6

Browse files
authored
feat: get_cwd and set_cwd (#1014)
2 parents 60f5308 + 607da8d commit a8519b6

File tree

6 files changed

+317
-22
lines changed

6 files changed

+317
-22
lines changed

‎doc/specs/stdlib_system.md‎

Lines changed: 84 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -646,6 +646,80 @@ Subroutine
646646

647647
---
648648

649+
## `get_cwd` - Gets the current working directory
650+
651+
### Status
652+
653+
Experimental
654+
655+
### Description
656+
657+
This subroutine retrieves the current working directory the running process is executing from.
658+
It is designed to work across multiple platforms. On Windows, paths with both forward `/` and backward `\` slashes are accepted.
659+
660+
### Syntax
661+
662+
`call [[stdlib_system(module):get_cwd(subroutine)]] (cwd [, err])`
663+
664+
### Class
665+
666+
Subroutine
667+
668+
### Arguments
669+
670+
`cwd`: Shall be a character string for receiving the path of the current working directory (cwd). It is an `intent(out)` argument.
671+
672+
`err`(optional): Shall be of type `state_type`, and is used for error handling. It is an `intent(out)` argument.
673+
674+
### Return values
675+
676+
`err` is an optional state return flag. On error if not requested, an `FS_ERROR` will trigger an error stop.
677+
678+
### Example
679+
680+
```fortran
681+
{!example/system/example_cwd.f90!}
682+
```
683+
684+
---
685+
686+
## `set_cwd` - Sets the current working directory
687+
688+
### Status
689+
690+
Experimental
691+
692+
### Description
693+
694+
This subrotine sets the current working directory the process is executing from.
695+
It is designed to work across multiple platforms. On Windows, paths with both forward `/` and backward `\` slashes are accepted.
696+
697+
### Syntax
698+
699+
`call [[stdlib_system(module):set_cwd(subroutine)]] (path [, err])`
700+
701+
### Class
702+
703+
Subroutine
704+
705+
### Arguments
706+
707+
`path`: Shall be a character string containing the path of the directory. It is an `intent(in)` argument.
708+
709+
`err`(optional): Shall be of type `state_type`, and is used for error handling. It is an `intent(out)` argument.
710+
711+
### Return values
712+
713+
`err` is an optional state return flag. On error if not requested, an `FS_ERROR` will trigger an error stop.
714+
715+
### Example
716+
717+
```fortran
718+
{!example/system/example_cwd.f90!}
719+
```
720+
721+
---
722+
649723
## `null_device` - Return the null device file path
650724

651725
### Status
@@ -682,6 +756,8 @@ None.
682756
{!example/system/example_null_device.f90!}
683757
```
684758

759+
---
760+
685761
## `delete_file` - Delete a file
686762

687763
### Status
@@ -723,6 +799,8 @@ The file is removed from the filesystem if the operation is successful. If the o
723799
{!example/system/example_delete_file.f90!}
724800
```
725801

802+
---
803+
726804
## `join_path` - Joins the provided paths according to the OS
727805

728806
### Status
@@ -785,6 +863,8 @@ The result is an `allocatable` character string or `type(string_type)`
785863
{!example/system/example_path_join.f90!}
786864
```
787865

866+
---
867+
788868
## `split_path` - splits a path immediately following the last separator
789869

790870
### Status
@@ -825,6 +905,8 @@ The splitted path. `head` and `tail`.
825905
{!example/system/example_path_split_path.f90!}
826906
```
827907

908+
---
909+
828910
## `base_name` - The last part of a path
829911

830912
### Status
@@ -860,6 +942,8 @@ A character string or `type(string_type)`.
860942
{!example/system/example_path_base_name.f90!}
861943
```
862944

945+
---
946+
863947
## `dir_name` - Everything except the last part of the path
864948

865949
### Status

‎example/system/CMakeLists.txt‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -18,3 +18,4 @@ ADD_EXAMPLE(path_base_name)
1818
ADD_EXAMPLE(path_dir_name)
1919
ADD_EXAMPLE(make_directory)
2020
ADD_EXAMPLE(remove_directory)
21+
ADD_EXAMPLE(cwd)

‎example/system/example_cwd.f90‎

Lines changed: 32 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,32 @@
1+
! Illustrate the usage of `get_cwd`, `set_cwd`
2+
program example_cwd
3+
use stdlib_system, only: get_cwd, set_cwd
4+
use stdlib_error, only: state_type
5+
implicit none
6+
7+
character(len=:), allocatable :: path
8+
type(state_type) :: err
9+
10+
call get_cwd(path, err)
11+
12+
if (err%error()) then
13+
print *, "Error getting current working directory: "//err%print()
14+
end if
15+
16+
print *, "CWD: "//path
17+
18+
call set_cwd("./src", err)
19+
20+
if (err%error()) then
21+
print *, "Error setting current working directory: "//err%print()
22+
end if
23+
24+
call get_cwd(path, err)
25+
26+
if (err%error()) then
27+
print *, "Error getting current working directory after using set_cwd: "//err%print()
28+
end if
29+
30+
print *, "CWD: "//path
31+
end program example_cwd
32+

‎src/stdlib_system.F90‎

Lines changed: 100 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,7 @@ module stdlib_system
22
use, intrinsic :: iso_c_binding, only : c_int, c_long, c_ptr, c_null_ptr, c_int64_t, c_size_t, &
33
c_f_pointer
44
use stdlib_kinds, only: int64, dp, c_bool, c_char
5-
use stdlib_strings, only: to_c_char, find
5+
use stdlib_strings, only: to_c_char, find, to_string
66
use stdlib_string_type, only: string_type
77
use stdlib_optval, only: optval
88
use stdlib_error, only: state_type, STDLIB_SUCCESS, STDLIB_FS_ERROR
@@ -156,6 +156,32 @@ module stdlib_system
156156
!!
157157
public :: remove_directory
158158

159+
!! version: experimental
160+
!!
161+
!! Gets the current working directory of the process
162+
!! ([Specification](../page/specs/stdlib_system.html#get_cwd))
163+
!!
164+
!! ### Summary
165+
!! Gets the current working directory.
166+
!!
167+
!! ### Description
168+
!! This subroutine gets the current working directory the process is executing from.
169+
!!
170+
public :: get_cwd
171+
172+
!! version: experimental
173+
!!
174+
!! Sets the current working directory of the process
175+
!! ([Specification](../page/specs/stdlib_system.html#set_cwd))
176+
!!
177+
!! ### Summary
178+
!! Changes the current working directory to the one specified.
179+
!!
180+
!! ### Description
181+
!! This subroutine sets the current working directory the process is executing from.
182+
!!
183+
public :: set_cwd
184+
159185
!! version: experimental
160186
!!
161187
!! Deletes a specified file from the filesystem.
@@ -896,6 +922,25 @@ end function stdlib_is_directory
896922

897923
end function is_directory
898924

925+
! A Helper function to convert C character arrays to Fortran character strings
926+
function to_f_char(c_str_ptr, len) result(f_str)
927+
type(c_ptr), intent(in) :: c_str_ptr
928+
! length of the string excluding the null character
929+
integer(kind=c_size_t), intent(in) :: len
930+
character(:), allocatable :: f_str
931+
932+
integer :: i
933+
character(kind=c_char), pointer :: c_str(:)
934+
935+
call c_f_pointer(c_str_ptr, c_str, [len])
936+
937+
allocate(character(len=len) :: f_str)
938+
939+
do concurrent (i=1:len)
940+
f_str(i:i) = c_str(i)
941+
end do
942+
end function to_f_char
943+
899944
! A helper function to get the result of the C function `strerror`.
900945
! `strerror` is a function provided by `<string.h>`.
901946
! It returns a string describing the meaning of `errno` in the C header `<errno.h>`
@@ -911,18 +956,11 @@ end function strerror
911956
end interface
912957

913958
type(c_ptr) :: c_str_ptr
914-
integer(c_size_t) :: len, i
915-
character(kind=c_char), pointer :: c_str(:)
959+
integer(c_size_t) :: len
916960

917961
c_str_ptr = strerror(len)
918962

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
963+
str = to_f_char(c_str_ptr, len)
926964
end function c_get_strerror
927965

928966
!! makes an empty directory
@@ -1024,6 +1062,56 @@ end function stdlib_remove_directory
10241062

10251063
end subroutine remove_directory
10261064

1065+
subroutine get_cwd(cwd, err)
1066+
character(:), allocatable, intent(out) :: cwd
1067+
type(state_type), optional, intent(out) :: err
1068+
type(state_type) :: err0
1069+
1070+
interface
1071+
type(c_ptr) function stdlib_get_cwd(len, stat) bind(C, name='stdlib_get_cwd')
1072+
import c_ptr, c_size_t
1073+
integer(c_size_t), intent(out) :: len
1074+
integer :: stat
1075+
end function stdlib_get_cwd
1076+
end interface
1077+
1078+
type(c_ptr) :: c_str_ptr
1079+
integer(c_size_t) :: len
1080+
integer :: stat
1081+
1082+
c_str_ptr = stdlib_get_cwd(len, stat)
1083+
1084+
if (stat /= 0) then
1085+
err0 = FS_ERROR_CODE(stat, c_get_strerror())
1086+
call err0%handle(err)
1087+
end if
1088+
1089+
cwd = to_f_char(c_str_ptr, len)
1090+
1091+
end subroutine get_cwd
1092+
1093+
subroutine set_cwd(path, err)
1094+
character(len=*), intent(in) :: path
1095+
type(state_type), optional, intent(out) :: err
1096+
type(state_type) :: err0
1097+
1098+
interface
1099+
integer function stdlib_set_cwd(path) bind(C, name='stdlib_set_cwd')
1100+
import c_char
1101+
character(kind=c_char), intent(in) :: path(*)
1102+
end function stdlib_set_cwd
1103+
end interface
1104+
1105+
integer :: code
1106+
1107+
code = stdlib_set_cwd(to_c_char(trim(path)))
1108+
1109+
if (code /= 0) then
1110+
err0 = FS_ERROR_CODE(code, c_get_strerror())
1111+
call err0%handle(err)
1112+
end if
1113+
end subroutine set_cwd
1114+
10271115
!> Returns the file path of the null device for the current operating system.
10281116
!>
10291117
!> Version: Helper function.
@@ -1042,21 +1130,13 @@ end function process_null_device
10421130

10431131
end interface
10441132

1045-
integer(c_size_t) :: i, len
1133+
integer(c_size_t) :: len
10461134
type(c_ptr) :: c_path_ptr
1047-
character(kind=c_char), pointer :: c_path(:)
10481135

10491136
! Call the C function to get the null device path and its length
10501137
c_path_ptr = process_null_device(len)
1051-
call c_f_pointer(c_path_ptr,c_path,[len])
10521138

1053-
! Allocate the Fortran string with the length returned from C
1054-
allocate(character(len=len) :: path)
1055-
1056-
do concurrent (i=1:len)
1057-
path(i:i) = c_path(i)
1058-
end do
1059-
1139+
path = to_f_char(c_path_ptr, len)
10601140
end function null_device
10611141

10621142
!> Delete a file at the given path.

‎src/stdlib_system.c‎

Lines changed: 47 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,6 @@
1+
#include <limits.h>
12
#include <stddef.h>
3+
#include <stdlib.h>
24
#include <sys/stat.h>
35
#include <sys/types.h>
46
#include <string.h>
@@ -44,3 +46,48 @@ int stdlib_remove_directory(const char* path){
4446

4547
return (!code) ? 0 : errno;
4648
}
49+
50+
// Wrapper to the platform's `getcwd`(get current working directory) call.
51+
// Uses `getcwd` on unix, `_getcwd` on windows.
52+
// Returns the cwd, sets the length of cwd and the `stat` of the operation.
53+
char* stdlib_get_cwd(size_t* len, int* stat){
54+
*stat = 0;
55+
#ifdef _WIN32
56+
char* buffer;
57+
buffer = _getcwd(NULL, 0);
58+
59+
if (buffer == NULL) {
60+
*stat = errno;
61+
return NULL;
62+
}
63+
64+
*len = strlen(buffer);
65+
return buffer;
66+
#else
67+
char buffer[PATH_MAX + 1];
68+
if (!getcwd(buffer, sizeof(buffer))) {
69+
*stat = errno;
70+
}
71+
72+
*len = strlen(buffer);
73+
74+
char* res = malloc(*len);
75+
strncpy(res, buffer, *len);
76+
77+
return res;
78+
#endif /* ifdef _WIN32 */
79+
}
80+
81+
// Wrapper to the platform's `chdir`(change directory) call.
82+
// Uses `chdir` on unix, `_chdir` on windows.
83+
// Returns 0 if successful, otherwise returns the `errno`.
84+
int stdlib_set_cwd(char* path) {
85+
int code;
86+
#ifdef _WIN32
87+
code = _chdir(path);
88+
#else
89+
code = chdir(path);
90+
#endif /* ifdef _WIN32 */
91+
92+
return (code == -1) ? errno : 0;
93+
}

0 commit comments

Comments
(0)

AltStyle によって変換されたページ (->オリジナル) /