Commit 9a201a80 authored by ulrich_y's avatar ulrich_y

Used iprint more often

parent eac15ea1
......@@ -28,7 +28,7 @@ PROGRAM TEST
#ifdef DEBUG
verb = readint(trim(arg),i)
#else
call errprint("Argument -verb is not available, compile with --debug")
call iprint("Argument -verb is not available, compile with --debug", 2)
#endif
case('-mpl-test')
tol = zero * 1.e5_prec
......@@ -51,7 +51,7 @@ PROGRAM TEST
call do_high_weight_tests
#else
case('-ginac-tests', '-speed-tests', '-hw-tests')
call errprint("Argument "//trim(arg)//" is not available, compile with --with-ginac --with-mcc")
call iprint("Argument "//trim(arg)//" is not available, compile with --with-ginac --with-mcc", 2)
#endif
#ifdef HAVE_GINAC
......@@ -60,7 +60,7 @@ PROGRAM TEST
call do_long_test
#else
case('-long-test')
call errprint("Argument "//trim(arg)//" is not available, compile with --with-ginac")
call iprint("Argument "//trim(arg)//" is not available, compile with --with-ginac", 2)
#endif
#ifdef DEBUG
case('-report')
......@@ -73,12 +73,16 @@ PROGRAM TEST
#if defined(HAVE_GINAC) && defined(HAVE_MM)
call do_ginac_tests
#endif
#else
case('-report')
call iprint("Argument -report is not available, compile with --debug", 2)
#endif
case('--help','--h','-h','-help')
call printhelp
stop 0
case default
call errprint("Unknown argument "//trim(arg)//". Try -h to get help")
call iprint("Unknown argument "//trim(arg)//". Try -h to get help",2)
end select
i = i+1
......@@ -88,18 +92,47 @@ PROGRAM TEST
if(tests_successful) then
print*, 'All tests passed. '
call iprint('All tests passed. ', 0)
else
call errprint('Some tests failed. ')
call iprint('Some tests failed. ',2)
end if
stop
CONTAINS
subroutine errprint(msg)
character(len=*) msg
write(0,*) "Error:", msg
stop 1
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
......@@ -145,22 +178,27 @@ CONTAINS
character(len=*) :: prev
i=i+1
call get_command_argument(i,arg)
if (len_trim(arg) == 0) call errprint("Argument "//prev//" requires a number")
if (len_trim(arg) == 0) call iprint("Argument "//prev//" requires a number",2)
read(arg,*,iostat=st) readint
if (st .ne. 0) call errprint("For argument "//prev//": "//trim(arg)//" is not a number")
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
print*, ' ',' passed with delta = ', delta
write(msg, 900) delta
call iprint(trim(msg), 0)
else
print*, ' ',' FAILED with delta = ', delta
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)
......@@ -168,7 +206,7 @@ CONTAINS
complex(kind=prec) :: x(:), ref, res
character(len=*) :: test_id
print*, ' ', 'testing MPL ', test_id, ' ...'
call iprint(' testing MPL '//test_id//' ...',-1)
res = MPL(m,x)
call check(res,ref)
end subroutine test_one_MPL
......@@ -198,7 +236,7 @@ CONTAINS
complex(kind=prec) :: z(:), y, res, ref
character(len=*) :: test_id
print*, ' ', 'testing GPL ', 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
......@@ -207,7 +245,7 @@ CONTAINS
complex(kind=prec) :: z(:), res, ref
character(len=*) :: test_id
print*, ' ', 'testing GPL ', test_id, ' ...'
call iprint(' testing GPL '//test_id//' ...',-1)
res = G(z)
call check(res,ref)
end subroutine test_one_flat
......@@ -310,126 +348,126 @@ CONTAINS
call test_one_flat([(0._prec,0._prec), (0.3_prec, 0.5_prec)],ref,'E.2')
ref = (3.79489584700899518570534417045601144619E-5_prec,0.)
print*, ' ', 'testing GPL ', 'E.3', ' ...'
call iprint(' testing GPL E.3 ...',-1)
res = G((/100._prec, 100._prec, 1._prec, 0._prec, 1._prec/))
call check(res,ref)
print*, ' ', 'testing GPL ', 'E.4', ' ...'
call iprint(' testing GPL E.4 ...',-1)
res = G((/100,100,1,0,1/))
call check(res,ref)
print*, ' ', 'testing GPL ', 'E.5', ' ...'
call iprint(' testing GPL E.5 ...',-1)
res = G_superflatn(toinum((/100,100,1,0,1/)), 5)
call check(res,ref)
print*, ' ', 'testing GPL ', 'E.6', ' ...'
call iprint(' testing GPL E.6 ...',-1)
res = G((/100._prec,100._prec,1._prec,0._prec/), 1._prec)
call check(res,ref)
print*, ' ', 'testing GPL ', 'E.7', ' ...'
call iprint(' testing GPL E.7 ...',-1)
res = G((/(100._prec,0.),(100._prec,0.),(1._prec,0.),(0._prec,0.)/), (1._prec,0.))
call check(res,ref)
print*, ' ', 'testing GPL ', 'E.8', ' ...'
call iprint(' testing GPL E.8 ...',-1)
res = G( (/1,1,1,1/) , (/ 100._prec, 100._prec, 1._prec, 0._prec /), 1._prec)
call check(res,ref)
!ref = cmplx(0.01592795952537145)
ref = (0.0485035531168477720320998551314479928648_prec,-2.82326885118931135859594797186107474877_prec)
print*, ' ', 'testing GPL ', 'E.9', ' ...'
call iprint(' testing GPL E.9 ...',-1)
res = G( (/ 3, 2 /), toinum((/ 1.3_prec, 1.1_prec /)), toinum(4._prec) )
call check(res,ref)
print*, ' ', 'testing GPL ', 'E.10', ' ...'
call iprint(' testing GPL E.10 ...',-1)
res = G( (/ 3, 2 /), (/ 1.3_prec, 1.1_prec /), 4._prec )
call check(res,ref)
print*, ' ', 'testing GPL ', 'E.11', ' ...'
call iprint(' testing GPL E.11 ...',-1)
res = G( (/ 3, 2 /), (/ (1.3_prec,0.), (1.1_prec,0.) /), (4._prec,0.) )
call check(res,ref)
print*, ' ', 'testing GPL ', 'E.12', ' ...'
call iprint(' testing GPL E.12 ...',-1)
ref = (0.107961231635965271810236308594279564021882373573100109007684973130605145011141_prec, 0.)
res = G((/ 0._prec, 1.3_prec, 0._prec, 0._prec, 4._prec, 1.1_prec /))
call check(res,ref)
print*, ' ', 'testing GPL ', 'E.13', ' ...'
call iprint(' testing GPL E.13 ...',-1)
ref = (-1.229846637025798984989235266565630713100_prec,-1.05705870670612913651142424798975000765_prec)
res = G([inum(2._prec, +1), inum(7._prec, +1)], inum(5._prec, +1))
call check(res,ref)
print*, ' ', 'testing GPL ', 'E.14', ' ...'
call iprint(' testing GPL E.14 ...',-1)
ref = (-1.229846637025798984989235266565630713100_prec,+1.05705870670612913651142424798975000765_prec)
res = G([inum(2._prec, -1), inum(7._prec, +1)], inum(5._prec, +1))
call check(res,ref)
print*, ' ', 'testing GPL ', 'E.15', ' ...'
call iprint(' testing GPL E.15 ...',-1)
ref = (0.2982254208688088675254638762780704094718_prec,0.)
res = G([inum(2._prec, -1), inum(7._prec, +1)], inum(-5._prec, -1))
call check(res,ref)
print*, ' ', 'testing GPL ', 'E.17', ' ...'
call iprint(' testing GPL E.17 ...',-1)
ref = (0.190800137777535619036913153766083992418_prec, 0.)
res = G((/ 6, 1, 1 /))
call check(res,ref)
print*, ' ', 'testing GPL ', 'E.18', ' ...'
call iprint(' testing GPL E.18 ...',-1)
ref = (0.058192342415778512650117048874978455691_prec, 0.)
res = G((/ 6, 1, -1 /))
call check(res,ref)
ref = cmplx(log(0.5_prec), pi,kind=prec)
print*, ' ', 'testing GPL ', 'E.19a', ' ...'
call iprint(' testing GPL E.19a ...',-1)
res = G((/ inum(2._prec, +1) /), inum(3._prec, +1))
call check(res,ref)
print*, ' ', 'testing GPL ', 'E.19b', ' ...'
call iprint(' testing GPL E.19b ...',-1)
res = G((/ inum(2._prec, -1) /), inum(3._prec, +1))
call check(res,conjg(ref))
print*, ' ', 'testing GPL ', 'E.19c', ' ...'
call iprint(' testing GPL E.19c ...',-1)
res = G((/ inum(2._prec, +1) /), inum(3._prec, -1))
call check(res,ref)
print*, ' ', 'testing GPL ', 'E.19d', ' ...'
call iprint(' testing GPL E.19d ...',-1)
res = G((/ inum(2._prec, -1) /), inum(3._prec, -1))
call check(res,conjg(ref))
print*, ' ', 'testing GPL ', 'E.19e', ' ...'
call iprint(' testing GPL E.19e ...',-1)
res = G((/ inum(-2._prec, +1) /), inum(-3._prec, +1))
call check(res,conjg(ref))
print*, ' ', 'testing GPL ', 'E.19f', ' ...'
call iprint(' testing GPL E.19f ...',-1)
res = G((/ inum(-2._prec, -1) /), inum(-3._prec, +1))
call check(res,ref)
print*, ' ', 'testing GPL ', 'E.19g', ' ...'
call iprint(' testing GPL E.19g ...',-1)
res = G((/ inum(-2._prec, +1) /), inum(-3._prec, -1))
call check(res,conjg(ref))
print*, ' ', 'testing GPL ', 'E.19h', ' ...'
call iprint(' testing GPL E.19h ...',-1)
res = G((/ inum(-2._prec, -1) /), inum(-3._prec, -1))
call check(res,ref)
ref = -(2.374395270272480200677499763071638424_prec, - 1.273806204919600530933131685580471698_prec)
print*, ' ', 'testing GPL ', 'E.20a', ' ...'
call iprint(' testing GPL E.20a ...',-1)
res = G((/ izero, inum(2._prec, +1) /), inum(3._prec, +1))
call check(res,ref)
print*, ' ', 'testing GPL ', 'E.20b', ' ...'
call iprint(' testing GPL E.20b ...',-1)
res = G((/ izero, inum(2._prec, -1) /), inum(3._prec, +1))
call check(res,conjg(ref))
print*, ' ', 'testing GPL ', 'E.20c', ' ...'
call iprint(' testing GPL E.20c ...',-1)
res = G((/ izero, inum(2._prec, +1) /), inum(3._prec, -1))
call check(res,ref)
print*, ' ', 'testing GPL ', 'E.20d', ' ...'
call iprint(' testing GPL E.20d ...',-1)
res = G((/ izero, inum(2._prec, -1) /), inum(3._prec, -1))
call check(res,conjg(ref))
print*, ' ', 'testing GPL ', 'E.20e', ' ...'
call iprint(' testing GPL E.20e ...',-1)
res = G((/ izero, inum(-2._prec, +1) /), inum(-3._prec, +1))
call check(res,conjg(ref))
print*, ' ', 'testing GPL ', 'E.20f', ' ...'
call iprint(' testing GPL E.20f ...',-1)
res = G((/ izero, inum(-2._prec, -1) /), inum(-3._prec, +1))
call check(res,ref)
print*, ' ', 'testing GPL ', 'E.20g', ' ...'
call iprint(' testing GPL E.20g ...',-1)
res = G((/ izero, inum(-2._prec, +1) /), inum(-3._prec, -1))
call check(res,conjg(ref))
print*, ' ', 'testing GPL ', 'E.20h', ' ...'
call iprint(' testing GPL E.20h ...',-1)
res = G((/ izero, inum(-2._prec, -1) /), inum(-3._prec, -1))
call check(res,ref)
......@@ -496,7 +534,7 @@ CONTAINS
! Here the branch cut matters, in Mathematica this is entered as G(1_-, 0, -I, -1.1)
ref = (0.0538179677556747874824671812943783830465_prec,0.340519960719077282936661573786600733497_prec)
print*, ' ', 'testing GPL ', 'F.15', ' ...'
call iprint(' testing GPL F.15 ...',-1)
res = G((/ inum(1._prec,-1), izero, inum((0._prec,-1._prec), -1) /), inum(-1.1_prec, +1))
call check(res,ref)
......
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