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
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;
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);
*length_flow = strlen(*flow);
*length_flow = (long) strlen(*flow);
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 :: 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)
call H5Tcopy_f(H5T_C_S1, filetype_id, hdferr)
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'
call H5Tcopy_f(H5T_FORTRAN_S1, memtype_id, hdferr)
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'
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'
call H5Pset_Fletcher32_f(dcpl,hdferr)
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)
if (hdferr < 0) error stop 'HDF5 error'
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))
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
end function IO_read
@ -605,17 +605,17 @@ pure function CRLF2LF(string)
character(len=*), intent(in) :: string
character(len=:), allocatable :: CRLF2LF
integer :: c,n
integer(pI64) :: c,n
allocate(character(len=len_trim(string))::CRLF2LF)
if (len(CRLF2LF) == 0) return
allocate(character(len=len_trim(string,pI64))::CRLF2LF)
if (len(CRLF2LF,pI64) == 0) return
n = 0
do c=1, len_trim(string)
n = 0_pI64
do c=1_pI64, len_trim(string,pI64)
CRLF2LF(c-n:c-n) = string(c:c)
if (c == len_trim(string)) exit
if (string(c:c+1) == CR//LF) n = n + 1
if (c == len_trim(string,pI64)) exit
if (string(c:c+1_pI64) == CR//LF) n = n + 1_pI64
end do
CRLF2LF = CRLF2LF(:c-n)

59
src/YAML_parse.f90
View File

@ -25,11 +25,11 @@ module YAML_parse
interface
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)
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
end subroutine to_flow_C
@ -104,25 +104,26 @@ recursive function parse_flow(YAML_flow) result(node)
character(len=:), allocatable :: &
flow_string, &
key
integer :: &
integer(pI64) :: &
e, & ! end position of dictionary or list
s, & ! start position of dictionary or list
d ! position of key: value separator (':')
flow_string = trim(adjustl(YAML_flow))
if (len_trim(flow_string) == 0) then
if (len_trim(flow_string,pI64) == 0_pI64) then
node => emptyDict
return
elseif (flow_string(1:1) == '{') then ! start of a dictionary
e = 1
e = 1_pI64
allocate(tDict::node)
do while (e < len_trim(flow_string))
do while (e < len_trim(flow_string,pI64))
s = e
d = s + scan(flow_string(s+1:),':')
e = d + find_end(flow_string(d+1:),'}')
key = trim(adjustl(flow_string(s+1:d-1)))
d = s + scan(flow_string(s+1_pI64:),':',kind=pI64)
e = d + find_end(flow_string(d+1_pI64:),'}')
key = trim(adjustl(flow_string(s+1_pI64:d-1_pI64)))
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)
class is (tDict)
@ -130,12 +131,12 @@ recursive function parse_flow(YAML_flow) result(node)
end select
end do
elseif (flow_string(1:1) == '[') then ! start of a list
e = 1
e = 1_pI64
allocate(tList::node)
do while (e < len_trim(flow_string))
do while (e < len_trim(flow_string,pI64))
s = e
e = s + find_end(flow_string(s+1:),']')
myVal => parse_flow(flow_string(s+1:e-1)) ! parse items (recursively)
e = s + find_end(flow_string(s+1_pI64:),']')
myVal => parse_flow(flow_string(s+1_pI64:e-1_pI64)) ! parse items (recursively)
select type (node)
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, 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
i
N_sq = 0
N_cu = 0
i = 1
do while(i<=len_trim(str))
if (scan(str(i:i),IO_QUOTES) == 1) i = i + scan(str(i+1:),str(i:i))
if (N_sq==0 .and. N_cu==0 .and. scan(str(i:i),e_char//',') == 1) exit
N_sq = N_sq + merge(1,0,str(i:i) == '[')
N_cu = N_cu + merge(1,0,str(i:i) == '{')
N_sq = N_sq - merge(1,0,str(i:i) == ']')
N_cu = N_cu - merge(1,0,str(i:i) == '}')
i = i + 1
N_sq = 0_pI64
N_cu = 0_pI64
i = 1_pI64
do while(i<=len_trim(str,pI64))
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//',',kind=pI64) == 1_pI64) exit
N_sq = N_sq + merge(1_pI64,0_pI64,str(i:i) == '[')
N_cu = N_cu + merge(1_pI64,0_pI64,str(i:i) == '{')
N_sq = N_sq - merge(1_pI64,0_pI64,str(i:i) == ']')
N_cu = N_cu - merge(1_pI64,0_pI64,str(i:i) == '}')
i = i + 1_pI64
end do
find_end = i
@ -217,17 +218,17 @@ function to_flow(mixed) result(flow)
character(:,C_CHAR), allocatable :: flow
type(C_PTR) :: str_ptr
integer(C_INT) :: strlen
integer(C_LONG) :: strlen
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)
block
character(len=strlen,kind=c_char), pointer :: s
call c_f_pointer(str_ptr,s)
flow = s(:len(s)-1)
flow = s(:len(s,pI64)-1_pI64)
end block
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(len=:), allocatable :: f_string
integer :: i
integer(pI64) :: i
allocate(character(len=size(c_string))::f_string)
arrayToString: do i=1,len(f_string)
allocate(character(len=size(c_string,kind=pI64))::f_string)
arrayToString: do i=1_pI64,len(f_string,pI64)
if (c_string(i) /= C_NULL_CHAR) then
f_string(i:i)=c_string(i)
else
f_string = f_string(:i-1)
f_string = f_string(:i-1_pI64)
exit
end if
end do arrayToString
@ -204,10 +204,10 @@ end function c_f_string
pure function f_c_string(f_string) result(c_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