Artifact
2309bc9461e0d2b10f88add2621acbd400d8caf8:
- File
dashboard.scm
— part of check-in
[3469edbbf7]
at
2011-10-08 20:23:24
on branch trunk
— 90% converted to using units
(user:
matt
size: 21997)
0000: 6b 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d k;;=============
0010: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0020: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0030: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0040: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 43 6f 70 =========.;; Cop
0050: 79 72 69 67 68 74 20 32 30 30 36 2d 32 30 31 31 yright 2006-2011
0060: 2c 20 4d 61 74 74 68 65 77 20 57 65 6c 6c 61 6e , Matthew Wellan
0070: 64 2e 0a 3b 3b 20 0a 3b 3b 20 20 54 68 69 73 20 d..;; .;; This
0080: 70 72 6f 67 72 61 6d 20 69 73 20 6d 61 64 65 20 program is made
0090: 61 76 61 69 6c 61 62 6c 65 20 75 6e 64 65 72 20 available under
00a0: 74 68 65 20 47 4e 55 20 47 50 4c 20 76 65 72 73 the GNU GPL vers
00b0: 69 6f 6e 20 32 2e 30 20 6f 72 0a 3b 3b 20 20 67 ion 2.0 or.;; g
00c0: 72 65 61 74 65 72 2e 20 53 65 65 20 74 68 65 20 reater. See the
00d0: 61 63 63 6f 6d 70 61 6e 79 69 6e 67 20 66 69 6c accompanying fil
00e0: 65 20 43 4f 50 59 49 4e 47 20 66 6f 72 20 64 65 e COPYING for de
00f0: 74 61 69 6c 73 2e 0a 3b 3b 20 0a 3b 3b 20 20 54 tails..;; .;; T
0100: 68 69 73 20 70 72 6f 67 72 61 6d 20 69 73 20 64 his program is d
0110: 69 73 74 72 69 62 75 74 65 64 20 57 49 54 48 4f istributed WITHO
0120: 55 54 20 41 4e 59 20 57 41 52 52 41 4e 54 59 3b UT ANY WARRANTY;
0130: 20 77 69 74 68 6f 75 74 20 65 76 65 6e 20 74 68 without even th
0140: 65 0a 3b 3b 20 20 69 6d 70 6c 69 65 64 20 77 61 e.;; implied wa
0150: 72 72 61 6e 74 79 20 6f 66 20 4d 45 52 43 48 41 rranty of MERCHA
0160: 4e 54 41 42 49 4c 49 54 59 20 6f 72 20 46 49 54 NTABILITY or FIT
0170: 4e 45 53 53 20 46 4f 52 20 41 20 50 41 52 54 49 NESS FOR A PARTI
0180: 43 55 4c 41 52 0a 3b 3b 20 20 50 55 52 50 4f 53 CULAR.;; PURPOS
0190: 45 2e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d E..;;===========
01a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 75 73 ===========..(us
01e0: 65 20 66 6f 72 6d 61 74 29 0a 28 72 65 71 75 69 e format).(requi
01f0: 72 65 2d 6c 69 62 72 61 72 79 20 69 75 70 29 0a re-library iup).
0200: 28 69 6d 70 6f 72 74 20 28 70 72 65 66 69 78 20 (import (prefix
0210: 69 75 70 20 69 75 70 3a 29 29 0a 0a 28 75 73 65 iup iup:))..(use
0220: 20 63 61 6e 76 61 73 2d 64 72 61 77 29 0a 0a 28 canvas-draw)..(
0230: 75 73 65 20 73 71 6c 69 74 65 33 20 73 72 66 69 use sqlite3 srfi
0240: 2d 31 20 70 6f 73 69 78 20 72 65 67 65 78 20 72 -1 posix regex r
0250: 65 67 65 78 2d 63 61 73 65 20 73 72 66 69 2d 36 egex-case srfi-6
0260: 39 29 0a 28 69 6d 70 6f 72 74 20 28 70 72 65 66 9).(import (pref
0270: 69 78 20 73 71 6c 69 74 65 33 20 73 71 6c 69 74 ix sqlite3 sqlit
0280: 65 33 3a 29 29 0a 0a 28 64 65 63 6c 61 72 65 20 e3:))..(declare
0290: 28 75 73 65 73 20 63 6f 6d 6d 6f 6e 29 29 0a 28 (uses common)).(
02a0: 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 6d 61 declare (uses ma
02b0: 72 67 73 29 29 0a 28 64 65 63 6c 61 72 65 20 28 rgs)).(declare (
02c0: 75 73 65 73 20 6b 65 79 73 29 29 0a 28 64 65 63 uses keys)).(dec
02d0: 6c 61 72 65 20 28 75 73 65 73 20 69 74 65 6d 73 lare (uses items
02e0: 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 )).(declare (use
02f0: 73 20 64 62 29 29 0a 28 64 65 63 6c 61 72 65 20 s db)).(declare
0300: 28 75 73 65 73 20 63 6f 6e 66 69 67 66 29 29 0a (uses configf)).
0310: 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 70 (declare (uses p
0320: 72 6f 63 65 73 73 29 29 0a 28 64 65 63 6c 61 72 rocess)).(declar
0330: 65 20 28 75 73 65 73 20 6c 61 75 6e 63 68 29 29 e (uses launch))
0340: 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 .(declare (uses
0350: 72 75 6e 73 29 29 0a 28 64 65 63 6c 61 72 65 20 runs)).(declare
0360: 28 75 73 65 73 20 64 62 6f 61 72 64 29 29 0a 28 (uses dboard)).(
0370: 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 64 61 declare (uses da
0380: 73 68 62 6f 61 72 64 2d 74 65 73 74 73 29 29 0a shboard-tests)).
0390: 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 6d (declare (uses m
03a0: 65 67 61 74 65 73 74 2d 76 65 72 73 69 6f 6e 29 egatest-version)
03b0: 29 0a 0a 28 69 6e 63 6c 75 64 65 20 22 63 6f 6d )..(include "com
03c0: 6d 6f 6e 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 mon_records.scm"
03d0: 29 0a 0a 28 64 65 66 69 6e 65 20 68 65 6c 70 20 )..(define help
03e0: 28 63 6f 6e 63 20 0a 22 4d 65 67 61 74 65 73 74 (conc ."Megatest
03f0: 20 44 61 73 68 62 6f 61 72 64 2c 20 64 6f 63 75 Dashboard, docu
0400: 6d 65 6e 74 61 74 69 6f 6e 20 61 74 20 68 74 74 mentation at htt
0410: 70 3a 2f 2f 77 77 77 2e 6b 69 61 74 6f 61 2e 63 p://www.kiatoa.c
0420: 6f 6d 2f 66 6f 73 73 69 6c 73 2f 6d 65 67 61 74 om/fossils/megat
0430: 65 73 74 0a 20 20 76 65 72 73 69 6f 6e 20 22 20 est. version "
0440: 6d 65 67 61 74 65 73 74 2d 76 65 72 73 69 6f 6e megatest-version
0450: 20 22 0a 20 20 6c 69 63 65 6e 73 65 20 47 50 4c ". license GPL
0460: 2c 20 43 6f 70 79 72 69 67 68 74 20 28 43 29 20 , Copyright (C)
0470: 4d 61 74 74 20 57 65 6c 6c 61 6e 64 20 32 30 31 Matt Welland 201
0480: 31 0a 0a 55 73 61 67 65 3a 20 64 61 73 68 62 6f 1..Usage: dashbo
0490: 61 72 64 20 5b 6f 70 74 69 6f 6e 73 5d 0a 20 20 ard [options].
04a0: 2d 68 20 20 20 20 20 20 20 20 20 20 20 20 20 20 -h
04b0: 3a 20 74 68 69 73 20 68 65 6c 70 0a 20 20 2d 72 : this help. -r
04c0: 75 6e 20 72 75 6e 69 64 20 20 20 20 20 20 3a 20 un runid :
04d0: 63 6f 6e 74 72 6f 6c 20 72 75 6e 20 69 64 65 6e control run iden
04e0: 74 69 66 69 65 64 20 62 79 20 72 75 6e 69 64 0a tified by runid.
04f0: 20 20 2d 74 65 73 74 20 74 65 73 74 69 64 20 20 -test testid
0500: 20 20 3a 20 63 6f 6e 74 72 6f 6c 20 74 65 73 74 : control test
0510: 20 69 64 65 6e 74 69 66 69 65 64 20 62 79 20 74 identified by t
0520: 65 73 74 69 64 0a 0a 4d 69 73 63 0a 20 20 2d 72 estid..Misc. -r
0530: 6f 77 73 20 4e 20 20 20 20 20 20 20 20 20 3a 20 ows N :
0540: 73 65 74 20 6e 75 6d 62 65 72 20 6f 66 20 72 6f set number of ro
0550: 77 73 0a 22 29 29 0a 0a 3b 3b 20 70 72 6f 63 65 ws."))..;; proce
0560: 73 73 20 61 72 67 73 0a 28 64 65 66 69 6e 65 20 ss args.(define
0570: 72 65 6d 61 72 67 73 20 28 61 72 67 73 3a 67 65 remargs (args:ge
0580: 74 2d 61 72 67 73 20 0a 09 09 20 28 61 72 67 76 t-args ... (argv
0590: 29 0a 09 09 20 28 6c 69 73 74 20 20 22 2d 72 6f )... (list "-ro
05a0: 77 73 22 0a 09 09 09 22 2d 72 75 6e 22 0a 09 09 ws"...."-run"...
05b0: 09 22 2d 74 65 73 74 22 0a 09 09 09 22 2d 64 65 ."-test"...."-de
05c0: 62 75 67 22 0a 09 09 09 29 20 0a 09 09 20 28 6c bug"....) ... (l
05d0: 69 73 74 20 20 22 2d 68 22 0a 09 09 09 22 2d 76 ist "-h"...."-v
05e0: 22 0a 09 09 09 22 2d 71 22 0a 09 09 20 20 20 20 "...."-q"...
05f0: 20 20 20 29 0a 09 09 20 61 72 67 73 3a 61 72 67 )... args:arg
0600: 2d 68 61 73 68 0a 09 09 20 30 29 29 0a 0a 28 69 -hash... 0))..(i
0610: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
0620: 22 2d 68 22 29 0a 20 20 20 20 28 62 65 67 69 6e "-h"). (begin
0630: 0a 20 20 20 20 20 20 28 70 72 69 6e 74 20 68 65 . (print he
0640: 6c 70 29 0a 20 20 20 20 20 20 28 65 78 69 74 29 lp). (exit)
0650: 29 29 0a 0a 28 69 66 20 28 6e 6f 74 20 28 73 65 ))..(if (not (se
0660: 74 75 70 2d 66 6f 72 2d 72 75 6e 29 29 0a 20 20 tup-for-run)).
0670: 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 (begin. (
0680: 70 72 69 6e 74 20 22 46 61 69 6c 65 64 20 74 6f print "Failed to
0690: 20 66 69 6e 64 20 6d 65 67 61 74 65 73 74 2e 63 find megatest.c
06a0: 6f 6e 66 69 67 2c 20 65 78 69 74 69 6e 67 22 29 onfig, exiting")
06b0: 20 0a 20 20 20 20 20 20 28 65 78 69 74 20 31 29 . (exit 1)
06c0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 2a 64 62 2a ))..(define *db*
06d0: 20 28 6f 70 65 6e 2d 64 62 29 29 0a 0a 28 64 65 (open-db))..(de
06e0: 66 69 6e 65 20 74 6f 70 6c 65 76 65 6c 20 23 66 fine toplevel #f
06f0: 29 0a 28 64 65 66 69 6e 65 20 64 6c 67 20 20 20 ).(define dlg
0700: 20 20 20 23 66 29 0a 28 64 65 66 69 6e 65 20 6d #f).(define m
0710: 61 78 2d 74 65 73 74 2d 6e 75 6d 20 30 29 0a 28 ax-test-num 0).(
0720: 64 65 66 69 6e 65 20 2a 6b 65 79 73 2a 20 20 20 define *keys*
0730: 28 67 65 74 2d 6b 65 79 73 20 20 20 2a 64 62 2a (get-keys *db*
0740: 29 29 0a 28 64 65 66 69 6e 65 20 2a 64 62 6b 65 )).(define *dbke
0750: 79 73 2a 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 ys* (map (lambd
0760: 61 20 28 78 29 28 76 65 63 74 6f 72 2d 72 65 66 a (x)(vector-ref
0770: 20 78 20 30 29 29 0a 09 09 20 20 20 20 20 20 28 x 0))... (
0780: 61 70 70 65 6e 64 20 2a 6b 65 79 73 2a 20 28 6c append *keys* (l
0790: 69 73 74 20 28 76 65 63 74 6f 72 20 22 72 75 6e ist (vector "run
07a0: 6e 61 6d 65 22 20 22 62 6c 61 68 22 29 29 29 29 name" "blah"))))
07b0: 29 0a 28 64 65 66 69 6e 65 20 2a 68 65 61 64 65 ).(define *heade
07c0: 72 2a 20 20 20 20 20 20 20 23 66 29 0a 28 64 65 r* #f).(de
07d0: 66 69 6e 65 20 2a 61 6c 6c 72 75 6e 73 2a 20 20 fine *allruns*
07e0: 20 20 20 27 28 29 29 0a 28 64 65 66 69 6e 65 20 '()).(define
07f0: 2a 62 75 74 74 6f 6e 64 61 74 2a 20 20 20 20 28 *buttondat* (
0800: 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 make-hash-table)
0810: 29 20 3b 3b 20 3c 72 75 6e 2d 69 64 20 63 6f 6c ) ;; <run-id col
0820: 6f 72 20 74 65 78 74 20 74 65 73 74 20 72 75 6e or text test run
0830: 2d 6b 65 79 3e 0a 28 64 65 66 69 6e 65 20 2a 61 -key>.(define *a
0840: 6c 6c 74 65 73 74 6e 61 6d 65 6c 73 74 2a 20 27 lltestnamelst* '
0850: 28 29 29 0a 28 64 65 66 69 6e 65 20 2a 73 65 61 ()).(define *sea
0860: 72 63 68 70 61 74 74 73 2a 20 20 28 6d 61 6b 65 rchpatts* (make
0870: 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 0a 28 64 -hash-table)).(d
0880: 65 66 69 6e 65 20 2a 6e 75 6d 2d 72 75 6e 73 2a efine *num-runs*
0890: 20 20 20 20 20 20 38 29 0a 28 64 65 66 69 6e 65 8).(define
08a0: 20 2a 74 6f 74 2d 72 75 6e 2d 63 6f 75 6e 74 2a *tot-run-count*
08b0: 20 28 64 62 3a 67 65 74 2d 6e 75 6d 2d 72 75 6e (db:get-num-run
08c0: 73 20 2a 64 62 2a 20 22 25 22 29 29 0a 28 64 65 s *db* "%")).(de
08d0: 66 69 6e 65 20 2a 6c 61 73 74 2d 75 70 64 61 74 fine *last-updat
08e0: 65 2a 20 20 20 28 63 75 72 72 65 6e 74 2d 73 65 e* (current-se
08f0: 63 6f 6e 64 73 29 29 0a 28 64 65 66 69 6e 65 20 conds)).(define
0900: 2a 6e 75 6d 2d 74 65 73 74 73 2a 20 20 20 20 20 *num-tests*
0910: 31 35 29 0a 28 64 65 66 69 6e 65 20 2a 73 74 61 15).(define *sta
0920: 72 74 2d 72 75 6e 2d 6f 66 66 73 65 74 2a 20 20 rt-run-offset*
0930: 30 29 0a 28 64 65 66 69 6e 65 20 2a 73 74 61 72 0).(define *star
0940: 74 2d 74 65 73 74 2d 6f 66 66 73 65 74 2a 20 30 t-test-offset* 0
0950: 29 0a 28 64 65 66 69 6e 65 20 2a 65 78 61 6d 69 ).(define *exami
0960: 6e 65 2d 74 65 73 74 2d 64 61 74 2a 20 28 6d 61 ne-test-dat* (ma
0970: 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 0a ke-hash-table)).
0980: 28 64 65 66 69 6e 65 20 2a 65 78 69 74 2d 73 74 (define *exit-st
0990: 61 72 74 65 64 2a 20 23 66 29 0a 0a 28 64 65 66 arted* #f)..(def
09a0: 69 6e 65 20 2a 76 65 72 62 6f 73 69 74 79 2a 20 ine *verbosity*
09b0: 28 63 6f 6e 64 0a 09 09 20 20 20 20 20 28 28 61 (cond... ((a
09c0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 65 rgs:get-arg "-de
09d0: 62 75 67 22 29 28 73 74 72 69 6e 67 2d 3e 6e 75 bug")(string->nu
09e0: 6d 62 65 72 20 28 61 72 67 73 3a 67 65 74 2d 61 mber (args:get-a
09f0: 72 67 20 22 2d 64 65 62 75 67 22 29 29 29 0a 09 rg "-debug")))..
0a00: 09 20 20 20 20 20 28 28 61 72 67 73 3a 67 65 74 . ((args:get
0a10: 2d 61 72 67 20 22 2d 76 22 29 20 20 20 20 32 29 -arg "-v") 2)
0a20: 0a 09 09 20 20 20 20 20 28 28 61 72 67 73 3a 67 ... ((args:g
0a30: 65 74 2d 61 72 67 20 22 2d 71 22 29 20 20 20 20 et-arg "-q")
0a40: 30 29 0a 09 09 20 20 20 20 20 28 65 6c 73 65 20 0)... (else
0a50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0a60: 20 20 31 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 1)))..(define
0a70: 75 69 64 61 74 20 23 66 29 0a 3b 3b 20 28 6d 65 uidat #f).;; (me
0a80: 67 61 74 65 73 74 2d 64 61 73 68 62 6f 61 72 64 gatest-dashboard
0a90: 29 0a 0a 3b 28 64 65 66 69 6e 65 20 69 6d 67 31 )..;(define img1
0aa0: 20 28 69 75 70 3a 69 6d 61 67 65 2f 70 61 6c 65 (iup:image/pale
0ab0: 74 74 65 20 31 36 20 31 36 20 28 75 38 76 65 63 tte 16 16 (u8vec
0ac0: 74 6f 72 2d 3e 62 6c 6f 62 20 28 75 38 76 65 63 tor->blob (u8vec
0ad0: 74 6f 72 0a 3b 09 09 09 09 20 20 20 31 20 31 20 tor.;.... 1 1
0ae0: 31 20 31 20 31 20 31 20 31 20 31 20 31 20 31 20 1 1 1 1 1 1 1 1
0af0: 31 20 31 20 31 20 31 20 31 20 32 20 0a 3b 09 09 1 1 1 1 1 2 .;..
0b00: 09 09 20 20 20 31 20 31 20 31 20 31 20 31 20 31 .. 1 1 1 1 1 1
0b10: 20 31 20 31 20 31 20 31 20 31 20 31 20 31 20 31 1 1 1 1 1 1 1 1
0b20: 20 32 20 32 20 0a 3b 09 09 09 09 20 20 20 31 20 2 2 .;.... 1
0b30: 31 20 31 20 31 20 31 20 31 20 31 20 31 20 31 20 1 1 1 1 1 1 1 1
0b40: 31 20 31 20 31 20 31 20 32 20 32 20 32 20 0a 3b 1 1 1 1 2 2 2 .;
0b50: 09 09 09 09 20 20 20 31 20 31 20 31 20 31 20 31 .... 1 1 1 1 1
0b60: 20 31 20 31 20 31 20 31 20 31 20 31 20 31 20 32 1 1 1 1 1 1 1 2
0b70: 20 32 20 32 20 32 20 0a 3b 09 09 09 09 20 20 20 2 2 2 .;....
0b80: 31 20 31 20 31 20 31 20 31 20 31 20 31 20 31 20 1 1 1 1 1 1 1 1
0b90: 31 20 31 20 31 20 32 20 32 20 32 20 32 20 32 20 1 1 1 2 2 2 2 2
0ba0: 0a 3b 09 09 09 09 20 20 20 31 20 31 20 31 20 31 .;.... 1 1 1 1
0bb0: 20 31 20 31 20 31 20 31 20 31 20 31 20 32 20 32 1 1 1 1 1 1 2 2
0bc0: 20 32 20 32 20 32 20 32 20 0a 3b 09 09 09 09 20 2 2 2 2 .;....
0bd0: 20 20 31 20 31 20 31 20 31 20 31 20 31 20 31 20 1 1 1 1 1 1 1
0be0: 31 20 31 20 32 20 32 20 32 20 32 20 32 20 32 20 1 1 2 2 2 2 2 2
0bf0: 32 20 0a 3b 09 09 09 09 20 20 20 31 20 31 20 31 2 .;.... 1 1 1
0c00: 20 31 20 31 20 31 20 31 20 31 20 32 20 32 20 32 1 1 1 1 1 2 2 2
0c10: 20 32 20 32 20 32 20 32 20 32 20 0a 3b 09 09 09 2 2 2 2 2 .;...
0c20: 09 20 20 20 32 20 32 20 32 20 32 20 32 20 32 20 . 2 2 2 2 2 2
0c30: 32 20 32 20 32 20 32 20 32 20 32 20 32 20 32 20 2 2 2 2 2 2 2 2
0c40: 32 20 32 20 0a 3b 09 09 09 09 20 20 20 32 20 32 2 2 .;.... 2 2
0c50: 20 32 20 32 20 32 20 32 20 32 20 32 20 32 20 32 2 2 2 2 2 2 2 2
0c60: 20 32 20 32 20 32 20 32 20 32 20 32 20 0a 3b 09 2 2 2 2 2 2 .;.
0c70: 09 09 09 20 20 20 32 20 32 20 32 20 30 20 32 20 ... 2 2 2 0 2
0c80: 32 20 32 20 32 20 32 20 32 20 32 20 32 20 32 20 2 2 2 2 2 2 2 2
0c90: 32 20 32 20 32 20 0a 3b 09 09 09 09 20 20 20 32 2 2 2 .;.... 2
0ca0: 20 32 20 32 20 30 20 32 20 32 20 32 20 32 20 32 2 2 0 2 2 2 2 2
0cb0: 20 32 20 32 20 32 20 32 20 32 20 32 20 32 20 0a 2 2 2 2 2 2 2 .
0cc0: 3b 09 09 09 09 20 20 20 32 20 32 20 32 20 30 20 ;.... 2 2 2 0
0cd0: 32 20 30 20 32 20 30 20 32 20 32 20 30 20 32 20 2 0 2 0 2 2 0 2
0ce0: 32 20 32 20 30 20 30 20 0a 3b 09 09 09 09 20 20 2 2 0 0 .;....
0cf0: 20 32 20 32 20 32 20 30 20 32 20 30 20 30 20 32 2 2 2 0 2 0 0 2
0d00: 20 30 20 30 20 32 20 30 20 32 20 30 20 32 20 32 0 0 2 0 2 0 2 2
0d10: 20 0a 3b 09 09 09 09 20 20 20 32 20 32 20 32 20 .;.... 2 2 2
0d20: 30 20 32 20 30 20 32 20 32 20 30 20 32 20 32 20 0 2 0 2 2 0 2 2
0d30: 30 20 32 20 32 20 32 20 32 20 0a 3b 09 09 09 09 0 2 2 2 2 .;....
0d40: 20 20 20 32 20 32 20 32 20 30 20 32 20 30 20 32 2 2 2 0 2 0 2
0d50: 20 32 20 30 20 32 20 32 20 30 20 32 20 32 20 30 2 0 2 2 0 2 2 0
0d60: 20 30 20 0a 3b 09 09 09 09 20 20 20 32 20 32 20 0 .;.... 2 2
0d70: 32 20 30 20 32 20 30 20 32 20 32 20 30 20 32 20 2 0 2 0 2 2 0 2
0d80: 32 20 30 20 32 20 30 20 32 20 31 29 29 29 29 0a 2 0 2 0 2 1)))).
0d90: 3b 0a 3b 28 64 65 66 69 6e 65 20 69 6d 67 32 20 ;.;(define img2
0da0: 28 69 75 70 3a 69 6d 61 67 65 2f 70 61 6c 65 74 (iup:image/palet
0db0: 74 65 20 31 36 20 31 36 20 28 75 38 76 65 63 74 te 16 16 (u8vect
0dc0: 6f 72 2d 3e 62 6c 6f 62 20 28 75 38 76 65 63 74 or->blob (u8vect
0dd0: 6f 72 0a 3b 09 09 09 09 20 20 20 32 20 32 20 32 or.;.... 2 2 2
0de0: 20 32 20 32 20 32 20 32 20 32 20 32 20 32 20 32 2 2 2 2 2 2 2 2
0df0: 20 32 20 32 20 32 20 32 20 31 20 0a 3b 09 09 09 2 2 2 2 1 .;...
0e00: 09 20 20 20 32 20 32 20 32 20 32 20 32 20 32 20 . 2 2 2 2 2 2
0e10: 32 20 32 20 32 20 32 20 32 20 32 20 32 20 32 20 2 2 2 2 2 2 2 2
0e20: 31 20 31 20 0a 3b 09 09 09 09 20 20 20 32 20 32 1 1 .;.... 2 2
0e30: 20 32 20 32 20 32 20 32 20 32 20 32 20 32 20 32 2 2 2 2 2 2 2 2
0e40: 20 32 20 32 20 32 20 31 20 31 20 31 20 0a 3b 09 2 2 2 1 1 1 .;.
0e50: 09 09 09 20 20 20 31 20 31 20 31 20 31 20 31 20 ... 1 1 1 1 1
0e60: 31 20 31 20 31 20 31 20 31 20 31 20 31 20 32 20 1 1 1 1 1 1 1 2
0e70: 32 20 32 20 32 20 0a 3b 09 09 09 09 20 20 20 31 2 2 2 .;.... 1
0e80: 20 31 20 31 20 31 20 31 20 31 20 31 20 31 20 31 1 1 1 1 1 1 1 1
0e90: 20 31 20 31 20 32 20 32 20 32 20 32 20 32 20 0a 1 1 2 2 2 2 2 .
0ea0: 3b 09 09 09 09 20 20 20 31 20 31 20 31 20 31 20 ;.... 1 1 1 1
0eb0: 31 20 31 20 31 20 31 20 31 20 31 20 32 20 32 20 1 1 1 1 1 1 2 2
0ec0: 32 20 32 20 32 20 32 20 0a 3b 09 09 09 09 20 20 2 2 2 2 .;....
0ed0: 20 31 20 31 20 31 20 31 20 31 20 31 20 31 20 31 1 1 1 1 1 1 1 1
0ee0: 20 31 20 32 20 32 20 32 20 32 20 32 20 32 20 32 1 2 2 2 2 2 2 2
0ef0: 20 0a 3b 09 09 09 09 20 20 20 31 20 31 20 31 20 .;.... 1 1 1
0f00: 31 20 31 20 31 20 31 20 31 20 32 20 32 20 32 20 1 1 1 1 1 2 2 2
0f10: 32 20 32 20 32 20 32 20 32 20 0a 3b 09 09 09 09 2 2 2 2 2 .;....
0f20: 20 20 20 32 20 32 20 32 20 32 20 32 20 32 20 32 2 2 2 2 2 2 2
0f30: 20 32 20 32 20 32 20 32 20 32 20 32 20 32 20 32 2 2 2 2 2 2 2 2
0f40: 20 32 20 0a 3b 09 09 09 09 20 20 20 32 20 32 20 2 .;.... 2 2
0f50: 32 20 32 20 32 20 32 20 32 20 32 20 32 20 32 20 2 2 2 2 2 2 2 2
0f60: 32 20 32 20 32 20 32 20 32 20 32 20 0a 3b 09 09 2 2 2 2 2 2 .;..
0f70: 09 09 20 20 20 32 20 32 20 32 20 30 20 32 20 32 .. 2 2 2 0 2 2
0f80: 20 32 20 32 20 32 20 32 20 32 20 32 20 32 20 32 2 2 2 2 2 2 2 2
0f90: 20 32 20 32 20 0a 3b 09 09 09 09 20 20 20 32 20 2 2 .;.... 2
0fa0: 32 20 32 20 30 20 32 20 32 20 32 20 32 20 32 20 2 2 0 2 2 2 2 2
0fb0: 32 20 32 20 32 20 32 20 32 20 32 20 32 20 0a 3b 2 2 2 2 2 2 2 .;
0fc0: 09 09 09 09 20 20 20 32 20 32 20 32 20 30 20 32 .... 2 2 2 0 2
0fd0: 20 30 20 32 20 30 20 32 20 32 20 30 20 32 20 32 0 2 0 2 2 0 2 2
0fe0: 20 32 20 30 20 30 20 0a 3b 09 09 09 09 20 20 20 2 0 0 .;....
0ff0: 32 20 32 20 32 20 30 20 32 20 30 20 30 20 32 20 2 2 2 0 2 0 0 2
1000: 30 20 30 20 32 20 30 20 32 20 30 20 32 20 32 20 0 0 2 0 2 0 2 2
1010: 0a 3b 09 09 09 09 20 20 20 32 20 32 20 32 20 30 .;.... 2 2 2 0
1020: 20 32 20 30 20 32 20 32 20 30 20 32 20 32 20 30 2 0 2 2 0 2 2 0
1030: 20 32 20 32 20 32 20 32 20 0a 3b 09 09 09 09 20 2 2 2 2 .;....
1040: 20 20 32 20 32 20 32 20 30 20 32 20 30 20 32 20 2 2 2 0 2 0 2
1050: 32 20 30 20 32 20 32 20 30 20 32 20 32 20 30 20 2 0 2 2 0 2 2 0
1060: 30 20 0a 3b 09 09 09 09 20 20 20 32 20 32 20 32 0 .;.... 2 2 2
1070: 20 30 20 32 20 30 20 32 20 32 20 30 20 32 20 32 0 2 0 2 2 0 2 2
1080: 20 30 20 32 20 30 20 32 20 31 29 29 29 29 0a 3b 0 2 0 2 1)))).;
1090: 0a 3b 28 69 75 70 3a 68 61 6e 64 6c 65 2d 6e 61 .;(iup:handle-na
10a0: 6d 65 2d 73 65 74 21 20 69 6d 67 31 20 22 69 6d me-set! img1 "im
10b0: 67 31 22 29 0a 3b 28 69 75 70 3a 61 74 74 72 69 g1").;(iup:attri
10c0: 62 75 74 65 2d 73 65 74 21 20 69 6d 67 31 20 22 bute-set! img1 "
10d0: 30 22 20 22 30 20 30 20 30 22 29 0a 3b 28 69 75 0" "0 0 0").;(iu
10e0: 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 p:attribute-set!
10f0: 20 69 6d 67 31 20 22 31 22 20 22 42 47 43 4f 4c img1 "1" "BGCOL
1100: 4f 52 22 29 0a 3b 28 69 75 70 3a 61 74 74 72 69 OR").;(iup:attri
1110: 62 75 74 65 2d 73 65 74 21 20 69 6d 67 31 20 22 bute-set! img1 "
1120: 32 22 20 22 32 35 35 20 30 20 30 22 29 0a 3b 0a 2" "255 0 0").;.
1130: 3b 28 69 75 70 3a 68 61 6e 64 6c 65 2d 6e 61 6d ;(iup:handle-nam
1140: 65 2d 73 65 74 21 20 69 6d 67 32 20 22 69 6d 67 e-set! img2 "img
1150: 32 22 29 0a 3b 28 69 75 70 3a 61 74 74 72 69 62 2").;(iup:attrib
1160: 75 74 65 2d 73 65 74 21 20 69 6d 67 32 20 22 30 ute-set! img2 "0
1170: 22 20 22 30 20 30 20 30 22 29 0a 3b 28 69 75 70 " "0 0 0").;(iup
1180: 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 :attribute-set!
1190: 69 6d 67 32 20 22 31 22 20 22 42 47 43 4f 4c 4f img2 "1" "BGCOLO
11a0: 52 22 29 0a 3b 28 69 75 70 3a 61 74 74 72 69 62 R").;(iup:attrib
11b0: 75 74 65 2d 73 65 74 21 20 69 6d 67 32 20 22 32 ute-set! img2 "2
11c0: 22 20 22 32 35 35 20 30 20 30 22 29 0a 0a 28 64 " "255 0 0")..(d
11d0: 65 66 69 6e 65 20 28 6d 65 73 73 61 67 65 2d 77 efine (message-w
11e0: 69 6e 64 6f 77 20 6d 73 67 29 0a 20 20 28 69 75 indow msg). (iu
11f0: 70 3a 73 68 6f 77 0a 20 20 20 28 69 75 70 3a 64 p:show. (iup:d
1200: 69 61 6c 6f 67 0a 20 20 20 20 28 69 75 70 3a 76 ialog. (iup:v
1210: 62 6f 78 20 0a 20 20 20 20 20 28 69 75 70 3a 6c box . (iup:l
1220: 61 62 65 6c 20 6d 73 67 20 23 3a 6d 61 72 67 69 abel msg #:margi
1230: 6e 20 22 34 30 78 34 30 22 29 29 29 29 29 0a 0a n "40x40")))))..
1240: 28 64 65 66 69 6e 65 20 28 69 75 70 6c 69 73 74 (define (iuplist
1250: 62 6f 78 2d 66 69 6c 6c 2d 6c 69 73 74 20 6c 62 box-fill-list lb
1260: 20 69 74 65 6d 73 20 2e 20 64 65 66 61 75 6c 74 items . default
1270: 29 0a 20 20 28 6c 65 74 20 28 28 69 20 31 29 0a ). (let ((i 1).
1280: 09 28 73 65 6c 65 63 74 65 64 2d 69 74 65 6d 20 .(selected-item
1290: 28 69 66 20 28 6e 75 6c 6c 3f 20 64 65 66 61 75 (if (null? defau
12a0: 6c 74 29 20 23 66 20 28 63 61 72 20 64 65 66 61 lt) #f (car defa
12b0: 75 6c 74 29 29 29 29 0a 20 20 20 20 28 69 75 70 ult)))). (iup
12c0: 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 :attribute-set!
12d0: 6c 62 20 22 56 41 4c 55 45 22 20 28 69 66 20 73 lb "VALUE" (if s
12e0: 65 6c 65 63 74 65 64 2d 69 74 65 6d 20 73 65 6c elected-item sel
12f0: 65 63 74 65 64 2d 69 74 65 6d 20 22 22 29 29 0a ected-item "")).
1300: 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c (for-each (l
1310: 61 6d 62 64 61 20 28 69 74 65 6d 29 0a 09 09 28 ambda (item)...(
1320: 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 iup:attribute-se
1330: 74 21 20 6c 62 20 28 6e 75 6d 62 65 72 2d 3e 73 t! lb (number->s
1340: 74 72 69 6e 67 20 69 29 20 69 74 65 6d 29 0a 09 tring i) item)..
1350: 09 28 69 66 20 73 65 6c 65 63 74 65 64 2d 69 74 .(if selected-it
1360: 65 6d 0a 09 09 20 20 20 20 28 69 66 20 28 65 71 em... (if (eq
1370: 75 61 6c 3f 20 73 65 6c 65 63 74 65 64 2d 69 74 ual? selected-it
1380: 65 6d 20 69 74 65 6d 29 0a 09 09 09 28 69 75 70 em item)....(iup
1390: 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 :attribute-set!
13a0: 6c 62 20 22 56 41 4c 55 45 22 20 69 74 65 6d 29 lb "VALUE" item)
13b0: 29 29 20 3b 3b 20 28 6e 75 6d 62 65 72 2d 3e 73 )) ;; (number->s
13c0: 74 72 69 6e 67 20 69 29 29 29 29 0a 09 09 28 73 tring i))))...(s
13d0: 65 74 21 20 69 20 28 2b 20 69 20 31 29 29 29 0a et! i (+ i 1))).
13e0: 09 20 20 20 20 20 20 69 74 65 6d 73 29 0a 20 20 . items).
13f0: 20 20 69 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 i))..(define (
1400: 70 61 64 2d 6c 69 73 74 20 6c 20 6e 29 28 61 70 pad-list l n)(ap
1410: 70 65 6e 64 20 6c 20 28 6d 61 6b 65 2d 6c 69 73 pend l (make-lis
1420: 74 20 28 2d 20 6e 20 28 6c 65 6e 67 74 68 20 6c t (- n (length l
1430: 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 )))))..(define (
1440: 63 6f 6c 6f 72 73 2d 73 69 6d 69 6c 61 72 3f 20 colors-similar?
1450: 63 6f 6c 6f 72 31 20 63 6f 6c 6f 72 32 29 0a 20 color1 color2).
1460: 20 28 6c 65 74 2a 20 28 28 63 31 20 28 6d 61 70 (let* ((c1 (map
1470: 20 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 string->number
1480: 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 63 6f (string-split co
1490: 6c 6f 72 31 29 29 29 0a 09 20 28 63 32 20 28 6d lor1))).. (c2 (m
14a0: 61 70 20 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 ap string->numbe
14b0: 72 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 r (string-split
14c0: 63 6f 6c 6f 72 32 29 29 29 0a 09 20 28 64 65 6c color2))).. (del
14d0: 74 61 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 ta (map (lambda
14e0: 28 61 20 62 29 28 61 62 73 20 28 2d 20 61 20 62 (a b)(abs (- a b
14f0: 29 29 29 20 63 31 20 63 32 29 29 29 0a 20 20 20 ))) c1 c2))).
1500: 20 28 6e 75 6c 6c 3f 20 28 66 69 6c 74 65 72 20 (null? (filter
1510: 28 6c 61 6d 62 64 61 20 28 78 29 28 3e 20 78 20 (lambda (x)(> x
1520: 33 29 29 20 64 65 6c 74 61 29 29 29 29 0a 0a 3b 3)) delta))))..;
1530: 3b 20 6b 65 79 70 61 74 74 73 3a 20 28 20 28 4b ; keypatts: ( (K
1540: 45 59 31 20 22 61 62 63 25 64 65 66 22 29 28 4b EY1 "abc%def")(K
1550: 45 59 32 20 22 25 22 29 20 29 0a 28 64 65 66 69 EY2 "%") ).(defi
1560: 6e 65 20 28 75 70 64 61 74 65 2d 72 75 6e 64 61 ne (update-runda
1570: 74 20 72 75 6e 6e 61 6d 65 70 61 74 74 20 6e 75 t runnamepatt nu
1580: 6d 72 75 6e 73 20 74 65 73 74 6e 61 6d 65 70 61 mruns testnamepa
1590: 74 74 20 69 74 65 6d 6e 61 6d 65 70 61 74 74 20 tt itemnamepatt
15a0: 6b 65 79 70 61 74 74 73 29 0a 20 20 28 6c 65 74 keypatts). (let
15b0: 2a 20 28 28 61 6c 6c 72 75 6e 73 20 20 20 20 20 * ((allruns
15c0: 28 64 62 3a 67 65 74 2d 72 75 6e 73 20 2a 64 62 (db:get-runs *db
15d0: 2a 20 72 75 6e 6e 61 6d 65 70 61 74 74 20 6e 75 * runnamepatt nu
15e0: 6d 72 75 6e 73 20 2a 73 74 61 72 74 2d 72 75 6e mruns *start-run
15f0: 2d 6f 66 66 73 65 74 2a 20 6b 65 79 70 61 74 74 -offset* keypatt
1600: 73 29 29 0a 09 20 28 68 65 61 64 65 72 20 20 20 s)).. (header
1610: 20 20 20 28 64 62 3a 67 65 74 2d 68 65 61 64 65 (db:get-heade
1620: 72 20 61 6c 6c 72 75 6e 73 29 29 0a 09 20 28 72 r allruns)).. (r
1630: 75 6e 73 20 20 20 20 20 20 20 20 28 64 62 3a 67 uns (db:g
1640: 65 74 2d 72 6f 77 73 20 20 20 61 6c 6c 72 75 6e et-rows allrun
1650: 73 29 29 0a 09 20 28 72 65 73 75 6c 74 20 20 20 s)).. (result
1660: 20 20 20 27 28 29 29 0a 09 20 28 6d 61 78 74 65 '()).. (maxte
1670: 73 74 73 20 20 20 20 30 29 29 0a 20 20 20 20 28 sts 0)). (
1680: 69 66 20 28 3e 20 28 2b 20 2a 6c 61 73 74 2d 75 if (> (+ *last-u
1690: 70 64 61 74 65 2a 20 33 30 30 29 20 28 63 75 72 pdate* 300) (cur
16a0: 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 29 20 3b rent-seconds)) ;
16b0: 3b 20 65 76 65 72 79 20 66 69 76 65 20 6d 69 6e ; every five min
16c0: 75 74 65 73 0a 09 28 62 65 67 69 6e 0a 09 20 20 utes..(begin..
16d0: 28 73 65 74 21 20 2a 6c 61 73 74 2d 75 70 64 61 (set! *last-upda
16e0: 74 65 2a 20 28 63 75 72 72 65 6e 74 2d 73 65 63 te* (current-sec
16f0: 6f 6e 64 73 29 29 0a 09 20 20 28 73 65 74 21 20 onds)).. (set!
1700: 2a 74 6f 74 2d 72 75 6e 2d 63 6f 75 6e 74 2a 20 *tot-run-count*
1710: 28 64 62 3a 67 65 74 2d 6e 75 6d 2d 72 75 6e 73 (db:get-num-runs
1720: 20 2a 64 62 2a 20 72 75 6e 6e 61 6d 65 70 61 74 *db* runnamepat
1730: 74 29 29 29 29 0a 20 20 20 20 28 66 6f 72 2d 65 t)))). (for-e
1740: 61 63 68 20 28 6c 61 6d 62 64 61 20 28 72 75 6e ach (lambda (run
1750: 29 0a 09 09 28 6c 65 74 2a 20 28 28 72 75 6e 2d )...(let* ((run-
1760: 69 64 20 20 20 28 64 62 3a 67 65 74 2d 76 61 6c id (db:get-val
1770: 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 6e ue-by-header run
1780: 20 68 65 61 64 65 72 20 22 69 64 22 29 29 0a 09 header "id"))..
1790: 09 20 20 20 20 20 20 20 28 74 65 73 74 73 20 20 . (tests
17a0: 20 20 28 64 62 2d 67 65 74 2d 74 65 73 74 73 2d (db-get-tests-
17b0: 66 6f 72 2d 72 75 6e 20 2a 64 62 2a 20 72 75 6e for-run *db* run
17c0: 2d 69 64 20 74 65 73 74 6e 61 6d 65 70 61 74 74 -id testnamepatt
17d0: 20 69 74 65 6d 6e 61 6d 65 70 61 74 74 29 29 0a itemnamepatt)).
17e0: 09 09 20 20 20 20 20 20 20 28 6b 65 79 2d 76 61 .. (key-va
17f0: 6c 73 20 28 67 65 74 2d 6b 65 79 2d 76 61 6c 73 ls (get-key-vals
1800: 20 2a 64 62 2a 20 72 75 6e 2d 69 64 29 29 29 0a *db* run-id))).
1810: 09 09 20 20 28 69 66 20 28 3e 20 28 6c 65 6e 67 .. (if (> (leng
1820: 74 68 20 74 65 73 74 73 29 20 6d 61 78 74 65 73 th tests) maxtes
1830: 74 73 29 0a 09 09 20 20 20 20 20 20 28 73 65 74 ts)... (set
1840: 21 20 6d 61 78 74 65 73 74 73 20 28 6c 65 6e 67 ! maxtests (leng
1850: 74 68 20 74 65 73 74 73 29 29 29 0a 09 09 20 20 th tests)))...
1860: 28 73 65 74 21 20 72 65 73 75 6c 74 20 28 63 6f (set! result (co
1870: 6e 73 20 28 76 65 63 74 6f 72 20 72 75 6e 20 74 ns (vector run t
1880: 65 73 74 73 20 6b 65 79 2d 76 61 6c 73 29 20 72 ests key-vals) r
1890: 65 73 75 6c 74 29 29 29 29 0a 09 20 20 20 20 20 esult))))..
18a0: 20 72 75 6e 73 29 0a 20 20 20 20 28 73 65 74 21 runs). (set!
18b0: 20 2a 68 65 61 64 65 72 2a 20 20 68 65 61 64 65 *header* heade
18c0: 72 29 0a 20 20 20 20 28 73 65 74 21 20 2a 61 6c r). (set! *al
18d0: 6c 72 75 6e 73 2a 20 72 65 73 75 6c 74 29 0a 20 lruns* result).
18e0: 20 20 20 6d 61 78 74 65 73 74 73 29 29 0a 0a 28 maxtests))..(
18f0: 64 65 66 69 6e 65 20 2a 63 6f 6c 6c 61 70 73 65 define *collapse
1900: 64 2a 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 d* (make-hash-ta
1910: 62 6c 65 29 29 0a 3b 20 28 64 65 66 69 6e 65 20 ble)).; (define
1920: 2a 72 6f 77 2d 6c 6f 6f 6b 75 70 2a 20 28 6d 61 *row-lookup* (ma
1930: 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 20 ke-hash-table))
1940: 3b 3b 20 74 65 73 74 6e 61 6d 65 20 3d 3e 20 28 ;; testname => (
1950: 72 6f 77 6e 75 6d 20 6c 61 62 6c 65 6f 62 6a 29 rownum lableobj)
1960: 0a 0a 28 64 65 66 69 6e 65 20 28 74 6f 67 67 6c ..(define (toggl
1970: 65 2d 68 69 64 65 20 6c 6e 75 6d 29 20 3b 20 66 e-hide lnum) ; f
1980: 75 6c 6c 74 65 73 74 6e 61 6d 65 29 0a 20 20 28 ulltestname). (
1990: 6c 65 74 2a 20 28 28 62 74 6e 20 28 76 65 63 74 let* ((btn (vect
19a0: 6f 72 2d 72 65 66 20 28 76 65 63 74 6f 72 2d 72 or-ref (vector-r
19b0: 65 66 20 75 69 64 61 74 20 30 29 20 6c 6e 75 6d ef uidat 0) lnum
19c0: 29 29 0a 09 20 28 66 75 6c 6c 74 65 73 74 6e 61 )).. (fulltestna
19d0: 6d 65 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 me (iup:attribut
19e0: 65 20 62 74 6e 20 22 54 49 54 4c 45 22 29 29 0a e btn "TITLE")).
19f0: 09 20 28 70 61 72 74 73 20 20 20 20 20 20 20 20 . (parts
1a00: 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 66 75 (string-split fu
1a10: 6c 6c 74 65 73 74 6e 61 6d 65 20 22 28 22 29 29 lltestname "("))
1a20: 0a 09 20 28 62 61 73 65 74 65 73 74 6e 61 6d 65 .. (basetestname
1a30: 20 28 69 66 20 28 6e 75 6c 6c 3f 20 70 61 72 74 (if (null? part
1a40: 73 29 20 22 22 20 28 63 61 72 20 70 61 72 74 73 s) "" (car parts
1a50: 29 29 29 29 0a 20 20 20 20 3b 28 70 72 69 6e 74 )))). ;(print
1a60: 20 22 54 6f 67 67 6c 69 6e 67 20 22 20 62 61 73 "Toggling " bas
1a70: 65 74 65 73 74 6e 61 6d 65 20 22 20 63 75 72 72 etestname " curr
1a80: 65 6e 74 6c 79 20 22 20 28 68 61 73 68 2d 74 61 ently " (hash-ta
1a90: 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 ble-ref/default
1aa0: 2a 63 6f 6c 6c 61 70 73 65 64 2a 20 62 61 73 65 *collapsed* base
1ab0: 74 65 73 74 6e 61 6d 65 20 23 66 29 29 0a 20 20 testname #f)).
1ac0: 20 20 28 69 66 20 28 68 61 73 68 2d 74 61 62 6c (if (hash-tabl
1ad0: 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 2a 63 e-ref/default *c
1ae0: 6f 6c 6c 61 70 73 65 64 2a 20 62 61 73 65 74 65 ollapsed* basete
1af0: 73 74 6e 61 6d 65 20 23 66 29 0a 09 28 62 65 67 stname #f)..(beg
1b00: 69 6e 0a 09 20 20 3b 28 69 75 70 3a 61 74 74 72 in.. ;(iup:attr
1b10: 69 62 75 74 65 2d 73 65 74 21 20 62 74 6e 20 22 ibute-set! btn "
1b20: 46 47 43 4f 4c 4f 52 22 20 22 30 20 30 20 30 22 FGCOLOR" "0 0 0"
1b30: 29 0a 09 20 20 28 68 61 73 68 2d 74 61 62 6c 65 ).. (hash-table
1b40: 2d 64 65 6c 65 74 65 21 20 2a 63 6f 6c 6c 61 70 -delete! *collap
1b50: 73 65 64 2a 20 62 61 73 65 74 65 73 74 6e 61 6d sed* basetestnam
1b60: 65 29 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 3b e))..(begin.. ;
1b70: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 (iup:attribute-s
1b80: 65 74 21 20 62 74 6e 20 22 46 47 43 4f 4c 4f 52 et! btn "FGCOLOR
1b90: 22 20 22 30 20 31 39 32 20 31 39 32 22 29 0a 09 " "0 192 192")..
1ba0: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 (hash-table-se
1bb0: 74 21 20 2a 63 6f 6c 6c 61 70 73 65 64 2a 20 62 t! *collapsed* b
1bc0: 61 73 65 74 65 73 74 6e 61 6d 65 20 23 74 29 29 asetestname #t))
1bd0: 29 29 29 0a 20 20 0a 28 64 65 66 69 6e 65 20 62 ))). .(define b
1be0: 6c 61 6e 6b 2d 6c 69 6e 65 2d 72 78 20 28 72 65 lank-line-rx (re
1bf0: 67 65 78 70 20 22 5e 5c 5c 73 2a 24 22 29 29 0a gexp "^\\s*$")).
1c00: 0a 28 64 65 66 69 6e 65 20 28 72 75 6e 2d 69 74 .(define (run-it
1c10: 65 6d 2d 6e 61 6d 65 2d 3e 76 65 63 74 6f 72 73 em-name->vectors
1c20: 20 6c 73 74 29 0a 20 20 28 6d 61 70 20 28 6c 61 lst). (map (la
1c30: 6d 62 64 61 20 28 78 29 0a 09 20 28 6c 65 74 20 mbda (x).. (let
1c40: 28 28 73 70 6c 73 74 20 28 73 74 72 69 6e 67 2d ((splst (string-
1c50: 73 70 6c 69 74 20 78 20 22 28 22 29 29 0a 09 20 split x "("))..
1c60: 20 20 20 20 20 20 28 72 65 73 20 20 20 28 76 65 (res (ve
1c70: 63 74 6f 72 20 22 22 20 22 22 29 29 29 0a 09 20 ctor "" "")))..
1c80: 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 72 (vector-set! r
1c90: 65 73 20 30 20 28 63 61 72 20 73 70 6c 73 74 29 es 0 (car splst)
1ca0: 29 0a 09 20 20 20 28 69 66 20 28 3e 20 28 6c 65 ).. (if (> (le
1cb0: 6e 67 74 68 20 73 70 6c 73 74 29 20 31 29 0a 09 ngth splst) 1)..
1cc0: 20 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d 73 (vector-s
1cd0: 65 74 21 20 72 65 73 20 31 20 28 63 61 72 20 28 et! res 1 (car (
1ce0: 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 28 63 61 string-split (ca
1cf0: 64 72 20 73 70 6c 73 74 29 20 22 29 22 29 29 29 dr splst) ")")))
1d00: 29 0a 09 20 20 20 72 65 73 29 29 0a 20 20 20 20 ).. res)).
1d10: 20 20 20 6c 73 74 29 29 0a 0a 28 64 65 66 69 6e lst))..(defin
1d20: 65 20 28 63 6f 6c 6c 61 70 73 65 2d 72 6f 77 73 e (collapse-rows
1d30: 20 69 6e 6c 73 74 29 0a 20 20 28 6c 65 74 2a 20 inlst). (let*
1d40: 28 28 6e 65 77 6c 73 74 20 28 66 69 6c 74 65 72 ((newlst (filter
1d50: 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 09 (lambda (x)....
1d60: 20 20 28 6c 65 74 2a 20 28 28 74 70 61 72 74 73 (let* ((tparts
1d70: 20 20 20 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 (string-spli
1d80: 74 20 78 20 22 28 22 29 29 0a 09 09 09 09 20 28 t x "("))..... (
1d90: 62 61 73 65 74 6e 61 6d 65 20 28 69 66 20 28 6e basetname (if (n
1da0: 75 6c 6c 3f 20 74 70 61 72 74 73 29 20 78 20 28 ull? tparts) x (
1db0: 63 61 72 20 74 70 61 72 74 73 29 29 29 29 0a 09 car tparts))))..
1dc0: 09 09 09 09 3b 28 70 72 69 6e 74 20 22 78 20 22 ....;(print "x "
1dd0: 20 78 20 22 20 74 70 61 72 74 73 3a 20 22 20 74 x " tparts: " t
1de0: 70 61 72 74 73 20 22 20 62 61 73 65 74 6e 61 6d parts " basetnam
1df0: 65 3a 20 22 20 62 61 73 65 74 6e 61 6d 65 29 0a e: " basetname).
1e00: 09 09 09 20 20 20 20 28 63 6f 6e 64 0a 09 09 09 ... (cond....
1e10: 20 20 20 20 20 28 28 73 74 72 69 6e 67 2d 6d 61 ((string-ma
1e20: 74 63 68 20 62 6c 61 6e 6b 2d 6c 69 6e 65 2d 72 tch blank-line-r
1e30: 78 20 78 29 20 23 66 29 0a 09 09 09 20 20 20 20 x x) #f)....
1e40: 20 28 28 65 71 75 61 6c 3f 20 78 20 62 61 73 65 ((equal? x base
1e50: 74 6e 61 6d 65 29 20 23 74 29 0a 09 09 09 20 20 tname) #t)....
1e60: 20 20 20 28 28 68 61 73 68 2d 74 61 62 6c 65 2d ((hash-table-
1e70: 72 65 66 2f 64 65 66 61 75 6c 74 20 2a 63 6f 6c ref/default *col
1e80: 6c 61 70 73 65 64 2a 20 62 61 73 65 74 6e 61 6d lapsed* basetnam
1e90: 65 20 23 66 29 20 0a 09 09 09 09 09 3b 28 70 72 e #f) ......;(pr
1ea0: 69 6e 74 20 22 52 65 6d 6f 76 69 6e 67 20 22 20 int "Removing "
1eb0: 62 61 73 65 74 6e 61 6d 65 20 22 20 66 72 6f 6d basetname " from
1ec0: 20 69 74 65 6d 73 22 29 0a 09 09 09 20 20 20 20 items")....
1ed0: 20 20 23 66 29 0a 09 09 09 20 20 20 20 20 28 65 #f).... (e
1ee0: 6c 73 65 20 23 74 29 29 29 29 0a 09 09 09 69 6e lse #t))))....in
1ef0: 6c 73 74 29 29 0a 09 20 28 76 6c 73 74 20 20 28 lst)).. (vlst (
1f00: 72 75 6e 2d 69 74 65 6d 2d 6e 61 6d 65 2d 3e 76 run-item-name->v
1f10: 65 63 74 6f 72 73 20 6e 65 77 6c 73 74 29 29 0a ectors newlst)).
1f20: 09 20 3b 3b 20 73 6f 72 74 20 62 79 20 73 65 63 . ;; sort by sec
1f30: 6f 6e 64 20 66 69 65 6c 64 0a 09 20 28 76 6c 73 ond field.. (vls
1f40: 74 2d 73 31 20 28 73 6f 72 74 20 76 6c 73 74 20 t-s1 (sort vlst
1f50: 28 6c 61 6d 62 64 61 20 28 61 20 62 29 0a 09 09 (lambda (a b)...
1f60: 09 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 61 . (let ((a
1f70: 73 74 72 20 28 76 65 63 74 6f 72 2d 72 65 66 20 str (vector-ref
1f80: 61 20 31 29 29 0a 09 09 09 09 20 20 20 20 20 28 a 1))..... (
1f90: 62 73 74 72 20 28 76 65 63 74 6f 72 2d 72 65 66 bstr (vector-ref
1fa0: 20 62 20 31 29 29 29 0a 09 09 09 09 20 28 69 66 b 1)))..... (if
1fb0: 20 28 73 74 72 69 6e 67 3d 3f 20 61 73 74 72 20 (string=? astr
1fc0: 22 22 29 20 23 66 20 23 74 29 29 29 29 29 0a 09 "") #f #t)))))..
1fd0: 09 09 3b 3b 20 28 3e 3d 20 28 73 74 72 69 6e 67 ..;; (>= (string
1fe0: 2d 6c 65 6e 67 74 68 20 28 76 65 63 74 6f 72 2d -length (vector-
1ff0: 72 65 66 20 61 20 31 29 29 28 73 74 72 69 6e 67 ref a 1))(string
2000: 2d 6c 65 6e 67 74 68 20 28 76 65 63 74 6f 72 2d -length (vector-
2010: 72 65 66 20 62 20 31 29 29 29 29 29 29 0a 09 20 ref b 1))))))..
2020: 28 76 6c 73 74 2d 73 32 20 28 73 6f 72 74 20 76 (vlst-s2 (sort v
2030: 6c 73 74 2d 73 31 20 28 6c 61 6d 62 64 61 20 28 lst-s1 (lambda (
2040: 61 20 62 29 0a 09 09 09 09 20 20 28 73 74 72 69 a b)..... (stri
2050: 6e 67 3e 3d 20 28 76 65 63 74 6f 72 2d 72 65 66 ng>= (vector-ref
2060: 20 61 20 30 29 28 76 65 63 74 6f 72 2d 72 65 66 a 0)(vector-ref
2070: 20 62 20 30 29 29 29 29 29 29 0a 20 20 20 20 28 b 0)))))). (
2080: 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 78 29 0a map (lambda (x).
2090: 09 20 20 20 28 69 66 20 28 65 71 75 61 6c 3f 20 . (if (equal?
20a0: 28 76 65 63 74 6f 72 2d 72 65 66 20 78 20 31 29 (vector-ref x 1)
20b0: 20 22 22 29 0a 09 20 20 20 20 20 20 20 28 76 65 "").. (ve
20c0: 63 74 6f 72 2d 72 65 66 20 78 20 30 29 0a 09 20 ctor-ref x 0)..
20d0: 20 20 20 20 20 20 28 63 6f 6e 63 20 28 76 65 63 (conc (vec
20e0: 74 6f 72 2d 72 65 66 20 78 20 30 29 20 22 28 22 tor-ref x 0) "("
20f0: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 78 20 31 (vector-ref x 1
2100: 29 20 22 29 22 29 29 29 0a 09 20 76 6c 73 74 2d ) ")"))).. vlst-
2110: 73 32 29 29 29 0a 20 20 20 20 0a 20 20 20 20 3b s2))). . ;
2120: 3b 20 28 73 6f 72 74 20 6e 65 77 6c 73 74 20 28 ; (sort newlst (
2130: 6c 61 6d 62 64 61 20 28 61 20 62 29 0a 20 20 20 lambda (a b).
2140: 20 3b 3b 20 20 20 20 20 09 20 20 20 28 6c 65 74 ;; . (let
2150: 2a 20 28 28 70 61 72 74 73 61 20 28 73 74 72 69 * ((partsa (stri
2160: 6e 67 2d 73 70 6c 69 74 20 61 20 22 28 22 29 29 ng-split a "("))
2170: 0a 20 20 20 20 3b 3b 20 20 20 20 20 09 09 20 20 . ;; ..
2180: 28 70 61 72 74 73 62 20 28 73 74 72 69 6e 67 2d (partsb (string-
2190: 73 70 6c 69 74 20 62 20 22 28 22 29 29 0a 20 20 split b "(")).
21a0: 20 20 3b 3b 20 20 20 20 20 09 09 20 20 28 6c 65 ;; .. (le
21b0: 6e 61 20 20 20 28 6c 65 6e 67 74 68 20 70 61 72 na (length par
21c0: 74 73 61 29 29 0a 20 20 20 20 3b 3b 20 20 20 20 tsa)). ;;
21d0: 20 09 09 20 20 28 6c 65 6e 62 20 20 20 28 6c 65 .. (lenb (le
21e0: 6e 67 74 68 20 70 61 72 74 73 62 29 29 29 0a 20 ngth partsb))).
21f0: 20 20 20 3b 3b 20 20 20 20 20 09 20 20 20 20 20 ;; .
2200: 28 69 66 20 28 6f 72 20 28 61 6e 64 20 28 65 71 (if (or (and (eq
2210: 3f 20 6c 65 6e 61 20 31 29 28 3e 20 6c 65 6e 62 ? lena 1)(> lenb
2220: 20 31 29 29 0a 20 20 20 20 3b 3b 20 20 20 20 20 1)). ;;
2230: 09 09 20 20 20 20 20 28 61 6e 64 20 28 65 71 3f .. (and (eq?
2240: 20 6c 65 6e 62 20 31 29 28 3e 20 6c 65 6e 61 20 lenb 1)(> lena
2250: 31 29 29 29 0a 20 20 20 20 3b 3b 20 20 20 20 20 1))). ;;
2260: 09 09 20 28 69 66 20 28 65 71 75 61 6c 3f 20 28 .. (if (equal? (
2270: 63 61 72 20 70 61 72 74 73 61 29 28 63 61 72 20 car partsa)(car
2280: 70 61 72 74 73 62 29 29 20 3b 3b 20 73 61 6d 65 partsb)) ;; same
2290: 20 74 65 73 74 0a 20 20 20 20 3b 3b 20 20 20 20 test. ;;
22a0: 20 09 09 20 20 20 20 20 28 3e 20 6c 65 6e 62 20 .. (> lenb
22b0: 6c 65 6e 61 29 0a 20 20 20 20 3b 3b 20 20 20 20 lena). ;;
22c0: 20 09 09 20 20 20 20 20 23 74 29 0a 20 20 20 20 .. #t).
22d0: 3b 3b 20 20 20 20 20 09 09 20 23 74 29 29 29 29 ;; .. #t))))
22e0: 29 29 0a 09 09 09 20 20 20 20 20 0a 28 64 65 66 )).... .(def
22f0: 69 6e 65 20 28 75 70 64 61 74 65 2d 6c 61 62 65 ine (update-labe
2300: 6c 73 20 75 69 64 61 74 29 0a 20 20 28 6c 65 74 ls uidat). (let
2310: 2a 20 28 28 72 6f 77 6e 20 20 20 20 30 29 0a 09 * ((rown 0)..
2320: 20 28 6c 66 74 63 6f 6c 20 20 28 76 65 63 74 6f (lftcol (vecto
2330: 72 2d 72 65 66 20 75 69 64 61 74 20 30 29 29 0a r-ref uidat 0)).
2340: 09 20 28 6e 75 6d 63 6f 6c 73 20 28 76 65 63 74 . (numcols (vect
2350: 6f 72 2d 6c 65 6e 67 74 68 20 6c 66 74 63 6f 6c or-length lftcol
2360: 29 29 0a 09 20 28 6d 61 78 6e 20 20 20 20 28 2d )).. (maxn (-
2370: 20 6e 75 6d 63 6f 6c 73 20 31 29 29 0a 09 20 28 numcols 1)).. (
2380: 61 6c 6c 76 61 6c 73 20 28 6d 61 6b 65 2d 76 65 allvals (make-ve
2390: 63 74 6f 72 20 6e 75 6d 63 6f 6c 73 20 22 22 29 ctor numcols "")
23a0: 29 29 0a 20 20 20 20 28 66 6f 72 2d 65 61 63 68 )). (for-each
23b0: 20 28 6c 61 6d 62 64 61 20 28 6e 61 6d 65 29 0a (lambda (name).
23c0: 09 09 28 69 66 20 28 3c 3d 20 72 6f 77 6e 20 6d ..(if (<= rown m
23d0: 61 78 6e 29 0a 09 09 20 20 20 20 28 6c 65 74 20 axn)... (let
23e0: 28 28 6c 61 62 6c 20 28 76 65 63 74 6f 72 2d 72 ((labl (vector-r
23f0: 65 66 20 6c 66 74 63 6f 6c 20 72 6f 77 6e 29 29 ef lftcol rown))
2400: 29 0a 09 09 20 20 20 20 20 20 28 76 65 63 74 6f )... (vecto
2410: 72 2d 73 65 74 21 20 61 6c 6c 76 61 6c 73 20 72 r-set! allvals r
2420: 6f 77 6e 20 6e 61 6d 65 29 29 29 0a 09 09 28 73 own name)))...(s
2430: 65 74 21 20 72 6f 77 6e 20 28 2b 20 31 20 72 6f et! rown (+ 1 ro
2440: 77 6e 29 29 29 0a 09 20 20 20 20 20 20 2a 61 6c wn))).. *al
2450: 6c 74 65 73 74 6e 61 6d 65 6c 73 74 2a 29 0a 09 ltestnamelst*)..
2460: 3b 20 20 20 20 20 20 28 69 66 20 28 3e 20 28 6c ; (if (> (l
2470: 65 6e 67 74 68 20 2a 61 6c 6c 74 65 73 74 6e 61 ength *alltestna
2480: 6d 65 6c 73 74 2a 29 20 2a 73 74 61 72 74 2d 74 melst*) *start-t
2490: 65 73 74 2d 6f 66 66 73 65 74 2a 29 0a 09 3b 09 est-offset*)..;.
24a0: 20 20 28 64 72 6f 70 20 2a 61 6c 6c 74 65 73 74 (drop *alltest
24b0: 6e 61 6d 65 6c 73 74 2a 20 2a 73 74 61 72 74 2d namelst* *start-
24c0: 74 65 73 74 2d 6f 66 66 73 65 74 2a 29 0a 09 3b test-offset*)..;
24d0: 09 20 20 27 28 29 29 29 0a 20 20 20 20 28 6c 65 . '())). (le
24e0: 74 20 6c 6f 6f 70 20 28 28 69 20 30 29 29 0a 20 t loop ((i 0)).
24f0: 20 20 20 20 20 28 6c 65 74 2a 20 28 28 6c 62 6c (let* ((lbl
2500: 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 (vector-ref
2510: 6c 66 74 63 6f 6c 20 69 29 29 0a 09 20 20 20 20 lftcol i))..
2520: 20 28 6f 6c 64 76 61 6c 20 28 69 75 70 3a 61 74 (oldval (iup:at
2530: 74 72 69 62 75 74 65 20 6c 62 6c 20 22 54 49 54 tribute lbl "TIT
2540: 4c 45 22 29 29 0a 09 20 20 20 20 20 28 6e 65 77 LE")).. (new
2550: 76 61 6c 20 28 76 65 63 74 6f 72 2d 72 65 66 20 val (vector-ref
2560: 61 6c 6c 76 61 6c 73 20 69 29 29 29 0a 09 28 69 allvals i)))..(i
2570: 66 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 6f f (not (equal? o
2580: 6c 64 76 61 6c 20 6e 65 77 76 61 6c 29 29 0a 09 ldval newval))..
2590: 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 (iup:attribu
25a0: 74 65 2d 73 65 74 21 20 6c 62 6c 20 22 54 49 54 te-set! lbl "TIT
25b0: 4c 45 22 20 6e 65 77 76 61 6c 29 29 0a 09 28 69 LE" newval))..(i
25c0: 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 up:attribute-set
25d0: 21 20 6c 62 6c 20 22 46 47 43 4f 4c 4f 52 22 20 ! lbl "FGCOLOR"
25e0: 28 69 66 20 28 68 61 73 68 2d 74 61 62 6c 65 2d (if (hash-table-
25f0: 72 65 66 2f 64 65 66 61 75 6c 74 20 2a 63 6f 6c ref/default *col
2600: 6c 61 70 73 65 64 2a 20 6e 65 77 76 61 6c 20 23 lapsed* newval #
2610: 66 29 20 22 30 20 31 31 32 20 31 31 32 22 20 22 f) "0 112 112" "
2620: 30 20 30 20 30 22 29 29 0a 09 28 69 66 20 28 3c 0 0 0"))..(if (<
2630: 20 69 20 6d 61 78 6e 29 0a 09 20 20 20 20 28 6c i maxn).. (l
2640: 6f 6f 70 20 28 2b 20 69 20 31 29 29 29 29 29 29 oop (+ i 1))))))
2650: 29 0a 0a 28 64 65 66 69 6e 65 20 28 67 65 74 2d )..(define (get-
2660: 63 6f 6c 6f 72 2d 66 6f 72 2d 73 74 61 74 65 2d color-for-state-
2670: 73 74 61 74 75 73 20 73 74 61 74 65 20 73 74 61 status state sta
2680: 74 75 73 29 0a 20 20 28 63 61 73 65 20 28 73 74 tus). (case (st
2690: 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 73 74 61 ring->symbol sta
26a0: 74 65 29 0a 20 20 20 20 28 28 43 4f 4d 50 4c 45 te). ((COMPLE
26b0: 54 45 44 29 0a 20 20 20 20 20 28 69 66 20 28 65 TED). (if (e
26c0: 71 75 61 6c 3f 20 73 74 61 74 75 73 20 22 50 41 qual? status "PA
26d0: 53 53 22 29 0a 09 20 22 37 30 20 32 34 39 20 37 SS").. "70 249 7
26e0: 33 22 0a 09 20 28 69 66 20 28 6f 72 20 28 65 71 3".. (if (or (eq
26f0: 75 61 6c 3f 20 73 74 61 74 75 73 20 22 57 41 52 ual? status "WAR
2700: 4e 22 29 0a 09 09 20 28 65 71 75 61 6c 3f 20 73 N")... (equal? s
2710: 74 61 74 75 73 20 22 57 41 49 56 45 44 22 29 29 tatus "WAIVED"))
2720: 0a 09 20 20 20 20 20 22 32 35 35 20 31 37 32 20 .. "255 172
2730: 31 33 22 0a 09 20 20 20 20 20 22 32 32 33 20 33 13".. "223 3
2740: 33 20 34 39 22 29 29 29 20 3b 3b 20 67 72 65 65 3 49"))) ;; gree
2750: 6e 69 73 68 20 6f 72 61 6e 67 65 69 73 68 20 72 nish orangeish r
2760: 65 64 69 73 68 0a 20 20 20 20 28 28 4c 41 55 4e edish. ((LAUN
2770: 43 48 45 44 29 20 20 20 20 20 20 20 20 20 22 31 CHED) "1
2780: 30 31 20 31 32 33 20 31 34 32 22 29 0a 20 20 20 01 123 142").
2790: 20 28 28 43 48 45 43 4b 29 20 20 20 20 20 20 20 ((CHECK)
27a0: 20 20 20 20 20 22 32 35 35 20 31 30 30 20 35 30 "255 100 50
27b0: 22 29 0a 20 20 20 20 28 28 52 45 4d 4f 54 45 48 "). ((REMOTEH
27c0: 4f 53 54 53 54 41 52 54 29 20 20 22 35 30 20 31 OSTSTART) "50 1
27d0: 33 30 20 31 39 35 22 29 0a 20 20 20 20 28 28 52 30 195"). ((R
27e0: 55 4e 4e 49 4e 47 29 20 20 20 20 20 20 20 20 20 UNNING)
27f0: 20 22 39 20 31 33 31 20 32 33 32 22 29 0a 20 20 "9 131 232").
2800: 20 20 28 28 4b 49 4c 4c 52 45 51 29 20 20 20 20 ((KILLREQ)
2810: 20 20 20 20 20 20 22 33 39 20 38 32 20 32 30 36 "39 82 206
2820: 22 29 0a 20 20 20 20 28 28 4b 49 4c 4c 45 44 29 "). ((KILLED)
2830: 20 20 20 20 20 20 20 20 20 20 20 22 32 33 34 20 "234
2840: 31 30 31 20 31 37 22 29 0a 20 20 20 20 28 28 4e 101 17"). ((N
2850: 4f 54 5f 53 54 41 52 54 45 44 29 20 20 20 20 20 OT_STARTED)
2860: 20 22 32 34 30 20 32 34 30 20 32 34 30 22 29 0a "240 240 240").
2870: 20 20 20 20 28 65 6c 73 65 20 20 20 20 20 20 20 (else
2880: 20 20 20 20 20 20 20 20 22 31 39 32 20 31 39 32 "192 192
2890: 20 31 39 32 22 29 29 29 0a 0a 28 64 65 66 69 6e 192")))..(defin
28a0: 65 20 28 75 70 64 61 74 65 2d 62 75 74 74 6f 6e e (update-button
28b0: 73 20 75 69 64 61 74 20 6e 75 6d 72 75 6e 73 20 s uidat numruns
28c0: 6e 75 6d 74 65 73 74 73 29 0a 20 20 28 6c 65 74 numtests). (let
28d0: 2a 20 28 28 72 75 6e 73 20 20 20 20 20 20 20 20 * ((runs
28e0: 28 69 66 20 28 3e 20 28 6c 65 6e 67 74 68 20 2a (if (> (length *
28f0: 61 6c 6c 72 75 6e 73 2a 29 20 6e 75 6d 72 75 6e allruns*) numrun
2900: 73 29 0a 09 09 09 20 20 28 74 61 6b 65 2d 72 69 s).... (take-ri
2910: 67 68 74 20 2a 61 6c 6c 72 75 6e 73 2a 20 6e 75 ght *allruns* nu
2920: 6d 72 75 6e 73 29 0a 09 09 09 20 20 28 70 61 64 mruns).... (pad
2930: 2d 6c 69 73 74 20 2a 61 6c 6c 72 75 6e 73 2a 20 -list *allruns*
2940: 6e 75 6d 72 75 6e 73 29 29 29 0a 09 20 28 6c 66 numruns))).. (lf
2950: 74 63 6f 6c 20 20 20 20 20 20 28 76 65 63 74 6f tcol (vecto
2960: 72 2d 72 65 66 20 75 69 64 61 74 20 30 29 29 0a r-ref uidat 0)).
2970: 09 20 28 74 61 62 6c 65 68 65 61 64 65 72 20 28 . (tableheader (
2980: 76 65 63 74 6f 72 2d 72 65 66 20 75 69 64 61 74 vector-ref uidat
2990: 20 31 29 29 0a 09 20 28 74 61 62 6c 65 20 20 20 1)).. (table
29a0: 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 (vector-ref
29b0: 75 69 64 61 74 20 32 29 29 0a 09 20 28 63 6f 6c uidat 2)).. (col
29c0: 6e 20 20 20 20 20 20 20 20 30 29 29 0a 20 20 20 n 0)).
29d0: 20 28 73 65 74 21 20 2a 61 6c 6c 74 65 73 74 6e (set! *alltestn
29e0: 61 6d 65 6c 73 74 2a 20 27 28 29 29 0a 20 20 20 amelst* '()).
29f0: 20 3b 3b 20 63 72 65 61 74 65 20 61 20 63 6f 6e ;; create a con
2a00: 63 69 73 65 20 6c 69 73 74 20 6f 66 20 74 65 73 cise list of tes
2a10: 74 20 6e 61 6d 65 73 0a 20 20 20 20 28 66 6f 72 t names. (for
2a20: 2d 65 61 63 68 0a 20 20 20 20 20 28 6c 61 6d 62 -each. (lamb
2a30: 64 61 20 28 72 75 6e 64 61 74 29 0a 20 20 20 20 da (rundat).
2a40: 20 20 20 28 69 66 20 28 76 65 63 74 6f 72 3f 20 (if (vector?
2a50: 72 75 6e 64 61 74 29 0a 09 20 20 20 28 6c 65 74 rundat).. (let
2a60: 2a 20 28 28 74 65 73 74 64 61 74 20 20 20 28 76 * ((testdat (v
2a70: 65 63 74 6f 72 2d 72 65 66 20 72 75 6e 64 61 74 ector-ref rundat
2a80: 20 31 29 29 0a 09 09 20 20 28 74 65 73 74 6e 61 1))... (testna
2a90: 6d 65 73 20 28 6d 61 70 20 74 65 73 74 3a 74 65 mes (map test:te
2aa0: 73 74 2d 67 65 74 2d 66 75 6c 6c 6e 61 6d 65 20 st-get-fullname
2ab0: 74 65 73 74 64 61 74 29 29 29 0a 09 20 20 20 20 testdat)))..
2ac0: 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 (for-each (lamb
2ad0: 64 61 20 28 74 65 73 74 6e 61 6d 65 29 0a 09 09 da (testname)...
2ae0: 09 20 28 69 66 20 28 6e 6f 74 20 28 6d 65 6d 62 . (if (not (memb
2af0: 65 72 20 74 65 73 74 6e 61 6d 65 20 2a 61 6c 6c er testname *all
2b00: 74 65 73 74 6e 61 6d 65 6c 73 74 2a 29 29 0a 09 testnamelst*))..
2b10: 09 09 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 .. (begin...
2b20: 09 20 20 20 20 20 20 20 28 73 65 74 21 20 2a 61 . (set! *a
2b30: 6c 6c 74 65 73 74 6e 61 6d 65 6c 73 74 2a 20 28 lltestnamelst* (
2b40: 61 70 70 65 6e 64 20 2a 61 6c 6c 74 65 73 74 6e append *alltestn
2b50: 61 6d 65 6c 73 74 2a 20 28 6c 69 73 74 20 74 65 amelst* (list te
2b60: 73 74 6e 61 6d 65 29 29 29 29 29 29 0a 09 09 20 stname))))))...
2b70: 20 20 20 20 20 20 74 65 73 74 6e 61 6d 65 73 29 testnames)
2b80: 29 29 29 0a 20 20 20 20 20 72 75 6e 73 29 0a 0a ))). runs)..
2b90: 20 20 20 20 28 73 65 74 21 20 2a 61 6c 6c 74 65 (set! *allte
2ba0: 73 74 6e 61 6d 65 6c 73 74 2a 20 28 63 6f 6c 6c stnamelst* (coll
2bb0: 61 70 73 65 2d 72 6f 77 73 20 2a 61 6c 6c 74 65 apse-rows *allte
2bc0: 73 74 6e 61 6d 65 6c 73 74 2a 29 29 20 3b 3b 3b stnamelst*)) ;;;
2bd0: 20 61 72 67 68 2e 20 70 6c 65 61 73 65 20 63 6c argh. please cl
2be0: 65 61 6e 20 75 70 20 74 68 69 73 20 73 69 6c 6c ean up this sill
2bf0: 79 6e 65 73 73 0a 20 20 20 20 28 73 65 74 21 20 yness. (set!
2c00: 2a 61 6c 6c 74 65 73 74 6e 61 6d 65 6c 73 74 2a *alltestnamelst*
2c10: 20 28 6c 65 74 20 28 28 78 6c 20 28 69 66 20 28 (let ((xl (if (
2c20: 3e 20 28 6c 65 6e 67 74 68 20 2a 61 6c 6c 74 65 > (length *allte
2c30: 73 74 6e 61 6d 65 6c 73 74 2a 29 20 2a 73 74 61 stnamelst*) *sta
2c40: 72 74 2d 74 65 73 74 2d 6f 66 66 73 65 74 2a 29 rt-test-offset*)
2c50: 0a 09 09 09 09 09 20 28 64 72 6f 70 20 2a 61 6c ...... (drop *al
2c60: 6c 74 65 73 74 6e 61 6d 65 6c 73 74 2a 20 2a 73 ltestnamelst* *s
2c70: 74 61 72 74 2d 74 65 73 74 2d 6f 66 66 73 65 74 tart-test-offset
2c80: 2a 29 0a 09 09 09 09 09 20 27 28 29 29 29 29 0a *)...... '()))).
2c90: 09 09 09 20 20 20 20 20 28 61 70 70 65 6e 64 20 ... (append
2ca0: 78 6c 20 28 6d 61 6b 65 2d 6c 69 73 74 20 28 2d xl (make-list (-
2cb0: 20 2a 6e 75 6d 2d 74 65 73 74 73 2a 20 28 6c 65 *num-tests* (le
2cc0: 6e 67 74 68 20 78 6c 29 29 20 22 22 29 29 29 29 ngth xl)) ""))))
2cd0: 0a 20 20 20 20 28 75 70 64 61 74 65 2d 6c 61 62 . (update-lab
2ce0: 65 6c 73 20 75 69 64 61 74 29 0a 20 20 20 20 28 els uidat). (
2cf0: 66 6f 72 2d 65 61 63 68 0a 20 20 20 20 20 28 6c for-each. (l
2d00: 61 6d 62 64 61 20 28 72 75 6e 64 61 74 29 0a 20 ambda (rundat).
2d10: 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 72 (if (not r
2d20: 75 6e 64 61 74 29 20 3b 3b 20 68 61 6e 64 6c 65 undat) ;; handle
2d30: 20 70 61 64 64 65 64 20 72 75 6e 73 0a 09 20 20 padded runs..
2d40: 20 3b 3b 20 20 20 20 20 20 20 20 20 20 20 3b 3b ;; ;;
2d50: 20 69 64 20 72 75 6e 2d 69 64 20 74 65 73 74 6e id run-id testn
2d60: 61 6d 65 20 73 74 61 74 65 20 73 74 61 74 75 73 ame state status
2d70: 20 65 76 65 6e 74 2d 74 69 6d 65 20 68 6f 73 74 event-time host
2d80: 20 63 70 75 6c 6f 61 64 20 64 69 73 6b 66 72 65 cpuload diskfre
2d90: 65 20 75 6e 61 6d 65 20 72 75 6e 64 69 72 20 69 e uname rundir i
2da0: 74 65 6d 2d 70 61 74 68 20 72 75 6e 2d 64 75 72 tem-path run-dur
2db0: 61 74 69 6f 6e 0a 09 20 20 20 28 73 65 74 21 20 ation.. (set!
2dc0: 72 75 6e 64 61 74 20 28 76 65 63 74 6f 72 20 28 rundat (vector (
2dd0: 6d 61 6b 65 2d 76 65 63 74 6f 72 20 32 30 20 23 make-vector 20 #
2de0: 66 29 20 27 28 29 20 28 6d 61 70 20 28 6c 61 6d f) '() (map (lam
2df0: 62 64 61 20 28 78 29 20 22 22 29 20 2a 6b 65 79 bda (x) "") *key
2e00: 73 2a 29 29 29 29 3b 3b 20 33 29 29 29 0a 20 20 s*))));; 3))).
2e10: 20 20 20 20 20 28 6c 65 74 2a 20 28 28 72 75 6e (let* ((run
2e20: 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 (vector-re
2e30: 66 20 72 75 6e 64 61 74 20 30 29 29 0a 09 20 20 f rundat 0))..
2e40: 20 20 20 20 28 74 65 73 74 73 64 61 74 20 28 76 (testsdat (v
2e50: 65 63 74 6f 72 2d 72 65 66 20 72 75 6e 64 61 74 ector-ref rundat
2e60: 20 31 29 29 0a 09 20 20 20 20 20 20 28 6b 65 79 1)).. (key
2e70: 2d 76 61 6c 2d 64 61 74 20 28 76 65 63 74 6f 72 -val-dat (vector
2e80: 2d 72 65 66 20 72 75 6e 64 61 74 20 32 29 29 0a -ref rundat 2)).
2e90: 09 20 20 20 20 20 20 28 72 75 6e 2d 69 64 20 20 . (run-id
2ea0: 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 (db:get-value-b
2eb0: 79 2d 68 65 61 64 65 72 20 72 75 6e 20 2a 68 65 y-header run *he
2ec0: 61 64 65 72 2a 20 22 69 64 22 29 29 0a 09 20 20 ader* "id"))..
2ed0: 20 20 20 20 28 6b 65 79 2d 76 61 6c 73 20 28 61 (key-vals (a
2ee0: 70 70 65 6e 64 20 6b 65 79 2d 76 61 6c 2d 64 61 ppend key-val-da
2ef0: 74 0a 09 09 09 09 28 6c 69 73 74 20 28 6c 65 74 t.....(list (let
2f00: 20 28 28 78 20 28 64 62 3a 67 65 74 2d 76 61 6c ((x (db:get-val
2f10: 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 6e ue-by-header run
2f20: 20 2a 68 65 61 64 65 72 2a 20 22 72 75 6e 6e 61 *header* "runna
2f30: 6d 65 22 29 29 29 0a 09 09 09 09 09 28 69 66 20 me")))......(if
2f40: 78 20 78 20 22 22 29 29 29 29 29 0a 09 20 20 20 x x "")))))..
2f50: 20 20 20 28 72 75 6e 2d 6b 65 79 20 20 28 73 74 (run-key (st
2f60: 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 ring-intersperse
2f70: 20 6b 65 79 2d 76 61 6c 73 20 22 5c 6e 22 29 29 key-vals "\n"))
2f80: 29 0a 0a 09 20 3b 3b 20 66 69 6c 6c 20 69 6e 20 )... ;; fill in
2f90: 74 68 65 20 72 75 6e 20 68 65 61 64 65 72 20 6b the run header k
2fa0: 65 79 20 76 61 6c 75 65 73 0a 09 20 28 6c 65 74 ey values.. (let
2fb0: 20 28 28 72 6f 77 6e 20 20 20 20 20 20 30 29 0a ((rown 0).
2fc0: 09 20 20 20 20 20 20 20 28 68 65 61 64 65 72 63 . (headerc
2fd0: 6f 6c 20 28 76 65 63 74 6f 72 2d 72 65 66 20 74 ol (vector-ref t
2fe0: 61 62 6c 65 68 65 61 64 65 72 20 63 6f 6c 6e 29 ableheader coln)
2ff0: 29 29 0a 09 20 20 20 28 66 6f 72 2d 65 61 63 68 )).. (for-each
3000: 20 28 6c 61 6d 62 64 61 20 28 6b 76 61 6c 29 0a (lambda (kval).
3010: 09 09 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 .. (let* (
3020: 28 6c 61 62 6c 20 20 20 20 20 20 28 76 65 63 74 (labl (vect
3030: 6f 72 2d 72 65 66 20 68 65 61 64 65 72 63 6f 6c or-ref headercol
3040: 20 72 6f 77 6e 29 29 29 0a 09 09 09 20 28 69 66 rown))).... (if
3050: 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 6b 76 (not (equal? kv
3060: 61 6c 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 al (iup:attribut
3070: 65 20 6c 61 62 6c 20 22 54 49 54 4c 45 22 29 29 e labl "TITLE"))
3080: 29 0a 09 09 09 20 20 20 20 20 28 69 75 70 3a 61 ).... (iup:a
3090: 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 28 76 ttribute-set! (v
30a0: 65 63 74 6f 72 2d 72 65 66 20 68 65 61 64 65 72 ector-ref header
30b0: 63 6f 6c 20 72 6f 77 6e 29 20 22 54 49 54 4c 45 col rown) "TITLE
30c0: 22 20 6b 76 61 6c 29 29 0a 09 09 09 20 28 73 65 " kval)).... (se
30d0: 74 21 20 72 6f 77 6e 20 28 2b 20 72 6f 77 6e 20 t! rown (+ rown
30e0: 31 29 29 29 29 0a 09 09 20 20 20 20 20 6b 65 79 1))))... key
30f0: 2d 76 61 6c 73 29 29 0a 0a 09 20 3b 3b 20 46 6f -vals))... ;; Fo
3100: 72 20 74 68 69 73 20 72 75 6e 20 6e 6f 77 20 66 r this run now f
3110: 69 6c 6c 20 69 6e 20 74 68 65 20 62 75 74 74 6f ill in the butto
3120: 6e 73 20 66 6f 72 20 65 61 63 68 20 74 65 73 74 ns for each test
3130: 0a 09 20 28 6c 65 74 20 28 28 72 6f 77 6e 20 30 .. (let ((rown 0
3140: 29 0a 09 20 20 20 20 20 20 20 28 63 6f 6c 75 6d ).. (colum
3150: 6e 64 61 74 20 20 28 76 65 63 74 6f 72 2d 72 65 ndat (vector-re
3160: 66 20 74 61 62 6c 65 20 63 6f 6c 6e 29 29 29 0a f table coln))).
3170: 09 20 20 20 28 66 6f 72 2d 65 61 63 68 0a 09 20 . (for-each..
3180: 20 20 20 28 6c 61 6d 62 64 61 20 28 74 65 73 74 (lambda (test
3190: 6e 61 6d 65 29 0a 09 20 20 20 20 20 20 28 6c 65 name).. (le
31a0: 74 20 28 28 62 75 74 74 6f 6e 64 61 74 20 20 28 t ((buttondat (
31b0: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 hash-table-ref/d
31c0: 65 66 61 75 6c 74 20 2a 62 75 74 74 6f 6e 64 61 efault *buttonda
31d0: 74 2a 20 28 6d 6b 73 74 72 20 63 6f 6c 6e 20 72 t* (mkstr coln r
31e0: 6f 77 6e 29 20 23 66 29 29 29 0a 09 09 28 69 66 own) #f)))...(if
31f0: 20 62 75 74 74 6f 6e 64 61 74 0a 09 09 20 20 20 buttondat...
3200: 20 28 6c 65 74 2a 20 28 28 74 65 73 74 20 20 20 (let* ((test
3210: 20 20 20 20 28 6c 65 74 20 28 28 6d 61 74 63 68 (let ((match
3220: 69 6e 67 20 28 66 69 6c 74 65 72 20 0a 09 09 09 ing (filter ....
3230: 09 09 09 09 28 6c 61 6d 62 64 61 20 28 78 29 28 ....(lambda (x)(
3240: 65 71 75 61 6c 3f 20 28 74 65 73 74 3a 74 65 73 equal? (test:tes
3250: 74 2d 67 65 74 2d 66 75 6c 6c 6e 61 6d 65 20 78 t-get-fullname x
3260: 29 20 74 65 73 74 6e 61 6d 65 29 29 0a 09 09 09 ) testname))....
3270: 09 09 09 09 74 65 73 74 73 64 61 74 29 29 29 0a ....testsdat))).
3280: 09 09 09 09 09 20 28 69 66 20 28 6e 75 6c 6c 3f ..... (if (null?
3290: 20 6d 61 74 63 68 69 6e 67 29 0a 09 09 09 09 09 matching)......
32a0: 20 20 20 20 20 28 76 65 63 74 6f 72 20 2d 31 20 (vector -1
32b0: 2d 31 20 22 22 20 22 22 20 22 22 20 30 20 22 22 -1 "" "" "" 0 ""
32c0: 20 22 22 20 30 20 22 22 20 22 22 20 22 22 20 30 "" 0 "" "" "" 0
32d0: 20 22 22 20 22 22 29 0a 09 09 09 09 09 20 20 20 "" "")......
32e0: 20 20 28 63 61 72 20 6d 61 74 63 68 69 6e 67 29 (car matching)
32f0: 29 29 29 0a 09 09 09 20 20 20 28 74 65 73 74 6e ))).... (testn
3300: 61 6d 65 20 20 20 28 64 62 3a 74 65 73 74 2d 67 ame (db:test-g
3310: 65 74 2d 74 65 73 74 6e 61 6d 65 20 20 74 65 73 et-testname tes
3320: 74 29 29 0a 09 09 09 20 20 20 28 69 74 65 6d 70 t)).... (itemp
3330: 61 74 68 20 20 20 28 64 62 3a 74 65 73 74 2d 67 ath (db:test-g
3340: 65 74 2d 69 74 65 6d 2d 70 61 74 68 20 74 65 73 et-item-path tes
3350: 74 29 29 0a 09 09 09 20 20 20 28 74 65 73 74 66 t)).... (testf
3360: 75 6c 6c 6e 61 6d 65 20 28 74 65 73 74 3a 74 65 ullname (test:te
3370: 73 74 2d 67 65 74 2d 66 75 6c 6c 6e 61 6d 65 20 st-get-fullname
3380: 74 65 73 74 29 29 0a 09 09 09 20 20 20 28 74 65 test)).... (te
3390: 73 74 73 74 61 74 75 73 20 28 64 62 3a 74 65 73 ststatus (db:tes
33a0: 74 2d 67 65 74 2d 73 74 61 74 75 73 20 20 20 74 t-get-status t
33b0: 65 73 74 29 29 0a 09 09 09 20 20 20 28 74 65 73 est)).... (tes
33c0: 74 73 74 61 74 65 20 20 28 64 62 3a 74 65 73 74 tstate (db:test
33d0: 2d 67 65 74 2d 73 74 61 74 65 20 20 20 20 74 65 -get-state te
33e0: 73 74 29 29 0a 09 09 09 20 20 20 28 74 65 73 74 st)).... (test
33f0: 73 74 61 72 74 20 20 28 64 62 3a 74 65 73 74 2d start (db:test-
3400: 67 65 74 2d 65 76 65 6e 74 5f 74 69 6d 65 20 74 get-event_time t
3410: 65 73 74 29 29 0a 09 09 09 20 20 20 28 72 75 6e est)).... (run
3420: 74 69 6d 65 20 20 20 20 28 64 62 3a 74 65 73 74 time (db:test
3430: 2d 67 65 74 2d 72 75 6e 5f 64 75 72 61 74 69 6f -get-run_duratio
3440: 6e 20 74 65 73 74 29 29 0a 09 09 09 20 20 20 28 n test)).... (
3450: 62 75 74 74 6f 6e 74 78 74 20 20 28 69 66 20 28 buttontxt (if (
3460: 65 71 75 61 6c 3f 20 74 65 73 74 73 74 61 74 65 equal? teststate
3470: 20 22 43 4f 4d 50 4c 45 54 45 44 22 29 20 74 65 "COMPLETED") te
3480: 73 74 73 74 61 74 75 73 20 74 65 73 74 73 74 61 ststatus teststa
3490: 74 65 29 29 0a 09 09 09 20 20 20 28 62 75 74 74 te)).... (butt
34a0: 6f 6e 20 20 20 20 20 28 76 65 63 74 6f 72 2d 72 on (vector-r
34b0: 65 66 20 63 6f 6c 75 6d 6e 64 61 74 20 72 6f 77 ef columndat row
34c0: 6e 29 29 0a 09 09 09 20 20 20 28 63 6f 6c 6f 72 n)).... (color
34d0: 20 20 20 20 20 20 28 67 65 74 2d 63 6f 6c 6f 72 (get-color
34e0: 2d 66 6f 72 2d 73 74 61 74 65 2d 73 74 61 74 75 -for-state-statu
34f0: 73 20 74 65 73 74 73 74 61 74 65 20 74 65 73 74 s teststate test
3500: 73 74 61 74 75 73 29 29 0a 09 09 09 20 20 20 28 status)).... (
3510: 63 75 72 72 2d 63 6f 6c 6f 72 20 28 76 65 63 74 curr-color (vect
3520: 6f 72 2d 72 65 66 20 62 75 74 74 6f 6e 64 61 74 or-ref buttondat
3530: 20 31 29 29 20 3b 3b 20 28 69 75 70 3a 61 74 74 1)) ;; (iup:att
3540: 72 69 62 75 74 65 20 62 75 74 74 6f 6e 20 22 42 ribute button "B
3550: 47 43 4f 4c 4f 52 22 29 29 0a 09 09 09 20 20 20 GCOLOR"))....
3560: 28 63 75 72 72 2d 74 69 74 6c 65 20 28 76 65 63 (curr-title (vec
3570: 74 6f 72 2d 72 65 66 20 62 75 74 74 6f 6e 64 61 tor-ref buttonda
3580: 74 20 32 29 29 29 20 3b 3b 20 28 69 75 70 3a 61 t 2))) ;; (iup:a
3590: 74 74 72 69 62 75 74 65 20 62 75 74 74 6f 6e 20 ttribute button
35a0: 22 54 49 54 4c 45 22 29 29 29 0a 09 09 20 20 20 "TITLE")))...
35b0: 20 20 20 28 69 66 20 28 6e 6f 74 20 28 65 71 75 (if (not (equ
35c0: 61 6c 3f 20 63 75 72 72 2d 63 6f 6c 6f 72 20 63 al? curr-color c
35d0: 6f 6c 6f 72 29 29 0a 09 09 09 20 20 28 69 75 70 olor)).... (iup
35e0: 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 :attribute-set!
35f0: 62 75 74 74 6f 6e 20 22 42 47 43 4f 4c 4f 52 22 button "BGCOLOR"
3600: 20 63 6f 6c 6f 72 29 29 0a 09 09 20 20 20 20 20 color))...
3610: 20 28 69 66 20 28 6e 6f 74 20 28 65 71 75 61 6c (if (not (equal
3620: 3f 20 63 75 72 72 2d 74 69 74 6c 65 20 62 75 74 ? curr-title but
3630: 74 6f 6e 74 78 74 29 29 0a 09 09 09 20 20 28 69 tontxt)).... (i
3640: 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 up:attribute-set
3650: 21 20 62 75 74 74 6f 6e 20 22 54 49 54 4c 45 22 ! button "TITLE"
3660: 20 20 20 62 75 74 74 6f 6e 74 78 74 29 29 0a 09 buttontxt))..
3670: 09 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d 73 . (vector-s
3680: 65 74 21 20 62 75 74 74 6f 6e 64 61 74 20 30 20 et! buttondat 0
3690: 72 75 6e 2d 69 64 29 0a 09 09 20 20 20 20 20 20 run-id)...
36a0: 28 76 65 63 74 6f 72 2d 73 65 74 21 20 62 75 74 (vector-set! but
36b0: 74 6f 6e 64 61 74 20 31 20 63 6f 6c 6f 72 29 0a tondat 1 color).
36c0: 09 09 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d .. (vector-
36d0: 73 65 74 21 20 62 75 74 74 6f 6e 64 61 74 20 32 set! buttondat 2
36e0: 20 62 75 74 74 6f 6e 74 78 74 29 0a 09 09 20 20 buttontxt)...
36f0: 20 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 (vector-set!
3700: 20 62 75 74 74 6f 6e 64 61 74 20 33 20 74 65 73 buttondat 3 tes
3710: 74 29 0a 09 09 20 20 20 20 20 20 28 76 65 63 74 t)... (vect
3720: 6f 72 2d 73 65 74 21 20 62 75 74 74 6f 6e 64 61 or-set! buttonda
3730: 74 20 34 20 72 75 6e 2d 6b 65 79 29 29 29 0a 09 t 4 run-key)))..
3740: 09 28 73 65 74 21 20 72 6f 77 6e 20 28 2b 20 72 .(set! rown (+ r
3750: 6f 77 6e 20 31 29 29 29 29 0a 09 20 20 20 20 2a own 1)))).. *
3760: 61 6c 6c 74 65 73 74 6e 61 6d 65 6c 73 74 2a 29 alltestnamelst*)
3770: 29 0a 09 20 28 73 65 74 21 20 63 6f 6c 6e 20 28 ).. (set! coln (
3780: 2b 20 63 6f 6c 6e 20 31 29 29 29 29 0a 20 20 20 + coln 1)))).
3790: 20 20 72 75 6e 73 29 29 29 0a 0a 28 64 65 66 69 runs)))..(defi
37a0: 6e 65 20 28 6d 6b 73 74 72 20 2e 20 78 29 0a 20 ne (mkstr . x).
37b0: 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 (string-intersp
37c0: 65 72 73 65 20 28 6d 61 70 20 63 6f 6e 63 20 78 erse (map conc x
37d0: 29 20 22 2c 22 29 29 0a 0a 28 64 65 66 69 6e 65 ) ","))..(define
37e0: 20 28 75 70 64 61 74 65 2d 73 65 61 72 63 68 20 (update-search
37f0: 78 20 76 61 6c 29 0a 20 20 3b 3b 20 28 70 72 69 x val). ;; (pri
3800: 6e 74 20 22 53 65 74 74 69 6e 67 20 73 65 61 72 nt "Setting sear
3810: 63 68 20 66 6f 72 20 22 20 78 20 22 20 74 6f 20 ch for " x " to
3820: 22 20 76 61 6c 29 0a 20 20 28 68 61 73 68 2d 74 " val). (hash-t
3830: 61 62 6c 65 2d 73 65 74 21 20 2a 73 65 61 72 63 able-set! *searc
3840: 68 70 61 74 74 73 2a 20 78 20 76 61 6c 29 29 0a hpatts* x val)).
3850: 0a 28 64 65 66 69 6e 65 20 28 6d 61 6b 65 2d 64 .(define (make-d
3860: 61 73 68 62 6f 61 72 64 2d 62 75 74 74 6f 6e 73 ashboard-buttons
3870: 20 6e 72 75 6e 73 20 6e 74 65 73 74 73 20 6b 65 nruns ntests ke
3880: 79 6e 61 6d 65 73 29 0a 20 20 28 6c 65 74 2a 20 ynames). (let*
3890: 28 28 6e 6b 65 79 73 20 20 20 28 6c 65 6e 67 74 ((nkeys (lengt
38a0: 68 20 6b 65 79 6e 61 6d 65 73 29 29 0a 09 20 28 h keynames)).. (
38b0: 72 75 6e 73 76 65 63 20 28 6d 61 6b 65 2d 76 65 runsvec (make-ve
38c0: 63 74 6f 72 20 6e 72 75 6e 73 29 29 0a 09 20 28 ctor nruns)).. (
38d0: 68 65 61 64 65 72 20 20 28 6d 61 6b 65 2d 76 65 header (make-ve
38e0: 63 74 6f 72 20 6e 72 75 6e 73 29 29 0a 09 20 28 ctor nruns)).. (
38f0: 6c 66 74 63 6f 6c 20 20 28 6d 61 6b 65 2d 76 65 lftcol (make-ve
3900: 63 74 6f 72 20 6e 74 65 73 74 73 29 29 0a 09 20 ctor ntests))..
3910: 28 63 6f 6e 74 72 6f 6c 73 20 27 28 29 29 0a 09 (controls '())..
3920: 20 28 6c 66 74 6c 73 74 20 20 27 28 29 29 0a 09 (lftlst '())..
3930: 20 28 68 64 72 6c 73 74 20 20 27 28 29 29 0a 09 (hdrlst '())..
3940: 20 28 62 64 79 6c 73 74 20 20 27 28 29 29 0a 09 (bdylst '())..
3950: 20 28 72 65 73 75 6c 74 20 20 27 28 29 29 0a 09 (result '())..
3960: 20 28 69 20 20 20 20 20 20 20 30 29 29 0a 20 20 (i 0)).
3970: 20 20 3b 3b 20 63 6f 6e 74 72 6f 6c 73 20 28 61 ;; controls (a
3980: 6c 6f 6e 67 20 62 6f 74 74 6f 6d 29 0a 20 20 20 long bottom).
3990: 20 28 73 65 74 21 20 63 6f 6e 74 72 6f 6c 73 0a (set! controls.
39a0: 09 20 20 28 69 75 70 3a 68 62 6f 78 0a 09 20 20 . (iup:hbox..
39b0: 20 28 69 75 70 3a 74 65 78 74 62 6f 78 20 23 3a (iup:textbox #:
39c0: 73 69 7a 65 20 22 36 30 78 31 35 22 20 23 3a 66 size "60x15" #:f
39d0: 6f 6e 74 73 69 7a 65 20 22 31 30 22 20 23 3a 76 ontsize "10" #:v
39e0: 61 6c 75 65 20 22 25 22 0a 09 09 09 23 3a 61 63 alue "%"....#:ac
39f0: 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 tion (lambda (ob
3a00: 6a 20 75 6e 6b 20 76 61 6c 29 0a 09 09 09 09 20 j unk val).....
3a10: 20 20 28 75 70 64 61 74 65 2d 73 65 61 72 63 68 (update-search
3a20: 20 22 74 65 73 74 2d 6e 61 6d 65 22 20 76 61 6c "test-name" val
3a30: 29 29 29 0a 09 20 20 20 28 69 75 70 3a 74 65 78 ))).. (iup:tex
3a40: 74 62 6f 78 20 23 3a 73 69 7a 65 20 22 36 30 78 tbox #:size "60x
3a50: 31 35 22 20 23 3a 66 6f 6e 74 73 69 7a 65 20 22 15" #:fontsize "
3a60: 31 30 22 20 23 3a 76 61 6c 75 65 20 22 25 22 0a 10" #:value "%".
3a70: 09 09 09 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d ...#:action (lam
3a80: 62 64 61 20 28 6f 62 6a 20 75 6e 6b 20 76 61 6c bda (obj unk val
3a90: 29 0a 09 09 09 09 20 20 20 28 75 70 64 61 74 65 )..... (update
3aa0: 2d 73 65 61 72 63 68 20 22 69 74 65 6d 2d 6e 61 -search "item-na
3ab0: 6d 65 22 20 76 61 6c 29 29 29 0a 09 20 20 20 28 me" val))).. (
3ac0: 69 75 70 3a 62 75 74 74 6f 6e 20 22 51 75 69 74 iup:button "Quit
3ad0: 22 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 " #:action (lamb
3ae0: 64 61 20 28 6f 62 6a 29 28 73 71 6c 69 74 65 33 da (obj)(sqlite3
3af0: 3a 66 69 6e 61 6c 69 7a 65 21 20 2a 64 62 2a 29 :finalize! *db*)
3b00: 28 65 78 69 74 29 29 29 0a 09 20 20 20 28 69 75 (exit))).. (iu
3b10: 70 3a 62 75 74 74 6f 6e 20 22 3c 2d 20 20 4c 65 p:button "<- Le
3b20: 66 74 22 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 ft" #:action (la
3b30: 6d 62 64 61 20 28 6f 62 6a 29 28 73 65 74 21 20 mbda (obj)(set!
3b40: 2a 73 74 61 72 74 2d 72 75 6e 2d 6f 66 66 73 65 *start-run-offse
3b50: 74 2a 20 20 28 2b 20 2a 73 74 61 72 74 2d 72 75 t* (+ *start-ru
3b60: 6e 2d 6f 66 66 73 65 74 2a 20 31 29 29 29 29 0a n-offset* 1)))).
3b70: 09 20 20 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 . (iup:button
3b80: 22 55 70 20 20 20 20 20 5e 22 20 23 3a 61 63 74 "Up ^" #:act
3b90: 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a ion (lambda (obj
3ba0: 29 28 73 65 74 21 20 2a 73 74 61 72 74 2d 74 65 )(set! *start-te
3bb0: 73 74 2d 6f 66 66 73 65 74 2a 20 28 69 66 20 28 st-offset* (if (
3bc0: 3e 20 2a 73 74 61 72 74 2d 74 65 73 74 2d 6f 66 > *start-test-of
3bd0: 66 73 65 74 2a 20 30 29 28 2d 20 2a 73 74 61 72 fset* 0)(- *star
3be0: 74 2d 74 65 73 74 2d 6f 66 66 73 65 74 2a 20 31 t-test-offset* 1
3bf0: 29 20 30 29 29 29 29 0a 09 20 20 20 28 69 75 70 ) 0)))).. (iup
3c00: 3a 62 75 74 74 6f 6e 20 22 44 6f 77 6e 20 20 20 :button "Down
3c10: 76 22 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d v" #:action (lam
3c20: 62 64 61 20 28 6f 62 6a 29 28 73 65 74 21 20 2a bda (obj)(set! *
3c30: 73 74 61 72 74 2d 74 65 73 74 2d 6f 66 66 73 65 start-test-offse
3c40: 74 2a 20 28 69 66 20 28 3e 3d 20 2a 73 74 61 72 t* (if (>= *star
3c50: 74 2d 74 65 73 74 2d 6f 66 66 73 65 74 2a 20 28 t-test-offset* (
3c60: 6c 65 6e 67 74 68 20 2a 61 6c 6c 74 65 73 74 6e length *alltestn
3c70: 61 6d 65 6c 73 74 2a 29 29 28 6c 65 6e 67 74 68 amelst*))(length
3c80: 20 2a 61 6c 6c 74 65 73 74 6e 61 6d 65 6c 73 74 *alltestnamelst
3c90: 2a 29 28 2b 20 2a 73 74 61 72 74 2d 74 65 73 74 *)(+ *start-test
3ca0: 2d 6f 66 66 73 65 74 2a 20 31 29 29 29 29 29 0a -offset* 1))))).
3cb0: 09 20 20 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 . (iup:button
3cc0: 22 52 69 67 68 74 20 2d 3e 22 20 23 3a 61 63 74 "Right ->" #:act
3cd0: 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a ion (lambda (obj
3ce0: 29 28 73 65 74 21 20 2a 73 74 61 72 74 2d 72 75 )(set! *start-ru
3cf0: 6e 2d 6f 66 66 73 65 74 2a 20 20 28 69 66 20 28 n-offset* (if (
3d00: 3e 20 2a 73 74 61 72 74 2d 72 75 6e 2d 6f 66 66 > *start-run-off
3d10: 73 65 74 2a 20 30 29 28 2d 20 2a 73 74 61 72 74 set* 0)(- *start
3d20: 2d 72 75 6e 2d 6f 66 66 73 65 74 2a 20 31 29 20 -run-offset* 1)
3d30: 30 29 29 29 29 0a 09 20 20 20 28 69 75 70 3a 76 0)))).. (iup:v
3d40: 61 6c 75 61 74 6f 72 20 23 3a 76 61 6c 75 65 63 aluator #:valuec
3d50: 68 61 6e 67 65 64 5f 63 62 20 28 6c 61 6d 62 64 hanged_cb (lambd
3d60: 61 20 28 6f 62 6a 29 0a 09 09 09 09 09 20 20 20 a (obj)......
3d70: 20 20 28 6c 65 74 20 28 28 76 61 6c 20 28 69 6e (let ((val (in
3d80: 65 78 61 63 74 2d 3e 65 78 61 63 74 20 28 72 6f exact->exact (ro
3d90: 75 6e 64 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d und (string->num
3da0: 62 65 72 20 28 69 75 70 3a 61 74 74 72 69 62 75 ber (iup:attribu
3db0: 74 65 20 6f 62 6a 20 22 56 41 4c 55 45 22 29 29 te obj "VALUE"))
3dc0: 29 29 29 0a 09 09 09 09 09 09 20 20 20 28 6d 61 )))....... (ma
3dd0: 78 72 75 6e 73 20 20 2a 74 6f 74 2d 72 75 6e 2d xruns *tot-run-
3de0: 63 6f 75 6e 74 2a 29 29 20 3b 3b 3b 20 28 2b 20 count*)) ;;; (+
3df0: 2a 6e 75 6d 2d 72 75 6e 73 2a 20 28 6c 65 6e 67 *num-runs* (leng
3e00: 74 68 20 2a 61 6c 6c 72 75 6e 73 2a 29 29 29 29 th *allruns*))))
3e10: 0a 09 09 09 09 09 20 20 20 20 20 20 20 28 73 65 ...... (se
3e20: 74 21 20 2a 73 74 61 72 74 2d 72 75 6e 2d 6f 66 t! *start-run-of
3e30: 66 73 65 74 2a 20 76 61 6c 29 0a 09 09 09 09 09 fset* val)......
3e40: 20 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 (debug:pr
3e50: 69 6e 74 20 33 20 22 6d 61 78 72 75 6e 73 3a 20 int 3 "maxruns:
3e60: 22 20 6d 61 78 72 75 6e 73 20 22 2c 20 76 61 6c " maxruns ", val
3e70: 3a 20 22 20 76 61 6c 29 0a 09 09 09 09 09 20 20 : " val)......
3e80: 20 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 (iup:attrib
3e90: 75 74 65 2d 73 65 74 21 20 6f 62 6a 20 22 4d 41 ute-set! obj "MA
3ea0: 58 22 20 6d 61 78 72 75 6e 73 29 29 29 0a 09 09 X" maxruns)))...
3eb0: 09 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53 22 . #:expand "YES"
3ec0: 0a 09 09 09 20 23 3a 6d 61 78 20 28 2b 20 2a 6e .... #:max (+ *n
3ed0: 75 6d 2d 72 75 6e 73 2a 20 28 6c 65 6e 67 74 68 um-runs* (length
3ee0: 20 2a 61 6c 6c 72 75 6e 73 2a 29 29 29 0a 09 20 *allruns*)))..
3ef0: 20 20 3b 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 ;(iup:button "
3f00: 69 6e 63 20 72 6f 77 73 22 20 23 3a 61 63 74 69 inc rows" #:acti
3f10: 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 29 on (lambda (obj)
3f20: 28 73 65 74 21 20 2a 6e 75 6d 2d 74 65 73 74 73 (set! *num-tests
3f30: 2a 20 28 2b 20 2a 6e 75 6d 2d 74 65 73 74 73 2a * (+ *num-tests*
3f40: 20 31 29 29 29 29 0a 09 20 20 20 3b 28 69 75 70 1)))).. ;(iup
3f50: 3a 62 75 74 74 6f 6e 20 22 64 65 63 20 72 6f 77 :button "dec row
3f60: 73 22 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d s" #:action (lam
3f70: 62 64 61 20 28 6f 62 6a 29 28 73 65 74 21 20 2a bda (obj)(set! *
3f80: 6e 75 6d 2d 74 65 73 74 73 2a 20 28 69 66 20 28 num-tests* (if (
3f90: 3e 20 2a 6e 75 6d 2d 74 65 73 74 73 2a 20 30 29 > *num-tests* 0)
3fa0: 28 2d 20 2a 6e 75 6d 2d 74 65 73 74 73 2a 20 31 (- *num-tests* 1
3fb0: 29 20 30 29 29 29 29 0a 09 20 20 20 29 0a 09 20 ) 0)))).. )..
3fc0: 20 29 0a 20 20 20 20 0a 20 20 20 20 3b 3b 20 63 ). . ;; c
3fd0: 72 65 61 74 65 20 74 68 65 20 6c 65 66 74 20 6d reate the left m
3fe0: 6f 73 74 20 63 6f 6c 75 6d 6e 20 66 6f 72 20 74 ost column for t
3ff0: 68 65 20 72 75 6e 20 6b 65 79 20 6e 61 6d 65 73 he run key names
4000: 20 61 6e 64 20 74 68 65 20 74 65 73 74 20 6e 61 and the test na
4010: 6d 65 73 20 0a 20 20 20 20 28 73 65 74 21 20 6c mes . (set! l
4020: 66 74 6c 73 74 20 28 6c 69 73 74 20 28 69 75 70 ftlst (list (iup
4030: 3a 68 62 6f 78 0a 09 09 09 28 69 75 70 3a 6c 61 :hbox....(iup:la
4040: 62 65 6c 29 20 3b 3b 20 28 69 75 70 3a 76 61 6c bel) ;; (iup:val
4050: 75 61 74 6f 72 29 0a 09 09 09 28 61 70 70 6c 79 uator)....(apply
4060: 20 69 75 70 3a 76 62 6f 78 20 0a 09 09 09 20 20 iup:vbox ....
4070: 20 20 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 (map (lambd
4080: 61 20 28 78 29 09 09 0a 09 09 09 09 20 20 20 20 a (x).......
4090: 20 20 28 6c 65 74 20 28 28 72 65 73 20 28 69 75 (let ((res (iu
40a0: 70 3a 68 62 6f 78 0a 09 09 09 09 09 09 20 20 28 p:hbox....... (
40b0: 69 75 70 3a 6c 61 62 65 6c 20 78 20 23 3a 73 69 iup:label x #:si
40c0: 7a 65 20 22 34 30 78 31 35 22 20 23 3a 66 6f 6e ze "40x15" #:fon
40d0: 74 73 69 7a 65 20 22 31 30 22 29 20 3b 3b 20 20 tsize "10") ;;
40e0: 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f #:expand "HORIZO
40f0: 4e 54 41 4c 22 29 0a 09 09 09 09 09 09 20 20 28 NTAL")....... (
4100: 69 75 70 3a 74 65 78 74 62 6f 78 20 23 3a 73 69 iup:textbox #:si
4110: 7a 65 20 22 36 30 78 31 35 22 20 23 3a 66 6f 6e ze "60x15" #:fon
4120: 74 73 69 7a 65 20 22 31 30 22 20 23 3a 76 61 6c tsize "10" #:val
4130: 75 65 20 22 25 22 20 3b 3b 20 23 3a 65 78 70 61 ue "%" ;; #:expa
4140: 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 0a nd "HORIZONTAL".
4150: 09 09 09 09 09 09 09 20 20 20 20 20 20 20 23 3a ....... #:
4160: 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 action (lambda (
4170: 6f 62 6a 20 75 6e 6b 20 76 61 6c 29 0a 09 09 09 obj unk val)....
4180: 09 09 09 09 09 09 20 20 28 75 70 64 61 74 65 2d ...... (update-
4190: 73 65 61 72 63 68 20 78 20 76 61 6c 29 29 29 29 search x val))))
41a0: 29 29 0a 09 09 09 09 09 28 73 65 74 21 20 69 20 ))......(set! i
41b0: 28 2b 20 69 20 31 29 29 0a 09 09 09 09 09 72 65 (+ i 1))......re
41c0: 73 29 29 0a 09 09 09 09 20 20 20 20 6b 65 79 6e s))..... keyn
41d0: 61 6d 65 73 29 29 29 29 29 0a 20 20 20 20 28 6c ames))))). (l
41e0: 65 74 20 6c 6f 6f 70 20 28 28 74 65 73 74 6e 75 et loop ((testnu
41f0: 6d 20 20 30 29 0a 09 20 20 20 20 20 20 20 28 72 m 0).. (r
4200: 65 73 20 20 20 20 20 20 27 28 29 29 29 0a 20 20 es '())).
4210: 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 (cond.
4220: 20 28 28 3e 3d 20 74 65 73 74 6e 75 6d 20 6e 74 ((>= testnum nt
4230: 65 73 74 73 29 0a 09 3b 3b 20 6e 6f 77 20 6c 66 ests)..;; now lf
4240: 74 6c 73 74 20 77 69 6c 6c 20 62 65 20 61 6e 20 tlst will be an
4250: 68 62 6f 78 20 77 69 74 68 20 74 68 65 20 74 65 hbox with the te
4260: 73 74 20 6b 65 79 73 20 61 6e 64 20 74 68 65 20 st keys and the
4270: 74 65 73 74 20 6e 61 6d 65 20 6c 61 62 65 6c 73 test name labels
4280: 0a 09 28 73 65 74 21 20 6c 66 74 6c 73 74 20 28 ..(set! lftlst (
4290: 61 70 70 65 6e 64 20 6c 66 74 6c 73 74 20 28 6c append lftlst (l
42a0: 69 73 74 20 28 69 75 70 3a 68 62 6f 78 20 0a 09 ist (iup:hbox ..
42b0: 09 09 09 09 20 20 20 28 69 75 70 3a 76 61 6c 75 .... (iup:valu
42c0: 61 74 6f 72 20 23 3a 76 61 6c 75 65 63 68 61 6e ator #:valuechan
42d0: 67 65 64 5f 63 62 20 28 6c 61 6d 62 64 61 20 28 ged_cb (lambda (
42e0: 6f 62 6a 29 0a 09 09 09 09 09 09 09 09 09 20 20 obj)..........
42f0: 20 20 20 28 6c 65 74 20 28 28 76 61 6c 20 28 69 (let ((val (i
4300: 75 70 3a 61 74 74 72 69 62 75 74 65 20 6f 62 6a up:attribute obj
4310: 20 22 56 41 4c 55 45 22 29 29 29 0a 09 09 09 09 "VALUE"))).....
4320: 09 09 09 09 09 20 20 20 20 20 20 20 28 73 65 74 ..... (set
4330: 21 20 2a 73 74 61 72 74 2d 74 65 73 74 2d 6f 66 ! *start-test-of
4340: 66 73 65 74 2a 20 28 69 6e 65 78 61 63 74 2d 3e fset* (inexact->
4350: 65 78 61 63 74 20 28 72 6f 75 6e 64 20 28 73 74 exact (round (st
4360: 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 76 61 6c ring->number val
4370: 29 29 29 29 0a 09 09 09 09 09 09 09 09 09 20 20 ))))..........
4380: 20 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 (iup:attrib
4390: 75 74 65 2d 73 65 74 21 20 6f 62 6a 20 22 4d 41 ute-set! obj "MA
43a0: 58 22 20 28 6c 65 6e 67 74 68 20 2a 61 6c 6c 74 X" (length *allt
43b0: 65 73 74 6e 61 6d 65 6c 73 74 2a 29 29 0a 09 09 estnamelst*))...
43c0: 09 09 09 09 09 09 09 20 20 20 20 20 20 20 29 20 ....... )
43d0: 29 0a 09 09 09 09 09 09 09 20 23 3a 65 78 70 61 )........ #:expa
43e0: 6e 64 20 22 59 45 53 22 20 0a 09 09 09 09 09 09 nd "YES" .......
43f0: 09 20 23 3a 6f 72 69 65 6e 74 61 74 69 6f 6e 20 . #:orientation
4400: 22 56 45 52 54 49 43 41 4c 22 29 0a 09 09 09 09 "VERTICAL").....
4410: 09 20 20 20 28 61 70 70 6c 79 20 69 75 70 3a 76 . (apply iup:v
4420: 62 6f 78 20 28 72 65 76 65 72 73 65 20 72 65 73 box (reverse res
4430: 29 29 29 29 29 29 29 0a 20 20 20 20 20 20 20 28 ))))))). (
4440: 65 6c 73 65 0a 09 28 6c 65 74 20 28 28 6c 61 62 else..(let ((lab
4450: 6c 20 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 l (iup:button "
4460: 22 20 0a 09 09 09 09 20 23 3a 66 6c 61 74 20 22 " ..... #:flat "
4470: 59 45 53 22 20 0a 09 09 09 09 20 3b 20 23 3a 69 YES" ..... ; #:i
4480: 6d 61 67 65 20 69 6d 67 31 0a 09 09 09 09 20 3b mage img1..... ;
4490: 20 23 3a 69 6d 70 72 65 73 73 20 69 6d 67 32 0a #:impress img2.
44a0: 09 09 09 09 20 23 3a 73 69 7a 65 20 22 31 30 30 .... #:size "100
44b0: 78 31 35 22 0a 09 09 09 09 20 23 3a 66 6f 6e 74 x15"..... #:font
44c0: 73 69 7a 65 20 22 31 30 22 0a 09 09 09 09 20 23 size "10"..... #
44d0: 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 :action (lambda
44e0: 28 6f 62 6a 29 0a 09 09 09 09 09 20 20 20 20 20 (obj)......
44f0: 20 28 74 6f 67 67 6c 65 2d 68 69 64 65 20 74 65 (toggle-hide te
4500: 73 74 6e 75 6d 29 29 29 29 29 20 3b 3b 20 28 69 stnum))))) ;; (i
4510: 75 70 3a 61 74 74 72 69 62 75 74 65 20 6f 62 6a up:attribute obj
4520: 20 22 54 49 54 4c 45 22 29 29 29 29 0a 09 20 20 "TITLE"))))..
4530: 28 76 65 63 74 6f 72 2d 73 65 74 21 20 6c 66 74 (vector-set! lft
4540: 63 6f 6c 20 74 65 73 74 6e 75 6d 20 6c 61 62 6c col testnum labl
4550: 29 0a 09 20 20 28 6c 6f 6f 70 20 28 2b 20 74 65 ).. (loop (+ te
4560: 73 74 6e 75 6d 20 31 29 28 63 6f 6e 73 20 6c 61 stnum 1)(cons la
4570: 62 6c 20 72 65 73 29 29 29 29 29 29 0a 20 20 20 bl res)))))).
4580: 20 3b 3b 20 0a 20 20 20 20 28 6c 65 74 20 6c 6f ;; . (let lo
4590: 6f 70 20 28 28 72 75 6e 6e 75 6d 20 20 30 29 0a op ((runnum 0).
45a0: 09 20 20 20 20 20 20 20 28 6b 65 79 6e 75 6d 20 . (keynum
45b0: 20 30 29 0a 09 20 20 20 20 20 20 20 28 6b 65 79 0).. (key
45c0: 76 65 63 20 20 28 6d 61 6b 65 2d 76 65 63 74 6f vec (make-vecto
45d0: 72 20 6e 6b 65 79 73 29 29 0a 09 20 20 20 20 20 r nkeys))..
45e0: 20 20 28 72 65 73 20 20 20 20 27 28 29 29 29 0a (res '())).
45f0: 20 20 20 20 20 20 28 63 6f 6e 64 20 3b 3b 20 6e (cond ;; n
4600: 62 2f 2f 20 6e 6f 20 65 6c 73 65 20 66 6f 72 20 b// no else for
4610: 74 68 69 73 20 61 70 70 72 6f 61 63 68 2e 0a 20 this approach..
4620: 20 20 20 20 20 20 28 28 3e 3d 20 72 75 6e 6e 75 ((>= runnu
4630: 6d 20 6e 72 75 6e 73 29 20 23 66 29 0a 20 20 20 m nruns) #f).
4640: 20 20 20 20 28 28 3e 3d 20 6b 65 79 6e 75 6d 20 ((>= keynum
4650: 6e 6b 65 79 73 29 20 0a 09 28 76 65 63 74 6f 72 nkeys) ..(vector
4660: 2d 73 65 74 21 20 68 65 61 64 65 72 20 72 75 6e -set! header run
4670: 6e 75 6d 20 6b 65 79 76 65 63 29 0a 09 28 73 65 num keyvec)..(se
4680: 74 21 20 68 64 72 6c 73 74 20 28 63 6f 6e 73 20 t! hdrlst (cons
4690: 28 61 70 70 6c 79 20 69 75 70 3a 76 62 6f 78 20 (apply iup:vbox
46a0: 28 72 65 76 65 72 73 65 20 72 65 73 29 29 20 68 (reverse res)) h
46b0: 64 72 6c 73 74 29 29 0a 09 28 6c 6f 6f 70 20 28 drlst))..(loop (
46c0: 2b 20 72 75 6e 6e 75 6d 20 31 29 20 30 20 28 6d + runnum 1) 0 (m
46d0: 61 6b 65 2d 76 65 63 74 6f 72 20 6e 6b 65 79 73 ake-vector nkeys
46e0: 29 20 27 28 29 29 29 0a 20 20 20 20 20 20 20 28 ) '())). (
46f0: 65 6c 73 65 0a 09 28 6c 65 74 20 28 28 6c 61 62 else..(let ((lab
4700: 6c 20 20 28 69 75 70 3a 6c 61 62 65 6c 20 22 22 l (iup:label ""
4710: 20 23 3a 73 69 7a 65 20 22 36 30 78 31 35 22 20 #:size "60x15"
4720: 23 3a 66 6f 6e 74 73 69 7a 65 20 22 31 30 22 29 #:fontsize "10")
4730: 29 29 20 3b 3b 20 23 3a 65 78 70 61 6e 64 20 22 )) ;; #:expand "
4740: 48 4f 52 49 5a 4f 4e 54 41 4c 22 0a 09 20 20 28 HORIZONTAL".. (
4750: 76 65 63 74 6f 72 2d 73 65 74 21 20 6b 65 79 76 vector-set! keyv
4760: 65 63 20 6b 65 79 6e 75 6d 20 6c 61 62 6c 29 0a ec keynum labl).
4770: 09 20 20 28 6c 6f 6f 70 20 72 75 6e 6e 75 6d 20 . (loop runnum
4780: 28 2b 20 6b 65 79 6e 75 6d 20 31 29 20 6b 65 79 (+ keynum 1) key
4790: 76 65 63 20 28 63 6f 6e 73 20 6c 61 62 6c 20 72 vec (cons labl r
47a0: 65 73 29 29 29 29 29 29 0a 20 20 20 20 3b 3b 20 es)))))). ;;
47b0: 42 79 20 68 65 72 65 20 74 68 65 20 68 64 72 6c By here the hdrl
47c0: 73 74 20 63 6f 6e 74 61 69 6e 73 20 61 20 6c 69 st contains a li
47d0: 73 74 20 6f 66 20 76 62 6f 78 65 73 20 63 6f 6e st of vboxes con
47e0: 74 61 69 6e 69 6e 67 20 6e 6b 65 79 73 20 6c 61 taining nkeys la
47f0: 62 65 6c 73 0a 20 20 20 20 28 6c 65 74 20 6c 6f bels. (let lo
4800: 6f 70 20 28 28 72 75 6e 6e 75 6d 20 20 30 29 0a op ((runnum 0).
4810: 09 20 20 20 20 20 20 20 28 74 65 73 74 6e 75 6d . (testnum
4820: 20 30 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 0).. (tes
4830: 74 76 65 63 20 20 28 6d 61 6b 65 2d 76 65 63 74 tvec (make-vect
4840: 6f 72 20 6e 74 65 73 74 73 29 29 0a 09 20 20 20 or ntests))..
4850: 20 20 20 20 28 72 65 73 20 20 20 20 27 28 29 29 (res '())
4860: 29 0a 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 ). (cond.
4870: 20 20 20 20 20 28 28 3e 3d 20 72 75 6e 6e 75 6d ((>= runnum
4880: 20 6e 72 75 6e 73 29 20 23 66 29 20 3b 3b 20 20 nruns) #f) ;;
4890: 28 76 65 63 74 6f 72 20 74 61 62 6c 65 68 65 61 (vector tablehea
48a0: 64 65 72 20 72 75 6e 73 76 65 63 29 29 0a 20 20 der runsvec)).
48b0: 20 20 20 20 20 28 28 3e 3d 20 74 65 73 74 6e 75 ((>= testnu
48c0: 6d 20 6e 74 65 73 74 73 29 20 0a 09 28 76 65 63 m ntests) ..(vec
48d0: 74 6f 72 2d 73 65 74 21 20 72 75 6e 73 76 65 63 tor-set! runsvec
48e0: 20 72 75 6e 6e 75 6d 20 74 65 73 74 76 65 63 29 runnum testvec)
48f0: 0a 09 28 73 65 74 21 20 62 64 79 6c 73 74 20 28 ..(set! bdylst (
4900: 63 6f 6e 73 20 28 61 70 70 6c 79 20 69 75 70 3a cons (apply iup:
4910: 76 62 6f 78 20 28 72 65 76 65 72 73 65 20 72 65 vbox (reverse re
4920: 73 29 29 20 62 64 79 6c 73 74 29 29 0a 09 28 6c s)) bdylst))..(l
4930: 6f 6f 70 20 28 2b 20 72 75 6e 6e 75 6d 20 31 29 oop (+ runnum 1)
4940: 20 30 20 28 6d 61 6b 65 2d 76 65 63 74 6f 72 20 0 (make-vector
4950: 6e 74 65 73 74 73 29 20 27 28 29 29 29 0a 20 20 ntests) '())).
4960: 20 20 20 20 20 28 65 6c 73 65 0a 09 28 6c 65 74 (else..(let
4970: 2a 20 28 28 62 75 74 74 6f 6e 2d 6b 65 79 20 28 * ((button-key (
4980: 6d 6b 73 74 72 20 72 75 6e 6e 75 6d 20 74 65 73 mkstr runnum tes
4990: 74 6e 75 6d 29 29 0a 09 20 20 20 20 20 20 20 28 tnum)).. (
49a0: 62 75 74 6e 20 20 20 20 20 20 20 28 69 75 70 3a butn (iup:
49b0: 62 75 74 74 6f 6e 20 22 22 20 3b 3b 20 62 75 74 button "" ;; but
49c0: 74 6f 6e 2d 6b 65 79 20 0a 09 09 09 09 20 20 20 ton-key .....
49d0: 20 20 20 20 23 3a 73 69 7a 65 20 22 36 30 78 31 #:size "60x1
49e0: 35 22 20 0a 09 09 09 09 20 20 20 20 20 20 20 3b 5" ..... ;
49f0: 3b 20 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 ; #:expand "HORI
4a00: 5a 4f 4e 54 41 4c 22 0a 09 09 09 09 20 20 20 20 ZONTAL".....
4a10: 20 20 20 23 3a 66 6f 6e 74 73 69 7a 65 20 22 31 #:fontsize "1
4a20: 30 22 20 0a 09 09 09 09 20 20 20 20 20 20 20 23 0" ..... #
4a30: 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 :action (lambda
4a40: 28 78 29 0a 09 09 09 09 09 09 20 20 28 6c 65 74 (x)....... (let
4a50: 2a 20 28 28 74 6f 6f 6c 70 61 74 68 20 28 63 61 * ((toolpath (ca
4a60: 72 20 28 61 72 67 76 29 29 29 0a 09 09 09 09 09 r (argv)))......
4a70: 09 09 20 28 62 75 74 74 6e 64 61 74 20 28 68 61 .. (buttndat (ha
4a80: 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 2a 62 75 sh-table-ref *bu
4a90: 74 74 6f 6e 64 61 74 2a 20 62 75 74 74 6f 6e 2d ttondat* button-
4aa0: 6b 65 79 29 29 0a 09 09 09 09 09 09 09 20 28 74 key))........ (t
4ab0: 65 73 74 2d 69 64 20 20 28 64 62 3a 74 65 73 74 est-id (db:test
4ac0: 2d 67 65 74 2d 69 64 20 28 76 65 63 74 6f 72 2d -get-id (vector-
4ad0: 72 65 66 20 62 75 74 74 6e 64 61 74 20 33 29 29 ref buttndat 3))
4ae0: 29 0a 09 09 09 09 09 09 09 20 28 63 6d 64 20 20 )........ (cmd
4af0: 28 63 6f 6e 63 20 74 6f 6f 6c 70 61 74 68 20 22 (conc toolpath "
4b00: 20 2d 74 65 73 74 20 22 20 74 65 73 74 2d 69 64 -test " test-id
4b10: 20 22 26 22 29 29 29 0a 09 09 09 09 09 09 20 20 "&"))).......
4b20: 20 20 3b 28 70 72 69 6e 74 20 22 4c 61 75 6e 63 ;(print "Launc
4b30: 68 69 6e 67 20 22 20 63 6d 64 29 0a 09 09 09 09 hing " cmd).....
4b40: 09 09 20 20 20 20 28 73 79 73 74 65 6d 20 63 6d .. (system cm
4b50: 64 29 29 29 29 29 29 0a 09 20 20 28 68 61 73 68 d)))))).. (hash
4b60: 2d 74 61 62 6c 65 2d 73 65 74 21 20 2a 62 75 74 -table-set! *but
4b70: 74 6f 6e 64 61 74 2a 20 62 75 74 74 6f 6e 2d 6b tondat* button-k
4b80: 65 79 20 28 76 65 63 74 6f 72 20 30 20 22 31 30 ey (vector 0 "10
4b90: 30 20 31 30 30 20 31 30 30 22 20 62 75 74 74 6f 0 100 100" butto
4ba0: 6e 2d 6b 65 79 20 23 66 20 23 66 29 29 20 0a 09 n-key #f #f)) ..
4bb0: 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 74 (vector-set! t
4bc0: 65 73 74 76 65 63 20 74 65 73 74 6e 75 6d 20 62 estvec testnum b
4bd0: 75 74 6e 29 0a 09 20 20 28 6c 6f 6f 70 20 72 75 utn).. (loop ru
4be0: 6e 6e 75 6d 20 28 2b 20 74 65 73 74 6e 75 6d 20 nnum (+ testnum
4bf0: 31 29 20 74 65 73 74 76 65 63 20 28 63 6f 6e 73 1) testvec (cons
4c00: 20 62 75 74 6e 20 72 65 73 29 29 29 29 29 29 0a butn res)))))).
4c10: 20 20 20 20 3b 3b 20 6e 6f 77 20 61 73 73 65 6d ;; now assem
4c20: 62 6c 65 20 74 68 65 20 68 64 72 6c 73 74 20 61 ble the hdrlst a
4c30: 6e 64 20 62 64 79 6c 73 74 20 61 6e 64 20 6b 69 nd bdylst and ki
4c40: 63 6b 20 6f 66 66 20 74 68 65 20 64 69 61 6c 6f ck off the dialo
4c50: 67 0a 20 20 20 20 28 69 75 70 3a 73 68 6f 77 0a g. (iup:show.
4c60: 20 20 20 20 20 28 69 75 70 3a 64 69 61 6c 6f 67 (iup:dialog
4c70: 20 0a 20 20 20 20 20 20 23 3a 74 69 74 6c 65 20 . #:title
4c80: 22 4d 65 67 61 74 65 73 74 20 64 61 73 68 62 6f "Megatest dashbo
4c90: 61 72 64 22 0a 20 20 20 20 20 20 28 69 75 70 3a ard". (iup:
4ca0: 76 62 6f 78 0a 09 28 61 70 70 6c 79 20 69 75 70 vbox..(apply iup
4cb0: 3a 68 62 6f 78 20 0a 09 20 20 20 20 20 20 20 28 :hbox .. (
4cc0: 63 6f 6e 73 20 28 61 70 70 6c 79 20 69 75 70 3a cons (apply iup:
4cd0: 76 62 6f 78 20 6c 66 74 6c 73 74 29 0a 09 09 20 vbox lftlst)...
4ce0: 20 20 20 20 28 6c 69 73 74 20 0a 09 09 20 20 20 (list ...
4cf0: 20 20 20 28 69 75 70 3a 76 62 6f 78 0a 09 09 20 (iup:vbox...
4d00: 20 20 20 20 20 20 3b 3b 20 74 68 65 20 68 65 61 ;; the hea
4d10: 64 65 72 0a 09 09 20 20 20 20 20 20 20 28 61 70 der... (ap
4d20: 70 6c 79 20 69 75 70 3a 68 62 6f 78 20 28 72 65 ply iup:hbox (re
4d30: 76 65 72 73 65 20 68 64 72 6c 73 74 29 29 0a 09 verse hdrlst))..
4d40: 09 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 69 . (apply i
4d50: 75 70 3a 68 62 6f 78 20 28 72 65 76 65 72 73 65 up:hbox (reverse
4d60: 20 62 64 79 6c 73 74 29 29 29 29 29 29 0a 20 20 bdylst)))))).
4d70: 20 20 20 20 20 63 6f 6e 74 72 6f 6c 73 29 29 29 controls)))
4d80: 0a 20 20 20 20 28 76 65 63 74 6f 72 20 6c 66 74 . (vector lft
4d90: 63 6f 6c 20 68 65 61 64 65 72 20 72 75 6e 73 76 col header runsv
4da0: 65 63 29 29 29 0a 0a 28 69 66 20 28 6f 72 20 28 ec)))..(if (or (
4db0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
4dc0: 6f 77 73 22 29 0a 09 28 67 65 74 2d 65 6e 76 69 ows")..(get-envi
4dd0: 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 ronment-variable
4de0: 20 22 44 41 53 48 42 4f 41 52 44 52 4f 57 53 22 "DASHBOARDROWS"
4df0: 20 29 29 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 )). (begin.
4e00: 20 20 20 20 20 20 20 28 73 65 74 21 20 2a 6e 75 (set! *nu
4e10: 6d 2d 74 65 73 74 73 2a 20 28 73 74 72 69 6e 67 m-tests* (string
4e20: 2d 3e 6e 75 6d 62 65 72 20 28 6f 72 20 28 61 72 ->number (or (ar
4e30: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 6f 77 gs:get-arg "-row
4e40: 73 22 29 0a 09 09 09 09 09 20 20 20 20 20 20 28 s")...... (
4e50: 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d get-environment-
4e60: 76 61 72 69 61 62 6c 65 20 22 44 41 53 48 42 4f variable "DASHBO
4e70: 41 52 44 52 4f 57 53 22 29 29 29 29 0a 09 28 75 ARDROWS"))))..(u
4e80: 70 64 61 74 65 2d 72 75 6e 64 61 74 20 22 25 22 pdate-rundat "%"
4e90: 20 2a 6e 75 6d 2d 72 75 6e 73 2a 20 22 25 22 20 *num-runs* "%"
4ea0: 22 25 22 20 27 28 29 29 29 0a 20 20 20 20 28 73 "%" '())). (s
4eb0: 65 74 21 20 2a 6e 75 6d 2d 74 65 73 74 73 2a 20 et! *num-tests*
4ec0: 28 6d 69 6e 20 28 6d 61 78 20 28 75 70 64 61 74 (min (max (updat
4ed0: 65 2d 72 75 6e 64 61 74 20 22 25 22 20 2a 6e 75 e-rundat "%" *nu
4ee0: 6d 2d 72 75 6e 73 2a 20 22 25 22 20 22 25 22 20 m-runs* "%" "%"
4ef0: 27 28 29 29 20 38 29 20 32 30 29 29 29 0a 0a 28 '()) 8) 20)))..(
4f00: 64 65 66 69 6e 65 20 2a 74 69 6d 2a 20 28 69 75 define *tim* (iu
4f10: 70 3a 74 69 6d 65 72 29 29 0a 28 64 65 66 69 6e p:timer)).(defin
4f20: 65 20 2a 6f 72 64 2a 20 23 66 29 0a 28 69 75 70 e *ord* #f).(iup
4f30: 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 :attribute-set!
4f40: 2a 74 69 6d 2a 20 22 54 49 4d 45 22 20 33 30 30 *tim* "TIME" 300
4f50: 29 0a 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 ).(iup:attribute
4f60: 2d 73 65 74 21 20 2a 74 69 6d 2a 20 22 52 55 4e -set! *tim* "RUN
4f70: 22 20 22 59 45 53 22 29 0a 0a 3b 3b 20 4d 6f 76 " "YES")..;; Mov
4f80: 65 20 74 68 69 73 20 73 74 75 66 66 20 74 6f 20 e this stuff to
4f90: 64 62 2e 73 63 6d 20 46 49 58 4d 45 0a 3b 3b 0a db.scm FIXME.;;.
4fa0: 28 64 65 66 69 6e 65 20 2a 6c 61 73 74 2d 64 62 (define *last-db
4fb0: 2d 75 70 64 61 74 65 2d 74 69 6d 65 2a 20 28 66 -update-time* (f
4fc0: 69 6c 65 2d 6d 6f 64 69 66 69 63 61 74 69 6f 6e ile-modification
4fd0: 2d 74 69 6d 65 20 28 63 6f 6e 63 20 2a 74 6f 70 -time (conc *top
4fe0: 70 61 74 68 2a 20 22 2f 6d 65 67 61 74 65 73 74 path* "/megatest
4ff0: 2e 64 62 22 29 29 29 0a 28 64 65 66 69 6e 65 20 .db"))).(define
5000: 28 64 62 3a 62 65 65 6e 2d 63 68 61 6e 67 65 64 (db:been-changed
5010: 29 0a 20 20 28 3e 20 28 66 69 6c 65 2d 6d 6f 64 ). (> (file-mod
5020: 69 66 69 63 61 74 69 6f 6e 2d 74 69 6d 65 20 28 ification-time (
5030: 63 6f 6e 63 20 2a 74 6f 70 70 61 74 68 2a 20 22 conc *toppath* "
5040: 2f 6d 65 67 61 74 65 73 74 2e 64 62 22 29 29 20 /megatest.db"))
5050: 2a 6c 61 73 74 2d 64 62 2d 75 70 64 61 74 65 2d *last-db-update-
5060: 74 69 6d 65 2a 29 29 0a 28 64 65 66 69 6e 65 20 time*)).(define
5070: 28 64 62 3a 73 65 74 2d 64 62 2d 75 70 64 61 74 (db:set-db-updat
5080: 65 2d 74 69 6d 65 29 0a 20 20 28 73 65 74 21 20 e-time). (set!
5090: 2a 6c 61 73 74 2d 64 62 2d 75 70 64 61 74 65 2d *last-db-update-
50a0: 74 69 6d 65 2a 20 28 66 69 6c 65 2d 6d 6f 64 69 time* (file-modi
50b0: 66 69 63 61 74 69 6f 6e 2d 74 69 6d 65 20 28 63 fication-time (c
50c0: 6f 6e 63 20 2a 74 6f 70 70 61 74 68 2a 20 22 2f onc *toppath* "/
50d0: 6d 65 67 61 74 65 73 74 2e 64 62 22 29 29 29 29 megatest.db"))))
50e0: 0a 0a 28 64 65 66 69 6e 65 20 28 72 75 6e 2d 75 ..(define (run-u
50f0: 70 64 61 74 65 20 78 29 0a 20 20 28 75 70 64 61 pdate x). (upda
5100: 74 65 2d 62 75 74 74 6f 6e 73 20 75 69 64 61 74 te-buttons uidat
5110: 20 2a 6e 75 6d 2d 72 75 6e 73 2a 20 2a 6e 75 6d *num-runs* *num
5120: 2d 74 65 73 74 73 2a 29 0a 20 20 3b 3b 20 28 69 -tests*). ;; (i
5130: 66 20 28 64 62 3a 62 65 65 6e 2d 63 68 61 6e 67 f (db:been-chang
5140: 65 64 29 0a 20 20 28 62 65 67 69 6e 0a 20 20 20 ed). (begin.
5150: 20 28 75 70 64 61 74 65 2d 72 75 6e 64 61 74 20 (update-rundat
5160: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f (hash-table-ref/
5170: 64 65 66 61 75 6c 74 20 2a 73 65 61 72 63 68 70 default *searchp
5180: 61 74 74 73 2a 20 22 72 75 6e 6e 61 6d 65 22 20 atts* "runname"
5190: 22 25 22 29 20 2a 6e 75 6d 2d 72 75 6e 73 2a 0a "%") *num-runs*.
51a0: 09 09 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 .. (hash-table
51b0: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 2a 73 65 -ref/default *se
51c0: 61 72 63 68 70 61 74 74 73 2a 20 22 74 65 73 74 archpatts* "test
51d0: 2d 6e 61 6d 65 22 20 22 25 22 29 0a 09 09 20 20 -name" "%")...
51e0: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
51f0: 2f 64 65 66 61 75 6c 74 20 2a 73 65 61 72 63 68 /default *search
5200: 70 61 74 74 73 2a 20 22 69 74 65 6d 2d 6e 61 6d patts* "item-nam
5210: 65 22 20 22 25 22 29 0a 09 09 20 20 20 28 6c 65 e" "%")... (le
5220: 74 20 28 28 72 65 73 20 27 28 29 29 29 0a 09 09 t ((res '()))...
5230: 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 (for-each (
5240: 6c 61 6d 62 64 61 20 28 6b 65 79 29 0a 09 09 09 lambda (key)....
5250: 09 20 28 6c 65 74 20 28 28 76 61 6c 20 28 68 61 . (let ((val (ha
5260: 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 sh-table-ref/def
5270: 61 75 6c 74 20 2a 73 65 61 72 63 68 70 61 74 74 ault *searchpatt
5280: 73 2a 20 6b 65 79 20 23 66 29 29 29 0a 09 09 09 s* key #f)))....
5290: 09 20 20 20 28 69 66 20 76 61 6c 20 28 73 65 74 . (if val (set
52a0: 21 20 72 65 73 20 28 63 6f 6e 73 20 28 6c 69 73 ! res (cons (lis
52b0: 74 20 6b 65 79 20 76 61 6c 29 20 72 65 73 29 29 t key val) res))
52c0: 29 29 29 0a 09 09 09 20 20 20 20 20 20 20 2a 64 ))).... *d
52d0: 62 6b 65 79 73 2a 29 0a 09 09 20 20 20 20 20 72 bkeys*)... r
52e0: 65 73 29 29 0a 20 20 20 20 3b 20 28 64 62 3a 73 es)). ; (db:s
52f0: 65 74 2d 64 62 2d 75 70 64 61 74 65 2d 74 69 6d et-db-update-tim
5300: 65 29 0a 20 20 20 20 29 29 0a 0a 28 63 6f 6e 64 e). ))..(cond
5310: 20 0a 20 28 28 61 72 67 73 3a 67 65 74 2d 61 72 . ((args:get-ar
5320: 67 20 22 2d 72 75 6e 22 29 0a 20 20 28 6c 65 74 g "-run"). (let
5330: 20 28 28 72 75 6e 69 64 20 28 73 74 72 69 6e 67 ((runid (string
5340: 2d 3e 6e 75 6d 62 65 72 20 28 61 72 67 73 3a 67 ->number (args:g
5350: 65 74 2d 61 72 67 20 22 2d 72 75 6e 22 29 29 29 et-arg "-run")))
5360: 29 0a 20 20 20 20 28 69 66 20 72 75 6e 69 64 0a ). (if runid.
5370: 09 28 62 65 67 69 6e 0a 09 20 20 28 6c 61 6d 62 .(begin.. (lamb
5380: 64 61 20 28 78 29 0a 09 20 20 20 20 28 6f 6e 2d da (x).. (on-
5390: 65 78 69 74 20 28 6c 61 6d 62 64 61 20 28 29 0a exit (lambda ().
53a0: 09 09 20 20 20 20 20 20 20 28 73 71 6c 69 74 65 .. (sqlite
53b0: 33 3a 66 69 6e 61 6c 69 7a 65 21 20 2a 64 62 2a 3:finalize! *db*
53c0: 29 29 29 0a 09 20 20 20 20 28 65 78 61 6d 69 6e ))).. (examin
53d0: 65 2d 72 75 6e 20 2a 64 62 2a 20 72 75 6e 69 64 e-run *db* runid
53e0: 29 29 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 )))..(begin.. (
53f0: 70 72 69 6e 74 20 22 45 52 52 4f 52 3a 20 72 75 print "ERROR: ru
5400: 6e 69 64 20 69 73 20 6e 6f 74 20 61 20 6e 75 6d nid is not a num
5410: 62 65 72 20 22 20 28 61 72 67 73 3a 67 65 74 2d ber " (args:get-
5420: 61 72 67 20 22 2d 72 75 6e 22 29 29 0a 09 20 20 arg "-run"))..
5430: 28 65 78 69 74 20 31 29 29 29 29 29 0a 20 28 28 (exit 1))))). ((
5440: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 args:get-arg "-t
5450: 65 73 74 22 29 0a 20 20 20 20 28 6c 65 74 20 28 est"). (let (
5460: 28 74 65 73 74 69 64 20 28 73 74 72 69 6e 67 2d (testid (string-
5470: 3e 6e 75 6d 62 65 72 20 28 61 72 67 73 3a 67 65 >number (args:ge
5480: 74 2d 61 72 67 20 22 2d 74 65 73 74 22 29 29 29 t-arg "-test")))
5490: 29 0a 20 20 20 20 28 69 66 20 74 65 73 74 69 64 ). (if testid
54a0: 0a 09 28 65 78 61 6d 69 6e 65 2d 74 65 73 74 20 ..(examine-test
54b0: 2a 64 62 2a 20 74 65 73 74 69 64 29 0a 09 28 62 *db* testid)..(b
54c0: 65 67 69 6e 0a 09 20 20 28 70 72 69 6e 74 20 22 egin.. (print "
54d0: 45 52 52 4f 52 3a 20 74 65 73 74 69 64 20 69 73 ERROR: testid is
54e0: 20 6e 6f 74 20 61 20 6e 75 6d 62 65 72 20 22 20 not a number "
54f0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
5500: 74 65 73 74 22 29 29 0a 09 20 20 28 65 78 69 74 test")).. (exit
5510: 20 31 29 29 29 29 29 0a 20 28 65 6c 73 65 0a 20 1))))). (else.
5520: 20 28 73 65 74 21 20 75 69 64 61 74 20 28 6d 61 (set! uidat (ma
5530: 6b 65 2d 64 61 73 68 62 6f 61 72 64 2d 62 75 74 ke-dashboard-but
5540: 74 6f 6e 73 20 2a 6e 75 6d 2d 72 75 6e 73 2a 20 tons *num-runs*
5550: 2a 6e 75 6d 2d 74 65 73 74 73 2a 20 2a 64 62 6b *num-tests* *dbk
5560: 65 79 73 2a 29 29 0a 20 20 28 69 75 70 3a 63 61 eys*)). (iup:ca
5570: 6c 6c 62 61 63 6b 2d 73 65 74 21 20 2a 74 69 6d llback-set! *tim
5580: 2a 0a 09 09 20 20 20 20 20 22 41 43 54 49 4f 4e *... "ACTION
5590: 5f 43 42 22 0a 09 09 20 20 20 20 20 28 6c 61 6d _CB"... (lam
55a0: 62 64 61 20 28 78 29 0a 09 09 20 20 20 20 20 20 bda (x)...
55b0: 20 28 72 75 6e 2d 75 70 64 61 74 65 20 78 29 29 (run-update x))
55c0: 29 29 29 0a 09 09 20 20 20 20 20 20 20 3b 28 70 )))... ;(p
55d0: 72 69 6e 74 20 78 29 29 29 29 29 0a 0a 28 69 75 rint x)))))..(iu
55e0: 70 3a 6d 61 69 6e 2d 6c 6f 6f 70 29 0a p:main-loop).