function to change working directory

This commit is contained in:
Martin Diehl 2018-05-25 23:22:32 +02:00
parent 39e2e8a305
commit 87a16b775e
2 changed files with 42 additions and 6 deletions

View File

@ -11,9 +11,9 @@
int isdirectory_c(const char *dir){
struct stat statbuf;
if(stat(dir, &statbuf) != 0)
return 0;
return S_ISDIR(statbuf.st_mode);
if(stat(dir, &statbuf) != 0) /* error */
return 0; /* return "NO, this is not a directory" */
return S_ISDIR(statbuf.st_mode); /* 1 => is directory, 0 => this is NOT a directory */
}
@ -29,7 +29,7 @@ void getcurrentworkdir_c(char cwd[], int *stat ){
}
void gethostname_c(char hostname[], int *stat ){
void gethostname_c(char hostname[], int *stat){
char hostname_tmp[1024];
if(gethostname(hostname_tmp, sizeof(hostname_tmp)) == 0){
strcpy(hostname,hostname_tmp);
@ -39,3 +39,8 @@ void gethostname_c(char hostname[], int *stat ){
*stat = 1;
}
}
int chdir_c(const char *dir){
return chdir(dir);
}

View File

@ -10,11 +10,12 @@ module system_routines
public :: &
isDirectory, &
getCWD, &
getHostName
getHostName, &
setCWD
interface
function isDirectory_C(path) BIND(C)
function isDirectory_C(path) bind(C)
use, intrinsic :: ISO_C_Binding, only: &
C_INT, &
C_CHAR
@ -38,6 +39,14 @@ interface
integer(C_INT),intent(out) :: stat
end subroutine getHostName_C
function chdir_C(path) bind(C)
use, intrinsic :: ISO_C_Binding, only: &
C_INT, &
C_CHAR
integer(C_INT) :: chdir_C
character(kind=C_CHAR), dimension(1024), intent(in) :: path ! C string is an array
end function chdir_C
end interface
@ -123,5 +132,27 @@ logical function getHostName(str)
end function getHostName
!--------------------------------------------------------------------------------------------------
!> @brief changes the current working directory
!--------------------------------------------------------------------------------------------------
logical function setCWD(path)
use, intrinsic :: ISO_C_Binding, only: &
C_INT, &
C_CHAR, &
C_NULL_CHAR
implicit none
character(len=*), intent(in) :: path
character(kind=C_CHAR), dimension(1024) :: strFixedLength ! C string is an array
integer :: i
strFixedLength = repeat(C_NULL_CHAR,len(strFixedLength))
do i=1,len(path) ! copy array components
strFixedLength(i)=path(i:i)
enddo
setCWD=merge(.True.,.False.,chdir_C(strFixedLength) /= 0_C_INT)
end function setCWD
end module system_routines