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 f2acfda

Browse files
committed
add a helper function to_f_char 
1 parent 21de394 commit f2acfda

File tree

1 file changed

+25
-27
lines changed

1 file changed

+25
-27
lines changed

‎src/stdlib_system.F90

Lines changed: 25 additions & 27 deletions
Original file line numberDiff line numberDiff line change
@@ -922,6 +922,25 @@ end function stdlib_is_directory
922922

923923
end function is_directory
924924

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+
925944
! A helper function to get the result of the C function `strerror`.
926945
! `strerror` is a function provided by `<string.h>`.
927946
! It returns a string describing the meaning of `errno` in the C header `<errno.h>`
@@ -937,18 +956,11 @@ end function strerror
937956
end interface
938957

939958
type(c_ptr) :: c_str_ptr
940-
integer(c_size_t) :: len, i
941-
character(kind=c_char), pointer :: c_str(:)
959+
integer(c_size_t) :: len
942960

943961
c_str_ptr = strerror(len)
944962

945-
call c_f_pointer(c_str_ptr, c_str, [len])
946-
947-
allocate(character(len=len) :: str)
948-
949-
do concurrent (i=1:len)
950-
str(i:i) = c_str(i)
951-
end do
963+
str = to_f_char(c_str_ptr, len)
952964
end function c_get_strerror
953965

954966
!! makes an empty directory
@@ -1064,9 +1076,8 @@ end function stdlib_get_cwd
10641076
end interface
10651077

10661078
type(c_ptr) :: c_str_ptr
1067-
integer(c_size_t) :: len, i
1079+
integer(c_size_t) :: len
10681080
integer :: stat
1069-
character(kind=c_char), pointer :: c_str(:)
10701081

10711082
c_str_ptr = stdlib_get_cwd(len, stat)
10721083

@@ -1075,13 +1086,8 @@ end function stdlib_get_cwd
10751086
call err0%handle(err)
10761087
end if
10771088

1078-
call c_f_pointer(c_str_ptr, c_str, [len])
1079-
1080-
allocate(character(len=len) :: cwd)
1089+
cwd = to_f_char(c_str_ptr, len)
10811090

1082-
do concurrent (i=1:len)
1083-
cwd(i:i) = c_str(i)
1084-
end do
10851091
end subroutine get_cwd
10861092

10871093
subroutine set_cwd(path, err)
@@ -1124,21 +1130,13 @@ end function process_null_device
11241130

11251131
end interface
11261132

1127-
integer(c_size_t) :: i, len
1133+
integer(c_size_t) :: len
11281134
type(c_ptr) :: c_path_ptr
1129-
character(kind=c_char), pointer :: c_path(:)
11301135

11311136
! Call the C function to get the null device path and its length
11321137
c_path_ptr = process_null_device(len)
1133-
call c_f_pointer(c_path_ptr,c_path,[len])
11341138

1135-
! Allocate the Fortran string with the length returned from C
1136-
allocate(character(len=len) :: path)
1137-
1138-
do concurrent (i=1:len)
1139-
path(i:i) = c_path(i)
1140-
end do
1141-
1139+
path = to_f_char(c_path_ptr, len)
11421140
end function null_device
11431141

11441142
!> Delete a file at the given path.

0 commit comments

Comments
(0)

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