if( polishing
This commit is contained in:
parent
25c5565580
commit
438167804c
|
@ -72,7 +72,7 @@ module YAML_types
|
||||||
getKey => tNode_getKey_byIndex
|
getKey => tNode_getKey_byIndex
|
||||||
procedure :: &
|
procedure :: &
|
||||||
contains => tNode_contains
|
contains => tNode_contains
|
||||||
|
|
||||||
generic :: &
|
generic :: &
|
||||||
get => tNode_get_byIndex, &
|
get => tNode_get_byIndex, &
|
||||||
tNode_get_byKey
|
tNode_get_byKey
|
||||||
|
@ -157,7 +157,7 @@ module YAML_types
|
||||||
emptyDict
|
emptyDict
|
||||||
type(tList), target, public :: &
|
type(tList), target, public :: &
|
||||||
emptyList
|
emptyList
|
||||||
|
|
||||||
abstract interface
|
abstract interface
|
||||||
|
|
||||||
recursive function asFormattedString(self,indent)
|
recursive function asFormattedString(self,indent)
|
||||||
|
@ -179,7 +179,7 @@ module YAML_types
|
||||||
|
|
||||||
public :: &
|
public :: &
|
||||||
YAML_types_init, &
|
YAML_types_init, &
|
||||||
output_asStrings, & !ToDo: Hack for GNU. Remove later
|
output_asStrings, & !ToDo: Hack for GNU. Remove later
|
||||||
assignment(=)
|
assignment(=)
|
||||||
|
|
||||||
contains
|
contains
|
||||||
|
@ -207,11 +207,11 @@ subroutine selfTest
|
||||||
select type(s1)
|
select type(s1)
|
||||||
class is(tScalar)
|
class is(tScalar)
|
||||||
s1 = '1'
|
s1 = '1'
|
||||||
if(s1%asInt() /= 1) error stop 'tScalar_asInt'
|
if (s1%asInt() /= 1) error stop 'tScalar_asInt'
|
||||||
if(dNeq(s1%asFloat(),1.0_pReal)) error stop 'tScalar_asFloat'
|
if (dNeq(s1%asFloat(),1.0_pReal)) error stop 'tScalar_asFloat'
|
||||||
s1 = 'true'
|
s1 = 'true'
|
||||||
if(.not. s1%asBool()) error stop 'tScalar_asBool'
|
if (.not. s1%asBool()) error stop 'tScalar_asBool'
|
||||||
if(s1%asString() /= 'true') error stop 'tScalar_asString'
|
if (s1%asString() /= 'true') error stop 'tScalar_asString'
|
||||||
end select
|
end select
|
||||||
|
|
||||||
block
|
block
|
||||||
|
@ -232,18 +232,18 @@ subroutine selfTest
|
||||||
call l1%append(s1)
|
call l1%append(s1)
|
||||||
call l1%append(s2)
|
call l1%append(s2)
|
||||||
n => l1
|
n => l1
|
||||||
if(any(l1%asInts() /= [2,3])) error stop 'tList_asInts'
|
if (any(l1%asInts() /= [2,3])) error stop 'tList_asInts'
|
||||||
if(any(dNeq(l1%asFloats(),[2.0_pReal,3.0_pReal]))) error stop 'tList_asFloats'
|
if (any(dNeq(l1%asFloats(),[2.0_pReal,3.0_pReal]))) error stop 'tList_asFloats'
|
||||||
if(n%get_asInt(1) /= 2) error stop 'byIndex_asInt'
|
if (n%get_asInt(1) /= 2) error stop 'byIndex_asInt'
|
||||||
if(dNeq(n%get_asFloat(2),3.0_pReal)) error stop 'byIndex_asFloat'
|
if (dNeq(n%get_asFloat(2),3.0_pReal)) error stop 'byIndex_asFloat'
|
||||||
endselect
|
endselect
|
||||||
|
|
||||||
allocate(tList::l2)
|
allocate(tList::l2)
|
||||||
select type(l2)
|
select type(l2)
|
||||||
class is(tList)
|
class is(tList)
|
||||||
call l2%append(l1)
|
call l2%append(l1)
|
||||||
if(any(l2%get_asInts(1) /= [2,3])) error stop 'byIndex_asInts'
|
if (any(l2%get_asInts(1) /= [2,3])) error stop 'byIndex_asInts'
|
||||||
if(any(dNeq(l2%get_asFloats(1),[2.0_pReal,3.0_pReal]))) error stop 'byIndex_asFloats'
|
if (any(dNeq(l2%get_asFloats(1),[2.0_pReal,3.0_pReal]))) error stop 'byIndex_asFloats'
|
||||||
n => l2
|
n => l2
|
||||||
end select
|
end select
|
||||||
deallocate(n)
|
deallocate(n)
|
||||||
|
@ -265,10 +265,10 @@ subroutine selfTest
|
||||||
call l1%append(s2)
|
call l1%append(s2)
|
||||||
n => l1
|
n => l1
|
||||||
|
|
||||||
if(any(l1%asBools() .neqv. [.true., .false.])) error stop 'tList_asBools'
|
if (any(l1%asBools() .neqv. [.true., .false.])) error stop 'tList_asBools'
|
||||||
if(any(l1%asStrings() /= ['true ','False'])) error stop 'tList_asStrings'
|
if (any(l1%asStrings() /= ['true ','False'])) error stop 'tList_asStrings'
|
||||||
if(n%get_asBool(2)) error stop 'byIndex_asBool'
|
if (n%get_asBool(2)) error stop 'byIndex_asBool'
|
||||||
if(n%get_asString(1) /= 'true') error stop 'byIndex_asString'
|
if (n%get_asString(1) /= 'true') error stop 'byIndex_asString'
|
||||||
end block
|
end block
|
||||||
|
|
||||||
end subroutine selfTest
|
end subroutine selfTest
|
||||||
|
@ -418,7 +418,7 @@ function tNode_get_byIndex(self,i) result(node)
|
||||||
integer :: j
|
integer :: j
|
||||||
|
|
||||||
self_ => self%asList()
|
self_ => self%asList()
|
||||||
if(i < 1 .or. i > self_%length) call IO_error(150,ext_msg='tNode_get_byIndex')
|
if (i < 1 .or. i > self_%length) call IO_error(150,ext_msg='tNode_get_byIndex')
|
||||||
|
|
||||||
j = 1
|
j = 1
|
||||||
item => self_%first
|
item => self_%first
|
||||||
|
@ -599,7 +599,7 @@ function tNode_getKey_byIndex(self,i) result(key)
|
||||||
dict => self%asDict()
|
dict => self%asDict()
|
||||||
item => dict%first
|
item => dict%first
|
||||||
do j = 1, dict%length
|
do j = 1, dict%length
|
||||||
if(j == i) then
|
if (j == i) then
|
||||||
key = item%key
|
key = item%key
|
||||||
exit
|
exit
|
||||||
else
|
else
|
||||||
|
@ -613,7 +613,7 @@ end function tNode_getKey_byIndex
|
||||||
!-------------------------------------------------------------------------------------------------
|
!-------------------------------------------------------------------------------------------------
|
||||||
!> @brief Checks if a given key/item is present in the dict/list
|
!> @brief Checks if a given key/item is present in the dict/list
|
||||||
!-------------------------------------------------------------------------------------------------
|
!-------------------------------------------------------------------------------------------------
|
||||||
function tNode_contains(self,k) result(exists)
|
function tNode_contains(self,k) result(exists)
|
||||||
|
|
||||||
class(tNode), intent(in), target :: self
|
class(tNode), intent(in), target :: self
|
||||||
character(len=*), intent(in) :: k
|
character(len=*), intent(in) :: k
|
||||||
|
@ -624,18 +624,18 @@ function tNode_contains(self,k) result(exists)
|
||||||
type(tDict), pointer :: dict
|
type(tDict), pointer :: dict
|
||||||
|
|
||||||
exists = .false.
|
exists = .false.
|
||||||
if(self%isDict()) then
|
if (self%isDict()) then
|
||||||
dict => self%asDict()
|
dict => self%asDict()
|
||||||
do j=1, dict%length
|
do j=1, dict%length
|
||||||
if(dict%getKey(j) == k) then
|
if (dict%getKey(j) == k) then
|
||||||
exists = .true.
|
exists = .true.
|
||||||
return
|
return
|
||||||
endif
|
endif
|
||||||
enddo
|
enddo
|
||||||
elseif(self%isList()) then
|
elseif (self%isList()) then
|
||||||
list => self%asList()
|
list => self%asList()
|
||||||
do j =1, list%length
|
do j=1, list%length
|
||||||
if(list%get_asString(j) == k) then
|
if (list%get_asString(j) == k) then
|
||||||
exists = .true.
|
exists = .true.
|
||||||
return
|
return
|
||||||
endif
|
endif
|
||||||
|
@ -663,8 +663,8 @@ function tNode_get_byKey(self,k,defaultVal) result(node)
|
||||||
logical :: found
|
logical :: found
|
||||||
|
|
||||||
found = present(defaultVal)
|
found = present(defaultVal)
|
||||||
if(found) node => defaultVal
|
if (found) node => defaultVal
|
||||||
|
|
||||||
self_ => self%asDict()
|
self_ => self%asDict()
|
||||||
|
|
||||||
j = 1
|
j = 1
|
||||||
|
@ -677,11 +677,11 @@ function tNode_get_byKey(self,k,defaultVal) result(node)
|
||||||
item => item%next
|
item => item%next
|
||||||
j = j + 1
|
j = j + 1
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
if (.not. found) then
|
if (.not. found) then
|
||||||
call IO_error(143,ext_msg=k)
|
call IO_error(143,ext_msg=k)
|
||||||
else
|
else
|
||||||
if(associated(item)) node => item%node
|
if (associated(item)) node => item%node
|
||||||
endif
|
endif
|
||||||
|
|
||||||
end function tNode_get_byKey
|
end function tNode_get_byKey
|
||||||
|
@ -700,11 +700,11 @@ function tNode_get_byKey_asFloat(self,k,defaultVal) result(nodeAsFloat)
|
||||||
class(tNode), pointer :: node
|
class(tNode), pointer :: node
|
||||||
type(tScalar), pointer :: scalar
|
type(tScalar), pointer :: scalar
|
||||||
|
|
||||||
if(self%contains(k)) then
|
if (self%contains(k)) then
|
||||||
node => self%get(k)
|
node => self%get(k)
|
||||||
scalar => node%asScalar()
|
scalar => node%asScalar()
|
||||||
nodeAsFloat = scalar%asFloat()
|
nodeAsFloat = scalar%asFloat()
|
||||||
elseif(present(defaultVal)) then
|
elseif (present(defaultVal)) then
|
||||||
nodeAsFloat = defaultVal
|
nodeAsFloat = defaultVal
|
||||||
else
|
else
|
||||||
call IO_error(143,ext_msg=k)
|
call IO_error(143,ext_msg=k)
|
||||||
|
@ -726,11 +726,11 @@ function tNode_get_byKey_asInt(self,k,defaultVal) result(nodeAsInt)
|
||||||
class(tNode), pointer :: node
|
class(tNode), pointer :: node
|
||||||
type(tScalar), pointer :: scalar
|
type(tScalar), pointer :: scalar
|
||||||
|
|
||||||
if(self%contains(k)) then
|
if (self%contains(k)) then
|
||||||
node => self%get(k)
|
node => self%get(k)
|
||||||
scalar => node%asScalar()
|
scalar => node%asScalar()
|
||||||
nodeAsInt = scalar%asInt()
|
nodeAsInt = scalar%asInt()
|
||||||
elseif(present(defaultVal)) then
|
elseif (present(defaultVal)) then
|
||||||
nodeAsInt = defaultVal
|
nodeAsInt = defaultVal
|
||||||
else
|
else
|
||||||
call IO_error(143,ext_msg=k)
|
call IO_error(143,ext_msg=k)
|
||||||
|
@ -752,11 +752,11 @@ function tNode_get_byKey_asBool(self,k,defaultVal) result(nodeAsBool)
|
||||||
class(tNode), pointer :: node
|
class(tNode), pointer :: node
|
||||||
type(tScalar), pointer :: scalar
|
type(tScalar), pointer :: scalar
|
||||||
|
|
||||||
if(self%contains(k)) then
|
if (self%contains(k)) then
|
||||||
node => self%get(k)
|
node => self%get(k)
|
||||||
scalar => node%asScalar()
|
scalar => node%asScalar()
|
||||||
nodeAsBool = scalar%asBool()
|
nodeAsBool = scalar%asBool()
|
||||||
elseif(present(defaultVal)) then
|
elseif (present(defaultVal)) then
|
||||||
nodeAsBool = defaultVal
|
nodeAsBool = defaultVal
|
||||||
else
|
else
|
||||||
call IO_error(143,ext_msg=k)
|
call IO_error(143,ext_msg=k)
|
||||||
|
@ -778,11 +778,11 @@ function tNode_get_byKey_asString(self,k,defaultVal) result(nodeAsString)
|
||||||
class(tNode), pointer :: node
|
class(tNode), pointer :: node
|
||||||
type(tScalar), pointer :: scalar
|
type(tScalar), pointer :: scalar
|
||||||
|
|
||||||
if(self%contains(k)) then
|
if (self%contains(k)) then
|
||||||
node => self%get(k)
|
node => self%get(k)
|
||||||
scalar => node%asScalar()
|
scalar => node%asScalar()
|
||||||
nodeAsString = scalar%asString()
|
nodeAsString = scalar%asString()
|
||||||
elseif(present(defaultVal)) then
|
elseif (present(defaultVal)) then
|
||||||
nodeAsString = defaultVal
|
nodeAsString = defaultVal
|
||||||
else
|
else
|
||||||
call IO_error(143,ext_msg=k)
|
call IO_error(143,ext_msg=k)
|
||||||
|
@ -806,18 +806,18 @@ function tNode_get_byKey_asFloats(self,k,defaultVal,requiredSize) result(nodeAsF
|
||||||
class(tNode), pointer :: node
|
class(tNode), pointer :: node
|
||||||
type(tList), pointer :: list
|
type(tList), pointer :: list
|
||||||
|
|
||||||
if(self%contains(k)) then
|
if (self%contains(k)) then
|
||||||
node => self%get(k)
|
node => self%get(k)
|
||||||
list => node%asList()
|
list => node%asList()
|
||||||
nodeAsFloats = list%asFloats()
|
nodeAsFloats = list%asFloats()
|
||||||
elseif(present(defaultVal)) then
|
elseif (present(defaultVal)) then
|
||||||
nodeAsFloats = defaultVal
|
nodeAsFloats = defaultVal
|
||||||
else
|
else
|
||||||
call IO_error(143,ext_msg=k)
|
call IO_error(143,ext_msg=k)
|
||||||
endif
|
endif
|
||||||
|
|
||||||
if(present(requiredSize)) then
|
if (present(requiredSize)) then
|
||||||
if(requiredSize /= size(nodeAsFloats)) call IO_error(146,ext_msg=k)
|
if (requiredSize /= size(nodeAsFloats)) call IO_error(146,ext_msg=k)
|
||||||
endif
|
endif
|
||||||
|
|
||||||
end function tNode_get_byKey_asFloats
|
end function tNode_get_byKey_asFloats
|
||||||
|
@ -837,18 +837,18 @@ function tNode_get_byKey_asInts(self,k,defaultVal,requiredSize) result(nodeAsInt
|
||||||
class(tNode), pointer :: node
|
class(tNode), pointer :: node
|
||||||
type(tList), pointer :: list
|
type(tList), pointer :: list
|
||||||
|
|
||||||
if(self%contains(k)) then
|
if (self%contains(k)) then
|
||||||
node => self%get(k)
|
node => self%get(k)
|
||||||
list => node%asList()
|
list => node%asList()
|
||||||
nodeAsInts = list%asInts()
|
nodeAsInts = list%asInts()
|
||||||
elseif(present(defaultVal)) then
|
elseif (present(defaultVal)) then
|
||||||
nodeAsInts = defaultVal
|
nodeAsInts = defaultVal
|
||||||
else
|
else
|
||||||
call IO_error(143,ext_msg=k)
|
call IO_error(143,ext_msg=k)
|
||||||
endif
|
endif
|
||||||
|
|
||||||
if(present(requiredSize)) then
|
if (present(requiredSize)) then
|
||||||
if(requiredSize /= size(nodeAsInts)) call IO_error(146,ext_msg=k)
|
if (requiredSize /= size(nodeAsInts)) call IO_error(146,ext_msg=k)
|
||||||
endif
|
endif
|
||||||
|
|
||||||
end function tNode_get_byKey_asInts
|
end function tNode_get_byKey_asInts
|
||||||
|
@ -867,11 +867,11 @@ function tNode_get_byKey_asBools(self,k,defaultVal) result(nodeAsBools)
|
||||||
class(tNode), pointer :: node
|
class(tNode), pointer :: node
|
||||||
type(tList), pointer :: list
|
type(tList), pointer :: list
|
||||||
|
|
||||||
if(self%contains(k)) then
|
if (self%contains(k)) then
|
||||||
node => self%get(k)
|
node => self%get(k)
|
||||||
list => node%asList()
|
list => node%asList()
|
||||||
nodeAsBools = list%asBools()
|
nodeAsBools = list%asBools()
|
||||||
elseif(present(defaultVal)) then
|
elseif (present(defaultVal)) then
|
||||||
nodeAsBools = defaultVal
|
nodeAsBools = defaultVal
|
||||||
else
|
else
|
||||||
call IO_error(143,ext_msg=k)
|
call IO_error(143,ext_msg=k)
|
||||||
|
@ -893,11 +893,11 @@ function tNode_get_byKey_asStrings(self,k,defaultVal) result(nodeAsStrings)
|
||||||
class(tNode), pointer :: node
|
class(tNode), pointer :: node
|
||||||
type(tList), pointer :: list
|
type(tList), pointer :: list
|
||||||
|
|
||||||
if(self%contains(k)) then
|
if (self%contains(k)) then
|
||||||
node => self%get(k)
|
node => self%get(k)
|
||||||
list => node%asList()
|
list => node%asList()
|
||||||
nodeAsStrings = list%asStrings()
|
nodeAsStrings = list%asStrings()
|
||||||
elseif(present(defaultVal)) then
|
elseif (present(defaultVal)) then
|
||||||
nodeAsStrings = defaultVal
|
nodeAsStrings = defaultVal
|
||||||
else
|
else
|
||||||
call IO_error(143,ext_msg=k)
|
call IO_error(143,ext_msg=k)
|
||||||
|
@ -925,7 +925,7 @@ function output_asStrings(self) result(output) !ToDo: SR: Rem
|
||||||
|
|
||||||
|
|
||||||
end function output_asStrings
|
end function output_asStrings
|
||||||
|
|
||||||
|
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
!> @brief Returns the index of a key in a dictionary
|
!> @brief Returns the index of a key in a dictionary
|
||||||
|
@ -944,7 +944,7 @@ function tNode_get_byKey_asIndex(self,key) result(keyIndex)
|
||||||
item => dict%first
|
item => dict%first
|
||||||
keyIndex = -1
|
keyIndex = -1
|
||||||
do i = 1, dict%length
|
do i = 1, dict%length
|
||||||
if(key == item%key) then
|
if (key == item%key) then
|
||||||
keyIndex = i
|
keyIndex = i
|
||||||
exit
|
exit
|
||||||
else
|
else
|
||||||
|
@ -952,9 +952,9 @@ function tNode_get_byKey_asIndex(self,key) result(keyIndex)
|
||||||
endif
|
endif
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
if(keyIndex == -1) call IO_error(140,ext_msg=key)
|
if (keyIndex == -1) call IO_error(140,ext_msg=key)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
end function tNode_get_byKey_asIndex
|
end function tNode_get_byKey_asIndex
|
||||||
|
|
||||||
|
|
||||||
|
@ -985,7 +985,7 @@ recursive function tList_asFormattedString(self,indent) result(str)
|
||||||
integer :: i, indent_
|
integer :: i, indent_
|
||||||
|
|
||||||
str = ''
|
str = ''
|
||||||
if(present(indent)) then
|
if (present(indent)) then
|
||||||
indent_ = indent
|
indent_ = indent
|
||||||
else
|
else
|
||||||
indent_ = 0
|
indent_ = 0
|
||||||
|
@ -993,7 +993,7 @@ recursive function tList_asFormattedString(self,indent) result(str)
|
||||||
|
|
||||||
item => self%first
|
item => self%first
|
||||||
do i = 1, self%length
|
do i = 1, self%length
|
||||||
if(i /= 1) str = str//repeat(' ',indent_)
|
if (i /= 1) str = str//repeat(' ',indent_)
|
||||||
str = str//'- '//item%node%asFormattedString(indent_+2)
|
str = str//'- '//item%node%asFormattedString(indent_+2)
|
||||||
item => item%next
|
item => item%next
|
||||||
end do
|
end do
|
||||||
|
@ -1014,7 +1014,7 @@ recursive function tDict_asFormattedString(self,indent) result(str)
|
||||||
integer :: i, indent_
|
integer :: i, indent_
|
||||||
|
|
||||||
str = ''
|
str = ''
|
||||||
if(present(indent)) then
|
if (present(indent)) then
|
||||||
indent_ = indent
|
indent_ = indent
|
||||||
else
|
else
|
||||||
indent_ = 0
|
indent_ = 0
|
||||||
|
@ -1022,7 +1022,7 @@ recursive function tDict_asFormattedString(self,indent) result(str)
|
||||||
|
|
||||||
item => self%first
|
item => self%first
|
||||||
do i = 1, self%length
|
do i = 1, self%length
|
||||||
if(i /= 1) str = str//repeat(' ',indent_)
|
if (i /= 1) str = str//repeat(' ',indent_)
|
||||||
select type(node_1 =>item%node)
|
select type(node_1 =>item%node)
|
||||||
class is(tScalar)
|
class is(tScalar)
|
||||||
str = str//trim(item%key)//': '//item%node%asFormattedString(indent_+len_trim(item%key)+2)
|
str = str//trim(item%key)//': '//item%node%asFormattedString(indent_+len_trim(item%key)+2)
|
||||||
|
@ -1270,7 +1270,7 @@ recursive subroutine tItem_finalize(self)
|
||||||
type(tItem),intent(inout) :: self
|
type(tItem),intent(inout) :: self
|
||||||
|
|
||||||
deallocate(self%node)
|
deallocate(self%node)
|
||||||
if(associated(self%next)) deallocate(self%next)
|
if (associated(self%next)) deallocate(self%next)
|
||||||
|
|
||||||
end subroutine tItem_finalize
|
end subroutine tItem_finalize
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue