223031012
/
DAMASK_EICMD
mirror of https://github.com/achalhp/DAMASK_EICMD.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity

Shorter YAML code

This commit is contained in:
Philip Eisenlohr 2022-11-25 07:55:31 +00:00 committed by Franz Roters
parent 3334d0845c
commit af24d47b9a
1 changed files with 39 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

69
src/YAML_types.f90
View File

@ -196,6 +196,7 @@ subroutine selfTest
s1 = '1' s1 = '1'
s2 = '2' s2 = '2'
allocate(l) allocate(l)
if (l%contains('1')) error stop 'empty tList_contains'
call l%append(s1) call l%append(s1)
call l%append(s2) call l%append(s2)
if (any(l%as1dInt() /= [1,2])) error stop 'tList_as1dInt' if (any(l%as1dInt() /= [1,2])) error stop 'tList_as1dInt'
@ -204,7 +205,9 @@ subroutine selfTest
s2 = 'false' s2 = 'false'
if (any(l%as1dBool() .neqv. [.true.,.false.])) error stop 'tList_as1dBool' if (any(l%as1dBool() .neqv. [.true.,.false.])) error stop 'tList_as1dBool'
if (any(l%as1dString() /= ['true ','false'])) error stop 'tList_as1dString' if (any(l%as1dString() /= ['true ','false'])) error stop 'tList_as1dString'
if (l%asFormattedString() /= '[true, false]') error stop 'tScalar_asFormattedString' if (l%asFormattedString() /= '[true, false]') error stop 'tList_asFormattedString'
if ( .not. l%contains('true') &
.or. .not. l%contains('false')) error stop 'tList_contains'
end block list end block list
@ -226,6 +229,8 @@ subroutine selfTest
s3 = '3' s3 = '3'
s4 = '4' s4 = '4'
allocate(d) allocate(d)
if (d%contains('one-two')) error stop 'empty tDict_contains'
if (d%get_asInt('one-two',defaultVal=-1) /= -1) error stop 'empty tDict_get'
call d%set('one-two',l) call d%set('one-two',l)
call d%set('three',s3) call d%set('three',s3)
call d%set('four',s4) call d%set('four',s4)
@ -233,6 +238,13 @@ subroutine selfTest
error stop 'tDict_asFormattedString' error stop 'tDict_asFormattedString'
if (d%get_asInt('three') /= 3) error stop 'tDict_get_asInt' if (d%get_asInt('three') /= 3) error stop 'tDict_get_asInt'
if (any(d%get_as1dInt('one-two') /= [1,2])) error stop 'tDict_get_as1dInt' if (any(d%get_as1dInt('one-two') /= [1,2])) error stop 'tDict_get_as1dInt'
call d%set('one-two',s4)
if (d%asFormattedString() /= '{one-two: 4, three: 3, four: 4}') &
error stop 'tDict_set overwrite'
if ( .not. d%contains('one-two') &
.or. .not. d%contains('three') &
.or. .not. d%contains('four') &
) error stop 'tDict_contains'
end block dict end block dict
@ -407,7 +419,7 @@ recursive function tList_asFormattedString(self) result(str)
str = '[' str = '['
item => self%first item => self%first
do i = 1, self%length -1 do i = 2, self%length
str = str//item%node%asFormattedString()//', ' str = str//item%node%asFormattedString()//', '
item => item%next item => item%next
end do end do
@ -593,15 +605,14 @@ function tList_contains(self,k) result(exists)
type(tScalar), pointer :: scalar type(tScalar), pointer :: scalar
exists = .false.
item => self%first item => self%first
do j = 1, self%length exists = .false.
j = 1
do while (j <= self%length .and. .not. exists)
scalar => item%node%asScalar() scalar => item%node%asScalar()
if (scalar%value == k) then exists = scalar%value == k
exists = .true.
exit
endif
item => item%next item => item%next
j = j + 1
end do end do
end function tList_contains end function tList_contains
@ -620,7 +631,8 @@ function tList_get(self,i) result(node)
integer :: j integer :: j
if (i < 1 .or. i > self%length) call IO_error(150,ext_msg='tList_get @ '//IO_intAsString(i)) if (i < 1 .or. i > self%length) call IO_error(150,ext_msg='tList_get @ '//IO_intAsString(i) &
//' of '//IO_intAsString(self%length) )
item => self%first item => self%first
do j = 2, i do j = 2, i
item => item%next item => item%next
@ -854,7 +866,7 @@ recursive function tDict_asFormattedString(self) result(str)
str = '{' str = '{'
item => self%first item => self%first
do i = 1, self%length -1 do i = 2, self%length
str = str//trim(item%key)//': '//item%node%asFormattedString()//', ' str = str//trim(item%key)//': '//item%node%asFormattedString()//', '
item => item%next item => item%next
end do end do
@ -881,8 +893,7 @@ subroutine tDict_set(self,key,node)
self%length = 1 self%length = 1
else else
item => self%first item => self%first
searchExisting: do while (associated(item%next)) searchExisting: do while (associated(item%next) .and. item%key /= key)
if (item%key == key) exit
item => item%next item => item%next
end do searchExisting end do searchExisting
if (item%key /= key) then if (item%key /= key) then
@ -935,9 +946,10 @@ function tDict_key(self,i) result(key)
type(tItem), pointer :: item type(tItem), pointer :: item
if (i < 1 .or. i > self%length) call IO_error(150,ext_msg='tDict_key @ '//IO_intAsString(i)) if (i < 1 .or. i > self%length) call IO_error(150,ext_msg='tDict_key @ '//IO_intAsString(i) &
//' of '//IO_intAsString(self%length) )
item => self%first item => self%first
do j = 1, i-1 do j = 2, i
item => item%next item => item%next
end do end do
@ -986,11 +998,10 @@ function tDict_contains(self,k) result(exists)
exists = .false. exists = .false.
do j=1, self%length j = 1
if (self%key(j) == k) then do while(j <= self%length .and. .not. exists)
exists = .true. exists = self%key(j) == k
return j = j + 1
end if
end do end do
end function tDict_contains end function tDict_contains
@ -1008,27 +1019,21 @@ function tDict_get(self,k,defaultVal) result(node)
type(tItem), pointer :: item type(tItem), pointer :: item
integer :: j integer :: j
logical :: found
found = present(defaultVal)
if (found) node => defaultVal
j = 1
item => self%first item => self%first
do while(j <= self%length)
do j=1, self%length
if (item%key == k) then if (item%key == k) then
found = .true. node => item%node
exit return
end if end if
item => item%next item => item%next
j = j + 1
end do end do
if (.not. found) then if (present(defaultVal)) then
call IO_error(143,ext_msg=k) node => defaultVal
else else
if (associated(item)) node => item%node call IO_error(143,ext_msg=k)
end if end if
end function tDict_get end function tDict_get