if( polishing

This commit is contained in:
Philip Eisenlohr 2021-03-04 15:11:39 -05:00
parent 25c5565580
commit 438167804c
1 changed files with 58 additions and 58 deletions

View File

@ -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
@ -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,7 +663,7 @@ 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()
@ -681,7 +681,7 @@ function tNode_get_byKey(self,k,defaultVal) result(node)
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)
@ -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,7 +952,7 @@ 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