From 9a201a80c212605e2e2b4c8ecedf1f859f5a482c Mon Sep 17 00:00:00 2001 From: Yannick Ulrich Date: Thu, 3 Oct 2019 12:30:59 +0200 Subject: [PATCH] Used iprint more often --- checks/test.f90 | 138 ++++++++++++++++++++++++++++++------------------ 1 file changed, 88 insertions(+), 50 deletions(-) diff --git a/checks/test.f90 b/checks/test.f90 index 75475ad..51ee0ac 100644 --- a/checks/test.f90 +++ b/checks/test.f90 @@ -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) -- GitLab