Artifact
d8bbd167b312fb2e52a1484e4bf8a7152538e885
File
dashboard.scm
— part of check-in
[e0c173490e]
at
2011-10-08 21:27:59
on branch trunk
— All (I hope) interdependencies captured and testing passes
(user:
matt
size: 22028)
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 61 73 68 62 6f 61 72 64 2d (uses dashboard-
0370: 74 65 73 74 73 29 29 0a 28 64 65 63 6c 61 72 65 tests)).(declare
0380: 20 28 75 73 65 73 20 6d 65 67 61 74 65 73 74 2d (uses megatest-
0390: 76 65 72 73 69 6f 6e 29 29 0a 0a 28 69 6e 63 6c version))..(incl
03a0: 75 64 65 20 22 63 6f 6d 6d 6f 6e 5f 72 65 63 6f ude "common_reco
03b0: 72 64 73 2e 73 63 6d 22 29 0a 28 69 6e 63 6c 75 rds.scm").(inclu
03c0: 64 65 20 22 64 62 5f 72 65 63 6f 72 64 73 2e 73 de "db_records.s
03d0: 63 6d 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 72 cm").(include "r
03e0: 75 6e 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 29 un_records.scm")
03f0: 0a 0a 28 64 65 66 69 6e 65 20 68 65 6c 70 20 28 ..(define help (
0400: 63 6f 6e 63 20 0a 22 4d 65 67 61 74 65 73 74 20 conc ."Megatest
0410: 44 61 73 68 62 6f 61 72 64 2c 20 64 6f 63 75 6d Dashboard, docum
0420: 65 6e 74 61 74 69 6f 6e 20 61 74 20 68 74 74 70 entation at http
0430: 3a 2f 2f 77 77 77 2e 6b 69 61 74 6f 61 2e 63 6f ://www.kiatoa.co
0440: 6d 2f 66 6f 73 73 69 6c 73 2f 6d 65 67 61 74 65 m/fossils/megate
0450: 73 74 0a 20 20 76 65 72 73 69 6f 6e 20 22 20 6d st. version " m
0460: 65 67 61 74 65 73 74 2d 76 65 72 73 69 6f 6e 20 egatest-version
0470: 22 0a 20 20 6c 69 63 65 6e 73 65 20 47 50 4c 2c ". license GPL,
0480: 20 43 6f 70 79 72 69 67 68 74 20 28 43 29 20 4d Copyright (C) M
0490: 61 74 74 20 57 65 6c 6c 61 6e 64 20 32 30 31 31 att Welland 2011
04a0: 0a 0a 55 73 61 67 65 3a 20 64 61 73 68 62 6f 61 ..Usage: dashboa
04b0: 72 64 20 5b 6f 70 74 69 6f 6e 73 5d 0a 20 20 2d rd [options]. -
04c0: 68 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a h :
04d0: 20 74 68 69 73 20 68 65 6c 70 0a 20 20 2d 72 75 this help. -ru
04e0: 6e 20 72 75 6e 69 64 20 20 20 20 20 20 3a 20 63 n runid : c
04f0: 6f 6e 74 72 6f 6c 20 72 75 6e 20 69 64 65 6e 74 ontrol run ident
0500: 69 66 69 65 64 20 62 79 20 72 75 6e 69 64 0a 20 ified by runid.
0510: 20 2d 74 65 73 74 20 74 65 73 74 69 64 20 20 20 -test testid
0520: 20 3a 20 63 6f 6e 74 72 6f 6c 20 74 65 73 74 20 : control test
0530: 69 64 65 6e 74 69 66 69 65 64 20 62 79 20 74 65 identified by te
0540: 73 74 69 64 0a 0a 4d 69 73 63 0a 20 20 2d 72 6f stid..Misc. -ro
0550: 77 73 20 4e 20 20 20 20 20 20 20 20 20 3a 20 73 ws N : s
0560: 65 74 20 6e 75 6d 62 65 72 20 6f 66 20 72 6f 77 et number of row
0570: 73 0a 22 29 29 0a 0a 3b 3b 20 70 72 6f 63 65 73 s."))..;; proces
0580: 73 20 61 72 67 73 0a 28 64 65 66 69 6e 65 20 72 s args.(define r
0590: 65 6d 61 72 67 73 20 28 61 72 67 73 3a 67 65 74 emargs (args:get
05a0: 2d 61 72 67 73 20 0a 09 09 20 28 61 72 67 76 29 -args ... (argv)
05b0: 0a 09 09 20 28 6c 69 73 74 20 20 22 2d 72 6f 77 ... (list "-row
05c0: 73 22 0a 09 09 09 22 2d 72 75 6e 22 0a 09 09 09 s"...."-run"....
05d0: 22 2d 74 65 73 74 22 0a 09 09 09 22 2d 64 65 62 "-test"...."-deb
05e0: 75 67 22 0a 09 09 09 29 20 0a 09 09 20 28 6c 69 ug"....) ... (li
05f0: 73 74 20 20 22 2d 68 22 0a 09 09 09 22 2d 76 22 st "-h"...."-v"
0600: 0a 09 09 09 22 2d 71 22 0a 09 09 20 20 20 20 20 ...."-q"...
0610: 20 20 29 0a 09 09 20 61 72 67 73 3a 61 72 67 2d )... args:arg-
0620: 68 61 73 68 0a 09 09 20 30 29 29 0a 0a 28 69 66 hash... 0))..(if
0630: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
0640: 2d 68 22 29 0a 20 20 20 20 28 62 65 67 69 6e 0a -h"). (begin.
0650: 20 20 20 20 20 20 28 70 72 69 6e 74 20 68 65 6c (print hel
0660: 70 29 0a 20 20 20 20 20 20 28 65 78 69 74 29 29 p). (exit))
0670: 29 0a 0a 28 69 66 20 28 6e 6f 74 20 28 73 65 74 )..(if (not (set
0680: 75 70 2d 66 6f 72 2d 72 75 6e 29 29 0a 20 20 20 up-for-run)).
0690: 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 70 (begin. (p
06a0: 72 69 6e 74 20 22 46 61 69 6c 65 64 20 74 6f 20 rint "Failed to
06b0: 66 69 6e 64 20 6d 65 67 61 74 65 73 74 2e 63 6f find megatest.co
06c0: 6e 66 69 67 2c 20 65 78 69 74 69 6e 67 22 29 20 nfig, exiting")
06d0: 0a 20 20 20 20 20 20 28 65 78 69 74 20 31 29 29 . (exit 1))
06e0: 29 0a 0a 28 64 65 66 69 6e 65 20 2a 64 62 2a 20 )..(define *db*
06f0: 28 6f 70 65 6e 2d 64 62 29 29 0a 0a 28 64 65 66 (open-db))..(def
0700: 69 6e 65 20 74 6f 70 6c 65 76 65 6c 20 23 66 29 ine toplevel #f)
0710: 0a 28 64 65 66 69 6e 65 20 64 6c 67 20 20 20 20 .(define dlg
0720: 20 20 23 66 29 0a 28 64 65 66 69 6e 65 20 6d 61 #f).(define ma
0730: 78 2d 74 65 73 74 2d 6e 75 6d 20 30 29 0a 28 64 x-test-num 0).(d
0740: 65 66 69 6e 65 20 2a 6b 65 79 73 2a 20 20 20 28 efine *keys* (
0750: 67 65 74 2d 6b 65 79 73 20 20 20 2a 64 62 2a 29 get-keys *db*)
0760: 29 0a 28 64 65 66 69 6e 65 20 2a 64 62 6b 65 79 ).(define *dbkey
0770: 73 2a 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 s* (map (lambda
0780: 20 28 78 29 28 76 65 63 74 6f 72 2d 72 65 66 20 (x)(vector-ref
0790: 78 20 30 29 29 0a 09 09 20 20 20 20 20 20 28 61 x 0))... (a
07a0: 70 70 65 6e 64 20 2a 6b 65 79 73 2a 20 28 6c 69 ppend *keys* (li
07b0: 73 74 20 28 76 65 63 74 6f 72 20 22 72 75 6e 6e st (vector "runn
07c0: 61 6d 65 22 20 22 62 6c 61 68 22 29 29 29 29 29 ame" "blah")))))
07d0: 0a 28 64 65 66 69 6e 65 20 2a 68 65 61 64 65 72 .(define *header
07e0: 2a 20 20 20 20 20 20 20 23 66 29 0a 28 64 65 66 * #f).(def
07f0: 69 6e 65 20 2a 61 6c 6c 72 75 6e 73 2a 20 20 20 ine *allruns*
0800: 20 20 27 28 29 29 0a 28 64 65 66 69 6e 65 20 2a '()).(define *
0810: 62 75 74 74 6f 6e 64 61 74 2a 20 20 20 20 28 6d buttondat* (m
0820: 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 ake-hash-table))
0830: 20 3b 3b 20 3c 72 75 6e 2d 69 64 20 63 6f 6c 6f ;; <run-id colo
0840: 72 20 74 65 78 74 20 74 65 73 74 20 72 75 6e 2d r text test run-
0850: 6b 65 79 3e 0a 28 64 65 66 69 6e 65 20 2a 61 6c key>.(define *al
0860: 6c 74 65 73 74 6e 61 6d 65 6c 73 74 2a 20 27 28 ltestnamelst* '(
0870: 29 29 0a 28 64 65 66 69 6e 65 20 2a 73 65 61 72 )).(define *sear
0880: 63 68 70 61 74 74 73 2a 20 20 28 6d 61 6b 65 2d chpatts* (make-
0890: 68 61 73 68 2d 74 61 62 6c 65 29 29 0a 28 64 65 hash-table)).(de
08a0: 66 69 6e 65 20 2a 6e 75 6d 2d 72 75 6e 73 2a 20 fine *num-runs*
08b0: 20 20 20 20 20 38 29 0a 28 64 65 66 69 6e 65 20 8).(define
08c0: 2a 74 6f 74 2d 72 75 6e 2d 63 6f 75 6e 74 2a 20 *tot-run-count*
08d0: 28 64 62 3a 67 65 74 2d 6e 75 6d 2d 72 75 6e 73 (db:get-num-runs
08e0: 20 2a 64 62 2a 20 22 25 22 29 29 0a 28 64 65 66 *db* "%")).(def
08f0: 69 6e 65 20 2a 6c 61 73 74 2d 75 70 64 61 74 65 ine *last-update
0900: 2a 20 20 20 28 63 75 72 72 65 6e 74 2d 73 65 63 * (current-sec
0910: 6f 6e 64 73 29 29 0a 28 64 65 66 69 6e 65 20 2a onds)).(define *
0920: 6e 75 6d 2d 74 65 73 74 73 2a 20 20 20 20 20 31 num-tests* 1
0930: 35 29 0a 28 64 65 66 69 6e 65 20 2a 73 74 61 72 5).(define *star
0940: 74 2d 72 75 6e 2d 6f 66 66 73 65 74 2a 20 20 30 t-run-offset* 0
0950: 29 0a 28 64 65 66 69 6e 65 20 2a 73 74 61 72 74 ).(define *start
0960: 2d 74 65 73 74 2d 6f 66 66 73 65 74 2a 20 30 29 -test-offset* 0)
0970: 0a 28 64 65 66 69 6e 65 20 2a 65 78 61 6d 69 6e .(define *examin
0980: 65 2d 74 65 73 74 2d 64 61 74 2a 20 28 6d 61 6b e-test-dat* (mak
0990: 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 0a 28 e-hash-table)).(
09a0: 64 65 66 69 6e 65 20 2a 65 78 69 74 2d 73 74 61 define *exit-sta
09b0: 72 74 65 64 2a 20 23 66 29 0a 0a 28 64 65 66 69 rted* #f)..(defi
09c0: 6e 65 20 2a 76 65 72 62 6f 73 69 74 79 2a 20 28 ne *verbosity* (
09d0: 63 6f 6e 64 0a 09 09 20 20 20 20 20 28 28 61 72 cond... ((ar
09e0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 65 62 gs:get-arg "-deb
09f0: 75 67 22 29 28 73 74 72 69 6e 67 2d 3e 6e 75 6d ug")(string->num
0a00: 62 65 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 ber (args:get-ar
0a10: 67 20 22 2d 64 65 62 75 67 22 29 29 29 0a 09 09 g "-debug")))...
0a20: 20 20 20 20 20 28 28 61 72 67 73 3a 67 65 74 2d ((args:get-
0a30: 61 72 67 20 22 2d 76 22 29 20 20 20 20 32 29 0a arg "-v") 2).
0a40: 09 09 20 20 20 20 20 28 28 61 72 67 73 3a 67 65 .. ((args:ge
0a50: 74 2d 61 72 67 20 22 2d 71 22 29 20 20 20 20 30 t-arg "-q") 0
0a60: 29 0a 09 09 20 20 20 20 20 28 65 6c 73 65 20 20 )... (else
0a70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0a80: 20 31 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 75 1)))..(define u
0a90: 69 64 61 74 20 23 66 29 0a 3b 3b 20 28 6d 65 67 idat #f).;; (meg
0aa0: 61 74 65 73 74 2d 64 61 73 68 62 6f 61 72 64 29 atest-dashboard)
0ab0: 0a 0a 3b 28 64 65 66 69 6e 65 20 69 6d 67 31 20 ..;(define img1
0ac0: 28 69 75 70 3a 69 6d 61 67 65 2f 70 61 6c 65 74 (iup:image/palet
0ad0: 74 65 20 31 36 20 31 36 20 28 75 38 76 65 63 74 te 16 16 (u8vect
0ae0: 6f 72 2d 3e 62 6c 6f 62 20 28 75 38 76 65 63 74 or->blob (u8vect
0af0: 6f 72 0a 3b 09 09 09 09 20 20 20 31 20 31 20 31 or.;.... 1 1 1
0b00: 20 31 20 31 20 31 20 31 20 31 20 31 20 31 20 31 1 1 1 1 1 1 1 1
0b10: 20 31 20 31 20 31 20 31 20 32 20 0a 3b 09 09 09 1 1 1 1 2 .;...
0b20: 09 20 20 20 31 20 31 20 31 20 31 20 31 20 31 20 . 1 1 1 1 1 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: 32 20 32 20 0a 3b 09 09 09 09 20 20 20 31 20 31 2 2 .;.... 1 1
0b50: 20 31 20 31 20 31 20 31 20 31 20 31 20 31 20 31 1 1 1 1 1 1 1 1
0b60: 20 31 20 31 20 31 20 32 20 32 20 32 20 0a 3b 09 1 1 1 2 2 2 .;.
0b70: 09 09 09 20 20 20 31 20 31 20 31 20 31 20 31 20 ... 1 1 1 1 1
0b80: 31 20 31 20 31 20 31 20 31 20 31 20 31 20 32 20 1 1 1 1 1 1 1 2
0b90: 32 20 32 20 32 20 0a 3b 09 09 09 09 20 20 20 31 2 2 2 .;.... 1
0ba0: 20 31 20 31 20 31 20 31 20 31 20 31 20 31 20 31 1 1 1 1 1 1 1 1
0bb0: 20 31 20 31 20 32 20 32 20 32 20 32 20 32 20 0a 1 1 2 2 2 2 2 .
0bc0: 3b 09 09 09 09 20 20 20 31 20 31 20 31 20 31 20 ;.... 1 1 1 1
0bd0: 31 20 31 20 31 20 31 20 31 20 31 20 32 20 32 20 1 1 1 1 1 1 2 2
0be0: 32 20 32 20 32 20 32 20 0a 3b 09 09 09 09 20 20 2 2 2 2 .;....
0bf0: 20 31 20 31 20 31 20 31 20 31 20 31 20 31 20 31 1 1 1 1 1 1 1 1
0c00: 20 31 20 32 20 32 20 32 20 32 20 32 20 32 20 32 1 2 2 2 2 2 2 2
0c10: 20 0a 3b 09 09 09 09 20 20 20 31 20 31 20 31 20 .;.... 1 1 1
0c20: 31 20 31 20 31 20 31 20 31 20 32 20 32 20 32 20 1 1 1 1 1 2 2 2
0c30: 32 20 32 20 32 20 32 20 32 20 0a 3b 09 09 09 09 2 2 2 2 2 .;....
0c40: 20 20 20 32 20 32 20 32 20 32 20 32 20 32 20 32 2 2 2 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 0a 3b 09 09 09 09 20 20 20 32 20 32 20 2 .;.... 2 2
0c70: 32 20 32 20 32 20 32 20 32 20 32 20 32 20 32 20 2 2 2 2 2 2 2 2
0c80: 32 20 32 20 32 20 32 20 32 20 32 20 0a 3b 09 09 2 2 2 2 2 2 .;..
0c90: 09 09 20 20 20 32 20 32 20 32 20 30 20 32 20 32 .. 2 2 2 0 2 2
0ca0: 20 32 20 32 20 32 20 32 20 32 20 32 20 32 20 32 2 2 2 2 2 2 2 2
0cb0: 20 32 20 32 20 0a 3b 09 09 09 09 20 20 20 32 20 2 2 .;.... 2
0cc0: 32 20 32 20 30 20 32 20 32 20 32 20 32 20 32 20 2 2 0 2 2 2 2 2
0cd0: 32 20 32 20 32 20 32 20 32 20 32 20 32 20 0a 3b 2 2 2 2 2 2 2 .;
0ce0: 09 09 09 09 20 20 20 32 20 32 20 32 20 30 20 32 .... 2 2 2 0 2
0cf0: 20 30 20 32 20 30 20 32 20 32 20 30 20 32 20 32 0 2 0 2 2 0 2 2
0d00: 20 32 20 30 20 30 20 0a 3b 09 09 09 09 20 20 20 2 0 0 .;....
0d10: 32 20 32 20 32 20 30 20 32 20 30 20 30 20 32 20 2 2 2 0 2 0 0 2
0d20: 30 20 30 20 32 20 30 20 32 20 30 20 32 20 32 20 0 0 2 0 2 0 2 2
0d30: 0a 3b 09 09 09 09 20 20 20 32 20 32 20 32 20 30 .;.... 2 2 2 0
0d40: 20 32 20 30 20 32 20 32 20 30 20 32 20 32 20 30 2 0 2 2 0 2 2 0
0d50: 20 32 20 32 20 32 20 32 20 0a 3b 09 09 09 09 20 2 2 2 2 .;....
0d60: 20 20 32 20 32 20 32 20 30 20 32 20 30 20 32 20 2 2 2 0 2 0 2
0d70: 32 20 30 20 32 20 32 20 30 20 32 20 32 20 30 20 2 0 2 2 0 2 2 0
0d80: 30 20 0a 3b 09 09 09 09 20 20 20 32 20 32 20 32 0 .;.... 2 2 2
0d90: 20 30 20 32 20 30 20 32 20 32 20 30 20 32 20 32 0 2 0 2 2 0 2 2
0da0: 20 30 20 32 20 30 20 32 20 31 29 29 29 29 0a 3b 0 2 0 2 1)))).;
0db0: 0a 3b 28 64 65 66 69 6e 65 20 69 6d 67 32 20 28 .;(define img2 (
0dc0: 69 75 70 3a 69 6d 61 67 65 2f 70 61 6c 65 74 74 iup:image/palett
0dd0: 65 20 31 36 20 31 36 20 28 75 38 76 65 63 74 6f e 16 16 (u8vecto
0de0: 72 2d 3e 62 6c 6f 62 20 28 75 38 76 65 63 74 6f r->blob (u8vecto
0df0: 72 0a 3b 09 09 09 09 20 20 20 32 20 32 20 32 20 r.;.... 2 2 2
0e00: 32 20 32 20 32 20 32 20 32 20 32 20 32 20 32 20 2 2 2 2 2 2 2 2
0e10: 32 20 32 20 32 20 32 20 31 20 0a 3b 09 09 09 09 2 2 2 2 1 .;....
0e20: 20 20 20 32 20 32 20 32 20 32 20 32 20 32 20 32 2 2 2 2 2 2 2
0e30: 20 32 20 32 20 32 20 32 20 32 20 32 20 32 20 31 2 2 2 2 2 2 2 1
0e40: 20 31 20 0a 3b 09 09 09 09 20 20 20 32 20 32 20 1 .;.... 2 2
0e50: 32 20 32 20 32 20 32 20 32 20 32 20 32 20 32 20 2 2 2 2 2 2 2 2
0e60: 32 20 32 20 32 20 31 20 31 20 31 20 0a 3b 09 09 2 2 2 1 1 1 .;..
0e70: 09 09 20 20 20 31 20 31 20 31 20 31 20 31 20 31 .. 1 1 1 1 1 1
0e80: 20 31 20 31 20 31 20 31 20 31 20 31 20 32 20 32 1 1 1 1 1 1 2 2
0e90: 20 32 20 32 20 0a 3b 09 09 09 09 20 20 20 31 20 2 2 .;.... 1
0ea0: 31 20 31 20 31 20 31 20 31 20 31 20 31 20 31 20 1 1 1 1 1 1 1 1
0eb0: 31 20 31 20 32 20 32 20 32 20 32 20 32 20 0a 3b 1 1 2 2 2 2 2 .;
0ec0: 09 09 09 09 20 20 20 31 20 31 20 31 20 31 20 31 .... 1 1 1 1 1
0ed0: 20 31 20 31 20 31 20 31 20 31 20 32 20 32 20 32 1 1 1 1 1 2 2 2
0ee0: 20 32 20 32 20 32 20 0a 3b 09 09 09 09 20 20 20 2 2 2 .;....
0ef0: 31 20 31 20 31 20 31 20 31 20 31 20 31 20 31 20 1 1 1 1 1 1 1 1
0f00: 31 20 32 20 32 20 32 20 32 20 32 20 32 20 32 20 1 2 2 2 2 2 2 2
0f10: 0a 3b 09 09 09 09 20 20 20 31 20 31 20 31 20 31 .;.... 1 1 1 1
0f20: 20 31 20 31 20 31 20 31 20 32 20 32 20 32 20 32 1 1 1 1 2 2 2 2
0f30: 20 32 20 32 20 32 20 32 20 0a 3b 09 09 09 09 20 2 2 2 2 .;....
0f40: 20 20 32 20 32 20 32 20 32 20 32 20 32 20 32 20 2 2 2 2 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 0a 3b 09 09 09 09 20 20 20 32 20 32 20 32 2 .;.... 2 2 2
0f70: 20 32 20 32 20 32 20 32 20 32 20 32 20 32 20 32 2 2 2 2 2 2 2 2
0f80: 20 32 20 32 20 32 20 32 20 32 20 0a 3b 09 09 09 2 2 2 2 2 .;...
0f90: 09 20 20 20 32 20 32 20 32 20 30 20 32 20 32 20 . 2 2 2 0 2 2
0fa0: 32 20 32 20 32 20 32 20 32 20 32 20 32 20 32 20 2 2 2 2 2 2 2 2
0fb0: 32 20 32 20 0a 3b 09 09 09 09 20 20 20 32 20 32 2 2 .;.... 2 2
0fc0: 20 32 20 30 20 32 20 32 20 32 20 32 20 32 20 32 2 0 2 2 2 2 2 2
0fd0: 20 32 20 32 20 32 20 32 20 32 20 32 20 0a 3b 09 2 2 2 2 2 2 .;.
0fe0: 09 09 09 20 20 20 32 20 32 20 32 20 30 20 32 20 ... 2 2 2 0 2
0ff0: 30 20 32 20 30 20 32 20 32 20 30 20 32 20 32 20 0 2 0 2 2 0 2 2
1000: 32 20 30 20 30 20 0a 3b 09 09 09 09 20 20 20 32 2 0 0 .;.... 2
1010: 20 32 20 32 20 30 20 32 20 30 20 30 20 32 20 30 2 2 0 2 0 0 2 0
1020: 20 30 20 32 20 30 20 32 20 30 20 32 20 32 20 0a 0 2 0 2 0 2 2 .
1030: 3b 09 09 09 09 20 20 20 32 20 32 20 32 20 30 20 ;.... 2 2 2 0
1040: 32 20 30 20 32 20 32 20 30 20 32 20 32 20 30 20 2 0 2 2 0 2 2 0
1050: 32 20 32 20 32 20 32 20 0a 3b 09 09 09 09 20 20 2 2 2 2 .;....
1060: 20 32 20 32 20 32 20 30 20 32 20 30 20 32 20 32 2 2 2 0 2 0 2 2
1070: 20 30 20 32 20 32 20 30 20 32 20 32 20 30 20 30 0 2 2 0 2 2 0 0
1080: 20 0a 3b 09 09 09 09 20 20 20 32 20 32 20 32 20 .;.... 2 2 2
1090: 30 20 32 20 30 20 32 20 32 20 30 20 32 20 32 20 0 2 0 2 2 0 2 2
10a0: 30 20 32 20 30 20 32 20 31 29 29 29 29 0a 3b 0a 0 2 0 2 1)))).;.
10b0: 3b 28 69 75 70 3a 68 61 6e 64 6c 65 2d 6e 61 6d ;(iup:handle-nam
10c0: 65 2d 73 65 74 21 20 69 6d 67 31 20 22 69 6d 67 e-set! img1 "img
10d0: 31 22 29 0a 3b 28 69 75 70 3a 61 74 74 72 69 62 1").;(iup:attrib
10e0: 75 74 65 2d 73 65 74 21 20 69 6d 67 31 20 22 30 ute-set! img1 "0
10f0: 22 20 22 30 20 30 20 30 22 29 0a 3b 28 69 75 70 " "0 0 0").;(iup
1100: 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 :attribute-set!
1110: 69 6d 67 31 20 22 31 22 20 22 42 47 43 4f 4c 4f img1 "1" "BGCOLO
1120: 52 22 29 0a 3b 28 69 75 70 3a 61 74 74 72 69 62 R").;(iup:attrib
1130: 75 74 65 2d 73 65 74 21 20 69 6d 67 31 20 22 32 ute-set! img1 "2
1140: 22 20 22 32 35 35 20 30 20 30 22 29 0a 3b 0a 3b " "255 0 0").;.;
1150: 28 69 75 70 3a 68 61 6e 64 6c 65 2d 6e 61 6d 65 (iup:handle-name
1160: 2d 73 65 74 21 20 69 6d 67 32 20 22 69 6d 67 32 -set! img2 "img2
1170: 22 29 0a 3b 28 69 75 70 3a 61 74 74 72 69 62 75 ").;(iup:attribu
1180: 74 65 2d 73 65 74 21 20 69 6d 67 32 20 22 30 22 te-set! img2 "0"
1190: 20 22 30 20 30 20 30 22 29 0a 3b 28 69 75 70 3a "0 0 0").;(iup:
11a0: 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 69 attribute-set! i
11b0: 6d 67 32 20 22 31 22 20 22 42 47 43 4f 4c 4f 52 mg2 "1" "BGCOLOR
11c0: 22 29 0a 3b 28 69 75 70 3a 61 74 74 72 69 62 75 ").;(iup:attribu
11d0: 74 65 2d 73 65 74 21 20 69 6d 67 32 20 22 32 22 te-set! img2 "2"
11e0: 20 22 32 35 35 20 30 20 30 22 29 0a 0a 28 64 65 "255 0 0")..(de
11f0: 66 69 6e 65 20 28 6d 65 73 73 61 67 65 2d 77 69 fine (message-wi
1200: 6e 64 6f 77 20 6d 73 67 29 0a 20 20 28 69 75 70 ndow msg). (iup
1210: 3a 73 68 6f 77 0a 20 20 20 28 69 75 70 3a 64 69 :show. (iup:di
1220: 61 6c 6f 67 0a 20 20 20 20 28 69 75 70 3a 76 62 alog. (iup:vb
1230: 6f 78 20 0a 20 20 20 20 20 28 69 75 70 3a 6c 61 ox . (iup:la
1240: 62 65 6c 20 6d 73 67 20 23 3a 6d 61 72 67 69 6e bel msg #:margin
1250: 20 22 34 30 78 34 30 22 29 29 29 29 29 0a 0a 28 "40x40")))))..(
1260: 64 65 66 69 6e 65 20 28 69 75 70 6c 69 73 74 62 define (iuplistb
1270: 6f 78 2d 66 69 6c 6c 2d 6c 69 73 74 20 6c 62 20 ox-fill-list lb
1280: 69 74 65 6d 73 20 2e 20 64 65 66 61 75 6c 74 29 items . default)
1290: 0a 20 20 28 6c 65 74 20 28 28 69 20 31 29 0a 09 . (let ((i 1)..
12a0: 28 73 65 6c 65 63 74 65 64 2d 69 74 65 6d 20 28 (selected-item (
12b0: 69 66 20 28 6e 75 6c 6c 3f 20 64 65 66 61 75 6c if (null? defaul
12c0: 74 29 20 23 66 20 28 63 61 72 20 64 65 66 61 75 t) #f (car defau
12d0: 6c 74 29 29 29 29 0a 20 20 20 20 28 69 75 70 3a lt)))). (iup:
12e0: 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 6c attribute-set! l
12f0: 62 20 22 56 41 4c 55 45 22 20 28 69 66 20 73 65 b "VALUE" (if se
1300: 6c 65 63 74 65 64 2d 69 74 65 6d 20 73 65 6c 65 lected-item sele
1310: 63 74 65 64 2d 69 74 65 6d 20 22 22 29 29 0a 20 cted-item "")).
1320: 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 (for-each (la
1330: 6d 62 64 61 20 28 69 74 65 6d 29 0a 09 09 28 69 mbda (item)...(i
1340: 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 up:attribute-set
1350: 21 20 6c 62 20 28 6e 75 6d 62 65 72 2d 3e 73 74 ! lb (number->st
1360: 72 69 6e 67 20 69 29 20 69 74 65 6d 29 0a 09 09 ring i) item)...
1370: 28 69 66 20 73 65 6c 65 63 74 65 64 2d 69 74 65 (if selected-ite
1380: 6d 0a 09 09 20 20 20 20 28 69 66 20 28 65 71 75 m... (if (equ
1390: 61 6c 3f 20 73 65 6c 65 63 74 65 64 2d 69 74 65 al? selected-ite
13a0: 6d 20 69 74 65 6d 29 0a 09 09 09 28 69 75 70 3a m item)....(iup:
13b0: 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 6c attribute-set! l
13c0: 62 20 22 56 41 4c 55 45 22 20 69 74 65 6d 29 29 b "VALUE" item))
13d0: 29 20 3b 3b 20 28 6e 75 6d 62 65 72 2d 3e 73 74 ) ;; (number->st
13e0: 72 69 6e 67 20 69 29 29 29 29 0a 09 09 28 73 65 ring i))))...(se
13f0: 74 21 20 69 20 28 2b 20 69 20 31 29 29 29 0a 09 t! i (+ i 1)))..
1400: 20 20 20 20 20 20 69 74 65 6d 73 29 0a 20 20 20 items).
1410: 20 69 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 70 i))..(define (p
1420: 61 64 2d 6c 69 73 74 20 6c 20 6e 29 28 61 70 70 ad-list l n)(app
1430: 65 6e 64 20 6c 20 28 6d 61 6b 65 2d 6c 69 73 74 end l (make-list
1440: 20 28 2d 20 6e 20 28 6c 65 6e 67 74 68 20 6c 29 (- n (length l)
1450: 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 ))))..(define (c
1460: 6f 6c 6f 72 73 2d 73 69 6d 69 6c 61 72 3f 20 63 olors-similar? c
1470: 6f 6c 6f 72 31 20 63 6f 6c 6f 72 32 29 0a 20 20 olor1 color2).
1480: 28 6c 65 74 2a 20 28 28 63 31 20 28 6d 61 70 20 (let* ((c1 (map
1490: 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 string->number (
14a0: 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 63 6f 6c string-split col
14b0: 6f 72 31 29 29 29 0a 09 20 28 63 32 20 28 6d 61 or1))).. (c2 (ma
14c0: 70 20 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 p string->number
14d0: 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 63 (string-split c
14e0: 6f 6c 6f 72 32 29 29 29 0a 09 20 28 64 65 6c 74 olor2))).. (delt
14f0: 61 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 a (map (lambda (
1500: 61 20 62 29 28 61 62 73 20 28 2d 20 61 20 62 29 a b)(abs (- a b)
1510: 29 29 20 63 31 20 63 32 29 29 29 0a 20 20 20 20 )) c1 c2))).
1520: 28 6e 75 6c 6c 3f 20 28 66 69 6c 74 65 72 20 28 (null? (filter (
1530: 6c 61 6d 62 64 61 20 28 78 29 28 3e 20 78 20 33 lambda (x)(> x 3
1540: 29 29 20 64 65 6c 74 61 29 29 29 29 0a 0a 3b 3b )) delta))))..;;
1550: 20 6b 65 79 70 61 74 74 73 3a 20 28 20 28 4b 45 keypatts: ( (KE
1560: 59 31 20 22 61 62 63 25 64 65 66 22 29 28 4b 45 Y1 "abc%def")(KE
1570: 59 32 20 22 25 22 29 20 29 0a 28 64 65 66 69 6e Y2 "%") ).(defin
1580: 65 20 28 75 70 64 61 74 65 2d 72 75 6e 64 61 74 e (update-rundat
1590: 20 72 75 6e 6e 61 6d 65 70 61 74 74 20 6e 75 6d runnamepatt num
15a0: 72 75 6e 73 20 74 65 73 74 6e 61 6d 65 70 61 74 runs testnamepat
15b0: 74 20 69 74 65 6d 6e 61 6d 65 70 61 74 74 20 6b t itemnamepatt k
15c0: 65 79 70 61 74 74 73 29 0a 20 20 28 6c 65 74 2a eypatts). (let*
15d0: 20 28 28 61 6c 6c 72 75 6e 73 20 20 20 20 20 28 ((allruns (
15e0: 64 62 3a 67 65 74 2d 72 75 6e 73 20 2a 64 62 2a db:get-runs *db*
15f0: 20 72 75 6e 6e 61 6d 65 70 61 74 74 20 6e 75 6d runnamepatt num
1600: 72 75 6e 73 20 2a 73 74 61 72 74 2d 72 75 6e 2d runs *start-run-
1610: 6f 66 66 73 65 74 2a 20 6b 65 79 70 61 74 74 73 offset* keypatts
1620: 29 29 0a 09 20 28 68 65 61 64 65 72 20 20 20 20 )).. (header
1630: 20 20 28 64 62 3a 67 65 74 2d 68 65 61 64 65 72 (db:get-header
1640: 20 61 6c 6c 72 75 6e 73 29 29 0a 09 20 28 72 75 allruns)).. (ru
1650: 6e 73 20 20 20 20 20 20 20 20 28 64 62 3a 67 65 ns (db:ge
1660: 74 2d 72 6f 77 73 20 20 20 61 6c 6c 72 75 6e 73 t-rows allruns
1670: 29 29 0a 09 20 28 72 65 73 75 6c 74 20 20 20 20 )).. (result
1680: 20 20 27 28 29 29 0a 09 20 28 6d 61 78 74 65 73 '()).. (maxtes
1690: 74 73 20 20 20 20 30 29 29 0a 20 20 20 20 28 69 ts 0)). (i
16a0: 66 20 28 3e 20 28 2b 20 2a 6c 61 73 74 2d 75 70 f (> (+ *last-up
16b0: 64 61 74 65 2a 20 33 30 30 29 20 28 63 75 72 72 date* 300) (curr
16c0: 65 6e 74 2d 73 65 63 6f 6e 64 73 29 29 20 3b 3b ent-seconds)) ;;
16d0: 20 65 76 65 72 79 20 66 69 76 65 20 6d 69 6e 75 every five minu
16e0: 74 65 73 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 tes..(begin.. (
16f0: 73 65 74 21 20 2a 6c 61 73 74 2d 75 70 64 61 74 set! *last-updat
1700: 65 2a 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f e* (current-seco
1710: 6e 64 73 29 29 0a 09 20 20 28 73 65 74 21 20 2a nds)).. (set! *
1720: 74 6f 74 2d 72 75 6e 2d 63 6f 75 6e 74 2a 20 28 tot-run-count* (
1730: 64 62 3a 67 65 74 2d 6e 75 6d 2d 72 75 6e 73 20 db:get-num-runs
1740: 2a 64 62 2a 20 72 75 6e 6e 61 6d 65 70 61 74 74 *db* runnamepatt
1750: 29 29 29 29 0a 20 20 20 20 28 66 6f 72 2d 65 61 )))). (for-ea
1760: 63 68 20 28 6c 61 6d 62 64 61 20 28 72 75 6e 29 ch (lambda (run)
1770: 0a 09 09 28 6c 65 74 2a 20 28 28 72 75 6e 2d 69 ...(let* ((run-i
1780: 64 20 20 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 d (db:get-valu
1790: 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 6e 20 e-by-header run
17a0: 68 65 61 64 65 72 20 22 69 64 22 29 29 0a 09 09 header "id"))...
17b0: 20 20 20 20 20 20 20 28 74 65 73 74 73 20 20 20 (tests
17c0: 20 28 64 62 2d 67 65 74 2d 74 65 73 74 73 2d 66 (db-get-tests-f
17d0: 6f 72 2d 72 75 6e 20 2a 64 62 2a 20 72 75 6e 2d or-run *db* run-
17e0: 69 64 20 74 65 73 74 6e 61 6d 65 70 61 74 74 20 id testnamepatt
17f0: 69 74 65 6d 6e 61 6d 65 70 61 74 74 29 29 0a 09 itemnamepatt))..
1800: 09 20 20 20 20 20 20 20 28 6b 65 79 2d 76 61 6c . (key-val
1810: 73 20 28 67 65 74 2d 6b 65 79 2d 76 61 6c 73 20 s (get-key-vals
1820: 2a 64 62 2a 20 72 75 6e 2d 69 64 29 29 29 0a 09 *db* run-id)))..
1830: 09 20 20 28 69 66 20 28 3e 20 28 6c 65 6e 67 74 . (if (> (lengt
1840: 68 20 74 65 73 74 73 29 20 6d 61 78 74 65 73 74 h tests) maxtest
1850: 73 29 0a 09 09 20 20 20 20 20 20 28 73 65 74 21 s)... (set!
1860: 20 6d 61 78 74 65 73 74 73 20 28 6c 65 6e 67 74 maxtests (lengt
1870: 68 20 74 65 73 74 73 29 29 29 0a 09 09 20 20 28 h tests)))... (
1880: 73 65 74 21 20 72 65 73 75 6c 74 20 28 63 6f 6e set! result (con
1890: 73 20 28 76 65 63 74 6f 72 20 72 75 6e 20 74 65 s (vector run te
18a0: 73 74 73 20 6b 65 79 2d 76 61 6c 73 29 20 72 65 sts key-vals) re
18b0: 73 75 6c 74 29 29 29 29 0a 09 20 20 20 20 20 20 sult))))..
18c0: 72 75 6e 73 29 0a 20 20 20 20 28 73 65 74 21 20 runs). (set!
18d0: 2a 68 65 61 64 65 72 2a 20 20 68 65 61 64 65 72 *header* header
18e0: 29 0a 20 20 20 20 28 73 65 74 21 20 2a 61 6c 6c ). (set! *all
18f0: 72 75 6e 73 2a 20 72 65 73 75 6c 74 29 0a 20 20 runs* result).
1900: 20 20 6d 61 78 74 65 73 74 73 29 29 0a 0a 28 64 maxtests))..(d
1910: 65 66 69 6e 65 20 2a 63 6f 6c 6c 61 70 73 65 64 efine *collapsed
1920: 2a 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 * (make-hash-tab
1930: 6c 65 29 29 0a 3b 20 28 64 65 66 69 6e 65 20 2a le)).; (define *
1940: 72 6f 77 2d 6c 6f 6f 6b 75 70 2a 20 28 6d 61 6b row-lookup* (mak
1950: 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 20 3b e-hash-table)) ;
1960: 3b 20 74 65 73 74 6e 61 6d 65 20 3d 3e 20 28 72 ; testname => (r
1970: 6f 77 6e 75 6d 20 6c 61 62 6c 65 6f 62 6a 29 0a ownum lableobj).
1980: 0a 28 64 65 66 69 6e 65 20 28 74 6f 67 67 6c 65 .(define (toggle
1990: 2d 68 69 64 65 20 6c 6e 75 6d 29 20 3b 20 66 75 -hide lnum) ; fu
19a0: 6c 6c 74 65 73 74 6e 61 6d 65 29 0a 20 20 28 6c lltestname). (l
19b0: 65 74 2a 20 28 28 62 74 6e 20 28 76 65 63 74 6f et* ((btn (vecto
19c0: 72 2d 72 65 66 20 28 76 65 63 74 6f 72 2d 72 65 r-ref (vector-re
19d0: 66 20 75 69 64 61 74 20 30 29 20 6c 6e 75 6d 29 f uidat 0) lnum)
19e0: 29 0a 09 20 28 66 75 6c 6c 74 65 73 74 6e 61 6d ).. (fulltestnam
19f0: 65 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 e (iup:attribute
1a00: 20 62 74 6e 20 22 54 49 54 4c 45 22 29 29 0a 09 btn "TITLE"))..
1a10: 20 28 70 61 72 74 73 20 20 20 20 20 20 20 20 28 (parts (
1a20: 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 66 75 6c string-split ful
1a30: 6c 74 65 73 74 6e 61 6d 65 20 22 28 22 29 29 0a ltestname "(")).
1a40: 09 20 28 62 61 73 65 74 65 73 74 6e 61 6d 65 20 . (basetestname
1a50: 28 69 66 20 28 6e 75 6c 6c 3f 20 70 61 72 74 73 (if (null? parts
1a60: 29 20 22 22 20 28 63 61 72 20 70 61 72 74 73 29 ) "" (car parts)
1a70: 29 29 29 0a 20 20 20 20 3b 28 70 72 69 6e 74 20 ))). ;(print
1a80: 22 54 6f 67 67 6c 69 6e 67 20 22 20 62 61 73 65 "Toggling " base
1a90: 74 65 73 74 6e 61 6d 65 20 22 20 63 75 72 72 65 testname " curre
1aa0: 6e 74 6c 79 20 22 20 28 68 61 73 68 2d 74 61 62 ntly " (hash-tab
1ab0: 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 2a le-ref/default *
1ac0: 63 6f 6c 6c 61 70 73 65 64 2a 20 62 61 73 65 74 collapsed* baset
1ad0: 65 73 74 6e 61 6d 65 20 23 66 29 29 0a 20 20 20 estname #f)).
1ae0: 20 28 69 66 20 28 68 61 73 68 2d 74 61 62 6c 65 (if (hash-table
1af0: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 2a 63 6f -ref/default *co
1b00: 6c 6c 61 70 73 65 64 2a 20 62 61 73 65 74 65 73 llapsed* basetes
1b10: 74 6e 61 6d 65 20 23 66 29 0a 09 28 62 65 67 69 tname #f)..(begi
1b20: 6e 0a 09 20 20 3b 28 69 75 70 3a 61 74 74 72 69 n.. ;(iup:attri
1b30: 62 75 74 65 2d 73 65 74 21 20 62 74 6e 20 22 46 bute-set! btn "F
1b40: 47 43 4f 4c 4f 52 22 20 22 30 20 30 20 30 22 29 GCOLOR" "0 0 0")
1b50: 0a 09 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d .. (hash-table-
1b60: 64 65 6c 65 74 65 21 20 2a 63 6f 6c 6c 61 70 73 delete! *collaps
1b70: 65 64 2a 20 62 61 73 65 74 65 73 74 6e 61 6d 65 ed* basetestname
1b80: 29 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 3b 28 ))..(begin.. ;(
1b90: 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 iup:attribute-se
1ba0: 74 21 20 62 74 6e 20 22 46 47 43 4f 4c 4f 52 22 t! btn "FGCOLOR"
1bb0: 20 22 30 20 31 39 32 20 31 39 32 22 29 0a 09 20 "0 192 192")..
1bc0: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 (hash-table-set
1bd0: 21 20 2a 63 6f 6c 6c 61 70 73 65 64 2a 20 62 61 ! *collapsed* ba
1be0: 73 65 74 65 73 74 6e 61 6d 65 20 23 74 29 29 29 setestname #t)))
1bf0: 29 29 0a 20 20 0a 28 64 65 66 69 6e 65 20 62 6c )). .(define bl
1c00: 61 6e 6b 2d 6c 69 6e 65 2d 72 78 20 28 72 65 67 ank-line-rx (reg
1c10: 65 78 70 20 22 5e 5c 5c 73 2a 24 22 29 29 0a 0a exp "^\\s*$"))..
1c20: 28 64 65 66 69 6e 65 20 28 72 75 6e 2d 69 74 65 (define (run-ite
1c30: 6d 2d 6e 61 6d 65 2d 3e 76 65 63 74 6f 72 73 20 m-name->vectors
1c40: 6c 73 74 29 0a 20 20 28 6d 61 70 20 28 6c 61 6d lst). (map (lam
1c50: 62 64 61 20 28 78 29 0a 09 20 28 6c 65 74 20 28 bda (x).. (let (
1c60: 28 73 70 6c 73 74 20 28 73 74 72 69 6e 67 2d 73 (splst (string-s
1c70: 70 6c 69 74 20 78 20 22 28 22 29 29 0a 09 20 20 plit x "("))..
1c80: 20 20 20 20 20 28 72 65 73 20 20 20 28 76 65 63 (res (vec
1c90: 74 6f 72 20 22 22 20 22 22 29 29 29 0a 09 20 20 tor "" "")))..
1ca0: 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 72 65 (vector-set! re
1cb0: 73 20 30 20 28 63 61 72 20 73 70 6c 73 74 29 29 s 0 (car splst))
1cc0: 0a 09 20 20 20 28 69 66 20 28 3e 20 28 6c 65 6e .. (if (> (len
1cd0: 67 74 68 20 73 70 6c 73 74 29 20 31 29 0a 09 20 gth splst) 1)..
1ce0: 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d 73 65 (vector-se
1cf0: 74 21 20 72 65 73 20 31 20 28 63 61 72 20 28 73 t! res 1 (car (s
1d00: 74 72 69 6e 67 2d 73 70 6c 69 74 20 28 63 61 64 tring-split (cad
1d10: 72 20 73 70 6c 73 74 29 20 22 29 22 29 29 29 29 r splst) ")"))))
1d20: 0a 09 20 20 20 72 65 73 29 29 0a 20 20 20 20 20 .. res)).
1d30: 20 20 6c 73 74 29 29 0a 0a 28 64 65 66 69 6e 65 lst))..(define
1d40: 20 28 63 6f 6c 6c 61 70 73 65 2d 72 6f 77 73 20 (collapse-rows
1d50: 69 6e 6c 73 74 29 0a 20 20 28 6c 65 74 2a 20 28 inlst). (let* (
1d60: 28 6e 65 77 6c 73 74 20 28 66 69 6c 74 65 72 20 (newlst (filter
1d70: 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 09 20 (lambda (x)....
1d80: 20 28 6c 65 74 2a 20 28 28 74 70 61 72 74 73 20 (let* ((tparts
1d90: 20 20 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 (string-split
1da0: 20 78 20 22 28 22 29 29 0a 09 09 09 09 20 28 62 x "("))..... (b
1db0: 61 73 65 74 6e 61 6d 65 20 28 69 66 20 28 6e 75 asetname (if (nu
1dc0: 6c 6c 3f 20 74 70 61 72 74 73 29 20 78 20 28 63 ll? tparts) x (c
1dd0: 61 72 20 74 70 61 72 74 73 29 29 29 29 0a 09 09 ar tparts))))...
1de0: 09 09 09 3b 28 70 72 69 6e 74 20 22 78 20 22 20 ...;(print "x "
1df0: 78 20 22 20 74 70 61 72 74 73 3a 20 22 20 74 70 x " tparts: " tp
1e00: 61 72 74 73 20 22 20 62 61 73 65 74 6e 61 6d 65 arts " basetname
1e10: 3a 20 22 20 62 61 73 65 74 6e 61 6d 65 29 0a 09 : " basetname)..
1e20: 09 09 20 20 20 20 28 63 6f 6e 64 0a 09 09 09 20 .. (cond....
1e30: 20 20 20 20 28 28 73 74 72 69 6e 67 2d 6d 61 74 ((string-mat
1e40: 63 68 20 62 6c 61 6e 6b 2d 6c 69 6e 65 2d 72 78 ch blank-line-rx
1e50: 20 78 29 20 23 66 29 0a 09 09 09 20 20 20 20 20 x) #f)....
1e60: 28 28 65 71 75 61 6c 3f 20 78 20 62 61 73 65 74 ((equal? x baset
1e70: 6e 61 6d 65 29 20 23 74 29 0a 09 09 09 20 20 20 name) #t)....
1e80: 20 20 28 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 ((hash-table-r
1e90: 65 66 2f 64 65 66 61 75 6c 74 20 2a 63 6f 6c 6c ef/default *coll
1ea0: 61 70 73 65 64 2a 20 62 61 73 65 74 6e 61 6d 65 apsed* basetname
1eb0: 20 23 66 29 20 0a 09 09 09 09 09 3b 28 70 72 69 #f) ......;(pri
1ec0: 6e 74 20 22 52 65 6d 6f 76 69 6e 67 20 22 20 62 nt "Removing " b
1ed0: 61 73 65 74 6e 61 6d 65 20 22 20 66 72 6f 6d 20 asetname " from
1ee0: 69 74 65 6d 73 22 29 0a 09 09 09 20 20 20 20 20 items")....
1ef0: 20 23 66 29 0a 09 09 09 20 20 20 20 20 28 65 6c #f).... (el
1f00: 73 65 20 23 74 29 29 29 29 0a 09 09 09 69 6e 6c se #t))))....inl
1f10: 73 74 29 29 0a 09 20 28 76 6c 73 74 20 20 28 72 st)).. (vlst (r
1f20: 75 6e 2d 69 74 65 6d 2d 6e 61 6d 65 2d 3e 76 65 un-item-name->ve
1f30: 63 74 6f 72 73 20 6e 65 77 6c 73 74 29 29 0a 09 ctors newlst))..
1f40: 20 3b 3b 20 73 6f 72 74 20 62 79 20 73 65 63 6f ;; sort by seco
1f50: 6e 64 20 66 69 65 6c 64 0a 09 20 28 76 6c 73 74 nd field.. (vlst
1f60: 2d 73 31 20 28 73 6f 72 74 20 76 6c 73 74 20 28 -s1 (sort vlst (
1f70: 6c 61 6d 62 64 61 20 28 61 20 62 29 0a 09 09 09 lambda (a b)....
1f80: 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 61 73 (let ((as
1f90: 74 72 20 28 76 65 63 74 6f 72 2d 72 65 66 20 61 tr (vector-ref a
1fa0: 20 31 29 29 0a 09 09 09 09 20 20 20 20 20 28 62 1))..... (b
1fb0: 73 74 72 20 28 76 65 63 74 6f 72 2d 72 65 66 20 str (vector-ref
1fc0: 62 20 31 29 29 29 0a 09 09 09 09 20 28 69 66 20 b 1)))..... (if
1fd0: 28 73 74 72 69 6e 67 3d 3f 20 61 73 74 72 20 22 (string=? astr "
1fe0: 22 29 20 23 66 20 23 74 29 29 29 29 29 0a 09 09 ") #f #t)))))...
1ff0: 09 3b 3b 20 28 3e 3d 20 28 73 74 72 69 6e 67 2d .;; (>= (string-
2000: 6c 65 6e 67 74 68 20 28 76 65 63 74 6f 72 2d 72 length (vector-r
2010: 65 66 20 61 20 31 29 29 28 73 74 72 69 6e 67 2d ef a 1))(string-
2020: 6c 65 6e 67 74 68 20 28 76 65 63 74 6f 72 2d 72 length (vector-r
2030: 65 66 20 62 20 31 29 29 29 29 29 29 0a 09 20 28 ef b 1)))))).. (
2040: 76 6c 73 74 2d 73 32 20 28 73 6f 72 74 20 76 6c vlst-s2 (sort vl
2050: 73 74 2d 73 31 20 28 6c 61 6d 62 64 61 20 28 61 st-s1 (lambda (a
2060: 20 62 29 0a 09 09 09 09 20 20 28 73 74 72 69 6e b)..... (strin
2070: 67 3e 3d 20 28 76 65 63 74 6f 72 2d 72 65 66 20 g>= (vector-ref
2080: 61 20 30 29 28 76 65 63 74 6f 72 2d 72 65 66 20 a 0)(vector-ref
2090: 62 20 30 29 29 29 29 29 29 0a 20 20 20 20 28 6d b 0)))))). (m
20a0: 61 70 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 ap (lambda (x)..
20b0: 20 20 20 28 69 66 20 28 65 71 75 61 6c 3f 20 28 (if (equal? (
20c0: 76 65 63 74 6f 72 2d 72 65 66 20 78 20 31 29 20 vector-ref x 1)
20d0: 22 22 29 0a 09 20 20 20 20 20 20 20 28 76 65 63 "").. (vec
20e0: 74 6f 72 2d 72 65 66 20 78 20 30 29 0a 09 20 20 tor-ref x 0)..
20f0: 20 20 20 20 20 28 63 6f 6e 63 20 28 76 65 63 74 (conc (vect
2100: 6f 72 2d 72 65 66 20 78 20 30 29 20 22 28 22 20 or-ref x 0) "("
2110: 28 76 65 63 74 6f 72 2d 72 65 66 20 78 20 31 29 (vector-ref x 1)
2120: 20 22 29 22 29 29 29 0a 09 20 76 6c 73 74 2d 73 ")"))).. vlst-s
2130: 32 29 29 29 0a 20 20 20 20 0a 20 20 20 20 3b 3b 2))). . ;;
2140: 20 28 73 6f 72 74 20 6e 65 77 6c 73 74 20 28 6c (sort newlst (l
2150: 61 6d 62 64 61 20 28 61 20 62 29 0a 20 20 20 20 ambda (a b).
2160: 3b 3b 20 20 20 20 20 09 20 20 20 28 6c 65 74 2a ;; . (let*
2170: 20 28 28 70 61 72 74 73 61 20 28 73 74 72 69 6e ((partsa (strin
2180: 67 2d 73 70 6c 69 74 20 61 20 22 28 22 29 29 0a g-split a "(")).
2190: 20 20 20 20 3b 3b 20 20 20 20 20 09 09 20 20 28 ;; .. (
21a0: 70 61 72 74 73 62 20 28 73 74 72 69 6e 67 2d 73 partsb (string-s
21b0: 70 6c 69 74 20 62 20 22 28 22 29 29 0a 20 20 20 plit b "(")).
21c0: 20 3b 3b 20 20 20 20 20 09 09 20 20 28 6c 65 6e ;; .. (len
21d0: 61 20 20 20 28 6c 65 6e 67 74 68 20 70 61 72 74 a (length part
21e0: 73 61 29 29 0a 20 20 20 20 3b 3b 20 20 20 20 20 sa)). ;;
21f0: 09 09 20 20 28 6c 65 6e 62 20 20 20 28 6c 65 6e .. (lenb (len
2200: 67 74 68 20 70 61 72 74 73 62 29 29 29 0a 20 20 gth partsb))).
2210: 20 20 3b 3b 20 20 20 20 20 09 20 20 20 20 20 28 ;; . (
2220: 69 66 20 28 6f 72 20 28 61 6e 64 20 28 65 71 3f if (or (and (eq?
2230: 20 6c 65 6e 61 20 31 29 28 3e 20 6c 65 6e 62 20 lena 1)(> lenb
2240: 31 29 29 0a 20 20 20 20 3b 3b 20 20 20 20 20 09 1)). ;; .
2250: 09 20 20 20 20 20 28 61 6e 64 20 28 65 71 3f 20 . (and (eq?
2260: 6c 65 6e 62 20 31 29 28 3e 20 6c 65 6e 61 20 31 lenb 1)(> lena 1
2270: 29 29 29 0a 20 20 20 20 3b 3b 20 20 20 20 20 09 ))). ;; .
2280: 09 20 28 69 66 20 28 65 71 75 61 6c 3f 20 28 63 . (if (equal? (c
2290: 61 72 20 70 61 72 74 73 61 29 28 63 61 72 20 70 ar partsa)(car p
22a0: 61 72 74 73 62 29 29 20 3b 3b 20 73 61 6d 65 20 artsb)) ;; same
22b0: 74 65 73 74 0a 20 20 20 20 3b 3b 20 20 20 20 20 test. ;;
22c0: 09 09 20 20 20 20 20 28 3e 20 6c 65 6e 62 20 6c .. (> lenb l
22d0: 65 6e 61 29 0a 20 20 20 20 3b 3b 20 20 20 20 20 ena). ;;
22e0: 09 09 20 20 20 20 20 23 74 29 0a 20 20 20 20 3b .. #t). ;
22f0: 3b 20 20 20 20 20 09 09 20 23 74 29 29 29 29 29 ; .. #t)))))
2300: 29 0a 09 09 09 20 20 20 20 20 0a 28 64 65 66 69 ).... .(defi
2310: 6e 65 20 28 75 70 64 61 74 65 2d 6c 61 62 65 6c ne (update-label
2320: 73 20 75 69 64 61 74 29 0a 20 20 28 6c 65 74 2a s uidat). (let*
2330: 20 28 28 72 6f 77 6e 20 20 20 20 30 29 0a 09 20 ((rown 0)..
2340: 28 6c 66 74 63 6f 6c 20 20 28 76 65 63 74 6f 72 (lftcol (vector
2350: 2d 72 65 66 20 75 69 64 61 74 20 30 29 29 0a 09 -ref uidat 0))..
2360: 20 28 6e 75 6d 63 6f 6c 73 20 28 76 65 63 74 6f (numcols (vecto
2370: 72 2d 6c 65 6e 67 74 68 20 6c 66 74 63 6f 6c 29 r-length lftcol)
2380: 29 0a 09 20 28 6d 61 78 6e 20 20 20 20 28 2d 20 ).. (maxn (-
2390: 6e 75 6d 63 6f 6c 73 20 31 29 29 0a 09 20 28 61 numcols 1)).. (a
23a0: 6c 6c 76 61 6c 73 20 28 6d 61 6b 65 2d 76 65 63 llvals (make-vec
23b0: 74 6f 72 20 6e 75 6d 63 6f 6c 73 20 22 22 29 29 tor numcols ""))
23c0: 29 0a 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 ). (for-each
23d0: 28 6c 61 6d 62 64 61 20 28 6e 61 6d 65 29 0a 09 (lambda (name)..
23e0: 09 28 69 66 20 28 3c 3d 20 72 6f 77 6e 20 6d 61 .(if (<= rown ma
23f0: 78 6e 29 0a 09 09 20 20 20 20 28 6c 65 74 20 28 xn)... (let (
2400: 28 6c 61 62 6c 20 28 76 65 63 74 6f 72 2d 72 65 (labl (vector-re
2410: 66 20 6c 66 74 63 6f 6c 20 72 6f 77 6e 29 29 29 f lftcol rown)))
2420: 0a 09 09 20 20 20 20 20 20 28 76 65 63 74 6f 72 ... (vector
2430: 2d 73 65 74 21 20 61 6c 6c 76 61 6c 73 20 72 6f -set! allvals ro
2440: 77 6e 20 6e 61 6d 65 29 29 29 0a 09 09 28 73 65 wn name)))...(se
2450: 74 21 20 72 6f 77 6e 20 28 2b 20 31 20 72 6f 77 t! rown (+ 1 row
2460: 6e 29 29 29 0a 09 20 20 20 20 20 20 2a 61 6c 6c n))).. *all
2470: 74 65 73 74 6e 61 6d 65 6c 73 74 2a 29 0a 09 3b testnamelst*)..;
2480: 20 20 20 20 20 20 28 69 66 20 28 3e 20 28 6c 65 (if (> (le
2490: 6e 67 74 68 20 2a 61 6c 6c 74 65 73 74 6e 61 6d ngth *alltestnam
24a0: 65 6c 73 74 2a 29 20 2a 73 74 61 72 74 2d 74 65 elst*) *start-te
24b0: 73 74 2d 6f 66 66 73 65 74 2a 29 0a 09 3b 09 20 st-offset*)..;.
24c0: 20 28 64 72 6f 70 20 2a 61 6c 6c 74 65 73 74 6e (drop *alltestn
24d0: 61 6d 65 6c 73 74 2a 20 2a 73 74 61 72 74 2d 74 amelst* *start-t
24e0: 65 73 74 2d 6f 66 66 73 65 74 2a 29 0a 09 3b 09 est-offset*)..;.
24f0: 20 20 27 28 29 29 29 0a 20 20 20 20 28 6c 65 74 '())). (let
2500: 20 6c 6f 6f 70 20 28 28 69 20 30 29 29 0a 20 20 loop ((i 0)).
2510: 20 20 20 20 28 6c 65 74 2a 20 28 28 6c 62 6c 20 (let* ((lbl
2520: 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 6c (vector-ref l
2530: 66 74 63 6f 6c 20 69 29 29 0a 09 20 20 20 20 20 ftcol i))..
2540: 28 6f 6c 64 76 61 6c 20 28 69 75 70 3a 61 74 74 (oldval (iup:att
2550: 72 69 62 75 74 65 20 6c 62 6c 20 22 54 49 54 4c ribute lbl "TITL
2560: 45 22 29 29 0a 09 20 20 20 20 20 28 6e 65 77 76 E")).. (newv
2570: 61 6c 20 28 76 65 63 74 6f 72 2d 72 65 66 20 61 al (vector-ref a
2580: 6c 6c 76 61 6c 73 20 69 29 29 29 0a 09 28 69 66 llvals i)))..(if
2590: 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 6f 6c (not (equal? ol
25a0: 64 76 61 6c 20 6e 65 77 76 61 6c 29 29 0a 09 20 dval newval))..
25b0: 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 (iup:attribut
25c0: 65 2d 73 65 74 21 20 6c 62 6c 20 22 54 49 54 4c e-set! lbl "TITL
25d0: 45 22 20 6e 65 77 76 61 6c 29 29 0a 09 28 69 75 E" newval))..(iu
25e0: 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 p:attribute-set!
25f0: 20 6c 62 6c 20 22 46 47 43 4f 4c 4f 52 22 20 28 lbl "FGCOLOR" (
2600: 69 66 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 if (hash-table-r
2610: 65 66 2f 64 65 66 61 75 6c 74 20 2a 63 6f 6c 6c ef/default *coll
2620: 61 70 73 65 64 2a 20 6e 65 77 76 61 6c 20 23 66 apsed* newval #f
2630: 29 20 22 30 20 31 31 32 20 31 31 32 22 20 22 30 ) "0 112 112" "0
2640: 20 30 20 30 22 29 29 0a 09 28 69 66 20 28 3c 20 0 0"))..(if (<
2650: 69 20 6d 61 78 6e 29 0a 09 20 20 20 20 28 6c 6f i maxn).. (lo
2660: 6f 70 20 28 2b 20 69 20 31 29 29 29 29 29 29 29 op (+ i 1)))))))
2670: 0a 0a 28 64 65 66 69 6e 65 20 28 67 65 74 2d 63 ..(define (get-c
2680: 6f 6c 6f 72 2d 66 6f 72 2d 73 74 61 74 65 2d 73 olor-for-state-s
2690: 74 61 74 75 73 20 73 74 61 74 65 20 73 74 61 74 tatus state stat
26a0: 75 73 29 0a 20 20 28 63 61 73 65 20 28 73 74 72 us). (case (str
26b0: 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 73 74 61 74 ing->symbol stat
26c0: 65 29 0a 20 20 20 20 28 28 43 4f 4d 50 4c 45 54 e). ((COMPLET
26d0: 45 44 29 0a 20 20 20 20 20 28 69 66 20 28 65 71 ED). (if (eq
26e0: 75 61 6c 3f 20 73 74 61 74 75 73 20 22 50 41 53 ual? status "PAS
26f0: 53 22 29 0a 09 20 22 37 30 20 32 34 39 20 37 33 S").. "70 249 73
2700: 22 0a 09 20 28 69 66 20 28 6f 72 20 28 65 71 75 ".. (if (or (equ
2710: 61 6c 3f 20 73 74 61 74 75 73 20 22 57 41 52 4e al? status "WARN
2720: 22 29 0a 09 09 20 28 65 71 75 61 6c 3f 20 73 74 ")... (equal? st
2730: 61 74 75 73 20 22 57 41 49 56 45 44 22 29 29 0a atus "WAIVED")).
2740: 09 20 20 20 20 20 22 32 35 35 20 31 37 32 20 31 . "255 172 1
2750: 33 22 0a 09 20 20 20 20 20 22 32 32 33 20 33 33 3".. "223 33
2760: 20 34 39 22 29 29 29 20 3b 3b 20 67 72 65 65 6e 49"))) ;; green
2770: 69 73 68 20 6f 72 61 6e 67 65 69 73 68 20 72 65 ish orangeish re
2780: 64 69 73 68 0a 20 20 20 20 28 28 4c 41 55 4e 43 dish. ((LAUNC
2790: 48 45 44 29 20 20 20 20 20 20 20 20 20 22 31 30 HED) "10
27a0: 31 20 31 32 33 20 31 34 32 22 29 0a 20 20 20 20 1 123 142").
27b0: 28 28 43 48 45 43 4b 29 20 20 20 20 20 20 20 20 ((CHECK)
27c0: 20 20 20 20 22 32 35 35 20 31 30 30 20 35 30 22 "255 100 50"
27d0: 29 0a 20 20 20 20 28 28 52 45 4d 4f 54 45 48 4f ). ((REMOTEHO
27e0: 53 54 53 54 41 52 54 29 20 20 22 35 30 20 31 33 STSTART) "50 13
27f0: 30 20 31 39 35 22 29 0a 20 20 20 20 28 28 52 55 0 195"). ((RU
2800: 4e 4e 49 4e 47 29 20 20 20 20 20 20 20 20 20 20 NNING)
2810: 22 39 20 31 33 31 20 32 33 32 22 29 0a 20 20 20 "9 131 232").
2820: 20 28 28 4b 49 4c 4c 52 45 51 29 20 20 20 20 20 ((KILLREQ)
2830: 20 20 20 20 20 22 33 39 20 38 32 20 32 30 36 22 "39 82 206"
2840: 29 0a 20 20 20 20 28 28 4b 49 4c 4c 45 44 29 20 ). ((KILLED)
2850: 20 20 20 20 20 20 20 20 20 20 22 32 33 34 20 31 "234 1
2860: 30 31 20 31 37 22 29 0a 20 20 20 20 28 28 4e 4f 01 17"). ((NO
2870: 54 5f 53 54 41 52 54 45 44 29 20 20 20 20 20 20 T_STARTED)
2880: 22 32 34 30 20 32 34 30 20 32 34 30 22 29 0a 20 "240 240 240").
2890: 20 20 20 28 65 6c 73 65 20 20 20 20 20 20 20 20 (else
28a0: 20 20 20 20 20 20 20 22 31 39 32 20 31 39 32 20 "192 192
28b0: 31 39 32 22 29 29 29 0a 0a 28 64 65 66 69 6e 65 192")))..(define
28c0: 20 28 75 70 64 61 74 65 2d 62 75 74 74 6f 6e 73 (update-buttons
28d0: 20 75 69 64 61 74 20 6e 75 6d 72 75 6e 73 20 6e uidat numruns n
28e0: 75 6d 74 65 73 74 73 29 0a 20 20 28 6c 65 74 2a umtests). (let*
28f0: 20 28 28 72 75 6e 73 20 20 20 20 20 20 20 20 28 ((runs (
2900: 69 66 20 28 3e 20 28 6c 65 6e 67 74 68 20 2a 61 if (> (length *a
2910: 6c 6c 72 75 6e 73 2a 29 20 6e 75 6d 72 75 6e 73 llruns*) numruns
2920: 29 0a 09 09 09 20 20 28 74 61 6b 65 2d 72 69 67 ).... (take-rig
2930: 68 74 20 2a 61 6c 6c 72 75 6e 73 2a 20 6e 75 6d ht *allruns* num
2940: 72 75 6e 73 29 0a 09 09 09 20 20 28 70 61 64 2d runs).... (pad-
2950: 6c 69 73 74 20 2a 61 6c 6c 72 75 6e 73 2a 20 6e list *allruns* n
2960: 75 6d 72 75 6e 73 29 29 29 0a 09 20 28 6c 66 74 umruns))).. (lft
2970: 63 6f 6c 20 20 20 20 20 20 28 76 65 63 74 6f 72 col (vector
2980: 2d 72 65 66 20 75 69 64 61 74 20 30 29 29 0a 09 -ref uidat 0))..
2990: 20 28 74 61 62 6c 65 68 65 61 64 65 72 20 28 76 (tableheader (v
29a0: 65 63 74 6f 72 2d 72 65 66 20 75 69 64 61 74 20 ector-ref uidat
29b0: 31 29 29 0a 09 20 28 74 61 62 6c 65 20 20 20 20 1)).. (table
29c0: 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 75 (vector-ref u
29d0: 69 64 61 74 20 32 29 29 0a 09 20 28 63 6f 6c 6e idat 2)).. (coln
29e0: 20 20 20 20 20 20 20 20 30 29 29 0a 20 20 20 20 0)).
29f0: 28 73 65 74 21 20 2a 61 6c 6c 74 65 73 74 6e 61 (set! *alltestna
2a00: 6d 65 6c 73 74 2a 20 27 28 29 29 0a 20 20 20 20 melst* '()).
2a10: 3b 3b 20 63 72 65 61 74 65 20 61 20 63 6f 6e 63 ;; create a conc
2a20: 69 73 65 20 6c 69 73 74 20 6f 66 20 74 65 73 74 ise list of test
2a30: 20 6e 61 6d 65 73 0a 20 20 20 20 28 66 6f 72 2d names. (for-
2a40: 65 61 63 68 0a 20 20 20 20 20 28 6c 61 6d 62 64 each. (lambd
2a50: 61 20 28 72 75 6e 64 61 74 29 0a 20 20 20 20 20 a (rundat).
2a60: 20 20 28 69 66 20 28 76 65 63 74 6f 72 3f 20 72 (if (vector? r
2a70: 75 6e 64 61 74 29 0a 09 20 20 20 28 6c 65 74 2a undat).. (let*
2a80: 20 28 28 74 65 73 74 64 61 74 20 20 20 28 76 65 ((testdat (ve
2a90: 63 74 6f 72 2d 72 65 66 20 72 75 6e 64 61 74 20 ctor-ref rundat
2aa0: 31 29 29 0a 09 09 20 20 28 74 65 73 74 6e 61 6d 1))... (testnam
2ab0: 65 73 20 28 6d 61 70 20 74 65 73 74 3a 74 65 73 es (map test:tes
2ac0: 74 2d 67 65 74 2d 66 75 6c 6c 6e 61 6d 65 20 74 t-get-fullname t
2ad0: 65 73 74 64 61 74 29 29 29 0a 09 20 20 20 20 20 estdat)))..
2ae0: 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 (for-each (lambd
2af0: 61 20 28 74 65 73 74 6e 61 6d 65 29 0a 09 09 09 a (testname)....
2b00: 20 28 69 66 20 28 6e 6f 74 20 28 6d 65 6d 62 65 (if (not (membe
2b10: 72 20 74 65 73 74 6e 61 6d 65 20 2a 61 6c 6c 74 r testname *allt
2b20: 65 73 74 6e 61 6d 65 6c 73 74 2a 29 29 0a 09 09 estnamelst*))...
2b30: 09 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 09 . (begin....
2b40: 20 20 20 20 20 20 20 28 73 65 74 21 20 2a 61 6c (set! *al
2b50: 6c 74 65 73 74 6e 61 6d 65 6c 73 74 2a 20 28 61 ltestnamelst* (a
2b60: 70 70 65 6e 64 20 2a 61 6c 6c 74 65 73 74 6e 61 ppend *alltestna
2b70: 6d 65 6c 73 74 2a 20 28 6c 69 73 74 20 74 65 73 melst* (list tes
2b80: 74 6e 61 6d 65 29 29 29 29 29 29 0a 09 09 20 20 tname))))))...
2b90: 20 20 20 20 20 74 65 73 74 6e 61 6d 65 73 29 29 testnames))
2ba0: 29 29 0a 20 20 20 20 20 72 75 6e 73 29 0a 0a 20 )). runs)..
2bb0: 20 20 20 28 73 65 74 21 20 2a 61 6c 6c 74 65 73 (set! *alltes
2bc0: 74 6e 61 6d 65 6c 73 74 2a 20 28 63 6f 6c 6c 61 tnamelst* (colla
2bd0: 70 73 65 2d 72 6f 77 73 20 2a 61 6c 6c 74 65 73 pse-rows *alltes
2be0: 74 6e 61 6d 65 6c 73 74 2a 29 29 20 3b 3b 3b 20 tnamelst*)) ;;;
2bf0: 61 72 67 68 2e 20 70 6c 65 61 73 65 20 63 6c 65 argh. please cle
2c00: 61 6e 20 75 70 20 74 68 69 73 20 73 69 6c 6c 79 an up this silly
2c10: 6e 65 73 73 0a 20 20 20 20 28 73 65 74 21 20 2a ness. (set! *
2c20: 61 6c 6c 74 65 73 74 6e 61 6d 65 6c 73 74 2a 20 alltestnamelst*
2c30: 28 6c 65 74 20 28 28 78 6c 20 28 69 66 20 28 3e (let ((xl (if (>
2c40: 20 28 6c 65 6e 67 74 68 20 2a 61 6c 6c 74 65 73 (length *alltes
2c50: 74 6e 61 6d 65 6c 73 74 2a 29 20 2a 73 74 61 72 tnamelst*) *star
2c60: 74 2d 74 65 73 74 2d 6f 66 66 73 65 74 2a 29 0a t-test-offset*).
2c70: 09 09 09 09 09 20 28 64 72 6f 70 20 2a 61 6c 6c ..... (drop *all
2c80: 74 65 73 74 6e 61 6d 65 6c 73 74 2a 20 2a 73 74 testnamelst* *st
2c90: 61 72 74 2d 74 65 73 74 2d 6f 66 66 73 65 74 2a art-test-offset*
2ca0: 29 0a 09 09 09 09 09 20 27 28 29 29 29 29 0a 09 )...... '())))..
2cb0: 09 09 20 20 20 20 20 28 61 70 70 65 6e 64 20 78 .. (append x
2cc0: 6c 20 28 6d 61 6b 65 2d 6c 69 73 74 20 28 2d 20 l (make-list (-
2cd0: 2a 6e 75 6d 2d 74 65 73 74 73 2a 20 28 6c 65 6e *num-tests* (len
2ce0: 67 74 68 20 78 6c 29 29 20 22 22 29 29 29 29 0a gth xl)) "")))).
2cf0: 20 20 20 20 28 75 70 64 61 74 65 2d 6c 61 62 65 (update-labe
2d00: 6c 73 20 75 69 64 61 74 29 0a 20 20 20 20 28 66 ls uidat). (f
2d10: 6f 72 2d 65 61 63 68 0a 20 20 20 20 20 28 6c 61 or-each. (la
2d20: 6d 62 64 61 20 28 72 75 6e 64 61 74 29 0a 20 20 mbda (rundat).
2d30: 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 72 75 (if (not ru
2d40: 6e 64 61 74 29 20 3b 3b 20 68 61 6e 64 6c 65 20 ndat) ;; handle
2d50: 70 61 64 64 65 64 20 72 75 6e 73 0a 09 20 20 20 padded runs..
2d60: 3b 3b 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 ;; ;;
2d70: 69 64 20 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 id run-id testna
2d80: 6d 65 20 73 74 61 74 65 20 73 74 61 74 75 73 20 me state status
2d90: 65 76 65 6e 74 2d 74 69 6d 65 20 68 6f 73 74 20 event-time host
2da0: 63 70 75 6c 6f 61 64 20 64 69 73 6b 66 72 65 65 cpuload diskfree
2db0: 20 75 6e 61 6d 65 20 72 75 6e 64 69 72 20 69 74 uname rundir it
2dc0: 65 6d 2d 70 61 74 68 20 72 75 6e 2d 64 75 72 61 em-path run-dura
2dd0: 74 69 6f 6e 0a 09 20 20 20 28 73 65 74 21 20 72 tion.. (set! r
2de0: 75 6e 64 61 74 20 28 76 65 63 74 6f 72 20 28 6d undat (vector (m
2df0: 61 6b 65 2d 76 65 63 74 6f 72 20 32 30 20 23 66 ake-vector 20 #f
2e00: 29 20 27 28 29 20 28 6d 61 70 20 28 6c 61 6d 62 ) '() (map (lamb
2e10: 64 61 20 28 78 29 20 22 22 29 20 2a 6b 65 79 73 da (x) "") *keys
2e20: 2a 29 29 29 29 3b 3b 20 33 29 29 29 0a 20 20 20 *))));; 3))).
2e30: 20 20 20 20 28 6c 65 74 2a 20 28 28 72 75 6e 20 (let* ((run
2e40: 20 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 (vector-ref
2e50: 20 72 75 6e 64 61 74 20 30 29 29 0a 09 20 20 20 rundat 0))..
2e60: 20 20 20 28 74 65 73 74 73 64 61 74 20 28 76 65 (testsdat (ve
2e70: 63 74 6f 72 2d 72 65 66 20 72 75 6e 64 61 74 20 ctor-ref rundat
2e80: 31 29 29 0a 09 20 20 20 20 20 20 28 6b 65 79 2d 1)).. (key-
2e90: 76 61 6c 2d 64 61 74 20 28 76 65 63 74 6f 72 2d val-dat (vector-
2ea0: 72 65 66 20 72 75 6e 64 61 74 20 32 29 29 0a 09 ref rundat 2))..
2eb0: 20 20 20 20 20 20 28 72 75 6e 2d 69 64 20 20 20 (run-id
2ec0: 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 (db:get-value-by
2ed0: 2d 68 65 61 64 65 72 20 72 75 6e 20 2a 68 65 61 -header run *hea
2ee0: 64 65 72 2a 20 22 69 64 22 29 29 0a 09 20 20 20 der* "id"))..
2ef0: 20 20 20 28 6b 65 79 2d 76 61 6c 73 20 28 61 70 (key-vals (ap
2f00: 70 65 6e 64 20 6b 65 79 2d 76 61 6c 2d 64 61 74 pend key-val-dat
2f10: 0a 09 09 09 09 28 6c 69 73 74 20 28 6c 65 74 20 .....(list (let
2f20: 28 28 78 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 ((x (db:get-valu
2f30: 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 6e 20 e-by-header run
2f40: 2a 68 65 61 64 65 72 2a 20 22 72 75 6e 6e 61 6d *header* "runnam
2f50: 65 22 29 29 29 0a 09 09 09 09 09 28 69 66 20 78 e")))......(if x
2f60: 20 78 20 22 22 29 29 29 29 29 0a 09 20 20 20 20 x "")))))..
2f70: 20 20 28 72 75 6e 2d 6b 65 79 20 20 28 73 74 72 (run-key (str
2f80: 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 ing-intersperse
2f90: 6b 65 79 2d 76 61 6c 73 20 22 5c 6e 22 29 29 29 key-vals "\n")))
2fa0: 0a 0a 09 20 3b 3b 20 66 69 6c 6c 20 69 6e 20 74 ... ;; fill in t
2fb0: 68 65 20 72 75 6e 20 68 65 61 64 65 72 20 6b 65 he run header ke
2fc0: 79 20 76 61 6c 75 65 73 0a 09 20 28 6c 65 74 20 y values.. (let
2fd0: 28 28 72 6f 77 6e 20 20 20 20 20 20 30 29 0a 09 ((rown 0)..
2fe0: 20 20 20 20 20 20 20 28 68 65 61 64 65 72 63 6f (headerco
2ff0: 6c 20 28 76 65 63 74 6f 72 2d 72 65 66 20 74 61 l (vector-ref ta
3000: 62 6c 65 68 65 61 64 65 72 20 63 6f 6c 6e 29 29 bleheader coln))
3010: 29 0a 09 20 20 20 28 66 6f 72 2d 65 61 63 68 20 ).. (for-each
3020: 28 6c 61 6d 62 64 61 20 28 6b 76 61 6c 29 0a 09 (lambda (kval)..
3030: 09 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 . (let* ((
3040: 6c 61 62 6c 20 20 20 20 20 20 28 76 65 63 74 6f labl (vecto
3050: 72 2d 72 65 66 20 68 65 61 64 65 72 63 6f 6c 20 r-ref headercol
3060: 72 6f 77 6e 29 29 29 0a 09 09 09 20 28 69 66 20 rown))).... (if
3070: 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 6b 76 61 (not (equal? kva
3080: 6c 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 l (iup:attribute
3090: 20 6c 61 62 6c 20 22 54 49 54 4c 45 22 29 29 29 labl "TITLE")))
30a0: 0a 09 09 09 20 20 20 20 20 28 69 75 70 3a 61 74 .... (iup:at
30b0: 74 72 69 62 75 74 65 2d 73 65 74 21 20 28 76 65 tribute-set! (ve
30c0: 63 74 6f 72 2d 72 65 66 20 68 65 61 64 65 72 63 ctor-ref headerc
30d0: 6f 6c 20 72 6f 77 6e 29 20 22 54 49 54 4c 45 22 ol rown) "TITLE"
30e0: 20 6b 76 61 6c 29 29 0a 09 09 09 20 28 73 65 74 kval)).... (set
30f0: 21 20 72 6f 77 6e 20 28 2b 20 72 6f 77 6e 20 31 ! rown (+ rown 1
3100: 29 29 29 29 0a 09 09 20 20 20 20 20 6b 65 79 2d ))))... key-
3110: 76 61 6c 73 29 29 0a 0a 09 20 3b 3b 20 46 6f 72 vals))... ;; For
3120: 20 74 68 69 73 20 72 75 6e 20 6e 6f 77 20 66 69 this run now fi
3130: 6c 6c 20 69 6e 20 74 68 65 20 62 75 74 74 6f 6e ll in the button
3140: 73 20 66 6f 72 20 65 61 63 68 20 74 65 73 74 0a s for each test.
3150: 09 20 28 6c 65 74 20 28 28 72 6f 77 6e 20 30 29 . (let ((rown 0)
3160: 0a 09 20 20 20 20 20 20 20 28 63 6f 6c 75 6d 6e .. (column
3170: 64 61 74 20 20 28 76 65 63 74 6f 72 2d 72 65 66 dat (vector-ref
3180: 20 74 61 62 6c 65 20 63 6f 6c 6e 29 29 29 0a 09 table coln)))..
3190: 20 20 20 28 66 6f 72 2d 65 61 63 68 0a 09 20 20 (for-each..
31a0: 20 20 28 6c 61 6d 62 64 61 20 28 74 65 73 74 6e (lambda (testn
31b0: 61 6d 65 29 0a 09 20 20 20 20 20 20 28 6c 65 74 ame).. (let
31c0: 20 28 28 62 75 74 74 6f 6e 64 61 74 20 20 28 68 ((buttondat (h
31d0: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de
31e0: 66 61 75 6c 74 20 2a 62 75 74 74 6f 6e 64 61 74 fault *buttondat
31f0: 2a 20 28 6d 6b 73 74 72 20 63 6f 6c 6e 20 72 6f * (mkstr coln ro
3200: 77 6e 29 20 23 66 29 29 29 0a 09 09 28 69 66 20 wn) #f)))...(if
3210: 62 75 74 74 6f 6e 64 61 74 0a 09 09 20 20 20 20 buttondat...
3220: 28 6c 65 74 2a 20 28 28 74 65 73 74 20 20 20 20 (let* ((test
3230: 20 20 20 28 6c 65 74 20 28 28 6d 61 74 63 68 69 (let ((matchi
3240: 6e 67 20 28 66 69 6c 74 65 72 20 0a 09 09 09 09 ng (filter .....
3250: 09 09 09 28 6c 61 6d 62 64 61 20 28 78 29 28 65 ...(lambda (x)(e
3260: 71 75 61 6c 3f 20 28 74 65 73 74 3a 74 65 73 74 qual? (test:test
3270: 2d 67 65 74 2d 66 75 6c 6c 6e 61 6d 65 20 78 29 -get-fullname x)
3280: 20 74 65 73 74 6e 61 6d 65 29 29 0a 09 09 09 09 testname)).....
3290: 09 09 09 74 65 73 74 73 64 61 74 29 29 29 0a 09 ...testsdat)))..
32a0: 09 09 09 09 20 28 69 66 20 28 6e 75 6c 6c 3f 20 .... (if (null?
32b0: 6d 61 74 63 68 69 6e 67 29 0a 09 09 09 09 09 20 matching)......
32c0: 20 20 20 20 28 76 65 63 74 6f 72 20 2d 31 20 2d (vector -1 -
32d0: 31 20 22 22 20 22 22 20 22 22 20 30 20 22 22 20 1 "" "" "" 0 ""
32e0: 22 22 20 30 20 22 22 20 22 22 20 22 22 20 30 20 "" 0 "" "" "" 0
32f0: 22 22 20 22 22 29 0a 09 09 09 09 09 20 20 20 20 "" "")......
3300: 20 28 63 61 72 20 6d 61 74 63 68 69 6e 67 29 29 (car matching))
3310: 29 29 0a 09 09 09 20 20 20 28 74 65 73 74 6e 61 )).... (testna
3320: 6d 65 20 20 20 28 64 62 3a 74 65 73 74 2d 67 65 me (db:test-ge
3330: 74 2d 74 65 73 74 6e 61 6d 65 20 20 74 65 73 74 t-testname test
3340: 29 29 0a 09 09 09 20 20 20 28 69 74 65 6d 70 61 )).... (itempa
3350: 74 68 20 20 20 28 64 62 3a 74 65 73 74 2d 67 65 th (db:test-ge
3360: 74 2d 69 74 65 6d 2d 70 61 74 68 20 74 65 73 74 t-item-path test
3370: 29 29 0a 09 09 09 20 20 20 28 74 65 73 74 66 75 )).... (testfu
3380: 6c 6c 6e 61 6d 65 20 28 74 65 73 74 3a 74 65 73 llname (test:tes
3390: 74 2d 67 65 74 2d 66 75 6c 6c 6e 61 6d 65 20 74 t-get-fullname t
33a0: 65 73 74 29 29 0a 09 09 09 20 20 20 28 74 65 73 est)).... (tes
33b0: 74 73 74 61 74 75 73 20 28 64 62 3a 74 65 73 74 tstatus (db:test
33c0: 2d 67 65 74 2d 73 74 61 74 75 73 20 20 20 74 65 -get-status te
33d0: 73 74 29 29 0a 09 09 09 20 20 20 28 74 65 73 74 st)).... (test
33e0: 73 74 61 74 65 20 20 28 64 62 3a 74 65 73 74 2d state (db:test-
33f0: 67 65 74 2d 73 74 61 74 65 20 20 20 20 74 65 73 get-state tes
3400: 74 29 29 0a 09 09 09 20 20 20 28 74 65 73 74 73 t)).... (tests
3410: 74 61 72 74 20 20 28 64 62 3a 74 65 73 74 2d 67 tart (db:test-g
3420: 65 74 2d 65 76 65 6e 74 5f 74 69 6d 65 20 74 65 et-event_time te
3430: 73 74 29 29 0a 09 09 09 20 20 20 28 72 75 6e 74 st)).... (runt
3440: 69 6d 65 20 20 20 20 28 64 62 3a 74 65 73 74 2d ime (db:test-
3450: 67 65 74 2d 72 75 6e 5f 64 75 72 61 74 69 6f 6e get-run_duration
3460: 20 74 65 73 74 29 29 0a 09 09 09 20 20 20 28 62 test)).... (b
3470: 75 74 74 6f 6e 74 78 74 20 20 28 69 66 20 28 65 uttontxt (if (e
3480: 71 75 61 6c 3f 20 74 65 73 74 73 74 61 74 65 20 qual? teststate
3490: 22 43 4f 4d 50 4c 45 54 45 44 22 29 20 74 65 73 "COMPLETED") tes
34a0: 74 73 74 61 74 75 73 20 74 65 73 74 73 74 61 74 tstatus teststat
34b0: 65 29 29 0a 09 09 09 20 20 20 28 62 75 74 74 6f e)).... (butto
34c0: 6e 20 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 n (vector-re
34d0: 66 20 63 6f 6c 75 6d 6e 64 61 74 20 72 6f 77 6e f columndat rown
34e0: 29 29 0a 09 09 09 20 20 20 28 63 6f 6c 6f 72 20 )).... (color
34f0: 20 20 20 20 20 28 67 65 74 2d 63 6f 6c 6f 72 2d (get-color-
3500: 66 6f 72 2d 73 74 61 74 65 2d 73 74 61 74 75 73 for-state-status
3510: 20 74 65 73 74 73 74 61 74 65 20 74 65 73 74 73 teststate tests
3520: 74 61 74 75 73 29 29 0a 09 09 09 20 20 20 28 63 tatus)).... (c
3530: 75 72 72 2d 63 6f 6c 6f 72 20 28 76 65 63 74 6f urr-color (vecto
3540: 72 2d 72 65 66 20 62 75 74 74 6f 6e 64 61 74 20 r-ref buttondat
3550: 31 29 29 20 3b 3b 20 28 69 75 70 3a 61 74 74 72 1)) ;; (iup:attr
3560: 69 62 75 74 65 20 62 75 74 74 6f 6e 20 22 42 47 ibute button "BG
3570: 43 4f 4c 4f 52 22 29 29 0a 09 09 09 20 20 20 28 COLOR")).... (
3580: 63 75 72 72 2d 74 69 74 6c 65 20 28 76 65 63 74 curr-title (vect
3590: 6f 72 2d 72 65 66 20 62 75 74 74 6f 6e 64 61 74 or-ref buttondat
35a0: 20 32 29 29 29 20 3b 3b 20 28 69 75 70 3a 61 74 2))) ;; (iup:at
35b0: 74 72 69 62 75 74 65 20 62 75 74 74 6f 6e 20 22 tribute button "
35c0: 54 49 54 4c 45 22 29 29 29 0a 09 09 20 20 20 20 TITLE")))...
35d0: 20 20 28 69 66 20 28 6e 6f 74 20 28 65 71 75 61 (if (not (equa
35e0: 6c 3f 20 63 75 72 72 2d 63 6f 6c 6f 72 20 63 6f l? curr-color co
35f0: 6c 6f 72 29 29 0a 09 09 09 20 20 28 69 75 70 3a lor)).... (iup:
3600: 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 62 attribute-set! b
3610: 75 74 74 6f 6e 20 22 42 47 43 4f 4c 4f 52 22 20 utton "BGCOLOR"
3620: 63 6f 6c 6f 72 29 29 0a 09 09 20 20 20 20 20 20 color))...
3630: 28 69 66 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f (if (not (equal?
3640: 20 63 75 72 72 2d 74 69 74 6c 65 20 62 75 74 74 curr-title butt
3650: 6f 6e 74 78 74 29 29 0a 09 09 09 20 20 28 69 75 ontxt)).... (iu
3660: 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 p:attribute-set!
3670: 20 62 75 74 74 6f 6e 20 22 54 49 54 4c 45 22 20 button "TITLE"
3680: 20 20 62 75 74 74 6f 6e 74 78 74 29 29 0a 09 09 buttontxt))...
3690: 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d 73 65 (vector-se
36a0: 74 21 20 62 75 74 74 6f 6e 64 61 74 20 30 20 72 t! buttondat 0 r
36b0: 75 6e 2d 69 64 29 0a 09 09 20 20 20 20 20 20 28 un-id)... (
36c0: 76 65 63 74 6f 72 2d 73 65 74 21 20 62 75 74 74 vector-set! butt
36d0: 6f 6e 64 61 74 20 31 20 63 6f 6c 6f 72 29 0a 09 ondat 1 color)..
36e0: 09 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d 73 . (vector-s
36f0: 65 74 21 20 62 75 74 74 6f 6e 64 61 74 20 32 20 et! buttondat 2
3700: 62 75 74 74 6f 6e 74 78 74 29 0a 09 09 20 20 20 buttontxt)...
3710: 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 (vector-set!
3720: 62 75 74 74 6f 6e 64 61 74 20 33 20 74 65 73 74 buttondat 3 test
3730: 29 0a 09 09 20 20 20 20 20 20 28 76 65 63 74 6f )... (vecto
3740: 72 2d 73 65 74 21 20 62 75 74 74 6f 6e 64 61 74 r-set! buttondat
3750: 20 34 20 72 75 6e 2d 6b 65 79 29 29 29 0a 09 09 4 run-key)))...
3760: 28 73 65 74 21 20 72 6f 77 6e 20 28 2b 20 72 6f (set! rown (+ ro
3770: 77 6e 20 31 29 29 29 29 0a 09 20 20 20 20 2a 61 wn 1)))).. *a
3780: 6c 6c 74 65 73 74 6e 61 6d 65 6c 73 74 2a 29 29 lltestnamelst*))
3790: 0a 09 20 28 73 65 74 21 20 63 6f 6c 6e 20 28 2b .. (set! coln (+
37a0: 20 63 6f 6c 6e 20 31 29 29 29 29 0a 20 20 20 20 coln 1)))).
37b0: 20 72 75 6e 73 29 29 29 0a 0a 28 64 65 66 69 6e runs)))..(defin
37c0: 65 20 28 6d 6b 73 74 72 20 2e 20 78 29 0a 20 20 e (mkstr . x).
37d0: 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 (string-interspe
37e0: 72 73 65 20 28 6d 61 70 20 63 6f 6e 63 20 78 29 rse (map conc x)
37f0: 20 22 2c 22 29 29 0a 0a 28 64 65 66 69 6e 65 20 ","))..(define
3800: 28 75 70 64 61 74 65 2d 73 65 61 72 63 68 20 78 (update-search x
3810: 20 76 61 6c 29 0a 20 20 3b 3b 20 28 70 72 69 6e val). ;; (prin
3820: 74 20 22 53 65 74 74 69 6e 67 20 73 65 61 72 63 t "Setting searc
3830: 68 20 66 6f 72 20 22 20 78 20 22 20 74 6f 20 22 h for " x " to "
3840: 20 76 61 6c 29 0a 20 20 28 68 61 73 68 2d 74 61 val). (hash-ta
3850: 62 6c 65 2d 73 65 74 21 20 2a 73 65 61 72 63 68 ble-set! *search
3860: 70 61 74 74 73 2a 20 78 20 76 61 6c 29 29 0a 0a patts* x val))..
3870: 28 64 65 66 69 6e 65 20 28 6d 61 6b 65 2d 64 61 (define (make-da
3880: 73 68 62 6f 61 72 64 2d 62 75 74 74 6f 6e 73 20 shboard-buttons
3890: 6e 72 75 6e 73 20 6e 74 65 73 74 73 20 6b 65 79 nruns ntests key
38a0: 6e 61 6d 65 73 29 0a 20 20 28 6c 65 74 2a 20 28 names). (let* (
38b0: 28 6e 6b 65 79 73 20 20 20 28 6c 65 6e 67 74 68 (nkeys (length
38c0: 20 6b 65 79 6e 61 6d 65 73 29 29 0a 09 20 28 72 keynames)).. (r
38d0: 75 6e 73 76 65 63 20 28 6d 61 6b 65 2d 76 65 63 unsvec (make-vec
38e0: 74 6f 72 20 6e 72 75 6e 73 29 29 0a 09 20 28 68 tor nruns)).. (h
38f0: 65 61 64 65 72 20 20 28 6d 61 6b 65 2d 76 65 63 eader (make-vec
3900: 74 6f 72 20 6e 72 75 6e 73 29 29 0a 09 20 28 6c tor nruns)).. (l
3910: 66 74 63 6f 6c 20 20 28 6d 61 6b 65 2d 76 65 63 ftcol (make-vec
3920: 74 6f 72 20 6e 74 65 73 74 73 29 29 0a 09 20 28 tor ntests)).. (
3930: 63 6f 6e 74 72 6f 6c 73 20 27 28 29 29 0a 09 20 controls '())..
3940: 28 6c 66 74 6c 73 74 20 20 27 28 29 29 0a 09 20 (lftlst '())..
3950: 28 68 64 72 6c 73 74 20 20 27 28 29 29 0a 09 20 (hdrlst '())..
3960: 28 62 64 79 6c 73 74 20 20 27 28 29 29 0a 09 20 (bdylst '())..
3970: 28 72 65 73 75 6c 74 20 20 27 28 29 29 0a 09 20 (result '())..
3980: 28 69 20 20 20 20 20 20 20 30 29 29 0a 20 20 20 (i 0)).
3990: 20 3b 3b 20 63 6f 6e 74 72 6f 6c 73 20 28 61 6c ;; controls (al
39a0: 6f 6e 67 20 62 6f 74 74 6f 6d 29 0a 20 20 20 20 ong bottom).
39b0: 28 73 65 74 21 20 63 6f 6e 74 72 6f 6c 73 0a 09 (set! controls..
39c0: 20 20 28 69 75 70 3a 68 62 6f 78 0a 09 20 20 20 (iup:hbox..
39d0: 28 69 75 70 3a 74 65 78 74 62 6f 78 20 23 3a 73 (iup:textbox #:s
39e0: 69 7a 65 20 22 36 30 78 31 35 22 20 23 3a 66 6f ize "60x15" #:fo
39f0: 6e 74 73 69 7a 65 20 22 31 30 22 20 23 3a 76 61 ntsize "10" #:va
3a00: 6c 75 65 20 22 25 22 0a 09 09 09 23 3a 61 63 74 lue "%"....#:act
3a10: 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a ion (lambda (obj
3a20: 20 75 6e 6b 20 76 61 6c 29 0a 09 09 09 09 20 20 unk val).....
3a30: 20 28 75 70 64 61 74 65 2d 73 65 61 72 63 68 20 (update-search
3a40: 22 74 65 73 74 2d 6e 61 6d 65 22 20 76 61 6c 29 "test-name" val)
3a50: 29 29 0a 09 20 20 20 28 69 75 70 3a 74 65 78 74 )).. (iup:text
3a60: 62 6f 78 20 23 3a 73 69 7a 65 20 22 36 30 78 31 box #:size "60x1
3a70: 35 22 20 23 3a 66 6f 6e 74 73 69 7a 65 20 22 31 5" #:fontsize "1
3a80: 30 22 20 23 3a 76 61 6c 75 65 20 22 25 22 0a 09 0" #:value "%"..
3a90: 09 09 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 ..#:action (lamb
3aa0: 64 61 20 28 6f 62 6a 20 75 6e 6b 20 76 61 6c 29 da (obj unk val)
3ab0: 0a 09 09 09 09 20 20 20 28 75 70 64 61 74 65 2d ..... (update-
3ac0: 73 65 61 72 63 68 20 22 69 74 65 6d 2d 6e 61 6d search "item-nam
3ad0: 65 22 20 76 61 6c 29 29 29 0a 09 20 20 20 28 69 e" val))).. (i
3ae0: 75 70 3a 62 75 74 74 6f 6e 20 22 51 75 69 74 22 up:button "Quit"
3af0: 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 #:action (lambd
3b00: 61 20 28 6f 62 6a 29 28 73 71 6c 69 74 65 33 3a a (obj)(sqlite3:
3b10: 66 69 6e 61 6c 69 7a 65 21 20 2a 64 62 2a 29 28 finalize! *db*)(
3b20: 65 78 69 74 29 29 29 0a 09 20 20 20 28 69 75 70 exit))).. (iup
3b30: 3a 62 75 74 74 6f 6e 20 22 3c 2d 20 20 4c 65 66 :button "<- Lef
3b40: 74 22 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d t" #:action (lam
3b50: 62 64 61 20 28 6f 62 6a 29 28 73 65 74 21 20 2a bda (obj)(set! *
3b60: 73 74 61 72 74 2d 72 75 6e 2d 6f 66 66 73 65 74 start-run-offset
3b70: 2a 20 20 28 2b 20 2a 73 74 61 72 74 2d 72 75 6e * (+ *start-run
3b80: 2d 6f 66 66 73 65 74 2a 20 31 29 29 29 29 0a 09 -offset* 1))))..
3b90: 20 20 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 (iup:button "
3ba0: 55 70 20 20 20 20 20 5e 22 20 23 3a 61 63 74 69 Up ^" #:acti
3bb0: 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 29 on (lambda (obj)
3bc0: 28 73 65 74 21 20 2a 73 74 61 72 74 2d 74 65 73 (set! *start-tes
3bd0: 74 2d 6f 66 66 73 65 74 2a 20 28 69 66 20 28 3e t-offset* (if (>
3be0: 20 2a 73 74 61 72 74 2d 74 65 73 74 2d 6f 66 66 *start-test-off
3bf0: 73 65 74 2a 20 30 29 28 2d 20 2a 73 74 61 72 74 set* 0)(- *start
3c00: 2d 74 65 73 74 2d 6f 66 66 73 65 74 2a 20 31 29 -test-offset* 1)
3c10: 20 30 29 29 29 29 0a 09 20 20 20 28 69 75 70 3a 0)))).. (iup:
3c20: 62 75 74 74 6f 6e 20 22 44 6f 77 6e 20 20 20 76 button "Down v
3c30: 22 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 " #:action (lamb
3c40: 64 61 20 28 6f 62 6a 29 28 73 65 74 21 20 2a 73 da (obj)(set! *s
3c50: 74 61 72 74 2d 74 65 73 74 2d 6f 66 66 73 65 74 tart-test-offset
3c60: 2a 20 28 69 66 20 28 3e 3d 20 2a 73 74 61 72 74 * (if (>= *start
3c70: 2d 74 65 73 74 2d 6f 66 66 73 65 74 2a 20 28 6c -test-offset* (l
3c80: 65 6e 67 74 68 20 2a 61 6c 6c 74 65 73 74 6e 61 ength *alltestna
3c90: 6d 65 6c 73 74 2a 29 29 28 6c 65 6e 67 74 68 20 melst*))(length
3ca0: 2a 61 6c 6c 74 65 73 74 6e 61 6d 65 6c 73 74 2a *alltestnamelst*
3cb0: 29 28 2b 20 2a 73 74 61 72 74 2d 74 65 73 74 2d )(+ *start-test-
3cc0: 6f 66 66 73 65 74 2a 20 31 29 29 29 29 29 0a 09 offset* 1)))))..
3cd0: 20 20 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 (iup:button "
3ce0: 52 69 67 68 74 20 2d 3e 22 20 23 3a 61 63 74 69 Right ->" #:acti
3cf0: 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 29 on (lambda (obj)
3d00: 28 73 65 74 21 20 2a 73 74 61 72 74 2d 72 75 6e (set! *start-run
3d10: 2d 6f 66 66 73 65 74 2a 20 20 28 69 66 20 28 3e -offset* (if (>
3d20: 20 2a 73 74 61 72 74 2d 72 75 6e 2d 6f 66 66 73 *start-run-offs
3d30: 65 74 2a 20 30 29 28 2d 20 2a 73 74 61 72 74 2d et* 0)(- *start-
3d40: 72 75 6e 2d 6f 66 66 73 65 74 2a 20 31 29 20 30 run-offset* 1) 0
3d50: 29 29 29 29 0a 09 20 20 20 28 69 75 70 3a 76 61 )))).. (iup:va
3d60: 6c 75 61 74 6f 72 20 23 3a 76 61 6c 75 65 63 68 luator #:valuech
3d70: 61 6e 67 65 64 5f 63 62 20 28 6c 61 6d 62 64 61 anged_cb (lambda
3d80: 20 28 6f 62 6a 29 0a 09 09 09 09 09 20 20 20 20 (obj)......
3d90: 20 28 6c 65 74 20 28 28 76 61 6c 20 28 69 6e 65 (let ((val (ine
3da0: 78 61 63 74 2d 3e 65 78 61 63 74 20 28 72 6f 75 xact->exact (rou
3db0: 6e 64 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 nd (string->numb
3dc0: 65 72 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 er (iup:attribut
3dd0: 65 20 6f 62 6a 20 22 56 41 4c 55 45 22 29 29 29 e obj "VALUE")))
3de0: 29 29 0a 09 09 09 09 09 09 20 20 20 28 6d 61 78 ))....... (max
3df0: 72 75 6e 73 20 20 2a 74 6f 74 2d 72 75 6e 2d 63 runs *tot-run-c
3e00: 6f 75 6e 74 2a 29 29 20 3b 3b 3b 20 28 2b 20 2a ount*)) ;;; (+ *
3e10: 6e 75 6d 2d 72 75 6e 73 2a 20 28 6c 65 6e 67 74 num-runs* (lengt
3e20: 68 20 2a 61 6c 6c 72 75 6e 73 2a 29 29 29 29 0a h *allruns*)))).
3e30: 09 09 09 09 09 20 20 20 20 20 20 20 28 73 65 74 ..... (set
3e40: 21 20 2a 73 74 61 72 74 2d 72 75 6e 2d 6f 66 66 ! *start-run-off
3e50: 73 65 74 2a 20 76 61 6c 29 0a 09 09 09 09 09 20 set* val)......
3e60: 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
3e70: 6e 74 20 33 20 22 6d 61 78 72 75 6e 73 3a 20 22 nt 3 "maxruns: "
3e80: 20 6d 61 78 72 75 6e 73 20 22 2c 20 76 61 6c 3a maxruns ", val:
3e90: 20 22 20 76 61 6c 29 0a 09 09 09 09 09 20 20 20 " val)......
3ea0: 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 (iup:attribu
3eb0: 74 65 2d 73 65 74 21 20 6f 62 6a 20 22 4d 41 58 te-set! obj "MAX
3ec0: 22 20 6d 61 78 72 75 6e 73 29 29 29 0a 09 09 09 " maxruns)))....
3ed0: 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53 22 0a #:expand "YES".
3ee0: 09 09 09 20 23 3a 6d 61 78 20 28 2b 20 2a 6e 75 ... #:max (+ *nu
3ef0: 6d 2d 72 75 6e 73 2a 20 28 6c 65 6e 67 74 68 20 m-runs* (length
3f00: 2a 61 6c 6c 72 75 6e 73 2a 29 29 29 0a 09 20 20 *allruns*)))..
3f10: 20 3b 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 69 ;(iup:button "i
3f20: 6e 63 20 72 6f 77 73 22 20 23 3a 61 63 74 69 6f nc rows" #:actio
3f30: 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 29 28 n (lambda (obj)(
3f40: 73 65 74 21 20 2a 6e 75 6d 2d 74 65 73 74 73 2a set! *num-tests*
3f50: 20 28 2b 20 2a 6e 75 6d 2d 74 65 73 74 73 2a 20 (+ *num-tests*
3f60: 31 29 29 29 29 0a 09 20 20 20 3b 28 69 75 70 3a 1)))).. ;(iup:
3f70: 62 75 74 74 6f 6e 20 22 64 65 63 20 72 6f 77 73 button "dec rows
3f80: 22 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 " #:action (lamb
3f90: 64 61 20 28 6f 62 6a 29 28 73 65 74 21 20 2a 6e da (obj)(set! *n
3fa0: 75 6d 2d 74 65 73 74 73 2a 20 28 69 66 20 28 3e um-tests* (if (>
3fb0: 20 2a 6e 75 6d 2d 74 65 73 74 73 2a 20 30 29 28 *num-tests* 0)(
3fc0: 2d 20 2a 6e 75 6d 2d 74 65 73 74 73 2a 20 31 29 - *num-tests* 1)
3fd0: 20 30 29 29 29 29 0a 09 20 20 20 29 0a 09 20 20 0)))).. )..
3fe0: 29 0a 20 20 20 20 0a 20 20 20 20 3b 3b 20 63 72 ). . ;; cr
3ff0: 65 61 74 65 20 74 68 65 20 6c 65 66 74 20 6d 6f eate the left mo
4000: 73 74 20 63 6f 6c 75 6d 6e 20 66 6f 72 20 74 68 st column for th
4010: 65 20 72 75 6e 20 6b 65 79 20 6e 61 6d 65 73 20 e run key names
4020: 61 6e 64 20 74 68 65 20 74 65 73 74 20 6e 61 6d and the test nam
4030: 65 73 20 0a 20 20 20 20 28 73 65 74 21 20 6c 66 es . (set! lf
4040: 74 6c 73 74 20 28 6c 69 73 74 20 28 69 75 70 3a tlst (list (iup:
4050: 68 62 6f 78 0a 09 09 09 28 69 75 70 3a 6c 61 62 hbox....(iup:lab
4060: 65 6c 29 20 3b 3b 20 28 69 75 70 3a 76 61 6c 75 el) ;; (iup:valu
4070: 61 74 6f 72 29 0a 09 09 09 28 61 70 70 6c 79 20 ator)....(apply
4080: 69 75 70 3a 76 62 6f 78 20 0a 09 09 09 20 20 20 iup:vbox ....
4090: 20 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 (map (lambda
40a0: 20 28 78 29 09 09 0a 09 09 09 09 20 20 20 20 20 (x).......
40b0: 20 28 6c 65 74 20 28 28 72 65 73 20 28 69 75 70 (let ((res (iup
40c0: 3a 68 62 6f 78 0a 09 09 09 09 09 09 20 20 28 69 :hbox....... (i
40d0: 75 70 3a 6c 61 62 65 6c 20 78 20 23 3a 73 69 7a up:label x #:siz
40e0: 65 20 22 34 30 78 31 35 22 20 23 3a 66 6f 6e 74 e "40x15" #:font
40f0: 73 69 7a 65 20 22 31 30 22 29 20 3b 3b 20 20 23 size "10") ;; #
4100: 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e :expand "HORIZON
4110: 54 41 4c 22 29 0a 09 09 09 09 09 09 20 20 28 69 TAL")....... (i
4120: 75 70 3a 74 65 78 74 62 6f 78 20 23 3a 73 69 7a up:textbox #:siz
4130: 65 20 22 36 30 78 31 35 22 20 23 3a 66 6f 6e 74 e "60x15" #:font
4140: 73 69 7a 65 20 22 31 30 22 20 23 3a 76 61 6c 75 size "10" #:valu
4150: 65 20 22 25 22 20 3b 3b 20 23 3a 65 78 70 61 6e e "%" ;; #:expan
4160: 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 0a 09 d "HORIZONTAL"..
4170: 09 09 09 09 09 09 20 20 20 20 20 20 20 23 3a 61 ...... #:a
4180: 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f ction (lambda (o
4190: 62 6a 20 75 6e 6b 20 76 61 6c 29 0a 09 09 09 09 bj unk val).....
41a0: 09 09 09 09 09 20 20 28 75 70 64 61 74 65 2d 73 ..... (update-s
41b0: 65 61 72 63 68 20 78 20 76 61 6c 29 29 29 29 29 earch x val)))))
41c0: 29 0a 09 09 09 09 09 28 73 65 74 21 20 69 20 28 )......(set! i (
41d0: 2b 20 69 20 31 29 29 0a 09 09 09 09 09 72 65 73 + i 1))......res
41e0: 29 29 0a 09 09 09 09 20 20 20 20 6b 65 79 6e 61 ))..... keyna
41f0: 6d 65 73 29 29 29 29 29 0a 20 20 20 20 28 6c 65 mes))))). (le
4200: 74 20 6c 6f 6f 70 20 28 28 74 65 73 74 6e 75 6d t loop ((testnum
4210: 20 20 30 29 0a 09 20 20 20 20 20 20 20 28 72 65 0).. (re
4220: 73 20 20 20 20 20 20 27 28 29 29 29 0a 20 20 20 s '())).
4230: 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 (cond.
4240: 28 28 3e 3d 20 74 65 73 74 6e 75 6d 20 6e 74 65 ((>= testnum nte
4250: 73 74 73 29 0a 09 3b 3b 20 6e 6f 77 20 6c 66 74 sts)..;; now lft
4260: 6c 73 74 20 77 69 6c 6c 20 62 65 20 61 6e 20 68 lst will be an h
4270: 62 6f 78 20 77 69 74 68 20 74 68 65 20 74 65 73 box with the tes
4280: 74 20 6b 65 79 73 20 61 6e 64 20 74 68 65 20 74 t keys and the t
4290: 65 73 74 20 6e 61 6d 65 20 6c 61 62 65 6c 73 0a est name labels.
42a0: 09 28 73 65 74 21 20 6c 66 74 6c 73 74 20 28 61 .(set! lftlst (a
42b0: 70 70 65 6e 64 20 6c 66 74 6c 73 74 20 28 6c 69 ppend lftlst (li
42c0: 73 74 20 28 69 75 70 3a 68 62 6f 78 20 0a 09 09 st (iup:hbox ...
42d0: 09 09 09 20 20 20 28 69 75 70 3a 76 61 6c 75 61 ... (iup:valua
42e0: 74 6f 72 20 23 3a 76 61 6c 75 65 63 68 61 6e 67 tor #:valuechang
42f0: 65 64 5f 63 62 20 28 6c 61 6d 62 64 61 20 28 6f ed_cb (lambda (o
4300: 62 6a 29 0a 09 09 09 09 09 09 09 09 09 20 20 20 bj)..........
4310: 20 20 28 6c 65 74 20 28 28 76 61 6c 20 28 69 75 (let ((val (iu
4320: 70 3a 61 74 74 72 69 62 75 74 65 20 6f 62 6a 20 p:attribute obj
4330: 22 56 41 4c 55 45 22 29 29 29 0a 09 09 09 09 09 "VALUE")))......
4340: 09 09 09 09 20 20 20 20 20 20 20 28 73 65 74 21 .... (set!
4350: 20 2a 73 74 61 72 74 2d 74 65 73 74 2d 6f 66 66 *start-test-off
4360: 73 65 74 2a 20 28 69 6e 65 78 61 63 74 2d 3e 65 set* (inexact->e
4370: 78 61 63 74 20 28 72 6f 75 6e 64 20 28 73 74 72 xact (round (str
4380: 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 76 61 6c 29 ing->number val)
4390: 29 29 29 0a 09 09 09 09 09 09 09 09 09 20 20 20 )))..........
43a0: 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 (iup:attribu
43b0: 74 65 2d 73 65 74 21 20 6f 62 6a 20 22 4d 41 58 te-set! obj "MAX
43c0: 22 20 28 6c 65 6e 67 74 68 20 2a 61 6c 6c 74 65 " (length *allte
43d0: 73 74 6e 61 6d 65 6c 73 74 2a 29 29 0a 09 09 09 stnamelst*))....
43e0: 09 09 09 09 09 09 20 20 20 20 20 20 20 29 20 29 ...... ) )
43f0: 0a 09 09 09 09 09 09 09 20 23 3a 65 78 70 61 6e ........ #:expan
4400: 64 20 22 59 45 53 22 20 0a 09 09 09 09 09 09 09 d "YES" ........
4410: 20 23 3a 6f 72 69 65 6e 74 61 74 69 6f 6e 20 22 #:orientation "
4420: 56 45 52 54 49 43 41 4c 22 29 0a 09 09 09 09 09 VERTICAL")......
4430: 20 20 20 28 61 70 70 6c 79 20 69 75 70 3a 76 62 (apply iup:vb
4440: 6f 78 20 28 72 65 76 65 72 73 65 20 72 65 73 29 ox (reverse res)
4450: 29 29 29 29 29 29 0a 20 20 20 20 20 20 20 28 65 )))))). (e
4460: 6c 73 65 0a 09 28 6c 65 74 20 28 28 6c 61 62 6c lse..(let ((labl
4470: 20 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 22 (iup:button ""
4480: 20 0a 09 09 09 09 20 23 3a 66 6c 61 74 20 22 59 ..... #:flat "Y
4490: 45 53 22 20 0a 09 09 09 09 20 3b 20 23 3a 69 6d ES" ..... ; #:im
44a0: 61 67 65 20 69 6d 67 31 0a 09 09 09 09 20 3b 20 age img1..... ;
44b0: 23 3a 69 6d 70 72 65 73 73 20 69 6d 67 32 0a 09 #:impress img2..
44c0: 09 09 09 20 23 3a 73 69 7a 65 20 22 31 30 30 78 ... #:size "100x
44d0: 31 35 22 0a 09 09 09 09 20 23 3a 66 6f 6e 74 73 15"..... #:fonts
44e0: 69 7a 65 20 22 31 30 22 0a 09 09 09 09 20 23 3a ize "10"..... #:
44f0: 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 action (lambda (
4500: 6f 62 6a 29 0a 09 09 09 09 09 20 20 20 20 20 20 obj)......
4510: 28 74 6f 67 67 6c 65 2d 68 69 64 65 20 74 65 73 (toggle-hide tes
4520: 74 6e 75 6d 29 29 29 29 29 20 3b 3b 20 28 69 75 tnum))))) ;; (iu
4530: 70 3a 61 74 74 72 69 62 75 74 65 20 6f 62 6a 20 p:attribute obj
4540: 22 54 49 54 4c 45 22 29 29 29 29 0a 09 20 20 28 "TITLE")))).. (
4550: 76 65 63 74 6f 72 2d 73 65 74 21 20 6c 66 74 63 vector-set! lftc
4560: 6f 6c 20 74 65 73 74 6e 75 6d 20 6c 61 62 6c 29 ol testnum labl)
4570: 0a 09 20 20 28 6c 6f 6f 70 20 28 2b 20 74 65 73 .. (loop (+ tes
4580: 74 6e 75 6d 20 31 29 28 63 6f 6e 73 20 6c 61 62 tnum 1)(cons lab
4590: 6c 20 72 65 73 29 29 29 29 29 29 0a 20 20 20 20 l res)))))).
45a0: 3b 3b 20 0a 20 20 20 20 28 6c 65 74 20 6c 6f 6f ;; . (let loo
45b0: 70 20 28 28 72 75 6e 6e 75 6d 20 20 30 29 0a 09 p ((runnum 0)..
45c0: 20 20 20 20 20 20 20 28 6b 65 79 6e 75 6d 20 20 (keynum
45d0: 30 29 0a 09 20 20 20 20 20 20 20 28 6b 65 79 76 0).. (keyv
45e0: 65 63 20 20 28 6d 61 6b 65 2d 76 65 63 74 6f 72 ec (make-vector
45f0: 20 6e 6b 65 79 73 29 29 0a 09 20 20 20 20 20 20 nkeys))..
4600: 20 28 72 65 73 20 20 20 20 27 28 29 29 29 0a 20 (res '())).
4610: 20 20 20 20 20 28 63 6f 6e 64 20 3b 3b 20 6e 62 (cond ;; nb
4620: 2f 2f 20 6e 6f 20 65 6c 73 65 20 66 6f 72 20 74 // no else for t
4630: 68 69 73 20 61 70 70 72 6f 61 63 68 2e 0a 20 20 his approach..
4640: 20 20 20 20 20 28 28 3e 3d 20 72 75 6e 6e 75 6d ((>= runnum
4650: 20 6e 72 75 6e 73 29 20 23 66 29 0a 20 20 20 20 nruns) #f).
4660: 20 20 20 28 28 3e 3d 20 6b 65 79 6e 75 6d 20 6e ((>= keynum n
4670: 6b 65 79 73 29 20 0a 09 28 76 65 63 74 6f 72 2d keys) ..(vector-
4680: 73 65 74 21 20 68 65 61 64 65 72 20 72 75 6e 6e set! header runn
4690: 75 6d 20 6b 65 79 76 65 63 29 0a 09 28 73 65 74 um keyvec)..(set
46a0: 21 20 68 64 72 6c 73 74 20 28 63 6f 6e 73 20 28 ! hdrlst (cons (
46b0: 61 70 70 6c 79 20 69 75 70 3a 76 62 6f 78 20 28 apply iup:vbox (
46c0: 72 65 76 65 72 73 65 20 72 65 73 29 29 20 68 64 reverse res)) hd
46d0: 72 6c 73 74 29 29 0a 09 28 6c 6f 6f 70 20 28 2b rlst))..(loop (+
46e0: 20 72 75 6e 6e 75 6d 20 31 29 20 30 20 28 6d 61 runnum 1) 0 (ma
46f0: 6b 65 2d 76 65 63 74 6f 72 20 6e 6b 65 79 73 29 ke-vector nkeys)
4700: 20 27 28 29 29 29 0a 20 20 20 20 20 20 20 28 65 '())). (e
4710: 6c 73 65 0a 09 28 6c 65 74 20 28 28 6c 61 62 6c lse..(let ((labl
4720: 20 20 28 69 75 70 3a 6c 61 62 65 6c 20 22 22 20 (iup:label ""
4730: 23 3a 73 69 7a 65 20 22 36 30 78 31 35 22 20 23 #:size "60x15" #
4740: 3a 66 6f 6e 74 73 69 7a 65 20 22 31 30 22 29 29 :fontsize "10"))
4750: 29 20 3b 3b 20 23 3a 65 78 70 61 6e 64 20 22 48 ) ;; #:expand "H
4760: 4f 52 49 5a 4f 4e 54 41 4c 22 0a 09 20 20 28 76 ORIZONTAL".. (v
4770: 65 63 74 6f 72 2d 73 65 74 21 20 6b 65 79 76 65 ector-set! keyve
4780: 63 20 6b 65 79 6e 75 6d 20 6c 61 62 6c 29 0a 09 c keynum labl)..
4790: 20 20 28 6c 6f 6f 70 20 72 75 6e 6e 75 6d 20 28 (loop runnum (
47a0: 2b 20 6b 65 79 6e 75 6d 20 31 29 20 6b 65 79 76 + keynum 1) keyv
47b0: 65 63 20 28 63 6f 6e 73 20 6c 61 62 6c 20 72 65 ec (cons labl re
47c0: 73 29 29 29 29 29 29 0a 20 20 20 20 3b 3b 20 42 s)))))). ;; B
47d0: 79 20 68 65 72 65 20 74 68 65 20 68 64 72 6c 73 y here the hdrls
47e0: 74 20 63 6f 6e 74 61 69 6e 73 20 61 20 6c 69 73 t contains a lis
47f0: 74 20 6f 66 20 76 62 6f 78 65 73 20 63 6f 6e 74 t of vboxes cont
4800: 61 69 6e 69 6e 67 20 6e 6b 65 79 73 20 6c 61 62 aining nkeys lab
4810: 65 6c 73 0a 20 20 20 20 28 6c 65 74 20 6c 6f 6f els. (let loo
4820: 70 20 28 28 72 75 6e 6e 75 6d 20 20 30 29 0a 09 p ((runnum 0)..
4830: 20 20 20 20 20 20 20 28 74 65 73 74 6e 75 6d 20 (testnum
4840: 30 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 0).. (test
4850: 76 65 63 20 20 28 6d 61 6b 65 2d 76 65 63 74 6f vec (make-vecto
4860: 72 20 6e 74 65 73 74 73 29 29 0a 09 20 20 20 20 r ntests))..
4870: 20 20 20 28 72 65 73 20 20 20 20 27 28 29 29 29 (res '()))
4880: 0a 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 . (cond.
4890: 20 20 20 20 28 28 3e 3d 20 72 75 6e 6e 75 6d 20 ((>= runnum
48a0: 6e 72 75 6e 73 29 20 23 66 29 20 3b 3b 20 20 28 nruns) #f) ;; (
48b0: 76 65 63 74 6f 72 20 74 61 62 6c 65 68 65 61 64 vector tablehead
48c0: 65 72 20 72 75 6e 73 76 65 63 29 29 0a 20 20 20 er runsvec)).
48d0: 20 20 20 20 28 28 3e 3d 20 74 65 73 74 6e 75 6d ((>= testnum
48e0: 20 6e 74 65 73 74 73 29 20 0a 09 28 76 65 63 74 ntests) ..(vect
48f0: 6f 72 2d 73 65 74 21 20 72 75 6e 73 76 65 63 20 or-set! runsvec
4900: 72 75 6e 6e 75 6d 20 74 65 73 74 76 65 63 29 0a runnum testvec).
4910: 09 28 73 65 74 21 20 62 64 79 6c 73 74 20 28 63 .(set! bdylst (c
4920: 6f 6e 73 20 28 61 70 70 6c 79 20 69 75 70 3a 76 ons (apply iup:v
4930: 62 6f 78 20 28 72 65 76 65 72 73 65 20 72 65 73 box (reverse res
4940: 29 29 20 62 64 79 6c 73 74 29 29 0a 09 28 6c 6f )) bdylst))..(lo
4950: 6f 70 20 28 2b 20 72 75 6e 6e 75 6d 20 31 29 20 op (+ runnum 1)
4960: 30 20 28 6d 61 6b 65 2d 76 65 63 74 6f 72 20 6e 0 (make-vector n
4970: 74 65 73 74 73 29 20 27 28 29 29 29 0a 20 20 20 tests) '())).
4980: 20 20 20 20 28 65 6c 73 65 0a 09 28 6c 65 74 2a (else..(let*
4990: 20 28 28 62 75 74 74 6f 6e 2d 6b 65 79 20 28 6d ((button-key (m
49a0: 6b 73 74 72 20 72 75 6e 6e 75 6d 20 74 65 73 74 kstr runnum test
49b0: 6e 75 6d 29 29 0a 09 20 20 20 20 20 20 20 28 62 num)).. (b
49c0: 75 74 6e 20 20 20 20 20 20 20 28 69 75 70 3a 62 utn (iup:b
49d0: 75 74 74 6f 6e 20 22 22 20 3b 3b 20 62 75 74 74 utton "" ;; butt
49e0: 6f 6e 2d 6b 65 79 20 0a 09 09 09 09 20 20 20 20 on-key .....
49f0: 20 20 20 23 3a 73 69 7a 65 20 22 36 30 78 31 35 #:size "60x15
4a00: 22 20 0a 09 09 09 09 20 20 20 20 20 20 20 3b 3b " ..... ;;
4a10: 20 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a #:expand "HORIZ
4a20: 4f 4e 54 41 4c 22 0a 09 09 09 09 20 20 20 20 20 ONTAL".....
4a30: 20 20 23 3a 66 6f 6e 74 73 69 7a 65 20 22 31 30 #:fontsize "10
4a40: 22 20 0a 09 09 09 09 20 20 20 20 20 20 20 23 3a " ..... #:
4a50: 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 action (lambda (
4a60: 78 29 0a 09 09 09 09 09 09 20 20 28 6c 65 74 2a x)....... (let*
4a70: 20 28 28 74 6f 6f 6c 70 61 74 68 20 28 63 61 72 ((toolpath (car
4a80: 20 28 61 72 67 76 29 29 29 0a 09 09 09 09 09 09 (argv))).......
4a90: 09 20 28 62 75 74 74 6e 64 61 74 20 28 68 61 73 . (buttndat (has
4aa0: 68 2d 74 61 62 6c 65 2d 72 65 66 20 2a 62 75 74 h-table-ref *but
4ab0: 74 6f 6e 64 61 74 2a 20 62 75 74 74 6f 6e 2d 6b tondat* button-k
4ac0: 65 79 29 29 0a 09 09 09 09 09 09 09 20 28 74 65 ey))........ (te
4ad0: 73 74 2d 69 64 20 20 28 64 62 3a 74 65 73 74 2d st-id (db:test-
4ae0: 67 65 74 2d 69 64 20 28 76 65 63 74 6f 72 2d 72 get-id (vector-r
4af0: 65 66 20 62 75 74 74 6e 64 61 74 20 33 29 29 29 ef buttndat 3)))
4b00: 0a 09 09 09 09 09 09 09 20 28 63 6d 64 20 20 28 ........ (cmd (
4b10: 63 6f 6e 63 20 74 6f 6f 6c 70 61 74 68 20 22 20 conc toolpath "
4b20: 2d 74 65 73 74 20 22 20 74 65 73 74 2d 69 64 20 -test " test-id
4b30: 22 26 22 29 29 29 0a 09 09 09 09 09 09 20 20 20 "&"))).......
4b40: 20 3b 28 70 72 69 6e 74 20 22 4c 61 75 6e 63 68 ;(print "Launch
4b50: 69 6e 67 20 22 20 63 6d 64 29 0a 09 09 09 09 09 ing " cmd)......
4b60: 09 20 20 20 20 28 73 79 73 74 65 6d 20 63 6d 64 . (system cmd
4b70: 29 29 29 29 29 29 0a 09 20 20 28 68 61 73 68 2d )))))).. (hash-
4b80: 74 61 62 6c 65 2d 73 65 74 21 20 2a 62 75 74 74 table-set! *butt
4b90: 6f 6e 64 61 74 2a 20 62 75 74 74 6f 6e 2d 6b 65 ondat* button-ke
4ba0: 79 20 28 76 65 63 74 6f 72 20 30 20 22 31 30 30 y (vector 0 "100
4bb0: 20 31 30 30 20 31 30 30 22 20 62 75 74 74 6f 6e 100 100" button
4bc0: 2d 6b 65 79 20 23 66 20 23 66 29 29 20 0a 09 20 -key #f #f)) ..
4bd0: 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 74 65 (vector-set! te
4be0: 73 74 76 65 63 20 74 65 73 74 6e 75 6d 20 62 75 stvec testnum bu
4bf0: 74 6e 29 0a 09 20 20 28 6c 6f 6f 70 20 72 75 6e tn).. (loop run
4c00: 6e 75 6d 20 28 2b 20 74 65 73 74 6e 75 6d 20 31 num (+ testnum 1
4c10: 29 20 74 65 73 74 76 65 63 20 28 63 6f 6e 73 20 ) testvec (cons
4c20: 62 75 74 6e 20 72 65 73 29 29 29 29 29 29 0a 20 butn res)))))).
4c30: 20 20 20 3b 3b 20 6e 6f 77 20 61 73 73 65 6d 62 ;; now assemb
4c40: 6c 65 20 74 68 65 20 68 64 72 6c 73 74 20 61 6e le the hdrlst an
4c50: 64 20 62 64 79 6c 73 74 20 61 6e 64 20 6b 69 63 d bdylst and kic
4c60: 6b 20 6f 66 66 20 74 68 65 20 64 69 61 6c 6f 67 k off the dialog
4c70: 0a 20 20 20 20 28 69 75 70 3a 73 68 6f 77 0a 20 . (iup:show.
4c80: 20 20 20 20 28 69 75 70 3a 64 69 61 6c 6f 67 20 (iup:dialog
4c90: 0a 20 20 20 20 20 20 23 3a 74 69 74 6c 65 20 22 . #:title "
4ca0: 4d 65 67 61 74 65 73 74 20 64 61 73 68 62 6f 61 Megatest dashboa
4cb0: 72 64 22 0a 20 20 20 20 20 20 28 69 75 70 3a 76 rd". (iup:v
4cc0: 62 6f 78 0a 09 28 61 70 70 6c 79 20 69 75 70 3a box..(apply iup:
4cd0: 68 62 6f 78 20 0a 09 20 20 20 20 20 20 20 28 63 hbox .. (c
4ce0: 6f 6e 73 20 28 61 70 70 6c 79 20 69 75 70 3a 76 ons (apply iup:v
4cf0: 62 6f 78 20 6c 66 74 6c 73 74 29 0a 09 09 20 20 box lftlst)...
4d00: 20 20 20 28 6c 69 73 74 20 0a 09 09 20 20 20 20 (list ...
4d10: 20 20 28 69 75 70 3a 76 62 6f 78 0a 09 09 20 20 (iup:vbox...
4d20: 20 20 20 20 20 3b 3b 20 74 68 65 20 68 65 61 64 ;; the head
4d30: 65 72 0a 09 09 20 20 20 20 20 20 20 28 61 70 70 er... (app
4d40: 6c 79 20 69 75 70 3a 68 62 6f 78 20 28 72 65 76 ly iup:hbox (rev
4d50: 65 72 73 65 20 68 64 72 6c 73 74 29 29 0a 09 09 erse hdrlst))...
4d60: 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 69 75 (apply iu
4d70: 70 3a 68 62 6f 78 20 28 72 65 76 65 72 73 65 20 p:hbox (reverse
4d80: 62 64 79 6c 73 74 29 29 29 29 29 29 0a 20 20 20 bdylst)))))).
4d90: 20 20 20 20 63 6f 6e 74 72 6f 6c 73 29 29 29 0a controls))).
4da0: 20 20 20 20 28 76 65 63 74 6f 72 20 6c 66 74 63 (vector lftc
4db0: 6f 6c 20 68 65 61 64 65 72 20 72 75 6e 73 76 65 ol header runsve
4dc0: 63 29 29 29 0a 0a 28 69 66 20 28 6f 72 20 28 61 c)))..(if (or (a
4dd0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 6f rgs:get-arg "-ro
4de0: 77 73 22 29 0a 09 28 67 65 74 2d 65 6e 76 69 72 ws")..(get-envir
4df0: 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 onment-variable
4e00: 22 44 41 53 48 42 4f 41 52 44 52 4f 57 53 22 20 "DASHBOARDROWS"
4e10: 29 29 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 )). (begin.
4e20: 20 20 20 20 20 20 28 73 65 74 21 20 2a 6e 75 6d (set! *num
4e30: 2d 74 65 73 74 73 2a 20 28 73 74 72 69 6e 67 2d -tests* (string-
4e40: 3e 6e 75 6d 62 65 72 20 28 6f 72 20 28 61 72 67 >number (or (arg
4e50: 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 6f 77 73 s:get-arg "-rows
4e60: 22 29 0a 09 09 09 09 09 20 20 20 20 20 20 28 67 ")...... (g
4e70: 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 et-environment-v
4e80: 61 72 69 61 62 6c 65 20 22 44 41 53 48 42 4f 41 ariable "DASHBOA
4e90: 52 44 52 4f 57 53 22 29 29 29 29 0a 09 28 75 70 RDROWS"))))..(up
4ea0: 64 61 74 65 2d 72 75 6e 64 61 74 20 22 25 22 20 date-rundat "%"
4eb0: 2a 6e 75 6d 2d 72 75 6e 73 2a 20 22 25 22 20 22 *num-runs* "%" "
4ec0: 25 22 20 27 28 29 29 29 0a 20 20 20 20 28 73 65 %" '())). (se
4ed0: 74 21 20 2a 6e 75 6d 2d 74 65 73 74 73 2a 20 28 t! *num-tests* (
4ee0: 6d 69 6e 20 28 6d 61 78 20 28 75 70 64 61 74 65 min (max (update
4ef0: 2d 72 75 6e 64 61 74 20 22 25 22 20 2a 6e 75 6d -rundat "%" *num
4f00: 2d 72 75 6e 73 2a 20 22 25 22 20 22 25 22 20 27 -runs* "%" "%" '
4f10: 28 29 29 20 38 29 20 32 30 29 29 29 0a 0a 28 64 ()) 8) 20)))..(d
4f20: 65 66 69 6e 65 20 2a 74 69 6d 2a 20 28 69 75 70 efine *tim* (iup
4f30: 3a 74 69 6d 65 72 29 29 0a 28 64 65 66 69 6e 65 :timer)).(define
4f40: 20 2a 6f 72 64 2a 20 23 66 29 0a 28 69 75 70 3a *ord* #f).(iup:
4f50: 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 2a attribute-set! *
4f60: 74 69 6d 2a 20 22 54 49 4d 45 22 20 33 30 30 29 tim* "TIME" 300)
4f70: 0a 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d .(iup:attribute-
4f80: 73 65 74 21 20 2a 74 69 6d 2a 20 22 52 55 4e 22 set! *tim* "RUN"
4f90: 20 22 59 45 53 22 29 0a 0a 3b 3b 20 4d 6f 76 65 "YES")..;; Move
4fa0: 20 74 68 69 73 20 73 74 75 66 66 20 74 6f 20 64 this stuff to d
4fb0: 62 2e 73 63 6d 20 46 49 58 4d 45 0a 3b 3b 0a 28 b.scm FIXME.;;.(
4fc0: 64 65 66 69 6e 65 20 2a 6c 61 73 74 2d 64 62 2d define *last-db-
4fd0: 75 70 64 61 74 65 2d 74 69 6d 65 2a 20 28 66 69 update-time* (fi
4fe0: 6c 65 2d 6d 6f 64 69 66 69 63 61 74 69 6f 6e 2d le-modification-
4ff0: 74 69 6d 65 20 28 63 6f 6e 63 20 2a 74 6f 70 70 time (conc *topp
5000: 61 74 68 2a 20 22 2f 6d 65 67 61 74 65 73 74 2e ath* "/megatest.
5010: 64 62 22 29 29 29 0a 28 64 65 66 69 6e 65 20 28 db"))).(define (
5020: 64 62 3a 62 65 65 6e 2d 63 68 61 6e 67 65 64 29 db:been-changed)
5030: 0a 20 20 28 3e 20 28 66 69 6c 65 2d 6d 6f 64 69 . (> (file-modi
5040: 66 69 63 61 74 69 6f 6e 2d 74 69 6d 65 20 28 63 fication-time (c
5050: 6f 6e 63 20 2a 74 6f 70 70 61 74 68 2a 20 22 2f onc *toppath* "/
5060: 6d 65 67 61 74 65 73 74 2e 64 62 22 29 29 20 2a megatest.db")) *
5070: 6c 61 73 74 2d 64 62 2d 75 70 64 61 74 65 2d 74 last-db-update-t
5080: 69 6d 65 2a 29 29 0a 28 64 65 66 69 6e 65 20 28 ime*)).(define (
5090: 64 62 3a 73 65 74 2d 64 62 2d 75 70 64 61 74 65 db:set-db-update
50a0: 2d 74 69 6d 65 29 0a 20 20 28 73 65 74 21 20 2a -time). (set! *
50b0: 6c 61 73 74 2d 64 62 2d 75 70 64 61 74 65 2d 74 last-db-update-t
50c0: 69 6d 65 2a 20 28 66 69 6c 65 2d 6d 6f 64 69 66 ime* (file-modif
50d0: 69 63 61 74 69 6f 6e 2d 74 69 6d 65 20 28 63 6f ication-time (co
50e0: 6e 63 20 2a 74 6f 70 70 61 74 68 2a 20 22 2f 6d nc *toppath* "/m
50f0: 65 67 61 74 65 73 74 2e 64 62 22 29 29 29 29 0a egatest.db")))).
5100: 0a 28 64 65 66 69 6e 65 20 28 72 75 6e 2d 75 70 .(define (run-up
5110: 64 61 74 65 20 78 29 0a 20 20 28 75 70 64 61 74 date x). (updat
5120: 65 2d 62 75 74 74 6f 6e 73 20 75 69 64 61 74 20 e-buttons uidat
5130: 2a 6e 75 6d 2d 72 75 6e 73 2a 20 2a 6e 75 6d 2d *num-runs* *num-
5140: 74 65 73 74 73 2a 29 0a 20 20 3b 3b 20 28 69 66 tests*). ;; (if
5150: 20 28 64 62 3a 62 65 65 6e 2d 63 68 61 6e 67 65 (db:been-change
5160: 64 29 0a 20 20 28 62 65 67 69 6e 0a 20 20 20 20 d). (begin.
5170: 28 75 70 64 61 74 65 2d 72 75 6e 64 61 74 20 28 (update-rundat (
5180: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 hash-table-ref/d
5190: 65 66 61 75 6c 74 20 2a 73 65 61 72 63 68 70 61 efault *searchpa
51a0: 74 74 73 2a 20 22 72 75 6e 6e 61 6d 65 22 20 22 tts* "runname" "
51b0: 25 22 29 20 2a 6e 75 6d 2d 72 75 6e 73 2a 0a 09 %") *num-runs*..
51c0: 09 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d . (hash-table-
51d0: 72 65 66 2f 64 65 66 61 75 6c 74 20 2a 73 65 61 ref/default *sea
51e0: 72 63 68 70 61 74 74 73 2a 20 22 74 65 73 74 2d rchpatts* "test-
51f0: 6e 61 6d 65 22 20 22 25 22 29 0a 09 09 20 20 20 name" "%")...
5200: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f (hash-table-ref/
5210: 64 65 66 61 75 6c 74 20 2a 73 65 61 72 63 68 70 default *searchp
5220: 61 74 74 73 2a 20 22 69 74 65 6d 2d 6e 61 6d 65 atts* "item-name
5230: 22 20 22 25 22 29 0a 09 09 20 20 20 28 6c 65 74 " "%")... (let
5240: 20 28 28 72 65 73 20 27 28 29 29 29 0a 09 09 20 ((res '()))...
5250: 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c (for-each (l
5260: 61 6d 62 64 61 20 28 6b 65 79 29 0a 09 09 09 09 ambda (key).....
5270: 20 28 6c 65 74 20 28 28 76 61 6c 20 28 68 61 73 (let ((val (has
5280: 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 h-table-ref/defa
5290: 75 6c 74 20 2a 73 65 61 72 63 68 70 61 74 74 73 ult *searchpatts
52a0: 2a 20 6b 65 79 20 23 66 29 29 29 0a 09 09 09 09 * key #f))).....
52b0: 20 20 20 28 69 66 20 76 61 6c 20 28 73 65 74 21 (if val (set!
52c0: 20 72 65 73 20 28 63 6f 6e 73 20 28 6c 69 73 74 res (cons (list
52d0: 20 6b 65 79 20 76 61 6c 29 20 72 65 73 29 29 29 key val) res)))
52e0: 29 29 0a 09 09 09 20 20 20 20 20 20 20 2a 64 62 )).... *db
52f0: 6b 65 79 73 2a 29 0a 09 09 20 20 20 20 20 72 65 keys*)... re
5300: 73 29 29 0a 20 20 20 20 3b 20 28 64 62 3a 73 65 s)). ; (db:se
5310: 74 2d 64 62 2d 75 70 64 61 74 65 2d 74 69 6d 65 t-db-update-time
5320: 29 0a 20 20 20 20 29 29 0a 0a 28 63 6f 6e 64 20 ). ))..(cond
5330: 0a 20 28 28 61 72 67 73 3a 67 65 74 2d 61 72 67 . ((args:get-arg
5340: 20 22 2d 72 75 6e 22 29 0a 20 20 28 6c 65 74 20 "-run"). (let
5350: 28 28 72 75 6e 69 64 20 28 73 74 72 69 6e 67 2d ((runid (string-
5360: 3e 6e 75 6d 62 65 72 20 28 61 72 67 73 3a 67 65 >number (args:ge
5370: 74 2d 61 72 67 20 22 2d 72 75 6e 22 29 29 29 29 t-arg "-run"))))
5380: 0a 20 20 20 20 28 69 66 20 72 75 6e 69 64 0a 09 . (if runid..
5390: 28 62 65 67 69 6e 0a 09 20 20 28 6c 61 6d 62 64 (begin.. (lambd
53a0: 61 20 28 78 29 0a 09 20 20 20 20 28 6f 6e 2d 65 a (x).. (on-e
53b0: 78 69 74 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 xit (lambda ()..
53c0: 09 20 20 20 20 20 20 20 28 73 71 6c 69 74 65 33 . (sqlite3
53d0: 3a 66 69 6e 61 6c 69 7a 65 21 20 2a 64 62 2a 29 :finalize! *db*)
53e0: 29 29 0a 09 20 20 20 20 28 65 78 61 6d 69 6e 65 )).. (examine
53f0: 2d 72 75 6e 20 2a 64 62 2a 20 72 75 6e 69 64 29 -run *db* runid)
5400: 29 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 70 ))..(begin.. (p
5410: 72 69 6e 74 20 22 45 52 52 4f 52 3a 20 72 75 6e rint "ERROR: run
5420: 69 64 20 69 73 20 6e 6f 74 20 61 20 6e 75 6d 62 id is not a numb
5430: 65 72 20 22 20 28 61 72 67 73 3a 67 65 74 2d 61 er " (args:get-a
5440: 72 67 20 22 2d 72 75 6e 22 29 29 0a 09 20 20 28 rg "-run")).. (
5450: 65 78 69 74 20 31 29 29 29 29 29 0a 20 28 28 61 exit 1))))). ((a
5460: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 rgs:get-arg "-te
5470: 73 74 22 29 0a 20 20 20 20 28 6c 65 74 20 28 28 st"). (let ((
5480: 74 65 73 74 69 64 20 28 73 74 72 69 6e 67 2d 3e testid (string->
5490: 6e 75 6d 62 65 72 20 28 61 72 67 73 3a 67 65 74 number (args:get
54a0: 2d 61 72 67 20 22 2d 74 65 73 74 22 29 29 29 29 -arg "-test"))))
54b0: 0a 20 20 20 20 28 69 66 20 74 65 73 74 69 64 0a . (if testid.
54c0: 09 28 65 78 61 6d 69 6e 65 2d 74 65 73 74 20 2a .(examine-test *
54d0: 64 62 2a 20 74 65 73 74 69 64 29 0a 09 28 62 65 db* testid)..(be
54e0: 67 69 6e 0a 09 20 20 28 70 72 69 6e 74 20 22 45 gin.. (print "E
54f0: 52 52 4f 52 3a 20 74 65 73 74 69 64 20 69 73 20 RROR: testid is
5500: 6e 6f 74 20 61 20 6e 75 6d 62 65 72 20 22 20 28 not a number " (
5510: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 args:get-arg "-t
5520: 65 73 74 22 29 29 0a 09 20 20 28 65 78 69 74 20 est")).. (exit
5530: 31 29 29 29 29 29 0a 20 28 65 6c 73 65 0a 20 20 1))))). (else.
5540: 28 73 65 74 21 20 75 69 64 61 74 20 28 6d 61 6b (set! uidat (mak
5550: 65 2d 64 61 73 68 62 6f 61 72 64 2d 62 75 74 74 e-dashboard-butt
5560: 6f 6e 73 20 2a 6e 75 6d 2d 72 75 6e 73 2a 20 2a ons *num-runs* *
5570: 6e 75 6d 2d 74 65 73 74 73 2a 20 2a 64 62 6b 65 num-tests* *dbke
5580: 79 73 2a 29 29 0a 20 20 28 69 75 70 3a 63 61 6c ys*)). (iup:cal
5590: 6c 62 61 63 6b 2d 73 65 74 21 20 2a 74 69 6d 2a lback-set! *tim*
55a0: 0a 09 09 20 20 20 20 20 22 41 43 54 49 4f 4e 5f ... "ACTION_
55b0: 43 42 22 0a 09 09 20 20 20 20 20 28 6c 61 6d 62 CB"... (lamb
55c0: 64 61 20 28 78 29 0a 09 09 20 20 20 20 20 20 20 da (x)...
55d0: 28 72 75 6e 2d 75 70 64 61 74 65 20 78 29 29 29 (run-update x)))
55e0: 29 29 0a 09 09 20 20 20 20 20 20 20 3b 28 70 72 ))... ;(pr
55f0: 69 6e 74 20 78 29 29 29 29 29 0a 0a 28 69 75 70 int x)))))..(iup
5600: 3a 6d 61 69 6e 2d 6c 6f 6f 70 29 0a :main-loop).