subroutine test_suite_M_list
use M_sort, only : sort_shell
use M_framework__verify, only : unit_test, unit_test_start, unit_test_end
use M_list, only : locate, insert, remove, replace, dictionary
character(len=*),parameter :: share=' -library libGPF -filename `pwd`/M_list.FF -documentation y -ufpp y -ccall n -archive GPF.a'
integer :: place
logical :: matched
! list
call test_locate() ! finds the index where a string is found or should be in a sorted array
call test_insert() ! insert entry into a string array at specified position
call test_remove() ! remove entry from an allocatable array at specified position
call test_replace() ! replace entry in a string array at specified position
! dictionary
call test_dict_set() ! add or replace a key-value pair in a dictionary
call test_dict_delete() ! delete entry by key name from a basic dictionary
call test_dict_get() ! value of key-value pair in a dictionary given key
call test_dict_ifdef() ! return whether name is present in dictionary or not
call test_dict_clr() ! clear basic dictionary
!
contains
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_dict_set
type(dictionary) :: dict
call unit_test_start('dict%set', 'add string into allocatable string array by name',opts=share,matched=matched)
if(.not.matched)return
call dict%set('A','value for a')
call unit_test('dict%set',all(dict%key.eq.[character(len=20) :: 'A']),msg='array should be A')
call dict%set('b','value for b')
call dict%set('c','value for c')
call dict%set('z','value for z')
call unit_test('dict%set',all(dict%key.eq.[character(len=20) :: 'z','c','b','A']),'array should be z c b A')
call dict%set('ZZ','value for ZZ')
call dict%set('NOT','not this one')
call dict%set('ZZZ','value for ZZZ')
call dict%set('Z','value for Z')
call unit_test('dict%set',all(dict%key.eq.[character(len=20) :: 'z','c','b','ZZZ','ZZ','Z','NOT','A']),'strings ok')
call unit_test_end('dict%set')
end subroutine test_dict_set
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_dict_delete
type(dictionary) :: dict
call unit_test_start('dict%del','delete string by name from allocatable string array',opts=share,matched=matched)
if(.not.matched)return
call dict%set('A','some A')
call dict%set('a','some a')
call dict%set('b','some b')
call dict%set('ZZ','some ZZ')
call dict%set('ZZZ','some ZZZ')
call dict%set('ZZ','some ZZ')
call dict%set('Z','some Z')
call dict%set('z','some z')
call dict%set('c','some c')
!write(*,'("built ",a)')dict%key
call dict%del('A')
call dict%del('Z')
call dict%del('X')
call dict%del('ZZZ')
call dict%del('ZZ')
call dict%del('z')
!write(*,'("remaining ",a)')dict%key
call unit_test('dict%del',all(dict%key.eq.[character(len=20) :: 'c','b','a']),'string deletes keys')
!write(*,'("remaining key ",a)')dict%key
!write(*,'("remaining val ",a)')dict%value
call unit_test('dict%del',all(dict%value.eq.[character(len=20) :: 'some c','some b','some a']),'string deletes values')
call unit_test_end('dict%del')
end subroutine test_dict_delete
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_dict_ifdef
type(dictionary) :: tt
logical,allocatable :: answers(:)
call unit_test_start('dict%ifdef','return whether name is present in dictionary or not',opts=share,matched=matched)
if(.not.matched)return
call tt%set('A','value for A')
call tt%set('B','value for B')
call tt%set('C','value for C')
call tt%set('D','value for D')
call tt%set('E','value for E')
call tt%set('F','value for F')
call tt%set('G','value for G')
call tt%del('F')
call tt%del('D')
answers=[tt%ifdef('A'), tt%ifdef('B'), tt%ifdef('C'), tt%ifdef('D'), tt%ifdef('E'), tt%ifdef('F'), tt%ifdef('G'), tt%ifdef('H')]
call unit_test('dict%',all(answers.eqv. [.true., .true., .true., .false., .true., .false., .true., .false.]),'ifdef tests')
call unit_test_end('dict%ifdef')
end subroutine test_dict_ifdef
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_dict_clr
type(dictionary) :: tt
logical,allocatable :: answers(:)
call unit_test_start('dict%ifdef', 'return whether name is present in dictionary or not',opts=share,matched=matched)
if(.not.matched)return
call tt%set('A','value for A')
call tt%set('B','value for B')
call tt%set('C','value for C')
call tt%set('D','value for D')
call tt%set('E','value for E')
call tt%set('F','value for F')
call tt%set('G','value for G')
call tt%del('F')
call tt%del('D')
call tt%clr()
answers=[tt%ifdef('A'), tt%ifdef('B'), tt%ifdef('C'), tt%ifdef('D'), tt%ifdef('E'), tt%ifdef('F'), tt%ifdef('G'), tt%ifdef('H')]
call unit_test('dict%',all(answers.eqv. [.false., .false., .false., .false., .false., .false., .false., .false.]),'clr tests')
call unit_test_end('dict%clr')
end subroutine test_dict_clr
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_dict_get
type(dictionary) :: dict
character(len=20),allocatable :: val(:)
call unit_test_start('dict%get', 'locate and get value by key name from dictionary',opts=share,matched=matched)
if(.not.matched)return
call dict%set('A','some A')
call dict%set('Z','some Z')
call dict%set('X','some X')
val=[dict%get('Z'), dict%get('A'), dict%get('X')]
!write(*,'("remaining ",a)')dict%key
call unit_test('dict%get',all(dict%key.eq.[character(len=20) :: 'Z','X','A']),'string get keys')
call unit_test('dict%get',all(dict%value.eq.[character(len=20) :: 'some Z','some X','some A']),'string get values ')
call unit_test_end('dict%get')
end subroutine test_dict_get
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_locate
character(len=:),allocatable :: lst(:)
lst=[character(len=20) :: '', 'ZZZ', 'aaa', 'b', 'xxx' ]
! make sure sorted in descending order
call sort_shell(lst,order='d')
call unit_test_start('locate', 'locate string in allocatable string array sorted in descending order',opts=share,matched=matched)
if(.not.matched)return
call locate(lst,'ZZZ',place)
call unit_test('locate',place.eq.4,'ZZZ',place,'should be ',4)
call locate(lst,'zqj',place)
call unit_test('locate',place.eq.-1,'zqj',place,'should be ',-1)
call unit_test_end('locate')
end subroutine test_locate
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_insert
implicit none
character(len=:),allocatable :: arr(:)
integer :: place
character(len=:),allocatable :: newkey
integer :: i1,i2
call unit_test_start('insert', 'insert value into allocatable array by index" ',opts=share,matched=matched)
if(.not.matched)return
! make sure sorted in descending order
arr=[character(len=20) :: '', 'ZZZ', 'aaa', 'b', 'xxx' ]
call sort_shell(arr,order='d')
newkey='NEW'
i1=size(arr)
call locate(arr,newkey,place) ! find where string is or should be
call unit_test('insert',place.lt.0,'should not be located',place)
if(place.lt.1)then ! if string was not found insert it
call insert(arr,newkey,abs(place)) ! not found so insert
call locate(arr,newkey,place) ! find where string is or should be
if(place.gt.0)then
call unit_test('insert',arr(place).eq.'NEW',arr(place),'should be "NEW"')
else
call unit_test('insert',.false.,arr(place),'should be positive for "NEW"')
endif
else
call unit_test('insert',place.le.0,'found but should not have been',place)
endif
i2=size(arr)
call unit_test('insert',i1+1.eq.i2,'array now bigger',i1,'to',i2)
call unit_test_end('insert')
end subroutine test_insert
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_remove
use M_sort, only : sort_shell
character(len=:),allocatable :: arr(:)
integer :: place
integer :: isize
call unit_test_start('remove','remove value from allocatable array by index" ',opts=share,matched=matched)
if(.not.matched)return
arr=[character(len=20) :: '', 'ZZZ', 'Z', 'aaa', 'b', 'x', 'ab', 'bb', 'xxx' ]
call sort_shell(arr,order='d') ! make sure sorted in descending order
isize=size(arr)
call locate(arr,'ab',place) ! find where string is or should be
call unit_test('remove',place.gt.0,'found the element to remove',place)
call remove(arr,place)
call locate(arr,'ab',place) ! find where string is or should be
call unit_test('remove',place.lt.0,'did not find the element to remove',place)
call locate(arr,'bb',place) ! find where string is or should be
call remove(arr,place)
call unit_test('remove',isize-2.eq.size(arr),'shrunk by two')
call unit_test_end('remove')
end subroutine test_remove
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_replace
use M_sort, only : sort_shell
character(len=:),allocatable :: arr(:)
integer :: place1
integer :: isize
call unit_test_start('replace','replace value from allocatable array by index" ',opts=share,matched=matched)
if(.not.matched)return
arr=[character(len=20) :: '', 'ZZZ', 'Z', 'aaa', 'b', 'x', 'ab', 'bb', 'xxx' ]
call sort_shell(arr,order='d') ! make sure sorted in descending order
isize=size(arr)
call locate(arr,'ab',place1) ! find where string is or should be
call unit_test('replace',place1.gt.0,'location=',place1)
call replace(arr,'new value for ab',place1)
! add 0+ to avoid gfortran-11 bug
call unit_test('replace',size(arr).eq.isize,'no change in size',0+size(arr))
if(place1.gt.0.and.place1.le.isize)then
call unit_test('replace',arr(place1).eq.'new value for ab',arr(place1))
else
call unit_test('replace',.false.,'bad location',place1)
endif
call unit_test_end('replace')
end subroutine test_replace
!===================================================================================================================================
end subroutine test_suite_M_list