Commit 6d2e2459 authored by ulrich_y's avatar ulrich_y

Moved testing tools to special file

parent 9a201a80
......@@ -9,10 +9,8 @@ PROGRAM TEST
use mpl_module
use gpl_module
use chenreftest, only: do_chen_test
use ttools
implicit none
real(kind=prec) :: tol = 8.0e-7
logical :: tests_successful = .true.
integer :: i
character(len=32) :: arg
......@@ -99,41 +97,6 @@ PROGRAM TEST
CONTAINS
subroutine iprint(imsg, typ)
character(len=*) imsg
character(len=100) msg
integer :: typ
character(len=5),parameter :: red = char(27)//'[31m'
character(len=5),parameter :: green = char(27)//'[32m'
character(len=5),parameter :: orange= char(27)//'[33m'
character(len=4),parameter :: norm = char(27)//'[0m'
character ,parameter :: cr = achar(13)
integer, save :: prevlen, prevtype
character(len=100), save :: prevmsg
if (prevtype == -1) then
msg = prevmsg(1:prevlen) // imsg
else
msg = imsg
endif
select case(typ)
case(0)
print*,green //'[PASS]'//norm//' '//trim(msg)
case(1)
print*, red //'[FAIL]'//norm//' '//trim(msg)
case(2)
print*, red //'[FATL]'//norm//' '//trim(msg)
stop 1
case(3)
print*,orange//'[WARN]'//norm//' '//trim(msg)
case(-1)
write(*,'(a)',advance='no')' [ ]'//' '//trim(msg)//cr
end select
prevtype = typ
prevlen = len_trim(msg)
prevmsg = msg
end subroutine
subroutine printhelp
character(len=32) :: arg
......@@ -172,45 +135,6 @@ CONTAINS
end subroutine
function readint(prev,i)
integer i, readint, st
character(len=32) :: arg
character(len=*) :: prev
i=i+1
call get_command_argument(i,arg)
if (len_trim(arg) == 0) call iprint("Argument "//prev//" requires a number",2)
read(arg,*,iostat=st) readint
if (st .ne. 0) call iprint("For argument "//prev//": "//trim(arg)//" is not a number",2)
end function
subroutine check(res, ref)
complex(kind=prec) :: res, ref
real(kind=prec) :: delta
character(len=40) :: msg
delta = abs(res-ref)
if(delta < tol) then
write(msg, 900) delta
call iprint(trim(msg), 0)
else
write(msg, 900) delta
call iprint(trim(msg), 1)
tests_successful = .false.
end if
900 format(" with delta = ",ES10.3)
end subroutine check
subroutine test_one_MPL(m,x,ref, test_id)
integer :: m(:)
complex(kind=prec) :: x(:), ref, res
character(len=*) :: test_id
call iprint(' testing MPL '//test_id//' ...',-1)
res = MPL(m,x)
call check(res,ref)
end subroutine test_one_MPL
subroutine do_MPL_tests()
complex(kind=prec) :: ref
print*, 'doing MPL tests...'
......@@ -231,25 +155,6 @@ CONTAINS
call test_one_MPL((/2, 1/), (/(-0.25_prec,0.),(-2._prec,0.) /), ref, '1.5')
end subroutine do_MPL_tests
subroutine test_one_condensed(m,z,y,k,ref,test_id)
integer :: m(:), k
complex(kind=prec) :: z(:), y, res, ref
character(len=*) :: test_id
call iprint(' testing GPL '//test_id//' ...',-1)
res = G_condensed(m,toinum(z),inum(y,di0),k)
call check(res,ref)
end subroutine test_one_condensed
subroutine test_one_flat(z,ref,test_id)
complex(kind=prec) :: z(:), res, ref
character(len=*) :: test_id
call iprint(' testing GPL '//test_id//' ...',-1)
res = G(z)
call check(res,ref)
end subroutine test_one_flat
subroutine do_GPL_tests()
complex(kind=prec) :: ref, res
real(kind=prec) :: z, xchen
......
MODULE TTOOLS
use globals
use mpl_module
use gpl_module
real(kind=prec) :: tol = 8.0e-7
logical :: tests_successful = .true.
contains
subroutine iprint(imsg, typ)
character(len=*) imsg
character(len=100) msg
integer :: typ
character(len=5),parameter :: red = char(27)//'[31m'
character(len=5),parameter :: green = char(27)//'[32m'
character(len=5),parameter :: orange= char(27)//'[33m'
character(len=4),parameter :: norm = char(27)//'[0m'
character ,parameter :: cr = achar(13)
integer, save :: prevlen, prevtype
character(len=100), save :: prevmsg
if (prevtype == -1) then
msg = prevmsg(1:prevlen) // imsg
else
msg = imsg
endif
select case(typ)
case(0)
print*,green //'[PASS]'//norm//' '//trim(msg)
case(1)
print*, red //'[FAIL]'//norm//' '//trim(msg)
case(2)
print*, red //'[FATL]'//norm//' '//trim(msg)
stop 1
case(3)
print*,orange//'[WARN]'//norm//' '//trim(msg)
case(-1)
write(*,'(a)',advance='no')' [ ]'//' '//trim(msg)//cr
end select
prevtype = typ
prevlen = len_trim(msg)
prevmsg = msg
end subroutine
function readint(prev,i)
integer i, readint, st
character(len=32) :: arg
character(len=*) :: prev
i=i+1
call get_command_argument(i,arg)
if (len_trim(arg) == 0) call iprint("Argument "//prev//" requires a number",2)
read(arg,*,iostat=st) readint
if (st .ne. 0) call iprint("For argument "//prev//": "//trim(arg)//" is not a number",2)
end function
subroutine check(res, ref)
complex(kind=prec) :: res, ref
real(kind=prec) :: delta
character(len=40) :: msg
delta = abs(res-ref)
if(delta < tol) then
write(msg, 900) delta
call iprint(trim(msg), 0)
else
write(msg, 900) delta
call iprint(trim(msg), 1)
tests_successful = .false.
end if
900 format(" with delta = ",ES10.3)
end subroutine check
subroutine test_one_MPL(m,x,ref, test_id)
integer :: m(:)
complex(kind=prec) :: x(:), ref, res
character(len=*) :: test_id
call iprint(' testing MPL '//test_id//' ...',-1)
res = MPL(m,x)
call check(res,ref)
end subroutine test_one_MPL
subroutine test_one_condensed(m,z,y,k,ref,test_id)
integer :: m(:), k
complex(kind=prec) :: z(:), y, res, ref
character(len=*) :: test_id
call iprint(' testing GPL '//test_id//' ...',-1)
res = G_condensed(m,toinum(z),inum(y,di0),k)
call check(res,ref)
end subroutine test_one_condensed
subroutine test_one_flat(z,ref,test_id)
complex(kind=prec) :: z(:), res, ref
character(len=*) :: test_id
call iprint(' testing GPL '//test_id//' ...',-1)
res = G(z)
call check(res,ref)
end subroutine test_one_flat
END MODULE TTOOLS
......@@ -790,6 +790,7 @@ checks/test-muoneNP.f90: checks/generate.m
EOF
echo -n "test: \$(objects) " >> makefile
echo -n "build/tools.o " >> makefile
echo -n "build/test-chenref.o " >> makefile
$HAVE_GINAC && echo -n "build/ginac.o " >> makefile
$HAVE_GINAC && $HAVE_MCC && echo -n "build/test-chen.o " >> makefile
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment