handle strings/YAML files > 2Gb (32 bit limit)

This commit is contained in:
Martin Diehl 2023-02-08 08:49:08 +01:00
parent 58c905d318
commit 4e57df9576
1 changed files with 31 additions and 30 deletions

View File

@ -95,33 +95,34 @@ end function YAML_parse_str_asDict
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
recursive function parse_flow(YAML_flow) result(node) recursive function parse_flow(YAML_flow) result(node)
character(len=*), intent(in) :: YAML_flow !< YAML file in flow style character(len=*), intent(in) :: YAML_flow !< YAML file in flow style
class(tNode), pointer :: node class(tNode), pointer :: node
class(tNode), pointer :: & class(tNode), pointer :: &
myVal myVal
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)
@ -129,12 +130,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)
@ -165,21 +166,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