more polishing, getStrings seems still somewhat murky... return lengths of strings are still inconsistent (64 and 65536)
This commit is contained in:
parent
32d481020f
commit
d6d1439f52
|
@ -23,7 +23,7 @@ module linked_list
|
||||||
procedure :: show => show
|
procedure :: show => show
|
||||||
|
|
||||||
procedure :: keyExists => exist
|
procedure :: keyExists => exist
|
||||||
procedure :: countKeys => countKeyAppearances
|
procedure :: countKeys => count
|
||||||
procedure :: getStringsRaw => strings
|
procedure :: getStringsRaw => strings
|
||||||
|
|
||||||
procedure :: getRaw => getRaw
|
procedure :: getRaw => getRaw
|
||||||
|
@ -139,10 +139,10 @@ end function exist
|
||||||
|
|
||||||
|
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
!> @brief prints all elements
|
!> @brief count number of key appearances
|
||||||
!> @details Strings are printed in order of insertion (FIFO)
|
!> @details traverses list and counts each occurrence of specified key
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
integer(pInt) function countKeyAppearances(this,key)
|
integer(pInt) function count(this,key)
|
||||||
use IO, only: &
|
use IO, only: &
|
||||||
IO_stringValue
|
IO_stringValue
|
||||||
|
|
||||||
|
@ -153,17 +153,16 @@ integer(pInt) function countKeyAppearances(this,key)
|
||||||
type(tPartitionedStringList), pointer :: item
|
type(tPartitionedStringList), pointer :: item
|
||||||
integer(pInt) :: i
|
integer(pInt) :: i
|
||||||
|
|
||||||
countKeyAppearances = 0_pInt
|
count = 0_pInt
|
||||||
|
|
||||||
item => this%next
|
item => this%next
|
||||||
do while (associated(item))
|
do while (associated(item))
|
||||||
if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then
|
if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) &
|
||||||
countKeyAppearances = countKeyAppearances + 1_pInt
|
count = count + 1_pInt
|
||||||
endif
|
|
||||||
item => item%next
|
item => item%next
|
||||||
end do
|
end do
|
||||||
|
|
||||||
end function countKeyAppearances
|
end function count
|
||||||
|
|
||||||
|
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
|
@ -191,7 +190,8 @@ function strings(this)
|
||||||
endif GfortranBug86033
|
endif GfortranBug86033
|
||||||
item => item%next
|
item => item%next
|
||||||
end do
|
end do
|
||||||
if (size(strings) < 0_pInt) call IO_error(142_pInt)
|
|
||||||
|
if (size(strings) < 0_pInt) call IO_error(142_pInt) ! better to check for "allocated"?
|
||||||
|
|
||||||
end function strings
|
end function strings
|
||||||
|
|
||||||
|
@ -208,12 +208,13 @@ subroutine getRaw(this,key,string,stringPos)
|
||||||
implicit none
|
implicit none
|
||||||
class(tPartitionedStringList), intent(in) :: this
|
class(tPartitionedStringList), intent(in) :: this
|
||||||
character(len=*), intent(in) :: key
|
character(len=*), intent(in) :: key
|
||||||
integer(pInt), dimension(:), allocatable, intent(out) :: stringPos
|
|
||||||
character(len=*), intent(out) :: string
|
character(len=*), intent(out) :: string
|
||||||
|
integer(pInt), dimension(:), allocatable, intent(out) :: stringPos
|
||||||
type(tPartitionedStringList), pointer :: item
|
type(tPartitionedStringList), pointer :: item
|
||||||
logical :: found
|
logical :: found
|
||||||
|
|
||||||
found = .false.
|
found = .false.
|
||||||
|
|
||||||
item => this%next
|
item => this%next
|
||||||
do while (associated(item) .and. .not. found)
|
do while (associated(item) .and. .not. found)
|
||||||
found = trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)
|
found = trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)
|
||||||
|
@ -223,6 +224,7 @@ subroutine getRaw(this,key,string,stringPos)
|
||||||
endif
|
endif
|
||||||
item => item%next
|
item => item%next
|
||||||
end do
|
end do
|
||||||
|
|
||||||
if (.not. found) call IO_error(140_pInt,ext_msg=key)
|
if (.not. found) call IO_error(140_pInt,ext_msg=key)
|
||||||
|
|
||||||
end subroutine getRaw
|
end subroutine getRaw
|
||||||
|
@ -230,8 +232,8 @@ end subroutine getRaw
|
||||||
|
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
!> @brief gets all strings that matches given key (i.e. first chunk)
|
!> @brief gets all strings that matches given key (i.e. first chunk)
|
||||||
!> @details returns raw strings and start/end positions of chunks in these strings. Will fail if
|
!> @details returns raw strings and start/end positions of chunks in these strings.
|
||||||
! number of positions in strings differs
|
! Will fail if number of positions in strings differs.
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
subroutine getRaws(this,key,string,stringPos)
|
subroutine getRaws(this,key,string,stringPos)
|
||||||
use IO, only: &
|
use IO, only: &
|
||||||
|
@ -241,8 +243,8 @@ subroutine getRaws(this,key,string,stringPos)
|
||||||
implicit none
|
implicit none
|
||||||
class(tPartitionedStringList), intent(in) :: this
|
class(tPartitionedStringList), intent(in) :: this
|
||||||
character(len=*), intent(in) :: key
|
character(len=*), intent(in) :: key
|
||||||
integer(pInt), dimension(:,:), allocatable, intent(out) :: stringPos
|
|
||||||
character(len=65536), dimension(:), allocatable, intent(out) :: string
|
character(len=65536), dimension(:), allocatable, intent(out) :: string
|
||||||
|
integer(pInt), dimension(:,:), allocatable, intent(out) :: stringPos
|
||||||
|
|
||||||
character(len=65536) :: string_tmp
|
character(len=65536) :: string_tmp
|
||||||
integer(pInt) :: posSize
|
integer(pInt) :: posSize
|
||||||
|
@ -296,8 +298,8 @@ real(pReal) function getFloat(this,key,defaultVal)
|
||||||
|
|
||||||
if (present(defaultVal)) getFloat = defaultVal
|
if (present(defaultVal)) getFloat = defaultVal
|
||||||
found = .false.
|
found = .false.
|
||||||
item => this%next
|
|
||||||
|
|
||||||
|
item => this%next
|
||||||
do while (associated(item) .and. .not. found)
|
do while (associated(item) .and. .not. found)
|
||||||
found = trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)
|
found = trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)
|
||||||
if (found) then
|
if (found) then
|
||||||
|
@ -331,8 +333,8 @@ integer(pInt) function getInt(this,key,defaultVal)
|
||||||
|
|
||||||
if (present(defaultVal)) getInt = defaultVal
|
if (present(defaultVal)) getInt = defaultVal
|
||||||
found = .false.
|
found = .false.
|
||||||
item => this%next
|
|
||||||
|
|
||||||
|
item => this%next
|
||||||
do while (associated(item) .and. .not. found)
|
do while (associated(item) .and. .not. found)
|
||||||
found = trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)
|
found = trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)
|
||||||
if (found) then
|
if (found) then
|
||||||
|
@ -362,31 +364,29 @@ character(len=65536) function getString(this,key,defaultVal,raw)
|
||||||
character(len=65536), intent(in), optional :: defaultVal
|
character(len=65536), intent(in), optional :: defaultVal
|
||||||
logical, intent(in), optional :: raw
|
logical, intent(in), optional :: raw
|
||||||
type(tPartitionedStringList), pointer :: item
|
type(tPartitionedStringList), pointer :: item
|
||||||
logical :: split
|
logical :: found, &
|
||||||
logical :: found
|
split
|
||||||
|
|
||||||
found = present(defaultVal)
|
|
||||||
if (present(defaultVal)) getString = defaultVal
|
if (present(defaultVal)) getString = defaultVal
|
||||||
split = merge(raw,.true.,present(raw))
|
split = merge(raw,.true.,present(raw))
|
||||||
item => this%next
|
found = .false.
|
||||||
|
|
||||||
do
|
item => this%next
|
||||||
endOfList: if (.not. associated(item)) then
|
do while (associated(item) .and. .not. found)
|
||||||
if(.not. found) call IO_error(140_pInt,ext_msg=key)
|
found = trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)
|
||||||
exit
|
if (found) then
|
||||||
endif endOfList
|
|
||||||
foundKey: if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then
|
|
||||||
found = .true.
|
|
||||||
if (split) then
|
if (split) then
|
||||||
if (item%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key)
|
if (item%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key)
|
||||||
getString = IO_StringValue(item%string%val,item%string%pos,2)
|
getString = IO_StringValue(item%string%val,item%string%pos,2)
|
||||||
else
|
else
|
||||||
getString = trim(item%string%val(item%string%pos(4):))
|
getString = trim(item%string%val(item%string%pos(4):)) ! raw string starting a second chunk
|
||||||
|
endif
|
||||||
endif
|
endif
|
||||||
endif foundKey
|
|
||||||
item => item%next
|
item => item%next
|
||||||
end do
|
end do
|
||||||
|
|
||||||
|
if (.not. found .and. .not. present(defaultVal)) call IO_error(140_pInt,ext_msg=key)
|
||||||
|
|
||||||
end function getString
|
end function getString
|
||||||
|
|
||||||
|
|
||||||
|
@ -399,23 +399,22 @@ function getStrings(this,key)
|
||||||
|
|
||||||
implicit none
|
implicit none
|
||||||
character(len=64),dimension(:), allocatable :: getStrings
|
character(len=64),dimension(:), allocatable :: getStrings
|
||||||
character(len=64) :: str
|
|
||||||
|
|
||||||
class(tPartitionedStringList), intent(in) :: this
|
class(tPartitionedStringList), intent(in) :: this
|
||||||
character(len=*), intent(in) :: key
|
character(len=*), intent(in) :: key
|
||||||
type(tPartitionedStringList), pointer :: list_tmp
|
type(tPartitionedStringList), pointer :: item
|
||||||
|
character(len=64) :: str
|
||||||
integer(pInt) :: i
|
integer(pInt) :: i
|
||||||
|
|
||||||
|
|
||||||
list_tmp => this%next
|
item => this%next
|
||||||
do
|
do
|
||||||
if (.not. associated(list_tmp)) then
|
if (.not. associated(item)) then
|
||||||
if (.not. allocated(getStrings)) allocate(getStrings(0),source=str)
|
if (.not. allocated(getStrings)) allocate(getStrings(0),source=str)
|
||||||
exit
|
exit
|
||||||
endif
|
endif
|
||||||
if (trim(IO_stringValue(list_tmp%string%val,list_tmp%string%pos,1))==trim(key)) then
|
if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then
|
||||||
if (list_tmp%string%pos(1) < 2) print*, "NOT WORKKING"
|
if (item%string%pos(1) < 2) print*, "NOT WORKING"
|
||||||
str = IO_StringValue(list_tmp%string%val,list_tmp%string%pos,2)
|
str = IO_StringValue(item%string%val,item%string%pos,2)
|
||||||
|
|
||||||
GfortranBug86033: if (.not. allocated(getStrings)) then
|
GfortranBug86033: if (.not. allocated(getStrings)) then
|
||||||
allocate(getStrings(1),source=str)
|
allocate(getStrings(1),source=str)
|
||||||
|
@ -423,7 +422,7 @@ function getStrings(this,key)
|
||||||
getStrings = [getStrings,str]
|
getStrings = [getStrings,str]
|
||||||
endif GfortranBug86033
|
endif GfortranBug86033
|
||||||
endif
|
endif
|
||||||
list_tmp => list_tmp%next
|
item => item%next
|
||||||
end do
|
end do
|
||||||
end function
|
end function
|
||||||
|
|
||||||
|
@ -445,8 +444,8 @@ function getIntArray(this,key,defaultVal)
|
||||||
integer(pInt), dimension(:), intent(in), optional :: defaultVal
|
integer(pInt), dimension(:), intent(in), optional :: defaultVal
|
||||||
type(tPartitionedStringList), pointer :: item
|
type(tPartitionedStringList), pointer :: item
|
||||||
integer(pInt) :: i
|
integer(pInt) :: i
|
||||||
logical :: found
|
logical :: found, &
|
||||||
logical :: cumulative
|
cumulative
|
||||||
|
|
||||||
cumulative = (key(1:1) == '(' .and. key(len_trim(key):len_trim(key)) == ')')
|
cumulative = (key(1:1) == '(' .and. key(len_trim(key):len_trim(key)) == ')')
|
||||||
found = .false.
|
found = .false.
|
||||||
|
|
Loading…
Reference in New Issue