Improve tests for associative map
Added implicit none to submodule
This commit is contained in:
parent
00a0721f04
commit
a64be9a3a5
3 changed files with 47 additions and 9 deletions
16
src/amap.f90
16
src/amap.f90
|
@ -24,6 +24,8 @@ module amap
|
||||||
generic, public :: write(formatted) => write_value_t
|
generic, public :: write(formatted) => write_value_t
|
||||||
procedure, private :: set_to_value_t
|
procedure, private :: set_to_value_t
|
||||||
generic, public :: assignment(=) => set_to_value_t
|
generic, public :: assignment(=) => set_to_value_t
|
||||||
|
procedure, private :: equals_value_t
|
||||||
|
generic, public :: operator(==) => equals_value_t
|
||||||
end type value_t
|
end type value_t
|
||||||
|
|
||||||
! Map elements are (key,value) pairs
|
! Map elements are (key,value) pairs
|
||||||
|
@ -45,6 +47,7 @@ module amap
|
||||||
procedure, public :: find => find_amap_t
|
procedure, public :: find => find_amap_t
|
||||||
procedure, public :: print => print_amap_t
|
procedure, public :: print => print_amap_t
|
||||||
procedure, public :: clear => clear_amap_t
|
procedure, public :: clear => clear_amap_t
|
||||||
|
procedure, public :: size => size_amap_t
|
||||||
procedure, private :: is_key_kt
|
procedure, private :: is_key_kt
|
||||||
procedure, private :: is_key_kvt
|
procedure, private :: is_key_kvt
|
||||||
generic, public :: contains => is_key_kt, is_key_kvt
|
generic, public :: contains => is_key_kt, is_key_kvt
|
||||||
|
@ -52,6 +55,12 @@ module amap
|
||||||
|
|
||||||
contains
|
contains
|
||||||
|
|
||||||
|
function size_amap_t(this) result(r)
|
||||||
|
class(amap_t), intent(in) :: this
|
||||||
|
integer :: r
|
||||||
|
r = this%high_water
|
||||||
|
end function size_amap_t
|
||||||
|
|
||||||
subroutine clear_amap_t(this)
|
subroutine clear_amap_t(this)
|
||||||
class(amap_t), intent(inout) :: this
|
class(amap_t), intent(inout) :: this
|
||||||
if (allocated(this%pairs)) then
|
if (allocated(this%pairs)) then
|
||||||
|
@ -169,6 +178,13 @@ contains
|
||||||
r = trim(adjustl(this%k)) == trim(adjustl(k%k))
|
r = trim(adjustl(this%k)) == trim(adjustl(k%k))
|
||||||
end function equals_key_t
|
end function equals_key_t
|
||||||
|
|
||||||
|
function equals_value_t(this, v) result(r)
|
||||||
|
class(value_t), intent(in) :: this
|
||||||
|
real(8), intent(in) :: v
|
||||||
|
logical :: r
|
||||||
|
r = this%v == v
|
||||||
|
end function equals_value_t
|
||||||
|
|
||||||
subroutine write_key_t(key, unit, iotype, v_list, iostat, iomsg)
|
subroutine write_key_t(key, unit, iotype, v_list, iostat, iomsg)
|
||||||
class(key_t), intent(in) :: key
|
class(key_t), intent(in) :: key
|
||||||
integer, intent(in) :: unit
|
integer, intent(in) :: unit
|
||||||
|
|
|
@ -1,5 +1,6 @@
|
||||||
! Implementation code for stack
|
! Implementation code for stack
|
||||||
submodule (rpn_stack) stack_sm
|
submodule (rpn_stack) stack_sm
|
||||||
|
use iso_fortran_env, only: output_unit
|
||||||
implicit none
|
implicit none
|
||||||
|
|
||||||
contains
|
contains
|
||||||
|
@ -22,8 +23,8 @@ contains
|
||||||
integer :: i, j
|
integer :: i, j
|
||||||
if (ve_mode) then
|
if (ve_mode) then
|
||||||
do i=stk%high_water,1,-1
|
do i=stk%high_water,1,-1
|
||||||
write(6,fmt='(a)',advance='no') stk%legend(i)//' '
|
write(output_unit,fmt='(a)',advance='no') stk%legend(i)//' '
|
||||||
write(6,'(dt)') stk%sdata(i)
|
write(output_unit,'(dt)') stk%sdata(i)
|
||||||
end do
|
end do
|
||||||
else
|
else
|
||||||
write(6,fmt='(dt)') stk%sdata(1)
|
write(6,fmt='(dt)') stk%sdata(1)
|
||||||
|
@ -141,6 +142,9 @@ end submodule stack_sm
|
||||||
|
|
||||||
! Implementation code for rpn_t
|
! Implementation code for rpn_t
|
||||||
submodule (rpn_stack) rpn_sm
|
submodule (rpn_stack) rpn_sm
|
||||||
|
use iso_fortran_env, only: output_unit
|
||||||
|
implicit none
|
||||||
|
|
||||||
contains
|
contains
|
||||||
|
|
||||||
module subroutine write_rpns(se, unit, iotype, v_list, iostat, iomsg)
|
module subroutine write_rpns(se, unit, iotype, v_list, iostat, iomsg)
|
||||||
|
@ -159,13 +163,13 @@ contains
|
||||||
call to_string(z%re,str_re)
|
call to_string(z%re,str_re)
|
||||||
call to_string(z%im,str_im)
|
call to_string(z%im,str_im)
|
||||||
if (se%is_cartesian()) then
|
if (se%is_cartesian()) then
|
||||||
write(6,'(a)') '('//str_re//','//str_im//')'
|
write(output_unit,'(a)') '('//str_re//','//str_im//')'
|
||||||
else
|
else
|
||||||
write(6,'(a)') '('//str_re//','//str_im//') p'
|
write(output_unit,'(a)') '('//str_re//','//str_im//') p'
|
||||||
end if
|
end if
|
||||||
else
|
else
|
||||||
call to_string(z%re,str_re)
|
call to_string(z%re,str_re)
|
||||||
write(6,'(a)') str_re
|
write(output_unit,'(a)') str_re
|
||||||
end if
|
end if
|
||||||
|
|
||||||
end subroutine write_rpns
|
end subroutine write_rpns
|
||||||
|
|
|
@ -1,18 +1,36 @@
|
||||||
program test_amap
|
program test_amap
|
||||||
use amap
|
use amap
|
||||||
|
use iso_fortran_env, only: output_unit
|
||||||
implicit none
|
implicit none
|
||||||
|
|
||||||
type(amap_t) :: my_amap
|
type(amap_t) :: my_amap
|
||||||
type(value_t) :: x
|
type(value_t) :: x
|
||||||
|
|
||||||
|
write(output_unit,fmt='(a)',advance='no') 'checking set ... '
|
||||||
call my_amap%set('one',1.0d0)
|
call my_amap%set('one',1.0d0)
|
||||||
call my_amap%set('two',2.d0)
|
call my_amap%set('two',2.d0)
|
||||||
call my_amap%set('three',3.0d0)
|
call my_amap%set('three',3.0d0)
|
||||||
|
call my_amap%set('four',7.0d0)
|
||||||
call my_amap%set('four',4.0d0)
|
call my_amap%set('four',4.0d0)
|
||||||
call my_amap%set('five',5.0d0)
|
call my_amap%set('five',5.0d0)
|
||||||
call my_amap%print
|
if (my_amap%size() == 5) then
|
||||||
|
write(output_unit,'(a)') 'passed'
|
||||||
|
else
|
||||||
|
write(output_unit,'(a)') 'FAILED'
|
||||||
|
end if
|
||||||
|
|
||||||
|
write(output_unit,fmt='(a)',advance='no') 'checking existence ... '
|
||||||
|
if (my_amap%contains('one') .and. .not. my_amap%contains('ten')) then
|
||||||
|
write(output_unit,'(a)') 'passed'
|
||||||
|
else
|
||||||
|
write(output_unit,'(a)') 'FAILED'
|
||||||
|
end if
|
||||||
|
|
||||||
|
write(output_unit,fmt='(a)',advance='no') 'checking data ... '
|
||||||
|
if (my_amap%get('four') == 4.0d0) then
|
||||||
|
write(output_unit,'(a)') 'passed'
|
||||||
|
else
|
||||||
|
write(output_unit,'(a)') 'FAILED'
|
||||||
|
end if
|
||||||
|
|
||||||
x = my_amap%get('four')
|
|
||||||
write(6,'(f0.6)') my_amap%get_value('four')
|
|
||||||
print *,my_amap%contains('one'),my_amap%contains('ten')
|
|
||||||
end program test_amap
|
end program test_amap
|
||||||
|
|
Loading…
Reference in a new issue