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

Merge branch 'long-YAML-files' into 'development' 

strlen returns 'size_t'

See merge request damask/DAMASK!723
This commit is contained in:
Sharan Roongta 2023-02-22 11:34:24 +00:00
parent 06bd74e43b ca2d184007
commit f7b0ae2041
5 changed files with 57 additions and 56 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
src/C_routines.c
View File

@ -86,7 +86,7 @@ void inflate_c(const uLong *s_deflated, const uLong *s_inflated, const Byte defl
} }
#ifdef FYAML #ifdef FYAML
void to_flow_c(char **flow, int* length_flow, const char *mixed){ void to_flow_c(char **flow, long* length_flow, const char *mixed){
struct fy_document *fyd = NULL; struct fy_document *fyd = NULL;
enum fy_emitter_cfg_flags emit_flags = FYECF_MODE_FLOW_ONELINE | FYECF_STRIP_LABELS | FYECF_STRIP_TAGS |FYECF_STRIP_DOC; enum fy_emitter_cfg_flags emit_flags = FYECF_MODE_FLOW_ONELINE | FYECF_STRIP_LABELS | FYECF_STRIP_TAGS |FYECF_STRIP_DOC;
@ -102,7 +102,7 @@ void to_flow_c(char **flow, int* length_flow, const char *mixed){
} }
*flow = fy_emit_document_to_string(fyd,emit_flags); *flow = fy_emit_document_to_string(fyd,emit_flags);
*length_flow = strlen(*flow); *length_flow = (long) strlen(*flow);
fy_document_destroy(fyd); fy_document_destroy(fyd);
} }

8
src/HDF5_utilities.f90
View File

@ -1441,19 +1441,19 @@ subroutine HDF5_write_str(dataset,loc_id,datasetName)
integer(HID_T) :: filetype_id, memtype_id, space_id, dataset_id, dcpl integer(HID_T) :: filetype_id, memtype_id, space_id, dataset_id, dcpl
integer :: hdferr integer :: hdferr
character(len=len_trim(dataset),kind=C_CHAR), target :: dataset_ character(len=len_trim(dataset,pI64),kind=C_CHAR), target :: dataset_
dataset_ = trim(dataset) dataset_ = trim(dataset)
call H5Tcopy_f(H5T_C_S1, filetype_id, hdferr) call H5Tcopy_f(H5T_C_S1, filetype_id, hdferr)
if (hdferr < 0) error stop 'HDF5 error' if (hdferr < 0) error stop 'HDF5 error'
call H5Tset_size_f(filetype_id, int(len(dataset_)+1,HSIZE_T), hdferr) ! +1 for NULL call H5Tset_size_f(filetype_id, len(dataset_,SIZE_T)+1_SIZE_T, hdferr) ! +1 for NULL
if (hdferr < 0) error stop 'HDF5 error' if (hdferr < 0) error stop 'HDF5 error'
call H5Tcopy_f(H5T_FORTRAN_S1, memtype_id, hdferr) call H5Tcopy_f(H5T_FORTRAN_S1, memtype_id, hdferr)
if (hdferr < 0) error stop 'HDF5 error' if (hdferr < 0) error stop 'HDF5 error'
call H5Tset_size_f(memtype_id, int(len(dataset_),HSIZE_T), hdferr) call H5Tset_size_f(memtype_id, len(dataset_,SIZE_T), hdferr)
if (hdferr < 0) error stop 'HDF5 error' if (hdferr < 0) error stop 'HDF5 error'
call H5Pcreate_f(H5P_DATASET_CREATE_F, dcpl, hdferr) call H5Pcreate_f(H5P_DATASET_CREATE_F, dcpl, hdferr)
@ -1462,7 +1462,7 @@ subroutine HDF5_write_str(dataset,loc_id,datasetName)
if (hdferr < 0) error stop 'HDF5 error' if (hdferr < 0) error stop 'HDF5 error'
call H5Pset_Fletcher32_f(dcpl,hdferr) call H5Pset_Fletcher32_f(dcpl,hdferr)
if (hdferr < 0) error stop 'HDF5 error' if (hdferr < 0) error stop 'HDF5 error'
if (compression_possible .and. len(dataset) > 1024*256) then if (compression_possible .and. len(dataset,pI64) > 1024_pI64*256_pI64) then
call H5Pset_shuffle_f(dcpl, hdferr) call H5Pset_shuffle_f(dcpl, hdferr)
if (hdferr < 0) error stop 'HDF5 error' if (hdferr < 0) error stop 'HDF5 error'
call H5Pset_deflate_f(dcpl, 6, hdferr) call H5Pset_deflate_f(dcpl, 6, hdferr)

16
src/IO.f90
View File

