223031012
/
DAMASK_EICMD
mirror of https://github.com/achalhp/DAMASK_EICMD.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity

maximum path length is 4096

This commit is contained in:
Martin Diehl 2020-01-26 12:19:36 +01:00
parent 9c7f6811a2
commit fe22b84d5c
2 changed files with 35 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
src/C_routines.c
View File

@ -20,7 +20,7 @@ int isdirectory_c(const char *dir){
void getcurrentworkdir_c(char cwd[], int *stat ){ void getcurrentworkdir_c(char cwd[], int *stat ){
char cwd_tmp[1024]; char cwd_tmp[4096];
if(getcwd(cwd_tmp, sizeof(cwd_tmp)) == cwd_tmp){ if(getcwd(cwd_tmp, sizeof(cwd_tmp)) == cwd_tmp){
strcpy(cwd,cwd_tmp); strcpy(cwd,cwd_tmp);
*stat = 0; *stat = 0;
@ -32,7 +32,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]; char hostname_tmp[4096];
if(gethostname(hostname_tmp, sizeof(hostname_tmp)) == 0){ if(gethostname(hostname_tmp, sizeof(hostname_tmp)) == 0){
strcpy(hostname,hostname_tmp); strcpy(hostname,hostname_tmp);
*stat = 0; *stat = 0;

43
src/system_routines.f90
View File

@ -5,6 +5,8 @@
module system_routines module system_routines
use, intrinsic :: ISO_C_Binding use, intrinsic :: ISO_C_Binding
use prec
implicit none implicit none
public :: & public :: &
@ -22,49 +24,64 @@ module system_routines
use, intrinsic :: ISO_C_Binding, only: & use, intrinsic :: ISO_C_Binding, only: &
C_INT, & C_INT, &
C_CHAR C_CHAR
use prec
integer(C_INT) :: isDirectory_C integer(C_INT) :: isDirectory_C
character(kind=C_CHAR), dimension(1024), intent(in) :: path ! C string is an array character(kind=C_CHAR), dimension(pPathLen), intent(in) :: path ! C string is an array
end function isDirectory_C end function isDirectory_C
subroutine getCurrentWorkDir_C(str, stat) bind(C) subroutine getCurrentWorkDir_C(path, stat) bind(C)
use, intrinsic :: ISO_C_Binding, only: & use, intrinsic :: ISO_C_Binding, only: &
C_INT, & C_INT, &
C_CHAR C_CHAR
character(kind=C_CHAR), dimension(1024), intent(out) :: str ! C string is an array
integer(C_INT),intent(out) :: stat use prec
character(kind=C_CHAR), dimension(pPathLen), intent(out) :: path ! C string is an array
integer(C_INT), intent(out) :: stat
end subroutine getCurrentWorkDir_C end subroutine getCurrentWorkDir_C
subroutine getHostName_C(str, stat) bind(C) subroutine getHostName_C(str, stat) bind(C)
use, intrinsic :: ISO_C_Binding, only: & use, intrinsic :: ISO_C_Binding, only: &
C_INT, & C_INT, &
C_CHAR C_CHAR
character(kind=C_CHAR), dimension(1024), intent(out) :: str ! C string is an array
integer(C_INT),intent(out) :: stat use prec
character(kind=C_CHAR), dimension(pStringLen), intent(out) :: str ! C string is an array
integer(C_INT), intent(out) :: stat
end subroutine getHostName_C end subroutine getHostName_C
function chdir_C(path) bind(C) function chdir_C(path) bind(C)
use, intrinsic :: ISO_C_Binding, only: & use, intrinsic :: ISO_C_Binding, only: &
C_INT, & C_INT, &
C_CHAR C_CHAR
use prec
integer(C_INT) :: chdir_C integer(C_INT) :: chdir_C
character(kind=C_CHAR), dimension(1024), intent(in) :: path ! C string is an array character(kind=C_CHAR), dimension(pPathLen), intent(in) :: path ! C string is an array
end function chdir_C end function chdir_C
subroutine signalterm_C(handler) bind(C) subroutine signalterm_C(handler) bind(C)
use, intrinsic :: ISO_C_Binding, only: & use, intrinsic :: ISO_C_Binding, only: &
C_FUNPTR C_FUNPTR
type(C_FUNPTR), intent(in), value :: handler type(C_FUNPTR), intent(in), value :: handler
end subroutine signalterm_C end subroutine signalterm_C
subroutine signalusr1_C(handler) bind(C) subroutine signalusr1_C(handler) bind(C)
use, intrinsic :: ISO_C_Binding, only: & use, intrinsic :: ISO_C_Binding, only: &
C_FUNPTR C_FUNPTR
type(C_FUNPTR), intent(in), value :: handler type(C_FUNPTR), intent(in), value :: handler
end subroutine signalusr1_C end subroutine signalusr1_C
subroutine signalusr2_C(handler) bind(C) subroutine signalusr2_C(handler) bind(C)
use, intrinsic :: ISO_C_Binding, only: & use, intrinsic :: ISO_C_Binding, only: &
C_FUNPTR C_FUNPTR
type(C_FUNPTR), intent(in), value :: handler type(C_FUNPTR), intent(in), value :: handler
end subroutine signalusr2_C end subroutine signalusr2_C
@ -78,7 +95,7 @@ contains
logical function isDirectory(path) logical function isDirectory(path)
character(len=*), intent(in) :: path character(len=*), intent(in) :: path
character(kind=C_CHAR), dimension(1024) :: strFixedLength ! C string as array character(kind=C_CHAR), dimension(pPathLen) :: strFixedLength ! C string as array
integer :: i integer :: i
strFixedLength = repeat(C_NULL_CHAR,len(strFixedLength)) strFixedLength = repeat(C_NULL_CHAR,len(strFixedLength))
@ -95,7 +112,7 @@ end function isDirectory
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function getCWD() function getCWD()
character(kind=C_CHAR), dimension(1024) :: charArray ! C string is an array character(kind=C_CHAR), dimension(pPathLen) :: charArray ! C string is an array
character(len=:), allocatable :: getCWD character(len=:), allocatable :: getCWD
integer(C_INT) :: stat integer(C_INT) :: stat
integer :: i integer :: i
@ -105,7 +122,7 @@ function getCWD()
if (stat /= 0_C_INT) then if (stat /= 0_C_INT) then
getCWD = 'Error occured when getting currend working directory' getCWD = 'Error occured when getting currend working directory'
else else
allocate(character(len=1024)::getCWD) allocate(character(len=pPathLen)::getCWD)
arrayToString: do i=1,len(getCWD) arrayToString: do i=1,len(getCWD)
if (charArray(i) /= C_NULL_CHAR) then if (charArray(i) /= C_NULL_CHAR) then
getCWD(i:i)=charArray(i) getCWD(i:i)=charArray(i)
@ -124,7 +141,7 @@ end function getCWD
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function getHostName() function getHostName()
character(kind=C_CHAR), dimension(1024) :: charArray ! C string is an array character(kind=C_CHAR), dimension(pPathLen) :: charArray ! C string is an array
character(len=:), allocatable :: getHostName character(len=:), allocatable :: getHostName
integer(C_INT) :: stat integer(C_INT) :: stat
integer :: i integer :: i
@ -134,7 +151,7 @@ function getHostName()
if (stat /= 0_C_INT) then if (stat /= 0_C_INT) then
getHostName = 'Error occured when getting host name' getHostName = 'Error occured when getting host name'
else else
allocate(character(len=1024)::getHostName) allocate(character(len=pPathLen)::getHostName)
arrayToString: do i=1,len(getHostName) arrayToString: do i=1,len(getHostName)
if (charArray(i) /= C_NULL_CHAR) then if (charArray(i) /= C_NULL_CHAR) then
getHostName(i:i)=charArray(i) getHostName(i:i)=charArray(i)
@ -154,7 +171,7 @@ end function getHostName
logical function setCWD(path) logical function setCWD(path)
character(len=*), intent(in) :: path character(len=*), intent(in) :: path
character(kind=C_CHAR), dimension(1024) :: strFixedLength ! C string is an array character(kind=C_CHAR), dimension(pPathLen) :: strFixedLength ! C string is an array
integer :: i integer :: i
strFixedLength = repeat(C_NULL_CHAR,len(strFixedLength)) strFixedLength = repeat(C_NULL_CHAR,len(strFixedLength))