@ -136,7 +136,7 @@ function IO_read(fileName) result(fileContent)
if (myStat /= 0) call IO_error(102,trim(fileName)) if (myStat /= 0) call IO_error(102,trim(fileName))
close(fileUnit) close(fileUnit)
if (scan(fileContent(:index(fileContent,LF)),CR//LF) /= 0) fileContent = CRLF2LF(fileContent) if (index(fileContent,CR//LF,kind=pI64) /= 0) fileContent = CRLF2LF(fileContent)
if (fileContent(fileLength:fileLength) /= IO_EOL) fileContent = fileContent//IO_EOL ! ensure EOL@EOF if (fileContent(fileLength:fileLength) /= IO_EOL) fileContent = fileContent//IO_EOL ! ensure EOL@EOF
end function IO_read end function IO_read
@ -605,17 +605,17 @@ pure function CRLF2LF(string)
character(len=*), intent(in) :: string character(len=*), intent(in) :: string
character(len=:), allocatable :: CRLF2LF character(len=:), allocatable :: CRLF2LF
integer :: c,n integer(pI64) :: c,n
allocate(character(len=len_trim(string))::CRLF2LF) allocate(character(len=len_trim(string,pI64))::CRLF2LF)
if (len(CRLF2LF) == 0) return if (len(CRLF2LF,pI64) == 0) return
n = 0 n = 0_pI64
do c=1, len_trim(string) do c=1_pI64, len_trim(string,pI64)
CRLF2LF(c-n:c-n) = string(c:c) CRLF2LF(c-n:c-n) = string(c:c)
if (c == len_trim(string)) exit if (c == len_trim(string,pI64)) exit
if (string(c:c+1) == CR//LF) n = n + 1 if (string(c:c+1_pI64) == CR//LF) n = n + 1_pI64
end do end do
CRLF2LF = CRLF2LF(:c-n) CRLF2LF = CRLF2LF(:c-n)

59
src/YAML_parse.f90
View File

@ -25,11 +25,11 @@ module YAML_parse
interface interface
subroutine to_flow_C(flow,length_flow,mixed) bind(C) subroutine to_flow_C(flow,length_flow,mixed) bind(C)
use, intrinsic :: ISO_C_Binding, only: C_INT, C_CHAR, C_PTR use, intrinsic :: ISO_C_Binding, only: C_LONG, C_CHAR, C_PTR
implicit none(type,external) implicit none(type,external)
type(C_PTR), intent(out) :: flow type(C_PTR), intent(out) :: flow
integer(C_INT), intent(out) :: length_flow integer(C_LONG), intent(out) :: length_flow
character(kind=C_CHAR), dimension(*), intent(in) :: mixed character(kind=C_CHAR), dimension(*), intent(in) :: mixed
end subroutine to_flow_C end subroutine to_flow_C
@ -104,25 +104,26 @@ recursive function parse_flow(YAML_flow) result(node)
character(len=:), allocatable :: & character(len=:), allocatable :: &
flow_string, & flow_string, &
key key
integer :: & integer(pI64) :: &
e, & ! end position of dictionary or list e, & ! end position of dictionary or list
s, & ! start position of dictionary or list s, & ! start position of dictionary or list
d ! position of key: value separator (':') d ! position of key: value separator (':')
flow_string = trim(adjustl(YAML_flow)) flow_string = trim(adjustl(YAML_flow))
if (len_trim(flow_string) == 0) then if (len_trim(flow_string,pI64) == 0_pI64) then
node => emptyDict node => emptyDict
return return
elseif (flow_string(1:1) == '{') then ! start of a dictionary elseif (flow_string(1:1) == '{') then ! start of a dictionary
e = 1 e = 1_pI64
allocate(tDict::node) allocate(tDict::node)
do while (e < len_trim(flow_string)) do while (e < len_trim(flow_string,pI64))
s = e s = e
d = s + scan(flow_string(s+1:),':') d = s + scan(flow_string(s+1_pI64:),':',kind=pI64)
e = d + find_end(flow_string(d+1:),'}') e = d + find_end(flow_string(d+1_pI64:),'}')
key = trim(adjustl(flow_string(s+1:d-1))) key = trim(adjustl(flow_string(s+1_pI64:d-1_pI64)))
if (quotedString(key)) key = key(2:len(key)-1) if (quotedString(key)) key = key(2:len(key)-1)
myVal => parse_flow(flow_string(d+1:e-1)) ! parse items (recursively) myVal => parse_flow(flow_string(d+1_pI64:e-1_pI64)) ! parse items (recursively)
select type (node) select type (node)
class is (tDict) class is (tDict)
@ -130,12 +131,12 @@ recursive function parse_flow(YAML_flow) result(node)
end select end select
end do end do
elseif (flow_string(1:1) == '[') then ! start of a list elseif (flow_string(1:1) == '[') then ! start of a list
e = 1 e = 1_pI64
allocate(tList::node) allocate(tList::node)
do while (e < len_trim(flow_string)) do while (e < len_trim(flow_string,pI64))
s = e s = e
e = s + find_end(flow_string(s+1:),']') e = s + find_end(flow_string(s+1_pI64:),']')
myVal => parse_flow(flow_string(s+1:e-1)) ! parse items (recursively) myVal => parse_flow(flow_string(s+1_pI64:e-1_pI64)) ! parse items (recursively)
select type (node) select type (node)
class is (tList) class is (tList)
@ -166,21 +167,21 @@ integer function find_end(str,e_char)
character(len=*), intent(in) :: str !< chunk of YAML flow string character(len=*), intent(in) :: str !< chunk of YAML flow string
character, intent(in) :: e_char !< end of list/dict ( '}' or ']') character, intent(in) :: e_char !< end of list/dict ( '}' or ']')
integer :: N_sq, & !< number of open square brackets integer(pI64) :: N_sq, & !< number of open square brackets
N_cu, & !< number of open curly brackets N_cu, & !< number of open curly brackets
i i
N_sq = 0 N_sq = 0_pI64
N_cu = 0 N_cu = 0_pI64
i = 1 i = 1_pI64
do while(i<=len_trim(str)) do while(i<=len_trim(str,pI64))
if (scan(str(i:i),IO_QUOTES) == 1) i = i + scan(str(i+1:),str(i:i)) if (scan(str(i:i),IO_QUOTES,kind=pI64) == 1_pI64) i = i + scan(str(i+1:),str(i:i),kind=pI64)
if (N_sq==0 .and. N_cu==0 .and. scan(str(i:i),e_char//',') == 1) exit if (N_sq==0 .and. N_cu==0 .and. scan(str(i:i),e_char//',',kind=pI64) == 1_pI64) exit
N_sq = N_sq + merge(1,0,str(i:i) == '[') N_sq = N_sq + merge(1_pI64,0_pI64,str(i:i) == '[')
N_cu = N_cu + merge(1,0,str(i:i) == '{') N_cu = N_cu + merge(1_pI64,0_pI64,str(i:i) == '{')
N_sq = N_sq - merge(1,0,str(i:i) == ']') N_sq = N_sq - merge(1_pI64,0_pI64,str(i:i) == ']')
N_cu = N_cu - merge(1,0,str(i:i) == '}') N_cu = N_cu - merge(1_pI64,0_pI64,str(i:i) == '}')
i = i + 1 i = i + 1_pI64
end do end do
find_end = i find_end = i
@ -217,17 +218,17 @@ function to_flow(mixed) result(flow)
character(:,C_CHAR), allocatable :: flow character(:,C_CHAR), allocatable :: flow
type(C_PTR) :: str_ptr type(C_PTR) :: str_ptr
integer(C_INT) :: strlen integer(C_LONG) :: strlen
call to_flow_C(str_ptr,strlen,f_c_string(mixed)) call to_flow_C(str_ptr,strlen,f_c_string(mixed))
if (strlen < 1) call IO_error(703,ext_msg='libyfaml') if (strlen < 1_C_LONG) call IO_error(703,ext_msg='libyfaml')
allocate(character(len=strlen,kind=c_char) :: flow) allocate(character(len=strlen,kind=c_char) :: flow)
block block
character(len=strlen,kind=c_char), pointer :: s character(len=strlen,kind=c_char), pointer :: s
call c_f_pointer(str_ptr,s) call c_f_pointer(str_ptr,s)
flow = s(:len(s)-1) flow = s(:len(s,pI64)-1_pI64)
end block end block
call free_C(str_ptr) call free_C(str_ptr)

12
src/system_routines.f90
View File

@ -181,15 +181,15 @@ pure function c_f_string(c_string) result(f_string)
character(kind=C_CHAR), dimension(:), intent(in) :: c_string character(kind=C_CHAR), dimension(:), intent(in) :: c_string
character(len=:), allocatable :: f_string character(len=:), allocatable :: f_string
integer :: i integer(pI64) :: i
allocate(character(len=size(c_string))::f_string) allocate(character(len=size(c_string,kind=pI64))::f_string)
arrayToString: do i=1,len(f_string) arrayToString: do i=1_pI64,len(f_string,pI64)
if (c_string(i) /= C_NULL_CHAR) then if (c_string(i) /= C_NULL_CHAR) then
f_string(i:i)=c_string(i) f_string(i:i)=c_string(i)
else else
f_string = f_string(:i-1) f_string = f_string(:i-1_pI64)
exit exit
end if end if
end do arrayToString end do arrayToString
@ -204,10 +204,10 @@ end function c_f_string
pure function f_c_string(f_string) result(c_string) pure function f_c_string(f_string) result(c_string)
character(len=*), intent(in) :: f_string character(len=*), intent(in) :: f_string
character(kind=C_CHAR), dimension(len_trim(f_string)+1) :: c_string character(kind=C_CHAR), dimension(len_trim(f_string,pI64)+1_pI64) :: c_string
c_string = transfer(trim(f_string)//C_NULL_CHAR,c_string,size=size(c_string)) c_string = transfer(trim(f_string)//C_NULL_CHAR,c_string,size=size(c_string,kind=pI64))
end function f_c_string end function f_c_string