Artifact
78b39d96f4f5940ff6a2d9747feea4ce8d73555a
File
dashboard.scm
— part of check-in
[b06b51df8d]
at
2012-03-01 22:49:21
on branch servermode
— Run server mode as part of -run*
(user:
matt
size: 24286)
[more...]
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 64 61 73 68 62 6f 61 72 64 (uses dashboard
0390: 2d 67 75 69 6d 6f 6e 69 74 6f 72 29 29 0a 28 64 -guimonitor)).(d
03a0: 65 63 6c 61 72 65 20 28 75 73 65 73 20 64 61 73 eclare (uses das
03b0: 68 62 6f 61 72 64 2d 6d 61 69 6e 29 29 0a 28 64 hboard-main)).(d
03c0: 65 63 6c 61 72 65 20 28 75 73 65 73 20 6d 65 67 eclare (uses meg
03d0: 61 74 65 73 74 2d 76 65 72 73 69 6f 6e 29 29 0a atest-version)).
03e0: 0a 28 69 6e 63 6c 75 64 65 20 22 63 6f 6d 6d 6f .(include "commo
03f0: 6e 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 29 0a n_records.scm").
0400: 28 69 6e 63 6c 75 64 65 20 22 64 62 5f 72 65 63 (include "db_rec
0410: 6f 72 64 73 2e 73 63 6d 22 29 0a 28 69 6e 63 6c ords.scm").(incl
0420: 75 64 65 20 22 72 75 6e 5f 72 65 63 6f 72 64 73 ude "run_records
0430: 2e 73 63 6d 22 29 0a 0a 28 64 65 66 69 6e 65 20 .scm")..(define
0440: 68 65 6c 70 20 28 63 6f 6e 63 20 0a 22 4d 65 67 help (conc ."Meg
0450: 61 74 65 73 74 20 44 61 73 68 62 6f 61 72 64 2c atest Dashboard,
0460: 20 64 6f 63 75 6d 65 6e 74 61 74 69 6f 6e 20 61 documentation a
0470: 74 20 68 74 74 70 3a 2f 2f 77 77 77 2e 6b 69 61 t http://www.kia
0480: 74 6f 61 2e 63 6f 6d 2f 66 6f 73 73 69 6c 73 2f toa.com/fossils/
0490: 6d 65 67 61 74 65 73 74 0a 20 20 76 65 72 73 69 megatest. versi
04a0: 6f 6e 20 22 20 6d 65 67 61 74 65 73 74 2d 76 65 on " megatest-ve
04b0: 72 73 69 6f 6e 20 22 0a 20 20 6c 69 63 65 6e 73 rsion ". licens
04c0: 65 20 47 50 4c 2c 20 43 6f 70 79 72 69 67 68 74 e GPL, Copyright
04d0: 20 28 43 29 20 4d 61 74 74 20 57 65 6c 6c 61 6e (C) Matt Wellan
04e0: 64 20 32 30 31 31 0a 0a 55 73 61 67 65 3a 20 64 d 2011..Usage: d
04f0: 61 73 68 62 6f 61 72 64 20 5b 6f 70 74 69 6f 6e ashboard [option
0500: 73 5d 0a 20 20 2d 68 20 20 20 20 20 20 20 20 20 s]. -h
0510: 20 20 20 20 20 3a 20 74 68 69 73 20 68 65 6c 70 : this help
0520: 0a 20 20 2d 74 65 73 74 20 74 65 73 74 69 64 20 . -test testid
0530: 20 20 20 3a 20 63 6f 6e 74 72 6f 6c 20 74 65 73 : control tes
0540: 74 20 69 64 65 6e 74 69 66 69 65 64 20 62 79 20 t identified by
0550: 74 65 73 74 69 64 0a 20 20 2d 67 75 69 6d 6f 6e testid. -guimon
0560: 69 74 6f 72 20 20 20 20 20 3a 20 63 6f 6e 74 72 itor : contr
0570: 6f 6c 20 70 61 6e 65 6c 20 66 6f 72 20 72 75 6e ol panel for run
0580: 73 0a 0a 4d 69 73 63 0a 20 20 2d 72 6f 77 73 20 s..Misc. -rows
0590: 4e 20 20 20 20 20 20 20 20 20 3a 20 73 65 74 20 N : set
05a0: 6e 75 6d 62 65 72 20 6f 66 20 72 6f 77 73 0a 22 number of rows."
05b0: 29 29 0a 0a 3b 3b 20 70 72 6f 63 65 73 73 20 61 ))..;; process a
05c0: 72 67 73 0a 28 64 65 66 69 6e 65 20 72 65 6d 61 rgs.(define rema
05d0: 72 67 73 20 28 61 72 67 73 3a 67 65 74 2d 61 72 rgs (args:get-ar
05e0: 67 73 20 0a 09 09 20 28 61 72 67 76 29 0a 09 09 gs ... (argv)...
05f0: 20 28 6c 69 73 74 20 20 22 2d 72 6f 77 73 22 0a (list "-rows".
0600: 09 09 09 22 2d 72 75 6e 22 0a 09 09 09 22 2d 74 ..."-run"...."-t
0610: 65 73 74 22 0a 09 09 09 22 2d 64 65 62 75 67 22 est"...."-debug"
0620: 0a 09 09 09 29 20 0a 09 09 20 28 6c 69 73 74 20 ....) ... (list
0630: 20 22 2d 68 22 0a 09 09 09 22 2d 67 75 69 6d 6f "-h"...."-guimo
0640: 6e 69 74 6f 72 22 0a 09 09 09 22 2d 6d 61 69 6e nitor"...."-main
0650: 22 0a 09 09 09 22 2d 76 22 0a 09 09 09 22 2d 71 "...."-v"...."-q
0660: 22 0a 09 09 20 20 20 20 20 20 20 29 0a 09 09 20 "... )...
0670: 61 72 67 73 3a 61 72 67 2d 68 61 73 68 0a 09 09 args:arg-hash...
0680: 20 30 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 0))..(if (args:
0690: 67 65 74 2d 61 72 67 20 22 2d 68 22 29 0a 20 20 get-arg "-h").
06a0: 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 (begin. (
06b0: 70 72 69 6e 74 20 68 65 6c 70 29 0a 20 20 20 20 print help).
06c0: 20 20 28 65 78 69 74 29 29 29 0a 0a 28 69 66 20 (exit)))..(if
06d0: 28 6e 6f 74 20 28 73 65 74 75 70 2d 66 6f 72 2d (not (setup-for-
06e0: 72 75 6e 29 29 0a 20 20 20 20 28 62 65 67 69 6e run)). (begin
06f0: 0a 20 20 20 20 20 20 28 70 72 69 6e 74 20 22 46 . (print "F
0700: 61 69 6c 65 64 20 74 6f 20 66 69 6e 64 20 6d 65 ailed to find me
0710: 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 2c 20 65 gatest.config, e
0720: 78 69 74 69 6e 67 22 29 20 0a 20 20 20 20 20 20 xiting") .
0730: 28 65 78 69 74 20 31 29 29 29 0a 0a 28 64 65 66 (exit 1)))..(def
0740: 69 6e 65 20 2a 64 62 2a 20 28 6f 70 65 6e 2d 64 ine *db* (open-d
0750: 62 29 29 0a 0a 3b 3b 20 48 41 43 4b 20 41 4c 45 b))..;; HACK ALE
0760: 52 54 3a 20 74 68 69 73 20 69 73 20 61 20 68 61 RT: this is a ha
0770: 63 6b 2c 20 70 6c 65 61 73 65 20 66 69 78 2e 0a ck, please fix..
0780: 28 64 65 66 69 6e 65 20 2a 72 65 61 64 2d 6f 6e (define *read-on
0790: 6c 79 2a 20 28 6e 6f 74 20 28 66 69 6c 65 2d 72 ly* (not (file-r
07a0: 65 61 64 2d 61 63 63 65 73 73 3f 20 28 63 6f 6e ead-access? (con
07b0: 63 20 2a 74 6f 70 70 61 74 68 2a 20 22 2f 6d 65 c *toppath* "/me
07c0: 67 61 74 65 73 74 2e 64 62 22 29 29 29 29 0a 3b gatest.db")))).;
07d0: 3b 20 28 73 65 72 76 65 72 3a 63 6c 69 65 6e 74 ; (server:client
07e0: 2d 73 65 74 75 70 20 2a 64 62 2a 29 0a 0a 28 64 -setup *db*)..(d
07f0: 65 66 69 6e 65 20 74 6f 70 6c 65 76 65 6c 20 23 efine toplevel #
0800: 66 29 0a 28 64 65 66 69 6e 65 20 64 6c 67 20 20 f).(define dlg
0810: 20 20 20 20 23 66 29 0a 28 64 65 66 69 6e 65 20 #f).(define
0820: 6d 61 78 2d 74 65 73 74 2d 6e 75 6d 20 30 29 0a max-test-num 0).
0830: 28 64 65 66 69 6e 65 20 2a 6b 65 79 73 2a 20 20 (define *keys*
0840: 20 28 72 64 62 3a 67 65 74 2d 6b 65 79 73 20 20 (rdb:get-keys
0850: 2a 64 62 2a 29 29 0a 3b 3b 20 28 64 65 66 69 6e *db*)).;; (defin
0860: 65 20 2a 6b 65 79 73 2a 20 20 20 28 64 62 3a 67 e *keys* (db:g
0870: 65 74 2d 6b 65 79 73 20 20 20 2a 64 62 2a 29 29 et-keys *db*))
0880: 0a 28 64 65 66 69 6e 65 20 2a 64 62 6b 65 79 73 .(define *dbkeys
0890: 2a 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 * (map (lambda
08a0: 28 78 29 28 76 65 63 74 6f 72 2d 72 65 66 20 78 (x)(vector-ref x
08b0: 20 30 29 29 0a 09 09 20 20 20 20 20 20 28 61 70 0))... (ap
08c0: 70 65 6e 64 20 2a 6b 65 79 73 2a 20 28 6c 69 73 pend *keys* (lis
08d0: 74 20 28 76 65 63 74 6f 72 20 22 72 75 6e 6e 61 t (vector "runna
08e0: 6d 65 22 20 22 62 6c 61 68 22 29 29 29 29 29 0a me" "blah"))))).
08f0: 28 64 65 66 69 6e 65 20 2a 68 65 61 64 65 72 2a (define *header*
0900: 20 20 20 20 20 20 20 23 66 29 0a 28 64 65 66 69 #f).(defi
0910: 6e 65 20 2a 61 6c 6c 72 75 6e 73 2a 20 20 20 20 ne *allruns*
0920: 20 27 28 29 29 0a 28 64 65 66 69 6e 65 20 2a 62 '()).(define *b
0930: 75 74 74 6f 6e 64 61 74 2a 20 20 20 20 28 6d 61 uttondat* (ma
0940: 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 20 ke-hash-table))
0950: 3b 3b 20 3c 72 75 6e 2d 69 64 20 63 6f 6c 6f 72 ;; <run-id color
0960: 20 74 65 78 74 20 74 65 73 74 20 72 75 6e 2d 6b text test run-k
0970: 65 79 3e 0a 28 64 65 66 69 6e 65 20 2a 61 6c 6c ey>.(define *all
0980: 74 65 73 74 6e 61 6d 65 6c 73 74 2a 20 27 28 29 testnamelst* '()
0990: 29 0a 28 64 65 66 69 6e 65 20 2a 73 65 61 72 63 ).(define *searc
09a0: 68 70 61 74 74 73 2a 20 20 28 6d 61 6b 65 2d 68 hpatts* (make-h
09b0: 61 73 68 2d 74 61 62 6c 65 29 29 0a 28 64 65 66 ash-table)).(def
09c0: 69 6e 65 20 2a 6e 75 6d 2d 72 75 6e 73 2a 20 20 ine *num-runs*
09d0: 20 20 20 20 38 29 0a 28 64 65 66 69 6e 65 20 2a 8).(define *
09e0: 74 6f 74 2d 72 75 6e 2d 63 6f 75 6e 74 2a 20 28 tot-run-count* (
09f0: 72 64 62 3a 67 65 74 2d 6e 75 6d 2d 72 75 6e 73 rdb:get-num-runs
0a00: 20 2a 64 62 2a 20 22 25 22 29 29 0a 3b 3b 20 28 *db* "%")).;; (
0a10: 64 65 66 69 6e 65 20 2a 74 6f 74 2d 72 75 6e 2d define *tot-run-
0a20: 63 6f 75 6e 74 2a 20 28 64 62 3a 67 65 74 2d 6e count* (db:get-n
0a30: 75 6d 2d 72 75 6e 73 20 2a 64 62 2a 20 22 25 22 um-runs *db* "%"
0a40: 29 29 0a 28 64 65 66 69 6e 65 20 2a 6c 61 73 74 )).(define *last
0a50: 2d 75 70 64 61 74 65 2a 20 20 20 28 63 75 72 72 -update* (curr
0a60: 65 6e 74 2d 73 65 63 6f 6e 64 73 29 29 0a 28 64 ent-seconds)).(d
0a70: 65 66 69 6e 65 20 2a 6e 75 6d 2d 74 65 73 74 73 efine *num-tests
0a80: 2a 20 20 20 20 20 31 35 29 0a 28 64 65 66 69 6e * 15).(defin
0a90: 65 20 2a 73 74 61 72 74 2d 72 75 6e 2d 6f 66 66 e *start-run-off
0aa0: 73 65 74 2a 20 20 30 29 0a 28 64 65 66 69 6e 65 set* 0).(define
0ab0: 20 2a 73 74 61 72 74 2d 74 65 73 74 2d 6f 66 66 *start-test-off
0ac0: 73 65 74 2a 20 30 29 0a 28 64 65 66 69 6e 65 20 set* 0).(define
0ad0: 2a 65 78 61 6d 69 6e 65 2d 74 65 73 74 2d 64 61 *examine-test-da
0ae0: 74 2a 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 t* (make-hash-ta
0af0: 62 6c 65 29 29 0a 28 64 65 66 69 6e 65 20 2a 65 ble)).(define *e
0b00: 78 69 74 2d 73 74 61 72 74 65 64 2a 20 23 66 29 xit-started* #f)
0b10: 0a 28 64 65 66 69 6e 65 20 2a 73 74 61 74 75 73 .(define *status
0b20: 2d 69 67 6e 6f 72 65 2d 68 61 73 68 2a 20 28 6d -ignore-hash* (m
0b30: 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 ake-hash-table))
0b40: 0a 28 64 65 66 69 6e 65 20 2a 73 74 61 74 65 2d .(define *state-
0b50: 69 67 6e 6f 72 65 2d 68 61 73 68 2a 20 20 28 6d ignore-hash* (m
0b60: 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 ake-hash-table))
0b70: 0a 0a 28 64 65 66 69 6e 65 20 2a 6c 61 73 74 2d ..(define *last-
0b80: 64 62 2d 75 70 64 61 74 65 2d 74 69 6d 65 2a 20 db-update-time*
0b90: 30 29 0a 28 64 65 66 69 6e 65 20 2a 70 6c 65 61 0).(define *plea
0ba0: 73 65 2d 75 70 64 61 74 65 2d 62 75 74 74 6f 6e se-update-button
0bb0: 73 2a 20 23 74 29 0a 28 64 65 66 69 6e 65 20 2a s* #t).(define *
0bc0: 64 65 6c 61 79 65 64 2d 75 70 64 61 74 65 2a 20 delayed-update*
0bd0: 30 29 0a 0a 28 64 65 66 69 6e 65 20 2a 64 62 2d 0)..(define *db-
0be0: 66 69 6c 65 2d 70 61 74 68 2a 20 28 63 6f 6e 63 file-path* (conc
0bf0: 20 2a 74 6f 70 70 61 74 68 2a 20 22 2f 6d 65 67 *toppath* "/meg
0c00: 61 74 65 73 74 2e 64 62 22 29 29 0a 0a 28 64 65 atest.db"))..(de
0c10: 66 69 6e 65 20 2a 74 65 73 74 73 2d 73 6f 72 74 fine *tests-sort
0c20: 2d 72 65 76 65 72 73 65 2a 20 23 66 29 0a 28 64 -reverse* #f).(d
0c30: 65 66 69 6e 65 20 2a 68 69 64 65 2d 65 6d 70 74 efine *hide-empt
0c40: 79 2d 72 75 6e 73 2a 20 23 66 29 0a 0a 28 64 65 y-runs* #f)..(de
0c50: 66 69 6e 65 20 2a 76 65 72 62 6f 73 69 74 79 2a fine *verbosity*
0c60: 20 28 63 6f 6e 64 0a 09 09 20 20 20 20 20 28 28 (cond... ((
0c70: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 args:get-arg "-d
0c80: 65 62 75 67 22 29 28 73 74 72 69 6e 67 2d 3e 6e ebug")(string->n
0c90: 75 6d 62 65 72 20 28 61 72 67 73 3a 67 65 74 2d umber (args:get-
0ca0: 61 72 67 20 22 2d 64 65 62 75 67 22 29 29 29 0a arg "-debug"))).
0cb0: 09 09 20 20 20 20 20 28 28 61 72 67 73 3a 67 65 .. ((args:ge
0cc0: 74 2d 61 72 67 20 22 2d 76 22 29 20 20 20 20 32 t-arg "-v") 2
0cd0: 29 0a 09 09 20 20 20 20 20 28 28 61 72 67 73 3a )... ((args:
0ce0: 67 65 74 2d 61 72 67 20 22 2d 71 22 29 20 20 20 get-arg "-q")
0cf0: 20 30 29 0a 09 09 20 20 20 20 20 28 65 6c 73 65 0)... (else
0d00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0d10: 20 20 20 31 29 29 29 0a 0a 28 64 65 66 69 6e 65 1)))..(define
0d20: 20 75 69 64 61 74 20 23 66 29 0a 0a 28 64 65 66 uidat #f)..(def
0d30: 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 64 62 6f 61 ine-inline (dboa
0d40: 72 64 3a 75 69 64 61 74 2d 67 65 74 2d 6b 65 79 rd:uidat-get-key
0d50: 63 6f 6c 20 20 76 65 63 29 28 76 65 63 74 6f 72 col vec)(vector
0d60: 2d 72 65 66 20 76 65 63 20 30 29 29 0a 28 64 65 -ref vec 0)).(de
0d70: 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 64 62 6f fine-inline (dbo
0d80: 61 72 64 3a 75 69 64 61 74 2d 67 65 74 2d 6c 66 ard:uidat-get-lf
0d90: 74 63 6f 6c 20 20 76 65 63 29 28 76 65 63 74 6f tcol vec)(vecto
0da0: 72 2d 72 65 66 20 76 65 63 20 31 29 29 0a 28 64 r-ref vec 1)).(d
0db0: 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 64 62 efine-inline (db
0dc0: 6f 61 72 64 3a 75 69 64 61 74 2d 67 65 74 2d 68 oard:uidat-get-h
0dd0: 65 61 64 65 72 20 20 76 65 63 29 28 76 65 63 74 eader vec)(vect
0de0: 6f 72 2d 72 65 66 20 76 65 63 20 32 29 29 0a 28 or-ref vec 2)).(
0df0: 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 64 define-inline (d
0e00: 62 6f 61 72 64 3a 75 69 64 61 74 2d 67 65 74 2d board:uidat-get-
0e10: 72 75 6e 73 76 65 63 20 76 65 63 29 28 76 65 63 runsvec vec)(vec
0e20: 74 6f 72 2d 72 65 66 20 76 65 63 20 33 29 29 0a tor-ref vec 3)).
0e30: 0a 0a 28 64 65 66 69 6e 65 20 28 6d 65 73 73 61 ..(define (messa
0e40: 67 65 2d 77 69 6e 64 6f 77 20 6d 73 67 29 0a 20 ge-window msg).
0e50: 20 28 69 75 70 3a 73 68 6f 77 0a 20 20 20 28 69 (iup:show. (i
0e60: 75 70 3a 64 69 61 6c 6f 67 0a 20 20 20 20 28 69 up:dialog. (i
0e70: 75 70 3a 76 62 6f 78 20 0a 20 20 20 20 20 28 69 up:vbox . (i
0e80: 75 70 3a 6c 61 62 65 6c 20 6d 73 67 20 23 3a 6d up:label msg #:m
0e90: 61 72 67 69 6e 20 22 34 30 78 34 30 22 29 29 29 argin "40x40")))
0ea0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 69 75 70 ))..(define (iup
0eb0: 6c 69 73 74 62 6f 78 2d 66 69 6c 6c 2d 6c 69 73 listbox-fill-lis
0ec0: 74 20 6c 62 20 69 74 65 6d 73 20 2e 20 64 65 66 t lb items . def
0ed0: 61 75 6c 74 29 0a 20 20 28 6c 65 74 20 28 28 69 ault). (let ((i
0ee0: 20 31 29 0a 09 28 73 65 6c 65 63 74 65 64 2d 69 1)..(selected-i
0ef0: 74 65 6d 20 28 69 66 20 28 6e 75 6c 6c 3f 20 64 tem (if (null? d
0f00: 65 66 61 75 6c 74 29 20 23 66 20 28 63 61 72 20 efault) #f (car
0f10: 64 65 66 61 75 6c 74 29 29 29 29 0a 20 20 20 20 default)))).
0f20: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 (iup:attribute-s
0f30: 65 74 21 20 6c 62 20 22 56 41 4c 55 45 22 20 28 et! lb "VALUE" (
0f40: 69 66 20 73 65 6c 65 63 74 65 64 2d 69 74 65 6d if selected-item
0f50: 20 73 65 6c 65 63 74 65 64 2d 69 74 65 6d 20 22 selected-item "
0f60: 22 29 29 0a 20 20 20 20 28 66 6f 72 2d 65 61 63 ")). (for-eac
0f70: 68 20 28 6c 61 6d 62 64 61 20 28 69 74 65 6d 29 h (lambda (item)
0f80: 0a 09 09 28 69 75 70 3a 61 74 74 72 69 62 75 74 ...(iup:attribut
0f90: 65 2d 73 65 74 21 20 6c 62 20 28 6e 75 6d 62 65 e-set! lb (numbe
0fa0: 72 2d 3e 73 74 72 69 6e 67 20 69 29 20 69 74 65 r->string i) ite
0fb0: 6d 29 0a 09 09 28 69 66 20 73 65 6c 65 63 74 65 m)...(if selecte
0fc0: 64 2d 69 74 65 6d 0a 09 09 20 20 20 20 28 69 66 d-item... (if
0fd0: 20 28 65 71 75 61 6c 3f 20 73 65 6c 65 63 74 65 (equal? selecte
0fe0: 64 2d 69 74 65 6d 20 69 74 65 6d 29 0a 09 09 09 d-item item)....
0ff0: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 (iup:attribute-s
1000: 65 74 21 20 6c 62 20 22 56 41 4c 55 45 22 20 69 et! lb "VALUE" i
1010: 74 65 6d 29 29 29 20 3b 3b 20 28 6e 75 6d 62 65 tem))) ;; (numbe
1020: 72 2d 3e 73 74 72 69 6e 67 20 69 29 29 29 29 0a r->string i)))).
1030: 09 09 28 73 65 74 21 20 69 20 28 2b 20 69 20 31 ..(set! i (+ i 1
1040: 29 29 29 0a 09 20 20 20 20 20 20 69 74 65 6d 73 ))).. items
1050: 29 0a 20 20 20 20 69 29 29 0a 0a 28 64 65 66 69 ). i))..(defi
1060: 6e 65 20 28 70 61 64 2d 6c 69 73 74 20 6c 20 6e ne (pad-list l n
1070: 29 28 61 70 70 65 6e 64 20 6c 20 28 6d 61 6b 65 )(append l (make
1080: 2d 6c 69 73 74 20 28 2d 20 6e 20 28 6c 65 6e 67 -list (- n (leng
1090: 74 68 20 6c 29 29 29 29 29 0a 0a 28 64 65 66 69 th l)))))..(defi
10a0: 6e 65 20 28 63 6f 6c 6f 72 73 2d 73 69 6d 69 6c ne (colors-simil
10b0: 61 72 3f 20 63 6f 6c 6f 72 31 20 63 6f 6c 6f 72 ar? color1 color
10c0: 32 29 0a 20 20 28 6c 65 74 2a 20 28 28 63 31 20 2). (let* ((c1
10d0: 28 6d 61 70 20 73 74 72 69 6e 67 2d 3e 6e 75 6d (map string->num
10e0: 62 65 72 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 ber (string-spli
10f0: 74 20 63 6f 6c 6f 72 31 29 29 29 0a 09 20 28 63 t color1))).. (c
1100: 32 20 28 6d 61 70 20 73 74 72 69 6e 67 2d 3e 6e 2 (map string->n
1110: 75 6d 62 65 72 20 28 73 74 72 69 6e 67 2d 73 70 umber (string-sp
1120: 6c 69 74 20 63 6f 6c 6f 72 32 29 29 29 0a 09 20 lit color2)))..
1130: 28 64 65 6c 74 61 20 28 6d 61 70 20 28 6c 61 6d (delta (map (lam
1140: 62 64 61 20 28 61 20 62 29 28 61 62 73 20 28 2d bda (a b)(abs (-
1150: 20 61 20 62 29 29 29 20 63 31 20 63 32 29 29 29 a b))) c1 c2)))
1160: 0a 20 20 20 20 28 6e 75 6c 6c 3f 20 28 66 69 6c . (null? (fil
1170: 74 65 72 20 28 6c 61 6d 62 64 61 20 28 78 29 28 ter (lambda (x)(
1180: 3e 20 78 20 33 29 29 20 64 65 6c 74 61 29 29 29 > x 3)) delta)))
1190: 29 0a 0a 3b 3b 20 6b 65 79 70 61 74 74 73 3a 20 )..;; keypatts:
11a0: 28 20 28 4b 45 59 31 20 22 61 62 63 25 64 65 66 ( (KEY1 "abc%def
11b0: 22 29 28 4b 45 59 32 20 22 25 22 29 20 29 0a 28 ")(KEY2 "%") ).(
11c0: 64 65 66 69 6e 65 20 28 75 70 64 61 74 65 2d 72 define (update-r
11d0: 75 6e 64 61 74 20 72 75 6e 6e 61 6d 65 70 61 74 undat runnamepat
11e0: 74 20 6e 75 6d 72 75 6e 73 20 74 65 73 74 6e 61 t numruns testna
11f0: 6d 65 70 61 74 74 20 69 74 65 6d 6e 61 6d 65 70 mepatt itemnamep
1200: 61 74 74 20 6b 65 79 70 61 74 74 73 29 0a 20 20 att keypatts).
1210: 28 6c 65 74 20 28 28 6d 6f 64 74 69 6d 65 20 28 (let ((modtime (
1220: 66 69 6c 65 2d 6d 6f 64 69 66 69 63 61 74 69 6f file-modificatio
1230: 6e 2d 74 69 6d 65 20 2a 64 62 2d 66 69 6c 65 2d n-time *db-file-
1240: 70 61 74 68 2a 29 29 29 0a 20 20 20 20 28 69 66 path*))). (if
1250: 20 28 6f 72 20 28 61 6e 64 20 28 3e 20 6d 6f 64 (or (and (> mod
1260: 74 69 6d 65 20 2a 6c 61 73 74 2d 64 62 2d 75 70 time *last-db-up
1270: 64 61 74 65 2d 74 69 6d 65 2a 29 0a 09 09 20 28 date-time*)... (
1280: 3e 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e > (current-secon
1290: 64 73 29 28 2b 20 2a 6c 61 73 74 2d 64 62 2d 75 ds)(+ *last-db-u
12a0: 70 64 61 74 65 2d 74 69 6d 65 2a 20 35 29 29 29 pdate-time* 5)))
12b0: 0a 09 20 20 20 20 28 3e 20 2a 64 65 6c 61 79 65 .. (> *delaye
12c0: 64 2d 75 70 64 61 74 65 2a 20 30 29 29 0a 09 28 d-update* 0))..(
12d0: 62 65 67 69 6e 0a 09 20 20 28 73 65 74 21 20 2a begin.. (set! *
12e0: 70 6c 65 61 73 65 2d 75 70 64 61 74 65 2d 62 75 please-update-bu
12f0: 74 74 6f 6e 73 2a 20 23 74 29 0a 09 20 20 28 73 ttons* #t).. (s
1300: 65 74 21 20 2a 6c 61 73 74 2d 64 62 2d 75 70 64 et! *last-db-upd
1310: 61 74 65 2d 74 69 6d 65 2a 20 6d 6f 64 74 69 6d ate-time* modtim
1320: 65 29 0a 09 20 20 28 73 65 74 21 20 2a 64 65 6c e).. (set! *del
1330: 61 79 65 64 2d 75 70 64 61 74 65 2a 20 28 2d 20 ayed-update* (-
1340: 2a 64 65 6c 61 79 65 64 2d 75 70 64 61 74 65 2a *delayed-update*
1350: 20 31 29 29 0a 09 20 20 28 6c 65 74 2a 20 28 28 1)).. (let* ((
1360: 61 6c 6c 72 75 6e 73 20 20 20 20 20 28 72 64 62 allruns (rdb
1370: 3a 67 65 74 2d 72 75 6e 73 20 2a 64 62 2a 20 72 :get-runs *db* r
1380: 75 6e 6e 61 6d 65 70 61 74 74 20 6e 75 6d 72 75 unnamepatt numru
1390: 6e 73 20 3b 3b 20 28 2b 20 6e 75 6d 72 75 6e 73 ns ;; (+ numruns
13a0: 20 31 29 20 3b 3b 20 28 2f 20 6e 75 6d 72 75 6e 1) ;; (/ numrun
13b0: 73 20 32 29 29 0a 09 09 09 09 09 20 20 20 2a 73 s 2))...... *s
13c0: 74 61 72 74 2d 72 75 6e 2d 6f 66 66 73 65 74 2a tart-run-offset*
13d0: 20 6b 65 79 70 61 74 74 73 29 29 0a 09 09 20 28 keypatts))... (
13e0: 68 65 61 64 65 72 20 20 20 20 20 20 28 64 62 3a header (db:
13f0: 67 65 74 2d 68 65 61 64 65 72 20 61 6c 6c 72 75 get-header allru
1400: 6e 73 29 29 0a 09 09 20 28 72 75 6e 73 20 20 20 ns))... (runs
1410: 20 20 20 20 20 28 64 62 3a 67 65 74 2d 72 6f 77 (db:get-row
1420: 73 20 20 20 61 6c 6c 72 75 6e 73 29 29 0a 09 09 s allruns))...
1430: 20 28 72 65 73 75 6c 74 20 20 20 20 20 20 27 28 (result '(
1440: 29 29 0a 09 09 20 28 6d 61 78 74 65 73 74 73 20 ))... (maxtests
1450: 20 20 20 30 29 0a 09 09 20 28 73 74 61 74 65 73 0)... (states
1460: 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c (hash-tabl
1470: 65 2d 6b 65 79 73 20 2a 73 74 61 74 65 2d 69 67 e-keys *state-ig
1480: 6e 6f 72 65 2d 68 61 73 68 2a 29 29 0a 09 09 20 nore-hash*))...
1490: 28 73 74 61 74 75 73 65 73 20 20 20 20 28 68 61 (statuses (ha
14a0: 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 2a 73 sh-table-keys *s
14b0: 74 61 74 75 73 2d 69 67 6e 6f 72 65 2d 68 61 73 tatus-ignore-has
14c0: 68 2a 29 29 29 0a 09 20 20 20 20 28 64 65 62 75 h*))).. (debu
14d0: 67 3a 70 72 69 6e 74 20 36 20 22 75 70 64 61 74 g:print 6 "updat
14e0: 65 2d 72 75 6e 64 61 74 2c 20 67 6f 74 20 22 20 e-rundat, got "
14f0: 28 6c 65 6e 67 74 68 20 72 75 6e 73 29 20 22 20 (length runs) "
1500: 72 75 6e 73 22 29 0a 09 20 20 20 20 28 69 66 20 runs").. (if
1510: 28 3e 20 28 2b 20 2a 6c 61 73 74 2d 75 70 64 61 (> (+ *last-upda
1520: 74 65 2a 20 33 30 30 29 20 28 63 75 72 72 65 6e te* 300) (curren
1530: 74 2d 73 65 63 6f 6e 64 73 29 29 20 3b 3b 20 65 t-seconds)) ;; e
1540: 76 65 72 79 20 66 69 76 65 20 6d 69 6e 75 74 65 very five minute
1550: 73 0a 09 09 28 62 65 67 69 6e 0a 09 09 20 20 28 s...(begin... (
1560: 73 65 74 21 20 2a 6c 61 73 74 2d 75 70 64 61 74 set! *last-updat
1570: 65 2a 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f e* (current-seco
1580: 6e 64 73 29 29 0a 09 09 20 20 28 73 65 74 21 20 nds))... (set!
1590: 2a 74 6f 74 2d 72 75 6e 2d 63 6f 75 6e 74 2a 20 *tot-run-count*
15a0: 28 72 64 62 3a 67 65 74 2d 6e 75 6d 2d 72 75 6e (rdb:get-num-run
15b0: 73 20 2a 64 62 2a 20 72 75 6e 6e 61 6d 65 70 61 s *db* runnamepa
15c0: 74 74 29 29 29 29 0a 09 20 20 20 20 28 66 6f 72 tt)))).. (for
15d0: 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 72 -each (lambda (r
15e0: 75 6e 29 0a 09 09 09 28 6c 65 74 2a 20 28 28 72 un)....(let* ((r
15f0: 75 6e 2d 69 64 20 20 20 28 64 62 3a 67 65 74 2d un-id (db:get-
1600: 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 value-by-header
1610: 72 75 6e 20 68 65 61 64 65 72 20 22 69 64 22 29 run header "id")
1620: 29 0a 09 09 09 20 20 20 20 20 20 20 28 74 65 73 ).... (tes
1630: 74 73 20 20 20 20 28 6c 65 74 20 28 28 74 73 74 ts (let ((tst
1640: 73 20 28 72 64 62 3a 67 65 74 2d 74 65 73 74 73 s (rdb:get-tests
1650: 2d 66 6f 72 2d 72 75 6e 20 2a 64 62 2a 20 72 75 -for-run *db* ru
1660: 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 70 61 74 n-id testnamepat
1670: 74 20 69 74 65 6d 6e 61 6d 65 70 61 74 74 20 73 t itemnamepatt s
1680: 74 61 74 65 73 20 73 74 61 74 75 73 65 73 29 29 tates statuses))
1690: 29 0a 09 09 09 09 09 20 20 20 28 69 66 20 2a 74 )...... (if *t
16a0: 65 73 74 73 2d 73 6f 72 74 2d 72 65 76 65 72 73 ests-sort-revers
16b0: 65 2a 20 28 72 65 76 65 72 73 65 20 74 73 74 73 e* (reverse tsts
16c0: 29 20 74 73 74 73 29 29 29 0a 09 09 09 20 20 20 ) tsts)))....
16d0: 20 20 20 20 28 6b 65 79 2d 76 61 6c 73 20 28 72 (key-vals (r
16e0: 64 62 3a 67 65 74 2d 6b 65 79 2d 76 61 6c 73 20 db:get-key-vals
16f0: 2a 64 62 2a 20 72 75 6e 2d 69 64 29 29 29 0a 09 *db* run-id)))..
1700: 09 09 20 20 28 69 66 20 28 3e 20 28 6c 65 6e 67 .. (if (> (leng
1710: 74 68 20 74 65 73 74 73 29 20 6d 61 78 74 65 73 th tests) maxtes
1720: 74 73 29 0a 09 09 09 20 20 20 20 20 20 28 73 65 ts).... (se
1730: 74 21 20 6d 61 78 74 65 73 74 73 20 28 6c 65 6e t! maxtests (len
1740: 67 74 68 20 74 65 73 74 73 29 29 29 0a 09 09 09 gth tests)))....
1750: 20 20 28 69 66 20 28 6f 72 20 28 6e 6f 74 20 2a (if (or (not *
1760: 68 69 64 65 2d 65 6d 70 74 79 2d 72 75 6e 73 2a hide-empty-runs*
1770: 29 20 3b 3b 20 74 68 69 73 20 72 65 64 75 63 65 ) ;; this reduce
1780: 73 20 74 68 65 20 64 61 74 61 20 62 75 72 64 65 s the data burde
1790: 6e 20 77 68 65 6e 20 73 65 74 0a 09 09 09 09 20 n when set.....
17a0: 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 74 65 73 (not (null? tes
17b0: 74 73 29 29 29 0a 09 09 09 20 20 20 20 20 20 28 ts))).... (
17c0: 73 65 74 21 20 72 65 73 75 6c 74 20 28 63 6f 6e set! result (con
17d0: 73 20 28 76 65 63 74 6f 72 20 72 75 6e 20 74 65 s (vector run te
17e0: 73 74 73 20 6b 65 79 2d 76 61 6c 73 29 20 72 65 sts key-vals) re
17f0: 73 75 6c 74 29 29 29 29 29 0a 09 09 20 20 20 20 sult)))))...
1800: 20 20 72 75 6e 73 29 0a 09 20 20 20 20 28 73 65 runs).. (se
1810: 74 21 20 2a 68 65 61 64 65 72 2a 20 20 68 65 61 t! *header* hea
1820: 64 65 72 29 0a 09 20 20 20 20 28 73 65 74 21 20 der).. (set!
1830: 2a 61 6c 6c 72 75 6e 73 2a 20 72 65 73 75 6c 74 *allruns* result
1840: 29 0a 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 ).. (debug:pr
1850: 69 6e 74 20 36 20 22 2a 61 6c 6c 72 75 6e 73 2a int 6 "*allruns*
1860: 20 68 61 73 20 22 20 28 6c 65 6e 67 74 68 20 2a has " (length *
1870: 61 6c 6c 72 75 6e 73 2a 29 20 22 20 72 75 6e 73 allruns*) " runs
1880: 22 29 0a 09 20 20 20 20 3b 3b 20 28 73 65 74 21 ").. ;; (set!
1890: 20 2a 74 6f 74 2d 72 75 6e 2d 63 6f 75 6e 74 2a *tot-run-count*
18a0: 20 28 2b 20 31 20 28 6c 65 6e 67 74 68 20 2a 61 (+ 1 (length *a
18b0: 6c 6c 72 75 6e 73 2a 29 29 29 0a 09 20 20 20 20 llruns*)))..
18c0: 6d 61 78 74 65 73 74 73 29 29 0a 09 2a 6e 75 6d maxtests))..*num
18d0: 2d 74 65 73 74 73 2a 29 29 29 20 3b 3b 20 46 49 -tests*))) ;; FI
18e0: 58 4d 45 2c 20 6e 61 75 67 68 74 79 20 63 6f 64 XME, naughty cod
18f0: 69 6e 67 20 65 68 3f 0a 0a 28 64 65 66 69 6e 65 ing eh?..(define
1900: 20 2a 63 6f 6c 6c 61 70 73 65 64 2a 20 28 6d 61 *collapsed* (ma
1910: 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 0a ke-hash-table)).
1920: 3b 20 28 64 65 66 69 6e 65 20 2a 72 6f 77 2d 6c ; (define *row-l
1930: 6f 6f 6b 75 70 2a 20 28 6d 61 6b 65 2d 68 61 73 ookup* (make-has
1940: 68 2d 74 61 62 6c 65 29 29 20 3b 3b 20 74 65 73 h-table)) ;; tes
1950: 74 6e 61 6d 65 20 3d 3e 20 28 72 6f 77 6e 75 6d tname => (rownum
1960: 20 6c 61 62 6c 65 6f 62 6a 29 0a 0a 28 64 65 66 lableobj)..(def
1970: 69 6e 65 20 28 74 6f 67 67 6c 65 2d 68 69 64 65 ine (toggle-hide
1980: 20 6c 6e 75 6d 29 20 3b 20 66 75 6c 6c 74 65 73 lnum) ; fulltes
1990: 74 6e 61 6d 65 29 0a 20 20 28 6c 65 74 2a 20 28 tname). (let* (
19a0: 28 62 74 6e 20 28 76 65 63 74 6f 72 2d 72 65 66 (btn (vector-ref
19b0: 20 28 64 62 6f 61 72 64 3a 75 69 64 61 74 2d 67 (dboard:uidat-g
19c0: 65 74 2d 6c 66 74 63 6f 6c 20 75 69 64 61 74 29 et-lftcol uidat)
19d0: 20 6c 6e 75 6d 29 29 0a 09 20 28 66 75 6c 6c 74 lnum)).. (fullt
19e0: 65 73 74 6e 61 6d 65 20 28 69 75 70 3a 61 74 74 estname (iup:att
19f0: 72 69 62 75 74 65 20 62 74 6e 20 22 54 49 54 4c ribute btn "TITL
1a00: 45 22 29 29 0a 09 20 28 70 61 72 74 73 20 20 20 E")).. (parts
1a10: 20 20 20 20 20 28 73 74 72 69 6e 67 2d 73 70 6c (string-spl
1a20: 69 74 20 66 75 6c 6c 74 65 73 74 6e 61 6d 65 20 it fulltestname
1a30: 22 28 22 29 29 0a 09 20 28 62 61 73 65 74 65 73 "(")).. (basetes
1a40: 74 6e 61 6d 65 20 28 69 66 20 28 6e 75 6c 6c 3f tname (if (null?
1a50: 20 70 61 72 74 73 29 20 22 22 20 28 63 61 72 20 parts) "" (car
1a60: 70 61 72 74 73 29 29 29 29 0a 20 20 20 20 3b 28 parts)))). ;(
1a70: 70 72 69 6e 74 20 22 54 6f 67 67 6c 69 6e 67 20 print "Toggling
1a80: 22 20 62 61 73 65 74 65 73 74 6e 61 6d 65 20 22 " basetestname "
1a90: 20 63 75 72 72 65 6e 74 6c 79 20 22 20 28 68 61 currently " (ha
1aa0: 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 sh-table-ref/def
1ab0: 61 75 6c 74 20 2a 63 6f 6c 6c 61 70 73 65 64 2a ault *collapsed*
1ac0: 20 62 61 73 65 74 65 73 74 6e 61 6d 65 20 23 66 basetestname #f
1ad0: 29 29 0a 20 20 20 20 28 69 66 20 28 68 61 73 68 )). (if (hash
1ae0: 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 -table-ref/defau
1af0: 6c 74 20 2a 63 6f 6c 6c 61 70 73 65 64 2a 20 62 lt *collapsed* b
1b00: 61 73 65 74 65 73 74 6e 61 6d 65 20 23 66 29 0a asetestname #f).
1b10: 09 28 62 65 67 69 6e 0a 09 20 20 3b 28 69 75 70 .(begin.. ;(iup
1b20: 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 :attribute-set!
1b30: 62 74 6e 20 22 46 47 43 4f 4c 4f 52 22 20 22 30 btn "FGCOLOR" "0
1b40: 20 30 20 30 22 29 0a 09 20 20 28 68 61 73 68 2d 0 0").. (hash-
1b50: 74 61 62 6c 65 2d 64 65 6c 65 74 65 21 20 2a 63 table-delete! *c
1b60: 6f 6c 6c 61 70 73 65 64 2a 20 62 61 73 65 74 65 ollapsed* basete
1b70: 73 74 6e 61 6d 65 29 29 0a 09 28 62 65 67 69 6e stname))..(begin
1b80: 0a 09 20 20 3b 28 69 75 70 3a 61 74 74 72 69 62 .. ;(iup:attrib
1b90: 75 74 65 2d 73 65 74 21 20 62 74 6e 20 22 46 47 ute-set! btn "FG
1ba0: 43 4f 4c 4f 52 22 20 22 30 20 31 39 32 20 31 39 COLOR" "0 192 19
1bb0: 32 22 29 0a 09 20 20 28 68 61 73 68 2d 74 61 62 2").. (hash-tab
1bc0: 6c 65 2d 73 65 74 21 20 2a 63 6f 6c 6c 61 70 73 le-set! *collaps
1bd0: 65 64 2a 20 62 61 73 65 74 65 73 74 6e 61 6d 65 ed* basetestname
1be0: 20 23 74 29 29 29 29 29 0a 20 20 0a 28 64 65 66 #t))))). .(def
1bf0: 69 6e 65 20 62 6c 61 6e 6b 2d 6c 69 6e 65 2d 72 ine blank-line-r
1c00: 78 20 28 72 65 67 65 78 70 20 22 5e 5c 5c 73 2a x (regexp "^\\s*
1c10: 24 22 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 $"))..(define (r
1c20: 75 6e 2d 69 74 65 6d 2d 6e 61 6d 65 2d 3e 76 65 un-item-name->ve
1c30: 63 74 6f 72 73 20 6c 73 74 29 0a 20 20 28 6d 61 ctors lst). (ma
1c40: 70 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 20 p (lambda (x)..
1c50: 28 6c 65 74 20 28 28 73 70 6c 73 74 20 28 73 74 (let ((splst (st
1c60: 72 69 6e 67 2d 73 70 6c 69 74 20 78 20 22 28 22 ring-split x "("
1c70: 29 29 0a 09 20 20 20 20 20 20 20 28 72 65 73 20 )).. (res
1c80: 20 20 28 76 65 63 74 6f 72 20 22 22 20 22 22 29 (vector "" "")
1c90: 29 29 0a 09 20 20 20 28 76 65 63 74 6f 72 2d 73 )).. (vector-s
1ca0: 65 74 21 20 72 65 73 20 30 20 28 63 61 72 20 73 et! res 0 (car s
1cb0: 70 6c 73 74 29 29 0a 09 20 20 20 28 69 66 20 28 plst)).. (if (
1cc0: 3e 20 28 6c 65 6e 67 74 68 20 73 70 6c 73 74 29 > (length splst)
1cd0: 20 31 29 0a 09 20 20 20 20 20 20 20 28 76 65 63 1).. (vec
1ce0: 74 6f 72 2d 73 65 74 21 20 72 65 73 20 31 20 28 tor-set! res 1 (
1cf0: 63 61 72 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 car (string-spli
1d00: 74 20 28 63 61 64 72 20 73 70 6c 73 74 29 20 22 t (cadr splst) "
1d10: 29 22 29 29 29 29 0a 09 20 20 20 72 65 73 29 29 )")))).. res))
1d20: 0a 20 20 20 20 20 20 20 6c 73 74 29 29 0a 0a 28 . lst))..(
1d30: 64 65 66 69 6e 65 20 28 63 6f 6c 6c 61 70 73 65 define (collapse
1d40: 2d 72 6f 77 73 20 69 6e 6c 73 74 29 0a 20 20 28 -rows inlst). (
1d50: 6c 65 74 2a 20 28 28 6e 65 77 6c 73 74 20 28 66 let* ((newlst (f
1d60: 69 6c 74 65 72 20 28 6c 61 6d 62 64 61 20 28 78 ilter (lambda (x
1d70: 29 0a 09 09 09 20 20 28 6c 65 74 2a 20 28 28 74 ).... (let* ((t
1d80: 70 61 72 74 73 20 20 20 20 28 73 74 72 69 6e 67 parts (string
1d90: 2d 73 70 6c 69 74 20 78 20 22 28 22 29 29 0a 09 -split x "("))..
1da0: 09 09 09 20 28 62 61 73 65 74 6e 61 6d 65 20 28 ... (basetname (
1db0: 69 66 20 28 6e 75 6c 6c 3f 20 74 70 61 72 74 73 if (null? tparts
1dc0: 29 20 78 20 28 63 61 72 20 74 70 61 72 74 73 29 ) x (car tparts)
1dd0: 29 29 29 0a 09 09 09 09 09 3b 28 70 72 69 6e 74 )))......;(print
1de0: 20 22 78 20 22 20 78 20 22 20 74 70 61 72 74 73 "x " x " tparts
1df0: 3a 20 22 20 74 70 61 72 74 73 20 22 20 62 61 73 : " tparts " bas
1e00: 65 74 6e 61 6d 65 3a 20 22 20 62 61 73 65 74 6e etname: " basetn
1e10: 61 6d 65 29 0a 09 09 09 20 20 20 20 28 63 6f 6e ame).... (con
1e20: 64 0a 09 09 09 20 20 20 20 20 28 28 73 74 72 69 d.... ((stri
1e30: 6e 67 2d 6d 61 74 63 68 20 62 6c 61 6e 6b 2d 6c ng-match blank-l
1e40: 69 6e 65 2d 72 78 20 78 29 20 23 66 29 0a 09 09 ine-rx x) #f)...
1e50: 09 20 20 20 20 20 28 28 65 71 75 61 6c 3f 20 78 . ((equal? x
1e60: 20 62 61 73 65 74 6e 61 6d 65 29 20 23 74 29 0a basetname) #t).
1e70: 09 09 09 20 20 20 20 20 28 28 68 61 73 68 2d 74 ... ((hash-t
1e80: 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 able-ref/default
1e90: 20 2a 63 6f 6c 6c 61 70 73 65 64 2a 20 62 61 73 *collapsed* bas
1ea0: 65 74 6e 61 6d 65 20 23 66 29 20 0a 09 09 09 09 etname #f) .....
1eb0: 09 3b 28 70 72 69 6e 74 20 22 52 65 6d 6f 76 69 .;(print "Removi
1ec0: 6e 67 20 22 20 62 61 73 65 74 6e 61 6d 65 20 22 ng " basetname "
1ed0: 20 66 72 6f 6d 20 69 74 65 6d 73 22 29 0a 09 09 from items")...
1ee0: 09 20 20 20 20 20 20 23 66 29 0a 09 09 09 20 20 . #f)....
1ef0: 20 20 20 28 65 6c 73 65 20 23 74 29 29 29 29 0a (else #t)))).
1f00: 09 09 09 69 6e 6c 73 74 29 29 0a 09 20 28 76 6c ...inlst)).. (vl
1f10: 73 74 20 20 28 72 75 6e 2d 69 74 65 6d 2d 6e 61 st (run-item-na
1f20: 6d 65 2d 3e 76 65 63 74 6f 72 73 20 6e 65 77 6c me->vectors newl
1f30: 73 74 29 29 0a 09 20 3b 3b 20 73 6f 72 74 20 62 st)).. ;; sort b
1f40: 79 20 73 65 63 6f 6e 64 20 66 69 65 6c 64 0a 09 y second field..
1f50: 20 28 76 6c 73 74 2d 73 31 20 28 73 6f 72 74 20 (vlst-s1 (sort
1f60: 76 6c 73 74 20 28 6c 61 6d 62 64 61 20 28 61 20 vlst (lambda (a
1f70: 62 29 0a 09 09 09 20 20 20 20 20 20 20 28 6c 65 b).... (le
1f80: 74 20 28 28 61 73 74 72 20 28 76 65 63 74 6f 72 t ((astr (vector
1f90: 2d 72 65 66 20 61 20 31 29 29 0a 09 09 09 09 20 -ref a 1)).....
1fa0: 20 20 20 20 28 62 73 74 72 20 28 76 65 63 74 6f (bstr (vecto
1fb0: 72 2d 72 65 66 20 62 20 31 29 29 29 0a 09 09 09 r-ref b 1)))....
1fc0: 09 20 28 69 66 20 28 73 74 72 69 6e 67 3d 3f 20 . (if (string=?
1fd0: 61 73 74 72 20 22 22 29 20 23 66 20 23 74 29 29 astr "") #f #t))
1fe0: 29 29 29 0a 09 09 09 3b 3b 20 28 3e 3d 20 28 73 )))....;; (>= (s
1ff0: 74 72 69 6e 67 2d 6c 65 6e 67 74 68 20 28 76 65 tring-length (ve
2000: 63 74 6f 72 2d 72 65 66 20 61 20 31 29 29 28 73 ctor-ref a 1))(s
2010: 74 72 69 6e 67 2d 6c 65 6e 67 74 68 20 28 76 65 tring-length (ve
2020: 63 74 6f 72 2d 72 65 66 20 62 20 31 29 29 29 29 ctor-ref b 1))))
2030: 29 29 0a 09 20 28 76 6c 73 74 2d 73 32 20 28 73 )).. (vlst-s2 (s
2040: 6f 72 74 20 76 6c 73 74 2d 73 31 20 28 6c 61 6d ort vlst-s1 (lam
2050: 62 64 61 20 28 61 20 62 29 0a 09 09 09 20 20 20 bda (a b)....
2060: 09 20 20 28 73 74 72 69 6e 67 3e 3d 20 28 76 65 . (string>= (ve
2070: 63 74 6f 72 2d 72 65 66 20 61 20 30 29 28 76 65 ctor-ref a 0)(ve
2080: 63 74 6f 72 2d 72 65 66 20 62 20 30 29 29 29 29 ctor-ref b 0))))
2090: 29 29 0a 20 20 20 20 28 6d 61 70 20 28 6c 61 6d )). (map (lam
20a0: 62 64 61 20 28 78 29 0a 09 20 20 20 28 69 66 20 bda (x).. (if
20b0: 28 65 71 75 61 6c 3f 20 28 76 65 63 74 6f 72 2d (equal? (vector-
20c0: 72 65 66 20 78 20 31 29 20 22 22 29 0a 09 20 20 ref x 1) "")..
20d0: 20 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 (vector-ref
20e0: 20 78 20 30 29 0a 09 20 20 20 20 20 20 20 28 63 x 0).. (c
20f0: 6f 6e 63 20 28 76 65 63 74 6f 72 2d 72 65 66 20 onc (vector-ref
2100: 78 20 30 29 20 22 28 22 20 28 76 65 63 74 6f 72 x 0) "(" (vector
2110: 2d 72 65 66 20 78 20 31 29 20 22 29 22 29 29 29 -ref x 1) ")")))
2120: 0a 09 20 76 6c 73 74 2d 73 32 29 29 29 0a 20 20 .. vlst-s2))).
2130: 20 20 0a 28 64 65 66 69 6e 65 20 28 75 70 64 61 .(define (upda
2140: 74 65 2d 6c 61 62 65 6c 73 20 75 69 64 61 74 29 te-labels uidat)
2150: 0a 20 20 28 6c 65 74 2a 20 28 28 72 6f 77 6e 20 . (let* ((rown
2160: 20 20 20 30 29 0a 09 20 28 6b 65 79 63 6f 6c 20 0).. (keycol
2170: 20 28 64 62 6f 61 72 64 3a 75 69 64 61 74 2d 67 (dboard:uidat-g
2180: 65 74 2d 6b 65 79 63 6f 6c 20 75 69 64 61 74 29 et-keycol uidat)
2190: 29 0a 09 20 28 6c 66 74 63 6f 6c 20 20 28 64 62 ).. (lftcol (db
21a0: 6f 61 72 64 3a 75 69 64 61 74 2d 67 65 74 2d 6c oard:uidat-get-l
21b0: 66 74 63 6f 6c 20 75 69 64 61 74 29 29 0a 09 20 ftcol uidat))..
21c0: 28 6e 75 6d 63 6f 6c 73 20 28 76 65 63 74 6f 72 (numcols (vector
21d0: 2d 6c 65 6e 67 74 68 20 6c 66 74 63 6f 6c 29 29 -length lftcol))
21e0: 0a 09 20 28 6d 61 78 6e 20 20 20 20 28 2d 20 6e .. (maxn (- n
21f0: 75 6d 63 6f 6c 73 20 31 29 29 0a 09 20 28 61 6c umcols 1)).. (al
2200: 6c 76 61 6c 73 20 28 6d 61 6b 65 2d 76 65 63 74 lvals (make-vect
2210: 6f 72 20 6e 75 6d 63 6f 6c 73 20 22 22 29 29 29 or numcols "")))
2220: 0a 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 . (for-each (
2230: 6c 61 6d 62 64 61 20 28 6e 61 6d 65 29 0a 09 09 lambda (name)...
2240: 28 69 66 20 28 3c 3d 20 72 6f 77 6e 20 6d 61 78 (if (<= rown max
2250: 6e 29 0a 09 09 20 20 20 20 28 76 65 63 74 6f 72 n)... (vector
2260: 2d 73 65 74 21 20 61 6c 6c 76 61 6c 73 20 72 6f -set! allvals ro
2270: 77 6e 20 6e 61 6d 65 29 29 20 3b 29 0a 09 09 28 wn name)) ;)...(
2280: 73 65 74 21 20 72 6f 77 6e 20 28 2b 20 31 20 72 set! rown (+ 1 r
2290: 6f 77 6e 29 29 29 0a 09 20 20 20 20 20 20 2a 61 own))).. *a
22a0: 6c 6c 74 65 73 74 6e 61 6d 65 6c 73 74 2a 29 0a lltestnamelst*).
22b0: 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 (let loop ((
22c0: 69 20 30 29 29 0a 20 20 20 20 20 20 28 6c 65 74 i 0)). (let
22d0: 2a 20 28 28 6c 62 6c 20 20 20 20 28 76 65 63 74 * ((lbl (vect
22e0: 6f 72 2d 72 65 66 20 6c 66 74 63 6f 6c 20 69 29 or-ref lftcol i)
22f0: 29 0a 09 20 20 20 20 20 28 6b 65 79 76 61 6c 20 ).. (keyval
2300: 28 76 65 63 74 6f 72 2d 72 65 66 20 6b 65 79 63 (vector-ref keyc
2310: 6f 6c 20 69 29 29 0a 09 20 20 20 20 20 28 6f 6c ol i)).. (ol
2320: 64 76 61 6c 20 28 69 75 70 3a 61 74 74 72 69 62 dval (iup:attrib
2330: 75 74 65 20 6c 62 6c 20 22 54 49 54 4c 45 22 29 ute lbl "TITLE")
2340: 29 0a 09 20 20 20 20 20 28 6e 65 77 76 61 6c 20 ).. (newval
2350: 28 76 65 63 74 6f 72 2d 72 65 66 20 61 6c 6c 76 (vector-ref allv
2360: 61 6c 73 20 69 29 29 29 0a 09 28 69 66 20 28 6e als i)))..(if (n
2370: 6f 74 20 28 65 71 75 61 6c 3f 20 6f 6c 64 76 61 ot (equal? oldva
2380: 6c 20 6e 65 77 76 61 6c 29 29 0a 09 20 20 20 20 l newval))..
2390: 28 6c 65 74 20 28 28 6d 75 6e 67 65 64 2d 76 61 (let ((munged-va
23a0: 6c 20 28 6c 65 74 20 28 28 70 61 72 74 73 20 28 l (let ((parts (
23b0: 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 6e 65 77 string-split new
23c0: 76 61 6c 20 22 28 22 29 29 29 0a 09 09 09 09 28 val "("))).....(
23d0: 69 66 20 28 3e 20 28 6c 65 6e 67 74 68 20 70 61 if (> (length pa
23e0: 72 74 73 29 20 31 29 28 63 6f 6e 63 20 22 20 20 rts) 1)(conc "
23f0: 22 20 28 63 61 72 20 28 73 74 72 69 6e 67 2d 73 " (car (string-s
2400: 70 6c 69 74 20 28 63 61 64 72 20 70 61 72 74 73 plit (cadr parts
2410: 29 20 22 29 22 29 29 29 20 6e 65 77 76 61 6c 29 ) ")"))) newval)
2420: 29 29 29 0a 09 20 20 20 20 20 20 28 76 65 63 74 ))).. (vect
2430: 6f 72 2d 73 65 74 21 20 6b 65 79 63 6f 6c 20 69 or-set! keycol i
2440: 20 6e 65 77 76 61 6c 29 0a 09 20 20 20 20 20 20 newval)..
2450: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 (iup:attribute-s
2460: 65 74 21 20 6c 62 6c 20 22 54 49 54 4c 45 22 20 et! lbl "TITLE"
2470: 6d 75 6e 67 65 64 2d 76 61 6c 29 29 29 0a 09 28 munged-val)))..(
2480: 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 iup:attribute-se
2490: 74 21 20 6c 62 6c 20 22 46 47 43 4f 4c 4f 52 22 t! lbl "FGCOLOR"
24a0: 20 28 69 66 20 28 68 61 73 68 2d 74 61 62 6c 65 (if (hash-table
24b0: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 2a 63 6f -ref/default *co
24c0: 6c 6c 61 70 73 65 64 2a 20 6e 65 77 76 61 6c 20 llapsed* newval
24d0: 23 66 29 20 22 30 20 31 31 32 20 31 31 32 22 20 #f) "0 112 112"
24e0: 22 30 20 30 20 30 22 29 29 0a 09 28 69 66 20 28 "0 0 0"))..(if (
24f0: 3c 20 69 20 6d 61 78 6e 29 0a 09 20 20 20 20 28 < i maxn).. (
2500: 6c 6f 6f 70 20 28 2b 20 69 20 31 29 29 29 29 29 loop (+ i 1)))))
2510: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 67 65 74 ))..(define (get
2520: 2d 63 6f 6c 6f 72 2d 66 6f 72 2d 73 74 61 74 65 -color-for-state
2530: 2d 73 74 61 74 75 73 20 73 74 61 74 65 20 73 74 -status state st
2540: 61 74 75 73 29 0a 20 20 28 63 61 73 65 20 28 73 atus). (case (s
2550: 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 73 74 tring->symbol st
2560: 61 74 65 29 0a 20 20 20 20 28 28 43 4f 4d 50 4c ate). ((COMPL
2570: 45 54 45 44 29 0a 20 20 20 20 20 28 69 66 20 28 ETED). (if (
2580: 65 71 75 61 6c 3f 20 73 74 61 74 75 73 20 22 50 equal? status "P
2590: 41 53 53 22 29 0a 09 20 22 37 30 20 32 34 39 20 ASS").. "70 249
25a0: 37 33 22 0a 09 20 28 69 66 20 28 6f 72 20 28 65 73".. (if (or (e
25b0: 71 75 61 6c 3f 20 73 74 61 74 75 73 20 22 57 41 qual? status "WA
25c0: 52 4e 22 29 0a 09 09 20 28 65 71 75 61 6c 3f 20 RN")... (equal?
25d0: 73 74 61 74 75 73 20 22 57 41 49 56 45 44 22 29 status "WAIVED")
25e0: 29 0a 09 20 20 20 20 20 22 32 35 35 20 31 37 32 ).. "255 172
25f0: 20 31 33 22 0a 09 20 20 20 20 20 22 32 32 33 20 13".. "223
2600: 33 33 20 34 39 22 29 29 29 20 3b 3b 20 67 72 65 33 49"))) ;; gre
2610: 65 6e 69 73 68 20 6f 72 61 6e 67 65 69 73 68 20 enish orangeish
2620: 72 65 64 69 73 68 0a 20 20 20 20 28 28 4c 41 55 redish. ((LAU
2630: 4e 43 48 45 44 29 20 20 20 20 20 20 20 20 20 22 NCHED) "
2640: 31 30 31 20 31 32 33 20 31 34 32 22 29 0a 20 20 101 123 142").
2650: 20 20 28 28 43 48 45 43 4b 29 20 20 20 20 20 20 ((CHECK)
2660: 20 20 20 20 20 20 22 32 35 35 20 31 30 30 20 35 "255 100 5
2670: 30 22 29 0a 20 20 20 20 28 28 52 45 4d 4f 54 45 0"). ((REMOTE
2680: 48 4f 53 54 53 54 41 52 54 29 20 20 22 35 30 20 HOSTSTART) "50
2690: 31 33 30 20 31 39 35 22 29 0a 20 20 20 20 28 28 130 195"). ((
26a0: 52 55 4e 4e 49 4e 47 29 20 20 20 20 20 20 20 20 RUNNING)
26b0: 20 20 22 39 20 31 33 31 20 32 33 32 22 29 0a 20 "9 131 232").
26c0: 20 20 20 28 28 4b 49 4c 4c 52 45 51 29 20 20 20 ((KILLREQ)
26d0: 20 20 20 20 20 20 20 22 33 39 20 38 32 20 32 30 "39 82 20
26e0: 36 22 29 0a 20 20 20 20 28 28 4b 49 4c 4c 45 44 6"). ((KILLED
26f0: 29 20 20 20 20 20 20 20 20 20 20 20 22 32 33 34 ) "234
2700: 20 31 30 31 20 31 37 22 29 0a 20 20 20 20 28 28 101 17"). ((
2710: 4e 4f 54 5f 53 54 41 52 54 45 44 29 20 20 20 20 NOT_STARTED)
2720: 20 20 22 32 34 30 20 32 34 30 20 32 34 30 22 29 "240 240 240")
2730: 0a 20 20 20 20 28 65 6c 73 65 20 20 20 20 20 20 . (else
2740: 20 20 20 20 20 20 20 20 20 22 31 39 32 20 31 39 "192 19
2750: 32 20 31 39 32 22 29 29 29 0a 0a 28 64 65 66 69 2 192")))..(defi
2760: 6e 65 20 28 75 70 64 61 74 65 2d 62 75 74 74 6f ne (update-butto
2770: 6e 73 20 75 69 64 61 74 20 6e 75 6d 72 75 6e 73 ns uidat numruns
2780: 20 6e 75 6d 74 65 73 74 73 29 0a 20 20 28 69 66 numtests). (if
2790: 20 2a 70 6c 65 61 73 65 2d 75 70 64 61 74 65 2d *please-update-
27a0: 62 75 74 74 6f 6e 73 2a 0a 20 20 20 20 20 20 28 buttons*. (
27b0: 6c 65 74 2a 20 28 28 72 75 6e 73 20 20 20 20 20 let* ((runs
27c0: 20 20 20 28 69 66 20 28 3e 20 28 6c 65 6e 67 74 (if (> (lengt
27d0: 68 20 2a 61 6c 6c 72 75 6e 73 2a 29 20 6e 75 6d h *allruns*) num
27e0: 72 75 6e 73 29 0a 09 09 09 20 20 20 20 20 20 28 runs).... (
27f0: 74 61 6b 65 2d 72 69 67 68 74 20 2a 61 6c 6c 72 take-right *allr
2800: 75 6e 73 2a 20 6e 75 6d 72 75 6e 73 29 0a 09 09 uns* numruns)...
2810: 09 20 20 20 20 20 20 28 70 61 64 2d 6c 69 73 74 . (pad-list
2820: 20 2a 61 6c 6c 72 75 6e 73 2a 20 6e 75 6d 72 75 *allruns* numru
2830: 6e 73 29 29 29 0a 09 20 20 20 20 20 28 6c 66 74 ns))).. (lft
2840: 63 6f 6c 20 20 20 20 20 20 28 64 62 6f 61 72 64 col (dboard
2850: 3a 75 69 64 61 74 2d 67 65 74 2d 6c 66 74 63 6f :uidat-get-lftco
2860: 6c 20 75 69 64 61 74 29 29 0a 09 20 20 20 20 20 l uidat))..
2870: 28 74 61 62 6c 65 68 65 61 64 65 72 20 28 64 62 (tableheader (db
2880: 6f 61 72 64 3a 75 69 64 61 74 2d 67 65 74 2d 68 oard:uidat-get-h
2890: 65 61 64 65 72 20 75 69 64 61 74 29 29 0a 09 20 eader uidat))..
28a0: 20 20 20 20 28 74 61 62 6c 65 20 20 20 20 20 20 (table
28b0: 20 28 64 62 6f 61 72 64 3a 75 69 64 61 74 2d 67 (dboard:uidat-g
28c0: 65 74 2d 72 75 6e 73 76 65 63 20 75 69 64 61 74 et-runsvec uidat
28d0: 29 29 0a 09 20 20 20 20 20 28 63 6f 6c 6e 20 20 )).. (coln
28e0: 20 20 20 20 20 20 30 29 29 0a 09 28 73 65 74 21 0))..(set!
28f0: 20 2a 70 6c 65 61 73 65 2d 75 70 64 61 74 65 2d *please-update-
2900: 62 75 74 74 6f 6e 73 2a 20 23 66 29 0a 09 28 73 buttons* #f)..(s
2910: 65 74 21 20 2a 61 6c 6c 74 65 73 74 6e 61 6d 65 et! *alltestname
2920: 6c 73 74 2a 20 27 28 29 29 0a 09 3b 3b 20 63 72 lst* '())..;; cr
2930: 65 61 74 65 20 61 20 63 6f 6e 63 69 73 65 20 6c eate a concise l
2940: 69 73 74 20 6f 66 20 74 65 73 74 20 6e 61 6d 65 ist of test name
2950: 73 0a 09 28 66 6f 72 2d 65 61 63 68 0a 09 20 28 s..(for-each.. (
2960: 6c 61 6d 62 64 61 20 28 72 75 6e 64 61 74 29 0a lambda (rundat).
2970: 09 20 20 20 28 69 66 20 28 76 65 63 74 6f 72 3f . (if (vector?
2980: 20 72 75 6e 64 61 74 29 0a 09 20 20 20 20 20 20 rundat)..
2990: 20 28 6c 65 74 2a 20 28 28 74 65 73 74 64 61 74 (let* ((testdat
29a0: 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 72 (vector-ref r
29b0: 75 6e 64 61 74 20 31 29 29 0a 09 09 20 20 20 20 undat 1))...
29c0: 20 20 28 74 65 73 74 6e 61 6d 65 73 20 28 6d 61 (testnames (ma
29d0: 70 20 74 65 73 74 3a 74 65 73 74 2d 67 65 74 2d p test:test-get-
29e0: 66 75 6c 6c 6e 61 6d 65 20 74 65 73 74 64 61 74 fullname testdat
29f0: 29 29 29 0a 09 09 20 28 69 66 20 28 6e 6f 74 20 )))... (if (not
2a00: 28 61 6e 64 20 2a 68 69 64 65 2d 65 6d 70 74 79 (and *hide-empty
2a10: 2d 72 75 6e 73 2a 0a 09 09 09 20 20 20 20 20 20 -runs*....
2a20: 20 28 6e 75 6c 6c 3f 20 74 65 73 74 6e 61 6d 65 (null? testname
2a30: 73 29 29 29 0a 09 09 20 20 20 20 20 28 66 6f 72 s)))... (for
2a40: 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 74 -each (lambda (t
2a50: 65 73 74 6e 61 6d 65 29 0a 09 09 09 09 20 28 69 estname)..... (i
2a60: 66 20 28 6e 6f 74 20 28 6d 65 6d 62 65 72 20 74 f (not (member t
2a70: 65 73 74 6e 61 6d 65 20 2a 61 6c 6c 74 65 73 74 estname *alltest
2a80: 6e 61 6d 65 6c 73 74 2a 29 29 0a 09 09 09 09 20 namelst*)).....
2a90: 20 20 20 20 28 62 65 67 69 6e 0a 09 09 09 09 20 (begin.....
2aa0: 20 20 20 20 20 20 28 73 65 74 21 20 2a 61 6c 6c (set! *all
2ab0: 74 65 73 74 6e 61 6d 65 6c 73 74 2a 20 28 61 70 testnamelst* (ap
2ac0: 70 65 6e 64 20 2a 61 6c 6c 74 65 73 74 6e 61 6d pend *alltestnam
2ad0: 65 6c 73 74 2a 20 28 6c 69 73 74 20 74 65 73 74 elst* (list test
2ae0: 6e 61 6d 65 29 29 29 29 29 29 0a 09 09 09 20 20 name))))))....
2af0: 20 20 20 20 20 74 65 73 74 6e 61 6d 65 73 29 29 testnames))
2b00: 29 29 29 0a 09 20 72 75 6e 73 29 0a 0a 09 28 73 ))).. runs)...(s
2b10: 65 74 21 20 2a 61 6c 6c 74 65 73 74 6e 61 6d 65 et! *alltestname
2b20: 6c 73 74 2a 20 28 63 6f 6c 6c 61 70 73 65 2d 72 lst* (collapse-r
2b30: 6f 77 73 20 2a 61 6c 6c 74 65 73 74 6e 61 6d 65 ows *alltestname
2b40: 6c 73 74 2a 29 29 20 3b 3b 3b 20 61 72 67 68 2e lst*)) ;;; argh.
2b50: 20 70 6c 65 61 73 65 20 63 6c 65 61 6e 20 75 70 please clean up
2b60: 20 74 68 69 73 20 73 69 6c 6c 79 6e 65 73 73 0a this sillyness.
2b70: 09 28 73 65 74 21 20 2a 61 6c 6c 74 65 73 74 6e .(set! *alltestn
2b80: 61 6d 65 6c 73 74 2a 20 28 6c 65 74 20 28 28 78 amelst* (let ((x
2b90: 6c 20 28 69 66 20 28 3e 20 28 6c 65 6e 67 74 68 l (if (> (length
2ba0: 20 2a 61 6c 6c 74 65 73 74 6e 61 6d 65 6c 73 74 *alltestnamelst
2bb0: 2a 29 20 2a 73 74 61 72 74 2d 74 65 73 74 2d 6f *) *start-test-o
2bc0: 66 66 73 65 74 2a 29 0a 09 09 09 09 09 20 20 20 ffset*)......
2bd0: 20 20 28 64 72 6f 70 20 2a 61 6c 6c 74 65 73 74 (drop *alltest
2be0: 6e 61 6d 65 6c 73 74 2a 20 2a 73 74 61 72 74 2d namelst* *start-
2bf0: 74 65 73 74 2d 6f 66 66 73 65 74 2a 29 0a 09 09 test-offset*)...
2c00: 09 09 09 20 20 20 20 20 27 28 29 29 29 29 0a 09 ... '())))..
2c10: 09 09 09 20 28 61 70 70 65 6e 64 20 78 6c 20 28 ... (append xl (
2c20: 6d 61 6b 65 2d 6c 69 73 74 20 28 2d 20 2a 6e 75 make-list (- *nu
2c30: 6d 2d 74 65 73 74 73 2a 20 28 6c 65 6e 67 74 68 m-tests* (length
2c40: 20 78 6c 29 29 20 22 22 29 29 29 29 0a 09 28 75 xl)) ""))))..(u
2c50: 70 64 61 74 65 2d 6c 61 62 65 6c 73 20 75 69 64 pdate-labels uid
2c60: 61 74 29 0a 09 28 66 6f 72 2d 65 61 63 68 0a 09 at)..(for-each..
2c70: 20 28 6c 61 6d 62 64 61 20 28 72 75 6e 64 61 74 (lambda (rundat
2c80: 29 0a 09 20 20 20 28 69 66 20 28 6e 6f 74 20 72 ).. (if (not r
2c90: 75 6e 64 61 74 29 20 3b 3b 20 68 61 6e 64 6c 65 undat) ;; handle
2ca0: 20 70 61 64 64 65 64 20 72 75 6e 73 0a 09 20 20 padded runs..
2cb0: 20 20 20 20 20 3b 3b 20 20 20 20 20 20 20 20 20 ;;
2cc0: 20 20 3b 3b 20 69 64 20 72 75 6e 2d 69 64 20 74 ;; id run-id t
2cd0: 65 73 74 6e 61 6d 65 20 73 74 61 74 65 20 73 74 estname state st
2ce0: 61 74 75 73 20 65 76 65 6e 74 2d 74 69 6d 65 20 atus event-time
2cf0: 68 6f 73 74 20 63 70 75 6c 6f 61 64 20 64 69 73 host cpuload dis
2d00: 6b 66 72 65 65 20 75 6e 61 6d 65 20 72 75 6e 64 kfree uname rund
2d10: 69 72 20 69 74 65 6d 2d 70 61 74 68 20 72 75 6e ir item-path run
2d20: 2d 64 75 72 61 74 69 6f 6e 0a 09 20 20 20 20 20 -duration..
2d30: 20 20 28 73 65 74 21 20 72 75 6e 64 61 74 20 28 (set! rundat (
2d40: 76 65 63 74 6f 72 20 28 6d 61 6b 65 2d 76 65 63 vector (make-vec
2d50: 74 6f 72 20 32 30 20 23 66 29 20 27 28 29 20 28 tor 20 #f) '() (
2d60: 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 78 29 20 map (lambda (x)
2d70: 22 22 29 20 2a 6b 65 79 73 2a 29 29 29 29 3b 3b "") *keys*))));;
2d80: 20 33 29 29 29 0a 09 20 20 20 28 6c 65 74 2a 20 3))).. (let*
2d90: 28 28 72 75 6e 20 20 20 20 20 20 28 76 65 63 74 ((run (vect
2da0: 6f 72 2d 72 65 66 20 72 75 6e 64 61 74 20 30 29 or-ref rundat 0)
2db0: 29 0a 09 09 20 20 28 74 65 73 74 73 64 61 74 20 )... (testsdat
2dc0: 28 76 65 63 74 6f 72 2d 72 65 66 20 72 75 6e 64 (vector-ref rund
2dd0: 61 74 20 31 29 29 0a 09 09 20 20 28 6b 65 79 2d at 1))... (key-
2de0: 76 61 6c 2d 64 61 74 20 28 76 65 63 74 6f 72 2d val-dat (vector-
2df0: 72 65 66 20 72 75 6e 64 61 74 20 32 29 29 0a 09 ref rundat 2))..
2e00: 09 20 20 28 72 75 6e 2d 69 64 20 20 20 28 64 62 . (run-id (db
2e10: 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 :get-value-by-he
2e20: 61 64 65 72 20 72 75 6e 20 2a 68 65 61 64 65 72 ader run *header
2e30: 2a 20 22 69 64 22 29 29 0a 09 09 20 20 28 6b 65 * "id"))... (ke
2e40: 79 2d 76 61 6c 73 20 28 61 70 70 65 6e 64 20 6b y-vals (append k
2e50: 65 79 2d 76 61 6c 2d 64 61 74 0a 09 09 09 09 20 ey-val-dat.....
2e60: 20 20 20 28 6c 69 73 74 20 28 6c 65 74 20 28 28 (list (let ((
2e70: 78 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d x (db:get-value-
2e80: 62 79 2d 68 65 61 64 65 72 20 72 75 6e 20 2a 68 by-header run *h
2e90: 65 61 64 65 72 2a 20 22 72 75 6e 6e 61 6d 65 22 eader* "runname"
2ea0: 29 29 29 0a 09 09 09 09 09 20 20 20 20 28 69 66 )))...... (if
2eb0: 20 78 20 78 20 22 22 29 29 29 29 29 0a 09 09 20 x x "")))))...
2ec0: 20 28 72 75 6e 2d 6b 65 79 20 20 28 73 74 72 69 (run-key (stri
2ed0: 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 6b ng-intersperse k
2ee0: 65 79 2d 76 61 6c 73 20 22 5c 6e 22 29 29 29 0a ey-vals "\n"))).
2ef0: 0a 09 20 20 20 20 20 3b 3b 20 66 69 6c 6c 20 69 .. ;; fill i
2f00: 6e 20 74 68 65 20 72 75 6e 20 68 65 61 64 65 72 n the run header
2f10: 20 6b 65 79 20 76 61 6c 75 65 73 0a 09 20 20 20 key values..
2f20: 20 20 28 6c 65 74 20 28 28 72 6f 77 6e 20 20 20 (let ((rown
2f30: 20 20 20 30 29 0a 09 09 20 20 20 28 68 65 61 64 0)... (head
2f40: 65 72 63 6f 6c 20 28 76 65 63 74 6f 72 2d 72 65 ercol (vector-re
2f50: 66 20 74 61 62 6c 65 68 65 61 64 65 72 20 63 6f f tableheader co
2f60: 6c 6e 29 29 29 0a 09 20 20 20 20 20 20 20 28 66 ln))).. (f
2f70: 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 or-each (lambda
2f80: 28 6b 76 61 6c 29 0a 09 09 09 20 20 20 28 6c 65 (kval).... (le
2f90: 74 2a 20 28 28 6c 61 62 6c 20 20 20 20 20 20 28 t* ((labl (
2fa0: 76 65 63 74 6f 72 2d 72 65 66 20 68 65 61 64 65 vector-ref heade
2fb0: 72 63 6f 6c 20 72 6f 77 6e 29 29 29 0a 09 09 09 rcol rown)))....
2fc0: 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 65 (if (not (e
2fd0: 71 75 61 6c 3f 20 6b 76 61 6c 20 28 69 75 70 3a qual? kval (iup:
2fe0: 61 74 74 72 69 62 75 74 65 20 6c 61 62 6c 20 22 attribute labl "
2ff0: 54 49 54 4c 45 22 29 29 29 0a 09 09 09 09 20 28 TITLE")))..... (
3000: 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 iup:attribute-se
3010: 74 21 20 28 76 65 63 74 6f 72 2d 72 65 66 20 68 t! (vector-ref h
3020: 65 61 64 65 72 63 6f 6c 20 72 6f 77 6e 29 20 22 eadercol rown) "
3030: 54 49 54 4c 45 22 20 6b 76 61 6c 29 29 0a 09 09 TITLE" kval))...
3040: 09 20 20 20 20 20 28 73 65 74 21 20 72 6f 77 6e . (set! rown
3050: 20 28 2b 20 72 6f 77 6e 20 31 29 29 29 29 0a 09 (+ rown 1))))..
3060: 09 09 20 6b 65 79 2d 76 61 6c 73 29 29 0a 0a 09 .. key-vals))...
3070: 20 20 20 20 20 3b 3b 20 46 6f 72 20 74 68 69 73 ;; For this
3080: 20 72 75 6e 20 6e 6f 77 20 66 69 6c 6c 20 69 6e run now fill in
3090: 20 74 68 65 20 62 75 74 74 6f 6e 73 20 66 6f 72 the buttons for
30a0: 20 65 61 63 68 20 74 65 73 74 0a 09 20 20 20 20 each test..
30b0: 20 28 6c 65 74 20 28 28 72 6f 77 6e 20 30 29 0a (let ((rown 0).
30c0: 09 09 20 20 20 28 63 6f 6c 75 6d 6e 64 61 74 20 .. (columndat
30d0: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 74 61 62 (vector-ref tab
30e0: 6c 65 20 63 6f 6c 6e 29 29 29 0a 09 20 20 20 20 le coln)))..
30f0: 20 20 20 28 66 6f 72 2d 65 61 63 68 0a 09 09 28 (for-each...(
3100: 6c 61 6d 62 64 61 20 28 74 65 73 74 6e 61 6d 65 lambda (testname
3110: 29 0a 09 09 20 20 28 6c 65 74 20 28 28 62 75 74 )... (let ((but
3120: 74 6f 6e 64 61 74 20 20 28 68 61 73 68 2d 74 61 tondat (hash-ta
3130: 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 ble-ref/default
3140: 2a 62 75 74 74 6f 6e 64 61 74 2a 20 28 6d 6b 73 *buttondat* (mks
3150: 74 72 20 63 6f 6c 6e 20 72 6f 77 6e 29 20 23 66 tr coln rown) #f
3160: 29 29 29 0a 09 09 20 20 20 20 28 69 66 20 62 75 )))... (if bu
3170: 74 74 6f 6e 64 61 74 0a 09 09 09 28 6c 65 74 2a ttondat....(let*
3180: 20 28 28 74 65 73 74 20 20 20 20 20 20 20 28 6c ((test (l
3190: 65 74 20 28 28 6d 61 74 63 68 69 6e 67 20 28 66 et ((matching (f
31a0: 69 6c 74 65 72 20 0a 09 09 09 09 09 09 09 20 20 ilter ........
31b0: 20 20 28 6c 61 6d 62 64 61 20 28 78 29 28 65 71 (lambda (x)(eq
31c0: 75 61 6c 3f 20 28 74 65 73 74 3a 74 65 73 74 2d ual? (test:test-
31d0: 67 65 74 2d 66 75 6c 6c 6e 61 6d 65 20 78 29 20 get-fullname x)
31e0: 74 65 73 74 6e 61 6d 65 29 29 0a 09 09 09 09 09 testname))......
31f0: 09 09 20 20 20 20 74 65 73 74 73 64 61 74 29 29 .. testsdat))
3200: 29 0a 09 09 09 09 09 20 20 20 20 20 28 69 66 20 )...... (if
3210: 28 6e 75 6c 6c 3f 20 6d 61 74 63 68 69 6e 67 29 (null? matching)
3220: 0a 09 09 09 09 09 09 20 28 76 65 63 74 6f 72 20 ....... (vector
3230: 2d 31 20 2d 31 20 22 22 20 22 22 20 22 22 20 30 -1 -1 "" "" "" 0
3240: 20 22 22 20 22 22 20 30 20 22 22 20 22 22 20 22 "" "" 0 "" "" "
3250: 22 20 30 20 22 22 20 22 22 29 0a 09 09 09 09 09 " 0 "" "")......
3260: 09 20 28 63 61 72 20 6d 61 74 63 68 69 6e 67 29 . (car matching)
3270: 29 29 29 0a 09 09 09 20 20 20 20 20 20 20 28 74 ))).... (t
3280: 65 73 74 6e 61 6d 65 20 20 20 28 64 62 3a 74 65 estname (db:te
3290: 73 74 2d 67 65 74 2d 74 65 73 74 6e 61 6d 65 20 st-get-testname
32a0: 20 74 65 73 74 29 29 0a 09 09 09 20 20 20 20 20 test))....
32b0: 20 20 28 69 74 65 6d 70 61 74 68 20 20 20 28 64 (itempath (d
32c0: 62 3a 74 65 73 74 2d 67 65 74 2d 69 74 65 6d 2d b:test-get-item-
32d0: 70 61 74 68 20 74 65 73 74 29 29 0a 09 09 09 20 path test))....
32e0: 20 20 20 20 20 20 28 74 65 73 74 66 75 6c 6c 6e (testfulln
32f0: 61 6d 65 20 28 74 65 73 74 3a 74 65 73 74 2d 67 ame (test:test-g
3300: 65 74 2d 66 75 6c 6c 6e 61 6d 65 20 74 65 73 74 et-fullname test
3310: 29 29 0a 09 09 09 20 20 20 20 20 20 20 28 74 65 )).... (te
3320: 73 74 73 74 61 74 75 73 20 28 64 62 3a 74 65 73 ststatus (db:tes
3330: 74 2d 67 65 74 2d 73 74 61 74 75 73 20 20 20 74 t-get-status t
3340: 65 73 74 29 29 0a 09 09 09 20 20 20 20 20 20 20 est))....
3350: 28 74 65 73 74 73 74 61 74 65 20 20 28 64 62 3a (teststate (db:
3360: 74 65 73 74 2d 67 65 74 2d 73 74 61 74 65 20 20 test-get-state
3370: 20 20 74 65 73 74 29 29 0a 09 09 09 20 20 20 20 test))....
3380: 20 20 20 28 74 65 73 74 73 74 61 72 74 20 20 28 (teststart (
3390: 64 62 3a 74 65 73 74 2d 67 65 74 2d 65 76 65 6e db:test-get-even
33a0: 74 5f 74 69 6d 65 20 74 65 73 74 29 29 0a 09 09 t_time test))...
33b0: 09 20 20 20 20 20 20 20 28 72 75 6e 74 69 6d 65 . (runtime
33c0: 20 20 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 (db:test-get
33d0: 2d 72 75 6e 5f 64 75 72 61 74 69 6f 6e 20 74 65 -run_duration te
33e0: 73 74 29 29 0a 09 09 09 20 20 20 20 20 20 20 28 st)).... (
33f0: 62 75 74 74 6f 6e 74 78 74 20 20 28 69 66 20 28 buttontxt (if (
3400: 65 71 75 61 6c 3f 20 74 65 73 74 73 74 61 74 65 equal? teststate
3410: 20 22 43 4f 4d 50 4c 45 54 45 44 22 29 20 74 65 "COMPLETED") te
3420: 73 74 73 74 61 74 75 73 20 74 65 73 74 73 74 61 ststatus teststa
3430: 74 65 29 29 0a 09 09 09 20 20 20 20 20 20 20 28 te)).... (
3440: 62 75 74 74 6f 6e 20 20 20 20 20 28 76 65 63 74 button (vect
3450: 6f 72 2d 72 65 66 20 63 6f 6c 75 6d 6e 64 61 74 or-ref columndat
3460: 20 72 6f 77 6e 29 29 0a 09 09 09 20 20 20 20 20 rown))....
3470: 20 20 28 63 6f 6c 6f 72 20 20 20 20 20 20 28 67 (color (g
3480: 65 74 2d 63 6f 6c 6f 72 2d 66 6f 72 2d 73 74 61 et-color-for-sta
3490: 74 65 2d 73 74 61 74 75 73 20 74 65 73 74 73 74 te-status testst
34a0: 61 74 65 20 74 65 73 74 73 74 61 74 75 73 29 29 ate teststatus))
34b0: 0a 09 09 09 20 20 20 20 20 20 20 28 63 75 72 72 .... (curr
34c0: 2d 63 6f 6c 6f 72 20 28 76 65 63 74 6f 72 2d 72 -color (vector-r
34d0: 65 66 20 62 75 74 74 6f 6e 64 61 74 20 31 29 29 ef buttondat 1))
34e0: 20 3b 3b 20 28 69 75 70 3a 61 74 74 72 69 62 75 ;; (iup:attribu
34f0: 74 65 20 62 75 74 74 6f 6e 20 22 42 47 43 4f 4c te button "BGCOL
3500: 4f 52 22 29 29 0a 09 09 09 20 20 20 20 20 20 20 OR"))....
3510: 28 63 75 72 72 2d 74 69 74 6c 65 20 28 76 65 63 (curr-title (vec
3520: 74 6f 72 2d 72 65 66 20 62 75 74 74 6f 6e 64 61 tor-ref buttonda
3530: 74 20 32 29 29 29 20 3b 3b 20 28 69 75 70 3a 61 t 2))) ;; (iup:a
3540: 74 74 72 69 62 75 74 65 20 62 75 74 74 6f 6e 20 ttribute button
3550: 22 54 49 54 4c 45 22 29 29 29 0a 09 09 09 20 20 "TITLE")))....
3560: 28 69 66 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f (if (not (equal?
3570: 20 63 75 72 72 2d 63 6f 6c 6f 72 20 63 6f 6c 6f curr-color colo
3580: 72 29 29 0a 09 09 09 20 20 20 20 20 20 28 69 75 r)).... (iu
3590: 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 p:attribute-set!
35a0: 20 62 75 74 74 6f 6e 20 22 42 47 43 4f 4c 4f 52 button "BGCOLOR
35b0: 22 20 63 6f 6c 6f 72 29 29 0a 09 09 09 20 20 28 " color)).... (
35c0: 69 66 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 if (not (equal?
35d0: 63 75 72 72 2d 74 69 74 6c 65 20 62 75 74 74 6f curr-title butto
35e0: 6e 74 78 74 29 29 0a 09 09 09 20 20 20 20 20 20 ntxt))....
35f0: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 (iup:attribute-s
3600: 65 74 21 20 62 75 74 74 6f 6e 20 22 54 49 54 4c et! button "TITL
3610: 45 22 20 20 20 62 75 74 74 6f 6e 74 78 74 29 29 E" buttontxt))
3620: 0a 09 09 09 20 20 28 76 65 63 74 6f 72 2d 73 65 .... (vector-se
3630: 74 21 20 62 75 74 74 6f 6e 64 61 74 20 30 20 72 t! buttondat 0 r
3640: 75 6e 2d 69 64 29 0a 09 09 09 20 20 28 76 65 63 un-id).... (vec
3650: 74 6f 72 2d 73 65 74 21 20 62 75 74 74 6f 6e 64 tor-set! buttond
3660: 61 74 20 31 20 63 6f 6c 6f 72 29 0a 09 09 09 20 at 1 color)....
3670: 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 62 75 (vector-set! bu
3680: 74 74 6f 6e 64 61 74 20 32 20 62 75 74 74 6f 6e ttondat 2 button
3690: 74 78 74 29 0a 09 09 09 20 20 28 76 65 63 74 6f txt).... (vecto
36a0: 72 2d 73 65 74 21 20 62 75 74 74 6f 6e 64 61 74 r-set! buttondat
36b0: 20 33 20 74 65 73 74 29 0a 09 09 09 20 20 28 76 3 test).... (v
36c0: 65 63 74 6f 72 2d 73 65 74 21 20 62 75 74 74 6f ector-set! butto
36d0: 6e 64 61 74 20 34 20 72 75 6e 2d 6b 65 79 29 29 ndat 4 run-key))
36e0: 29 0a 09 09 20 20 20 20 28 73 65 74 21 20 72 6f )... (set! ro
36f0: 77 6e 20 28 2b 20 72 6f 77 6e 20 31 29 29 29 29 wn (+ rown 1))))
3700: 0a 09 09 2a 61 6c 6c 74 65 73 74 6e 61 6d 65 6c ...*alltestnamel
3710: 73 74 2a 29 29 0a 09 20 20 20 20 20 28 73 65 74 st*)).. (set
3720: 21 20 63 6f 6c 6e 20 28 2b 20 63 6f 6c 6e 20 31 ! coln (+ coln 1
3730: 29 29 29 29 0a 09 20 72 75 6e 73 29 29 29 29 0a )))).. runs)))).
3740: 0a 28 64 65 66 69 6e 65 20 28 6d 6b 73 74 72 20 .(define (mkstr
3750: 2e 20 78 29 0a 20 20 28 73 74 72 69 6e 67 2d 69 . x). (string-i
3760: 6e 74 65 72 73 70 65 72 73 65 20 28 6d 61 70 20 ntersperse (map
3770: 63 6f 6e 63 20 78 29 20 22 2c 22 29 29 0a 0a 28 conc x) ","))..(
3780: 64 65 66 69 6e 65 20 28 75 70 64 61 74 65 2d 73 define (update-s
3790: 65 61 72 63 68 20 78 20 76 61 6c 29 0a 20 20 3b earch x val). ;
37a0: 3b 20 28 70 72 69 6e 74 20 22 53 65 74 74 69 6e ; (print "Settin
37b0: 67 20 73 65 61 72 63 68 20 66 6f 72 20 22 20 78 g search for " x
37c0: 20 22 20 74 6f 20 22 20 76 61 6c 29 0a 20 20 28 " to " val). (
37d0: 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 hash-table-set!
37e0: 2a 73 65 61 72 63 68 70 61 74 74 73 2a 20 78 20 *searchpatts* x
37f0: 76 61 6c 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 val))..(define (
3800: 6d 61 72 6b 2d 66 6f 72 2d 75 70 64 61 74 65 29 mark-for-update)
3810: 0a 20 20 28 73 65 74 21 20 2a 6c 61 73 74 2d 64 . (set! *last-d
3820: 62 2d 75 70 64 61 74 65 2d 74 69 6d 65 2a 20 30 b-update-time* 0
3830: 29 0a 20 20 28 73 65 74 21 20 2a 64 65 6c 61 79 ). (set! *delay
3840: 65 64 2d 75 70 64 61 74 65 2a 20 31 29 0a 20 20 ed-update* 1).
3850: 29 0a 0a 28 64 65 66 69 6e 65 20 28 6d 61 6b 65 )..(define (make
3860: 2d 64 61 73 68 62 6f 61 72 64 2d 62 75 74 74 6f -dashboard-butto
3870: 6e 73 20 6e 72 75 6e 73 20 6e 74 65 73 74 73 20 ns nruns ntests
3880: 6b 65 79 6e 61 6d 65 73 29 0a 20 20 28 6c 65 74 keynames). (let
3890: 2a 20 28 28 6e 6b 65 79 73 20 20 20 28 6c 65 6e * ((nkeys (len
38a0: 67 74 68 20 6b 65 79 6e 61 6d 65 73 29 29 0a 09 gth keynames))..
38b0: 20 28 72 75 6e 73 76 65 63 20 28 6d 61 6b 65 2d (runsvec (make-
38c0: 76 65 63 74 6f 72 20 6e 72 75 6e 73 29 29 0a 09 vector nruns))..
38d0: 20 28 68 65 61 64 65 72 20 20 28 6d 61 6b 65 2d (header (make-
38e0: 76 65 63 74 6f 72 20 6e 72 75 6e 73 29 29 0a 09 vector nruns))..
38f0: 20 28 6c 66 74 63 6f 6c 20 20 28 6d 61 6b 65 2d (lftcol (make-
3900: 76 65 63 74 6f 72 20 6e 74 65 73 74 73 29 29 0a vector ntests)).
3910: 09 20 28 6b 65 79 63 6f 6c 20 20 28 6d 61 6b 65 . (keycol (make
3920: 2d 76 65 63 74 6f 72 20 6e 74 65 73 74 73 29 29 -vector ntests))
3930: 0a 09 20 28 63 6f 6e 74 72 6f 6c 73 20 27 28 29 .. (controls '()
3940: 29 0a 09 20 28 6c 66 74 6c 73 74 20 20 27 28 29 ).. (lftlst '()
3950: 29 0a 09 20 28 68 64 72 6c 73 74 20 20 27 28 29 ).. (hdrlst '()
3960: 29 0a 09 20 28 62 64 79 6c 73 74 20 20 27 28 29 ).. (bdylst '()
3970: 29 0a 09 20 28 72 65 73 75 6c 74 20 20 27 28 29 ).. (result '()
3980: 29 0a 09 20 28 69 20 20 20 20 20 20 20 30 29 29 ).. (i 0))
3990: 0a 20 20 20 20 3b 3b 20 63 6f 6e 74 72 6f 6c 73 . ;; controls
39a0: 20 28 61 6c 6f 6e 67 20 62 6f 74 74 6f 6d 29 0a (along bottom).
39b0: 20 20 20 20 28 73 65 74 21 20 63 6f 6e 74 72 6f (set! contro
39c0: 6c 73 0a 09 20 20 28 69 75 70 3a 68 62 6f 78 0a ls.. (iup:hbox.
39d0: 09 20 20 20 28 69 75 70 3a 76 62 6f 78 0a 09 20 . (iup:vbox..
39e0: 20 20 20 28 69 75 70 3a 66 72 61 6d 65 20 0a 09 (iup:frame ..
39f0: 20 20 20 20 20 23 3a 74 69 74 6c 65 20 22 66 69 #:title "fi
3a00: 6c 74 65 72 20 74 65 73 74 20 61 6e 64 20 69 74 lter test and it
3a10: 65 6d 73 22 0a 09 20 20 20 20 20 28 69 75 70 3a ems".. (iup:
3a20: 68 62 6f 78 0a 09 20 20 20 20 20 20 28 69 75 70 hbox.. (iup
3a30: 3a 74 65 78 74 62 6f 78 20 23 3a 73 69 7a 65 20 :textbox #:size
3a40: 22 36 30 78 31 35 22 20 23 3a 66 6f 6e 74 73 69 "60x15" #:fontsi
3a50: 7a 65 20 22 31 30 22 20 23 3a 76 61 6c 75 65 20 ze "10" #:value
3a60: 22 25 22 0a 09 09 09 20 20 20 23 3a 61 63 74 69 "%".... #:acti
3a70: 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 20 on (lambda (obj
3a80: 75 6e 6b 20 76 61 6c 29 0a 09 09 09 09 20 20 20 unk val).....
3a90: 20 20 20 28 6d 61 72 6b 2d 66 6f 72 2d 75 70 64 (mark-for-upd
3aa0: 61 74 65 29 0a 09 09 09 09 20 20 20 20 20 20 28 ate)..... (
3ab0: 75 70 64 61 74 65 2d 73 65 61 72 63 68 20 22 74 update-search "t
3ac0: 65 73 74 2d 6e 61 6d 65 22 20 76 61 6c 29 29 29 est-name" val)))
3ad0: 0a 09 20 20 20 20 20 20 28 69 75 70 3a 74 65 78 .. (iup:tex
3ae0: 74 62 6f 78 20 23 3a 73 69 7a 65 20 22 36 30 78 tbox #:size "60x
3af0: 31 35 22 20 23 3a 66 6f 6e 74 73 69 7a 65 20 22 15" #:fontsize "
3b00: 31 30 22 20 23 3a 76 61 6c 75 65 20 22 25 22 0a 10" #:value "%".
3b10: 09 09 09 20 20 20 23 3a 61 63 74 69 6f 6e 20 28 ... #:action (
3b20: 6c 61 6d 62 64 61 20 28 6f 62 6a 20 75 6e 6b 20 lambda (obj unk
3b30: 76 61 6c 29 0a 09 09 09 09 20 20 20 20 20 20 28 val)..... (
3b40: 6d 61 72 6b 2d 66 6f 72 2d 75 70 64 61 74 65 29 mark-for-update)
3b50: 0a 09 09 09 09 20 20 20 20 20 20 28 75 70 64 61 ..... (upda
3b60: 74 65 2d 73 65 61 72 63 68 20 22 69 74 65 6d 2d te-search "item-
3b70: 6e 61 6d 65 22 20 76 61 6c 29 29 29 29 29 0a 09 name" val)))))..
3b80: 20 20 20 20 28 69 75 70 3a 76 62 6f 78 0a 09 20 (iup:vbox..
3b90: 20 20 20 20 28 69 75 70 3a 68 62 6f 78 0a 09 20 (iup:hbox..
3ba0: 20 20 20 20 20 28 69 75 70 3a 62 75 74 74 6f 6e (iup:button
3bb0: 20 22 53 6f 72 74 22 20 23 3a 61 63 74 69 6f 6e "Sort" #:action
3bc0: 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 29 0a 09 (lambda (obj)..
3bd0: 09 09 09 09 20 20 20 20 28 73 65 74 21 20 2a 74 .... (set! *t
3be0: 65 73 74 73 2d 73 6f 72 74 2d 72 65 76 65 72 73 ests-sort-revers
3bf0: 65 2a 20 28 6e 6f 74 20 2a 74 65 73 74 73 2d 73 e* (not *tests-s
3c00: 6f 72 74 2d 72 65 76 65 72 73 65 2a 29 29 0a 09 ort-reverse*))..
3c10: 09 09 09 09 20 20 20 20 28 69 75 70 3a 61 74 74 .... (iup:att
3c20: 72 69 62 75 74 65 2d 73 65 74 21 20 6f 62 6a 20 ribute-set! obj
3c30: 22 54 49 54 4c 45 22 20 28 69 66 20 2a 74 65 73 "TITLE" (if *tes
3c40: 74 73 2d 73 6f 72 74 2d 72 65 76 65 72 73 65 2a ts-sort-reverse*
3c50: 20 22 2b 53 6f 72 74 22 20 22 2d 53 6f 72 74 22 "+Sort" "-Sort"
3c60: 29 29 0a 09 09 09 09 09 20 20 20 20 28 6d 61 72 ))...... (mar
3c70: 6b 2d 66 6f 72 2d 75 70 64 61 74 65 29 29 29 0a k-for-update))).
3c80: 09 20 20 20 20 20 20 28 69 75 70 3a 62 75 74 74 . (iup:butt
3c90: 6f 6e 20 22 48 69 64 65 45 6d 70 74 79 22 20 23 on "HideEmpty" #
3ca0: 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 :action (lambda
3cb0: 28 6f 62 6a 29 0a 09 09 09 09 09 09 20 28 73 65 (obj)....... (se
3cc0: 74 21 20 2a 68 69 64 65 2d 65 6d 70 74 79 2d 72 t! *hide-empty-r
3cd0: 75 6e 73 2a 20 28 6e 6f 74 20 2a 68 69 64 65 2d uns* (not *hide-
3ce0: 65 6d 70 74 79 2d 72 75 6e 73 2a 29 29 0a 09 09 empty-runs*))...
3cf0: 09 09 09 09 20 28 69 75 70 3a 61 74 74 72 69 62 .... (iup:attrib
3d00: 75 74 65 2d 73 65 74 21 20 6f 62 6a 20 22 54 49 ute-set! obj "TI
3d10: 54 4c 45 22 20 28 69 66 20 2a 68 69 64 65 2d 65 TLE" (if *hide-e
3d20: 6d 70 74 79 2d 72 75 6e 73 2a 20 22 2b 48 69 64 mpty-runs* "+Hid
3d30: 65 22 20 22 2d 48 69 64 65 22 29 29 0a 09 09 09 e" "-Hide"))....
3d40: 09 09 09 20 28 6d 61 72 6b 2d 66 6f 72 2d 75 70 ... (mark-for-up
3d50: 64 61 74 65 29 29 29 0a 09 20 20 20 20 20 20 28 date))).. (
3d60: 69 75 70 3a 62 75 74 74 6f 6e 20 22 52 65 66 72 iup:button "Refr
3d70: 65 73 68 22 20 20 20 23 3a 61 63 74 69 6f 6e 20 esh" #:action
3d80: 28 6c 61 6d 62 64 61 20 28 6f 62 6a 29 0a 09 09 (lambda (obj)...
3d90: 09 09 09 09 20 28 6d 61 72 6b 2d 66 6f 72 2d 75 .... (mark-for-u
3da0: 70 64 61 74 65 29 29 29 29 0a 09 20 20 20 20 20 pdate))))..
3db0: 28 69 75 70 3a 68 62 6f 78 0a 09 20 20 20 20 20 (iup:hbox..
3dc0: 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 51 75 (iup:button "Qu
3dd0: 69 74 22 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 it" #:action (la
3de0: 6d 62 64 61 20 28 6f 62 6a 29 28 73 71 6c 69 74 mbda (obj)(sqlit
3df0: 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 2a 64 62 e3:finalize! *db
3e00: 2a 29 28 65 78 69 74 29 29 29 0a 09 20 20 20 20 *)(exit)))..
3e10: 20 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 4d (iup:button "M
3e20: 6f 6e 69 74 6f 72 22 20 23 3a 61 63 74 69 6f 6e onitor" #:action
3e30: 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 29 28 73 (lambda (obj)(s
3e40: 79 73 74 65 6d 20 28 63 6f 6e 63 20 28 63 61 72 ystem (conc (car
3e50: 20 28 61 72 67 76 29 29 22 20 2d 67 75 69 6d 6f (argv))" -guimo
3e60: 6e 69 74 6f 72 20 26 22 29 29 29 29 29 0a 09 20 nitor &")))))..
3e70: 20 20 20 20 29 29 0a 09 20 20 20 3b 3b 20 28 69 )).. ;; (i
3e80: 75 70 3a 62 75 74 74 6f 6e 20 22 3c 2d 20 20 4c up:button "<- L
3e90: 65 66 74 22 20 23 3a 61 63 74 69 6f 6e 20 28 6c eft" #:action (l
3ea0: 61 6d 62 64 61 20 28 6f 62 6a 29 28 73 65 74 21 ambda (obj)(set!
3eb0: 20 2a 73 74 61 72 74 2d 72 75 6e 2d 6f 66 66 73 *start-run-offs
3ec0: 65 74 2a 20 20 28 2b 20 2a 73 74 61 72 74 2d 72 et* (+ *start-r
3ed0: 75 6e 2d 6f 66 66 73 65 74 2a 20 31 29 29 29 29 un-offset* 1))))
3ee0: 0a 09 20 20 20 3b 3b 20 28 69 75 70 3a 62 75 74 .. ;; (iup:but
3ef0: 74 6f 6e 20 22 55 70 20 20 20 20 20 5e 22 20 23 ton "Up ^" #
3f00: 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 :action (lambda
3f10: 28 6f 62 6a 29 28 73 65 74 21 20 2a 73 74 61 72 (obj)(set! *star
3f20: 74 2d 74 65 73 74 2d 6f 66 66 73 65 74 2a 20 28 t-test-offset* (
3f30: 69 66 20 28 3e 20 2a 73 74 61 72 74 2d 74 65 73 if (> *start-tes
3f40: 74 2d 6f 66 66 73 65 74 2a 20 30 29 28 2d 20 2a t-offset* 0)(- *
3f50: 73 74 61 72 74 2d 74 65 73 74 2d 6f 66 66 73 65 start-test-offse
3f60: 74 2a 20 31 29 20 30 29 29 29 29 0a 09 20 20 20 t* 1) 0))))..
3f70: 3b 3b 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 ;; (iup:button "
3f80: 44 6f 77 6e 20 20 20 76 22 20 23 3a 61 63 74 69 Down v" #:acti
3f90: 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 29 on (lambda (obj)
3fa0: 28 73 65 74 21 20 2a 73 74 61 72 74 2d 74 65 73 (set! *start-tes
3fb0: 74 2d 6f 66 66 73 65 74 2a 20 28 69 66 20 28 3e t-offset* (if (>
3fc0: 3d 20 2a 73 74 61 72 74 2d 74 65 73 74 2d 6f 66 = *start-test-of
3fd0: 66 73 65 74 2a 20 28 6c 65 6e 67 74 68 20 2a 61 fset* (length *a
3fe0: 6c 6c 74 65 73 74 6e 61 6d 65 6c 73 74 2a 29 29 lltestnamelst*))
3ff0: 28 6c 65 6e 67 74 68 20 2a 61 6c 6c 74 65 73 74 (length *alltest
4000: 6e 61 6d 65 6c 73 74 2a 29 28 2b 20 2a 73 74 61 namelst*)(+ *sta
4010: 72 74 2d 74 65 73 74 2d 6f 66 66 73 65 74 2a 20 rt-test-offset*
4020: 31 29 29 29 29 29 0a 09 20 20 20 3b 3b 20 28 69 1))))).. ;; (i
4030: 75 70 3a 62 75 74 74 6f 6e 20 22 52 69 67 68 74 up:button "Right
4040: 20 2d 3e 22 20 23 3a 61 63 74 69 6f 6e 20 28 6c ->" #:action (l
4050: 61 6d 62 64 61 20 28 6f 62 6a 29 28 73 65 74 21 ambda (obj)(set!
4060: 20 2a 73 74 61 72 74 2d 72 75 6e 2d 6f 66 66 73 *start-run-offs
4070: 65 74 2a 20 20 28 69 66 20 28 3e 20 2a 73 74 61 et* (if (> *sta
4080: 72 74 2d 72 75 6e 2d 6f 66 66 73 65 74 2a 20 30 rt-run-offset* 0
4090: 29 28 2d 20 2a 73 74 61 72 74 2d 72 75 6e 2d 6f )(- *start-run-o
40a0: 66 66 73 65 74 2a 20 31 29 20 30 29 29 29 29 0a ffset* 1) 0)))).
40b0: 09 20 20 20 28 69 75 70 3a 66 72 61 6d 65 20 0a . (iup:frame .
40c0: 09 20 20 20 20 23 3a 74 69 74 6c 65 20 22 68 69 . #:title "hi
40d0: 64 65 22 0a 09 20 20 20 20 28 69 75 70 3a 76 62 de".. (iup:vb
40e0: 6f 78 0a 09 20 20 20 20 20 28 61 70 70 6c 79 20 ox.. (apply
40f0: 0a 09 20 20 20 20 20 20 69 75 70 3a 68 62 6f 78 .. iup:hbox
4100: 0a 09 20 20 20 20 20 20 28 6d 61 70 20 28 6c 61 .. (map (la
4110: 6d 62 64 61 20 28 73 74 61 74 75 73 29 0a 09 09 mbda (status)...
4120: 20 20 20 20 20 28 69 75 70 3a 74 6f 67 67 6c 65 (iup:toggle
4130: 20 73 74 61 74 75 73 20 20 23 3a 61 63 74 69 6f status #:actio
4140: 6e 20 20 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a n (lambda (obj
4150: 20 76 61 6c 29 0a 09 09 09 09 09 09 20 20 20 20 val).......
4160: 20 20 28 6d 61 72 6b 2d 66 6f 72 2d 75 70 64 61 (mark-for-upda
4170: 74 65 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 te).......
4180: 28 69 66 20 28 65 71 3f 20 76 61 6c 20 31 29 0a (if (eq? val 1).
4190: 09 09 09 09 09 09 09 20 20 28 68 61 73 68 2d 74 ....... (hash-t
41a0: 61 62 6c 65 2d 73 65 74 21 20 2a 73 74 61 74 75 able-set! *statu
41b0: 73 2d 69 67 6e 6f 72 65 2d 68 61 73 68 2a 20 73 s-ignore-hash* s
41c0: 74 61 74 75 73 20 23 74 29 0a 09 09 09 09 09 09 tatus #t).......
41d0: 09 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 64 . (hash-table-d
41e0: 65 6c 65 74 65 21 20 2a 73 74 61 74 75 73 2d 69 elete! *status-i
41f0: 67 6e 6f 72 65 2d 68 61 73 68 2a 20 73 74 61 74 gnore-hash* stat
4200: 75 73 29 29 29 29 29 0a 09 20 20 20 20 20 20 27 us))))).. '
4210: 28 22 50 41 53 53 22 20 22 46 41 49 4c 22 20 22 ("PASS" "FAIL" "
4220: 57 41 52 4e 22 20 22 43 48 45 43 4b 22 20 22 57 WARN" "CHECK" "W
4230: 41 49 56 45 44 22 20 22 53 54 55 43 4b 2f 44 45 AIVED" "STUCK/DE
4240: 41 44 22 20 22 6e 2f 61 22 29 29 29 0a 09 20 20 AD" "n/a")))..
4250: 20 20 20 28 61 70 70 6c 79 20 0a 09 20 20 20 20 (apply ..
4260: 20 20 69 75 70 3a 68 62 6f 78 0a 09 20 20 20 20 iup:hbox..
4270: 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 (map (lambda (
4280: 73 74 61 74 65 29 0a 09 09 20 20 20 20 20 28 69 state)... (i
4290: 75 70 3a 74 6f 67 67 6c 65 20 73 74 61 74 65 20 up:toggle state
42a0: 20 20 23 3a 61 63 74 69 6f 6e 20 20 20 28 6c 61 #:action (la
42b0: 6d 62 64 61 20 28 6f 62 6a 20 76 61 6c 29 0a 09 mbda (obj val)..
42c0: 09 09 09 09 09 20 20 20 20 20 20 28 6d 61 72 6b ..... (mark
42d0: 2d 66 6f 72 2d 75 70 64 61 74 65 29 0a 09 09 09 -for-update)....
42e0: 09 09 09 20 20 20 20 20 20 28 69 66 20 28 65 71 ... (if (eq
42f0: 3f 20 76 61 6c 20 31 29 0a 09 09 09 09 09 09 09 ? val 1)........
4300: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 (hash-table-se
4310: 74 21 20 2a 73 74 61 74 65 2d 69 67 6e 6f 72 65 t! *state-ignore
4320: 2d 68 61 73 68 2a 20 73 74 61 74 65 20 23 74 29 -hash* state #t)
4330: 0a 09 09 09 09 09 09 09 20 20 28 68 61 73 68 2d ........ (hash-
4340: 74 61 62 6c 65 2d 64 65 6c 65 74 65 21 20 2a 73 table-delete! *s
4350: 74 61 74 65 2d 69 67 6e 6f 72 65 2d 68 61 73 68 tate-ignore-hash
4360: 2a 20 73 74 61 74 65 29 29 29 29 29 0a 09 09 20 * state)))))...
4370: 20 20 27 28 22 52 55 4e 4e 49 4e 47 22 20 22 43 '("RUNNING" "C
4380: 4f 4d 50 4c 45 54 45 44 22 20 22 49 4e 43 4f 4d OMPLETED" "INCOM
4390: 50 4c 45 54 45 22 20 22 4c 41 55 4e 43 48 45 44 PLETE" "LAUNCHED
43a0: 22 20 22 4e 4f 54 5f 53 54 41 52 54 45 44 22 20 " "NOT_STARTED"
43b0: 22 4b 49 4c 4c 45 44 22 29 29 29 0a 09 20 20 20 "KILLED")))..
43c0: 20 20 28 69 75 70 3a 76 61 6c 75 61 74 6f 72 20 (iup:valuator
43d0: 23 3a 76 61 6c 75 65 63 68 61 6e 67 65 64 5f 63 #:valuechanged_c
43e0: 62 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 29 0a b (lambda (obj).
43f0: 09 09 09 09 09 20 20 20 20 20 20 20 28 6c 65 74 ..... (let
4400: 20 28 28 76 61 6c 20 28 69 6e 65 78 61 63 74 2d ((val (inexact-
4410: 3e 65 78 61 63 74 20 28 72 6f 75 6e 64 20 28 2f >exact (round (/
4420: 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 (string->number
4430: 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 20 (iup:attribute
4440: 6f 62 6a 20 22 56 41 4c 55 45 22 29 29 20 31 30 obj "VALUE")) 10
4450: 29 29 29 29 0a 09 09 09 09 09 09 20 20 20 20 20 )))).......
4460: 28 6f 6c 64 6d 61 78 20 20 20 28 73 74 72 69 6e (oldmax (strin
4470: 67 2d 3e 6e 75 6d 62 65 72 20 28 69 75 70 3a 61 g->number (iup:a
4480: 74 74 72 69 62 75 74 65 20 6f 62 6a 20 22 4d 41 ttribute obj "MA
4490: 58 22 29 29 29 0a 09 09 09 09 09 09 20 20 20 20 X"))).......
44a0: 20 28 6d 61 78 72 75 6e 73 20 20 2a 74 6f 74 2d (maxruns *tot-
44b0: 72 75 6e 2d 63 6f 75 6e 74 2a 29 29 0a 09 09 09 run-count*))....
44c0: 09 09 09 20 28 73 65 74 21 20 2a 73 74 61 72 74 ... (set! *start
44d0: 2d 72 75 6e 2d 6f 66 66 73 65 74 2a 20 76 61 6c -run-offset* val
44e0: 29 0a 09 09 09 09 09 09 20 28 6d 61 72 6b 2d 66 )....... (mark-f
44f0: 6f 72 2d 75 70 64 61 74 65 29 0a 09 09 09 09 09 or-update)......
4500: 09 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 36 . (debug:print 6
4510: 20 22 2a 73 74 61 72 74 2d 72 75 6e 2d 6f 66 66 "*start-run-off
4520: 73 65 74 2a 20 22 20 2a 73 74 61 72 74 2d 72 75 set* " *start-ru
4530: 6e 2d 6f 66 66 73 65 74 2a 20 22 20 6d 61 78 72 n-offset* " maxr
4540: 75 6e 73 3a 20 22 20 6d 61 78 72 75 6e 73 20 22 uns: " maxruns "
4550: 2c 20 76 61 6c 3a 20 22 20 76 61 6c 20 22 20 6f , val: " val " o
4560: 6c 64 6d 61 78 3a 20 22 20 6f 6c 64 6d 61 78 29 ldmax: " oldmax)
4570: 0a 09 09 09 09 09 09 20 28 69 75 70 3a 61 74 74 ....... (iup:att
4580: 72 69 62 75 74 65 2d 73 65 74 21 20 6f 62 6a 20 ribute-set! obj
4590: 22 4d 41 58 22 20 28 2a 20 6d 61 78 72 75 6e 73 "MAX" (* maxruns
45a0: 20 31 30 29 29 29 29 0a 09 09 09 20 20 20 23 3a 10)))).... #:
45b0: 65 78 70 61 6e 64 20 22 59 45 53 22 0a 09 09 09 expand "YES"....
45c0: 20 20 20 23 3a 6d 61 78 20 28 2a 20 31 30 20 28 #:max (* 10 (
45d0: 6c 65 6e 67 74 68 20 2a 61 6c 6c 72 75 6e 73 2a length *allruns*
45e0: 29 29 29 29 29 0a 09 20 20 20 3b 28 69 75 70 3a ))))).. ;(iup:
45f0: 62 75 74 74 6f 6e 20 22 69 6e 63 20 72 6f 77 73 button "inc rows
4600: 22 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 " #:action (lamb
4610: 64 61 20 28 6f 62 6a 29 28 73 65 74 21 20 2a 6e da (obj)(set! *n
4620: 75 6d 2d 74 65 73 74 73 2a 20 28 2b 20 2a 6e 75 um-tests* (+ *nu
4630: 6d 2d 74 65 73 74 73 2a 20 31 29 29 29 29 0a 09 m-tests* 1))))..
4640: 20 20 20 3b 28 69 75 70 3a 62 75 74 74 6f 6e 20 ;(iup:button
4650: 22 64 65 63 20 72 6f 77 73 22 20 23 3a 61 63 74 "dec rows" #:act
4660: 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a ion (lambda (obj
4670: 29 28 73 65 74 21 20 2a 6e 75 6d 2d 74 65 73 74 )(set! *num-test
4680: 73 2a 20 28 69 66 20 28 3e 20 2a 6e 75 6d 2d 74 s* (if (> *num-t
4690: 65 73 74 73 2a 20 30 29 28 2d 20 2a 6e 75 6d 2d ests* 0)(- *num-
46a0: 74 65 73 74 73 2a 20 31 29 20 30 29 29 29 29 0a tests* 1) 0)))).
46b0: 09 20 20 20 29 0a 09 20 20 29 0a 20 20 20 20 0a . ).. ). .
46c0: 20 20 20 20 3b 3b 20 63 72 65 61 74 65 20 74 68 ;; create th
46d0: 65 20 6c 65 66 74 20 6d 6f 73 74 20 63 6f 6c 75 e left most colu
46e0: 6d 6e 20 66 6f 72 20 74 68 65 20 72 75 6e 20 6b mn for the run k
46f0: 65 79 20 6e 61 6d 65 73 20 61 6e 64 20 74 68 65 ey names and the
4700: 20 74 65 73 74 20 6e 61 6d 65 73 20 0a 20 20 20 test names .
4710: 20 28 73 65 74 21 20 6c 66 74 6c 73 74 20 28 6c (set! lftlst (l
4720: 69 73 74 20 28 69 75 70 3a 68 62 6f 78 0a 09 09 ist (iup:hbox...
4730: 09 28 69 75 70 3a 6c 61 62 65 6c 29 20 3b 3b 20 .(iup:label) ;;
4740: 28 69 75 70 3a 76 61 6c 75 61 74 6f 72 29 0a 09 (iup:valuator)..
4750: 09 09 28 61 70 70 6c 79 20 69 75 70 3a 76 62 6f ..(apply iup:vbo
4760: 78 20 0a 09 09 09 20 20 20 20 20 20 20 28 6d 61 x .... (ma
4770: 70 20 28 6c 61 6d 62 64 61 20 28 78 29 09 09 0a p (lambda (x)...
4780: 09 09 09 09 20 20 20 20 20 20 28 6c 65 74 20 28 .... (let (
4790: 28 72 65 73 20 28 69 75 70 3a 68 62 6f 78 0a 09 (res (iup:hbox..
47a0: 09 09 09 09 09 20 20 28 69 75 70 3a 6c 61 62 65 ..... (iup:labe
47b0: 6c 20 78 20 23 3a 73 69 7a 65 20 22 34 30 78 31 l x #:size "40x1
47c0: 35 22 20 23 3a 66 6f 6e 74 73 69 7a 65 20 22 31 5" #:fontsize "1
47d0: 30 22 29 20 3b 3b 20 20 23 3a 65 78 70 61 6e 64 0") ;; #:expand
47e0: 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 29 0a 09 "HORIZONTAL")..
47f0: 09 09 09 09 09 20 20 28 69 75 70 3a 74 65 78 74 ..... (iup:text
4800: 62 6f 78 20 23 3a 73 69 7a 65 20 22 36 30 78 31 box #:size "60x1
4810: 35 22 20 23 3a 66 6f 6e 74 73 69 7a 65 20 22 31 5" #:fontsize "1
4820: 30 22 20 23 3a 76 61 6c 75 65 20 22 25 22 20 3b 0" #:value "%" ;
4830: 3b 20 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 ; #:expand "HORI
4840: 5a 4f 4e 54 41 4c 22 0a 09 09 09 09 09 09 09 20 ZONTAL"........
4850: 20 20 20 20 20 20 23 3a 61 63 74 69 6f 6e 20 28 #:action (
4860: 6c 61 6d 62 64 61 20 28 6f 62 6a 20 75 6e 6b 20 lambda (obj unk
4870: 76 61 6c 29 0a 09 09 09 09 09 09 09 09 09 20 20 val)..........
4880: 28 6d 61 72 6b 2d 66 6f 72 2d 75 70 64 61 74 65 (mark-for-update
4890: 29 0a 09 09 09 09 09 09 09 09 09 20 20 28 75 70 ).......... (up
48a0: 64 61 74 65 2d 73 65 61 72 63 68 20 78 20 76 61 date-search x va
48b0: 6c 29 29 29 29 29 29 0a 09 09 09 09 09 28 73 65 l))))))......(se
48c0: 74 21 20 69 20 28 2b 20 69 20 31 29 29 0a 09 09 t! i (+ i 1))...
48d0: 09 09 09 72 65 73 29 29 0a 09 09 09 09 20 20 20 ...res)).....
48e0: 20 6b 65 79 6e 61 6d 65 73 29 29 29 29 29 0a 20 keynames))))).
48f0: 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 74 (let loop ((t
4900: 65 73 74 6e 75 6d 20 20 30 29 0a 09 20 20 20 20 estnum 0)..
4910: 20 20 20 28 72 65 73 20 20 20 20 20 20 27 28 29 (res '()
4920: 29 29 0a 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 )). (cond.
4930: 20 20 20 20 20 20 28 28 3e 3d 20 74 65 73 74 6e ((>= testn
4940: 75 6d 20 6e 74 65 73 74 73 29 0a 09 3b 3b 20 6e um ntests)..;; n
4950: 6f 77 20 6c 66 74 6c 73 74 20 77 69 6c 6c 20 62 ow lftlst will b
4960: 65 20 61 6e 20 68 62 6f 78 20 77 69 74 68 20 74 e an hbox with t
4970: 68 65 20 74 65 73 74 20 6b 65 79 73 20 61 6e 64 he test keys and
4980: 20 74 68 65 20 74 65 73 74 20 6e 61 6d 65 20 6c the test name l
4990: 61 62 65 6c 73 0a 09 28 73 65 74 21 20 6c 66 74 abels..(set! lft
49a0: 6c 73 74 20 28 61 70 70 65 6e 64 20 6c 66 74 6c lst (append lftl
49b0: 73 74 20 28 6c 69 73 74 20 28 69 75 70 3a 68 62 st (list (iup:hb
49c0: 6f 78 20 0a 09 09 09 09 09 20 20 20 28 69 75 70 ox ...... (iup
49d0: 3a 76 61 6c 75 61 74 6f 72 20 23 3a 76 61 6c 75 :valuator #:valu
49e0: 65 63 68 61 6e 67 65 64 5f 63 62 20 28 6c 61 6d echanged_cb (lam
49f0: 62 64 61 20 28 6f 62 6a 29 0a 09 09 09 09 09 09 bda (obj).......
4a00: 09 09 09 20 20 20 20 20 28 6c 65 74 20 28 28 76 ... (let ((v
4a10: 61 6c 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 al (string->numb
4a20: 65 72 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 er (iup:attribut
4a30: 65 20 6f 62 6a 20 22 56 41 4c 55 45 22 29 29 29 e obj "VALUE")))
4a40: 0a 09 09 09 09 09 09 09 09 09 09 20 20 20 28 6f ........... (o
4a50: 6c 64 6d 61 78 20 20 28 73 74 72 69 6e 67 2d 3e ldmax (string->
4a60: 6e 75 6d 62 65 72 20 28 69 75 70 3a 61 74 74 72 number (iup:attr
4a70: 69 62 75 74 65 20 6f 62 6a 20 22 4d 41 58 22 29 ibute obj "MAX")
4a80: 29 29 0a 09 09 09 09 09 09 09 09 09 09 20 20 20 ))...........
4a90: 28 6e 65 77 6d 61 78 20 20 28 2a 20 31 30 20 28 (newmax (* 10 (
4aa0: 6c 65 6e 67 74 68 20 2a 61 6c 6c 74 65 73 74 6e length *alltestn
4ab0: 61 6d 65 6c 73 74 2a 29 29 29 29 0a 09 09 09 09 amelst*)))).....
4ac0: 09 09 09 09 09 20 20 20 20 20 20 20 28 73 65 74 ..... (set
4ad0: 21 20 2a 70 6c 65 61 73 65 2d 75 70 64 61 74 65 ! *please-update
4ae0: 2d 62 75 74 74 6f 6e 73 2a 20 23 74 29 0a 09 09 -buttons* #t)...
4af0: 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 73 ....... (s
4b00: 65 74 21 20 2a 73 74 61 72 74 2d 74 65 73 74 2d et! *start-test-
4b10: 6f 66 66 73 65 74 2a 20 28 69 6e 65 78 61 63 74 offset* (inexact
4b20: 2d 3e 65 78 61 63 74 20 28 72 6f 75 6e 64 20 28 ->exact (round (
4b30: 2f 20 76 61 6c 20 31 30 29 29 29 29 0a 09 09 09 / val 10))))....
4b40: 09 09 09 09 09 09 20 20 20 20 20 20 20 28 64 65 ...... (de
4b50: 62 75 67 3a 70 72 69 6e 74 20 36 20 22 2a 73 74 bug:print 6 "*st
4b60: 61 72 74 2d 74 65 73 74 2d 6f 66 66 73 65 74 2a art-test-offset*
4b70: 20 22 20 2a 73 74 61 72 74 2d 74 65 73 74 2d 6f " *start-test-o
4b80: 66 66 73 65 74 2a 20 22 20 76 61 6c 3a 20 22 20 ffset* " val: "
4b90: 76 61 6c 20 22 20 6e 65 77 6d 61 78 3a 20 22 20 val " newmax: "
4ba0: 6e 65 77 6d 61 78 20 22 20 6f 6c 64 6d 61 78 3a newmax " oldmax:
4bb0: 20 22 20 6f 6c 64 6d 61 78 29 0a 09 09 09 09 09 " oldmax)......
4bc0: 09 09 09 09 20 20 20 20 20 20 20 28 69 66 20 28 .... (if (
4bd0: 3c 20 76 61 6c 20 31 30 29 0a 09 09 09 09 09 09 < val 10).......
4be0: 09 09 09 09 20 20 20 28 69 75 70 3a 61 74 74 72 .... (iup:attr
4bf0: 69 62 75 74 65 2d 73 65 74 21 20 6f 62 6a 20 22 ibute-set! obj "
4c00: 4d 41 58 22 20 6e 65 77 6d 61 78 29 29 0a 09 09 MAX" newmax))...
4c10: 09 09 09 09 09 09 09 20 20 20 20 20 20 20 29 29 ....... ))
4c20: 0a 09 09 09 09 09 09 09 20 23 3a 65 78 70 61 6e ........ #:expan
4c30: 64 20 22 59 45 53 22 20 0a 09 09 09 09 09 09 09 d "YES" ........
4c40: 20 23 3a 6f 72 69 65 6e 74 61 74 69 6f 6e 20 22 #:orientation "
4c50: 56 45 52 54 49 43 41 4c 22 29 0a 09 09 09 09 09 VERTICAL")......
4c60: 20 20 20 28 61 70 70 6c 79 20 69 75 70 3a 76 62 (apply iup:vb
4c70: 6f 78 20 28 72 65 76 65 72 73 65 20 72 65 73 29 ox (reverse res)
4c80: 29 29 29 29 29 29 0a 20 20 20 20 20 20 20 28 65 )))))). (e
4c90: 6c 73 65 0a 09 28 6c 65 74 20 28 28 6c 61 62 6c lse..(let ((labl
4ca0: 20 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 22 (iup:button ""
4cb0: 20 0a 09 09 09 09 20 23 3a 66 6c 61 74 20 22 59 ..... #:flat "Y
4cc0: 45 53 22 20 0a 09 09 09 09 20 23 3a 61 6c 69 67 ES" ..... #:alig
4cd0: 6e 6d 65 6e 74 20 22 41 4c 45 46 54 22 0a 09 09 nment "ALEFT"...
4ce0: 09 09 20 3b 20 23 3a 69 6d 61 67 65 20 69 6d 67 .. ; #:image img
4cf0: 31 0a 09 09 09 09 20 3b 20 23 3a 69 6d 70 72 65 1..... ; #:impre
4d00: 73 73 20 69 6d 67 32 0a 09 09 09 09 20 23 3a 73 ss img2..... #:s
4d10: 69 7a 65 20 22 31 30 30 78 31 35 22 0a 09 09 09 ize "100x15"....
4d20: 09 20 23 3a 66 6f 6e 74 73 69 7a 65 20 22 31 30 . #:fontsize "10
4d30: 22 0a 09 09 09 09 20 23 3a 61 63 74 69 6f 6e 20 "..... #:action
4d40: 28 6c 61 6d 62 64 61 20 28 6f 62 6a 29 0a 09 09 (lambda (obj)...
4d50: 09 09 09 20 20 20 20 28 6d 61 72 6b 2d 66 6f 72 ... (mark-for
4d60: 2d 75 70 64 61 74 65 29 0a 09 09 09 09 09 20 20 -update)......
4d70: 20 20 28 74 6f 67 67 6c 65 2d 68 69 64 65 20 74 (toggle-hide t
4d80: 65 73 74 6e 75 6d 29 29 29 29 29 20 3b 3b 20 28 estnum))))) ;; (
4d90: 69 75 70 3a 61 74 74 72 69 62 75 74 65 20 6f 62 iup:attribute ob
4da0: 6a 20 22 54 49 54 4c 45 22 29 29 29 29 0a 09 20 j "TITLE"))))..
4db0: 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 6c 66 (vector-set! lf
4dc0: 74 63 6f 6c 20 74 65 73 74 6e 75 6d 20 6c 61 62 tcol testnum lab
4dd0: 6c 29 0a 09 20 20 28 6c 6f 6f 70 20 28 2b 20 74 l).. (loop (+ t
4de0: 65 73 74 6e 75 6d 20 31 29 28 63 6f 6e 73 20 6c estnum 1)(cons l
4df0: 61 62 6c 20 72 65 73 29 29 29 29 29 29 0a 20 20 abl res)))))).
4e00: 20 20 3b 3b 20 0a 20 20 20 20 28 6c 65 74 20 6c ;; . (let l
4e10: 6f 6f 70 20 28 28 72 75 6e 6e 75 6d 20 20 30 29 oop ((runnum 0)
4e20: 0a 09 20 20 20 20 20 20 20 28 6b 65 79 6e 75 6d .. (keynum
4e30: 20 20 30 29 0a 09 20 20 20 20 20 20 20 28 6b 65 0).. (ke
4e40: 79 76 65 63 20 20 28 6d 61 6b 65 2d 76 65 63 74 yvec (make-vect
4e50: 6f 72 20 6e 6b 65 79 73 29 29 0a 09 20 20 20 20 or nkeys))..
4e60: 20 20 20 28 72 65 73 20 20 20 20 27 28 29 29 29 (res '()))
4e70: 0a 20 20 20 20 20 20 28 63 6f 6e 64 20 3b 3b 20 . (cond ;;
4e80: 6e 62 2f 2f 20 6e 6f 20 65 6c 73 65 20 66 6f 72 nb// no else for
4e90: 20 74 68 69 73 20 61 70 70 72 6f 61 63 68 2e 0a this approach..
4ea0: 20 20 20 20 20 20 20 28 28 3e 3d 20 72 75 6e 6e ((>= runn
4eb0: 75 6d 20 6e 72 75 6e 73 29 20 23 66 29 0a 20 20 um nruns) #f).
4ec0: 20 20 20 20 20 28 28 3e 3d 20 6b 65 79 6e 75 6d ((>= keynum
4ed0: 20 6e 6b 65 79 73 29 20 0a 09 28 76 65 63 74 6f nkeys) ..(vecto
4ee0: 72 2d 73 65 74 21 20 68 65 61 64 65 72 20 72 75 r-set! header ru
4ef0: 6e 6e 75 6d 20 6b 65 79 76 65 63 29 0a 09 28 73 nnum keyvec)..(s
4f00: 65 74 21 20 68 64 72 6c 73 74 20 28 63 6f 6e 73 et! hdrlst (cons
4f10: 20 28 61 70 70 6c 79 20 69 75 70 3a 76 62 6f 78 (apply iup:vbox
4f20: 20 28 72 65 76 65 72 73 65 20 72 65 73 29 29 20 (reverse res))
4f30: 68 64 72 6c 73 74 29 29 0a 09 28 6c 6f 6f 70 20 hdrlst))..(loop
4f40: 28 2b 20 72 75 6e 6e 75 6d 20 31 29 20 30 20 28 (+ runnum 1) 0 (
4f50: 6d 61 6b 65 2d 76 65 63 74 6f 72 20 6e 6b 65 79 make-vector nkey
4f60: 73 29 20 27 28 29 29 29 0a 20 20 20 20 20 20 20 s) '())).
4f70: 28 65 6c 73 65 0a 09 28 6c 65 74 20 28 28 6c 61 (else..(let ((la
4f80: 62 6c 20 20 28 69 75 70 3a 6c 61 62 65 6c 20 22 bl (iup:label "
4f90: 22 20 23 3a 73 69 7a 65 20 22 36 30 78 31 35 22 " #:size "60x15"
4fa0: 20 23 3a 66 6f 6e 74 73 69 7a 65 20 22 31 30 22 #:fontsize "10"
4fb0: 29 29 29 20 3b 3b 20 23 3a 65 78 70 61 6e 64 20 ))) ;; #:expand
4fc0: 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 0a 09 20 20 "HORIZONTAL"..
4fd0: 28 76 65 63 74 6f 72 2d 73 65 74 21 20 6b 65 79 (vector-set! key
4fe0: 76 65 63 20 6b 65 79 6e 75 6d 20 6c 61 62 6c 29 vec keynum labl)
4ff0: 0a 09 20 20 28 6c 6f 6f 70 20 72 75 6e 6e 75 6d .. (loop runnum
5000: 20 28 2b 20 6b 65 79 6e 75 6d 20 31 29 20 6b 65 (+ keynum 1) ke
5010: 79 76 65 63 20 28 63 6f 6e 73 20 6c 61 62 6c 20 yvec (cons labl
5020: 72 65 73 29 29 29 29 29 29 0a 20 20 20 20 3b 3b res)))))). ;;
5030: 20 42 79 20 68 65 72 65 20 74 68 65 20 68 64 72 By here the hdr
5040: 6c 73 74 20 63 6f 6e 74 61 69 6e 73 20 61 20 6c lst contains a l
5050: 69 73 74 20 6f 66 20 76 62 6f 78 65 73 20 63 6f ist of vboxes co
5060: 6e 74 61 69 6e 69 6e 67 20 6e 6b 65 79 73 20 6c ntaining nkeys l
5070: 61 62 65 6c 73 0a 20 20 20 20 28 6c 65 74 20 6c abels. (let l
5080: 6f 6f 70 20 28 28 72 75 6e 6e 75 6d 20 20 30 29 oop ((runnum 0)
5090: 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 6e 75 .. (testnu
50a0: 6d 20 30 29 0a 09 20 20 20 20 20 20 20 28 74 65 m 0).. (te
50b0: 73 74 76 65 63 20 20 28 6d 61 6b 65 2d 76 65 63 stvec (make-vec
50c0: 74 6f 72 20 6e 74 65 73 74 73 29 29 0a 09 20 20 tor ntests))..
50d0: 20 20 20 20 20 28 72 65 73 20 20 20 20 27 28 29 (res '()
50e0: 29 29 0a 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 )). (cond.
50f0: 20 20 20 20 20 20 28 28 3e 3d 20 72 75 6e 6e 75 ((>= runnu
5100: 6d 20 6e 72 75 6e 73 29 20 23 66 29 20 3b 3b 20 m nruns) #f) ;;
5110: 20 28 76 65 63 74 6f 72 20 74 61 62 6c 65 68 65 (vector tablehe
5120: 61 64 65 72 20 72 75 6e 73 76 65 63 29 29 0a 20 ader runsvec)).
5130: 20 20 20 20 20 20 28 28 3e 3d 20 74 65 73 74 6e ((>= testn
5140: 75 6d 20 6e 74 65 73 74 73 29 20 0a 09 28 76 65 um ntests) ..(ve
5150: 63 74 6f 72 2d 73 65 74 21 20 72 75 6e 73 76 65 ctor-set! runsve
5160: 63 20 72 75 6e 6e 75 6d 20 74 65 73 74 76 65 63 c runnum testvec
5170: 29 0a 09 28 73 65 74 21 20 62 64 79 6c 73 74 20 )..(set! bdylst
5180: 28 63 6f 6e 73 20 28 61 70 70 6c 79 20 69 75 70 (cons (apply iup
5190: 3a 76 62 6f 78 20 28 72 65 76 65 72 73 65 20 72 :vbox (reverse r
51a0: 65 73 29 29 20 62 64 79 6c 73 74 29 29 0a 09 28 es)) bdylst))..(
51b0: 6c 6f 6f 70 20 28 2b 20 72 75 6e 6e 75 6d 20 31 loop (+ runnum 1
51c0: 29 20 30 20 28 6d 61 6b 65 2d 76 65 63 74 6f 72 ) 0 (make-vector
51d0: 20 6e 74 65 73 74 73 29 20 27 28 29 29 29 0a 20 ntests) '())).
51e0: 20 20 20 20 20 20 28 65 6c 73 65 0a 09 28 6c 65 (else..(le
51f0: 74 2a 20 28 28 62 75 74 74 6f 6e 2d 6b 65 79 20 t* ((button-key
5200: 28 6d 6b 73 74 72 20 72 75 6e 6e 75 6d 20 74 65 (mkstr runnum te
5210: 73 74 6e 75 6d 29 29 0a 09 20 20 20 20 20 20 20 stnum))..
5220: 28 62 75 74 6e 20 20 20 20 20 20 20 28 69 75 70 (butn (iup
5230: 3a 62 75 74 74 6f 6e 20 22 22 20 3b 3b 20 62 75 :button "" ;; bu
5240: 74 74 6f 6e 2d 6b 65 79 20 0a 09 09 09 09 20 20 tton-key .....
5250: 20 20 20 20 20 23 3a 73 69 7a 65 20 22 36 30 78 #:size "60x
5260: 31 35 22 20 0a 09 09 09 09 20 20 20 20 20 20 20 15" .....
5270: 3b 3b 20 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 ;; #:expand "HOR
5280: 49 5a 4f 4e 54 41 4c 22 0a 09 09 09 09 20 20 20 IZONTAL".....
5290: 20 20 20 20 23 3a 66 6f 6e 74 73 69 7a 65 20 22 #:fontsize "
52a0: 31 30 22 20 0a 09 09 09 09 20 20 20 20 20 20 20 10" .....
52b0: 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 #:action (lambda
52c0: 20 28 78 29 0a 09 09 09 09 09 09 20 20 28 6c 65 (x)....... (le
52d0: 74 2a 20 28 28 74 6f 6f 6c 70 61 74 68 20 28 63 t* ((toolpath (c
52e0: 61 72 20 28 61 72 67 76 29 29 29 0a 09 09 09 09 ar (argv))).....
52f0: 09 09 09 20 28 62 75 74 74 6e 64 61 74 20 28 68 ... (buttndat (h
5300: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 2a 62 ash-table-ref *b
5310: 75 74 74 6f 6e 64 61 74 2a 20 62 75 74 74 6f 6e uttondat* button
5320: 2d 6b 65 79 29 29 0a 09 09 09 09 09 09 09 20 28 -key))........ (
5330: 74 65 73 74 2d 69 64 20 20 28 64 62 3a 74 65 73 test-id (db:tes
5340: 74 2d 67 65 74 2d 69 64 20 28 76 65 63 74 6f 72 t-get-id (vector
5350: 2d 72 65 66 20 62 75 74 74 6e 64 61 74 20 33 29 -ref buttndat 3)
5360: 29 29 0a 09 09 09 09 09 09 09 20 28 63 6d 64 20 ))........ (cmd
5370: 20 28 63 6f 6e 63 20 74 6f 6f 6c 70 61 74 68 20 (conc toolpath
5380: 22 20 2d 74 65 73 74 20 22 20 74 65 73 74 2d 69 " -test " test-i
5390: 64 20 22 26 22 29 29 29 0a 09 09 09 09 09 09 20 d "&"))).......
53a0: 20 20 20 3b 28 70 72 69 6e 74 20 22 4c 61 75 6e ;(print "Laun
53b0: 63 68 69 6e 67 20 22 20 63 6d 64 29 0a 09 09 09 ching " cmd)....
53c0: 09 09 09 20 20 20 20 28 73 79 73 74 65 6d 20 63 ... (system c
53d0: 6d 64 29 29 29 29 29 29 0a 09 20 20 28 68 61 73 md)))))).. (has
53e0: 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 2a 62 75 h-table-set! *bu
53f0: 74 74 6f 6e 64 61 74 2a 20 62 75 74 74 6f 6e 2d ttondat* button-
5400: 6b 65 79 20 28 76 65 63 74 6f 72 20 30 20 22 31 key (vector 0 "1
5410: 30 30 20 31 30 30 20 31 30 30 22 20 62 75 74 74 00 100 100" butt
5420: 6f 6e 2d 6b 65 79 20 23 66 20 23 66 29 29 20 0a on-key #f #f)) .
5430: 09 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 . (vector-set!
5440: 74 65 73 74 76 65 63 20 74 65 73 74 6e 75 6d 20 testvec testnum
5450: 62 75 74 6e 29 0a 09 20 20 28 6c 6f 6f 70 20 72 butn).. (loop r
5460: 75 6e 6e 75 6d 20 28 2b 20 74 65 73 74 6e 75 6d unnum (+ testnum
5470: 20 31 29 20 74 65 73 74 76 65 63 20 28 63 6f 6e 1) testvec (con
5480: 73 20 62 75 74 6e 20 72 65 73 29 29 29 29 29 29 s butn res))))))
5490: 0a 20 20 20 20 3b 3b 20 6e 6f 77 20 61 73 73 65 . ;; now asse
54a0: 6d 62 6c 65 20 74 68 65 20 68 64 72 6c 73 74 20 mble the hdrlst
54b0: 61 6e 64 20 62 64 79 6c 73 74 20 61 6e 64 20 6b and bdylst and k
54c0: 69 63 6b 20 6f 66 66 20 74 68 65 20 64 69 61 6c ick off the dial
54d0: 6f 67 0a 20 20 20 20 28 69 75 70 3a 73 68 6f 77 og. (iup:show
54e0: 0a 20 20 20 20 20 28 69 75 70 3a 64 69 61 6c 6f . (iup:dialo
54f0: 67 20 0a 20 20 20 20 20 20 23 3a 74 69 74 6c 65 g . #:title
5500: 20 22 4d 65 67 61 74 65 73 74 20 64 61 73 68 62 "Megatest dashb
5510: 6f 61 72 64 22 0a 20 20 20 20 20 20 28 69 75 70 oard". (iup
5520: 3a 76 62 6f 78 0a 09 28 61 70 70 6c 79 20 69 75 :vbox..(apply iu
5530: 70 3a 68 62 6f 78 20 0a 09 20 20 20 20 20 20 20 p:hbox ..
5540: 28 63 6f 6e 73 20 28 61 70 70 6c 79 20 69 75 70 (cons (apply iup
5550: 3a 76 62 6f 78 20 6c 66 74 6c 73 74 29 0a 09 09 :vbox lftlst)...
5560: 20 20 20 20 20 28 6c 69 73 74 20 0a 09 09 20 20 (list ...
5570: 20 20 20 20 28 69 75 70 3a 76 62 6f 78 0a 09 09 (iup:vbox...
5580: 20 20 20 20 20 20 20 3b 3b 20 74 68 65 20 68 65 ;; the he
5590: 61 64 65 72 0a 09 09 20 20 20 20 20 20 20 28 61 ader... (a
55a0: 70 70 6c 79 20 69 75 70 3a 68 62 6f 78 20 28 72 pply iup:hbox (r
55b0: 65 76 65 72 73 65 20 68 64 72 6c 73 74 29 29 0a everse hdrlst)).
55c0: 09 09 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 .. (apply
55d0: 69 75 70 3a 68 62 6f 78 20 28 72 65 76 65 72 73 iup:hbox (revers
55e0: 65 20 62 64 79 6c 73 74 29 29 29 29 29 29 0a 20 e bdylst)))))).
55f0: 20 20 20 20 20 20 63 6f 6e 74 72 6f 6c 73 29 29 controls))
5600: 29 0a 20 20 20 20 28 76 65 63 74 6f 72 20 6b 65 ). (vector ke
5610: 79 63 6f 6c 20 6c 66 74 63 6f 6c 20 68 65 61 64 ycol lftcol head
5620: 65 72 20 72 75 6e 73 76 65 63 29 29 29 0a 0a 28 er runsvec)))..(
5630: 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 if (or (args:get
5640: 2d 61 72 67 20 22 2d 72 6f 77 73 22 29 0a 09 28 -arg "-rows")..(
5650: 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d get-environment-
5660: 76 61 72 69 61 62 6c 65 20 22 44 41 53 48 42 4f variable "DASHBO
5670: 41 52 44 52 4f 57 53 22 20 29 29 0a 20 20 20 20 ARDROWS" )).
5680: 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20 20 28 (begin. (
5690: 73 65 74 21 20 2a 6e 75 6d 2d 74 65 73 74 73 2a set! *num-tests*
56a0: 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 (string->number
56b0: 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 (or (args:get-a
56c0: 72 67 20 22 2d 72 6f 77 73 22 29 0a 09 09 09 09 rg "-rows").....
56d0: 09 20 20 20 20 20 20 28 67 65 74 2d 65 6e 76 69 . (get-envi
56e0: 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 ronment-variable
56f0: 20 22 44 41 53 48 42 4f 41 52 44 52 4f 57 53 22 "DASHBOARDROWS"
5700: 29 29 29 29 0a 09 28 75 70 64 61 74 65 2d 72 75 ))))..(update-ru
5710: 6e 64 61 74 20 22 25 22 20 2a 6e 75 6d 2d 72 75 ndat "%" *num-ru
5720: 6e 73 2a 20 22 25 22 20 22 25 22 20 27 28 29 29 ns* "%" "%" '())
5730: 29 0a 20 20 20 20 28 73 65 74 21 20 2a 6e 75 6d ). (set! *num
5740: 2d 74 65 73 74 73 2a 20 28 6d 69 6e 20 28 6d 61 -tests* (min (ma
5750: 78 20 28 75 70 64 61 74 65 2d 72 75 6e 64 61 74 x (update-rundat
5760: 20 22 25 22 20 2a 6e 75 6d 2d 72 75 6e 73 2a 20 "%" *num-runs*
5770: 22 25 22 20 22 25 22 20 27 28 29 29 20 38 29 20 "%" "%" '()) 8)
5780: 32 30 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 2a 20)))..(define *
5790: 74 69 6d 2a 20 28 69 75 70 3a 74 69 6d 65 72 29 tim* (iup:timer)
57a0: 29 0a 28 64 65 66 69 6e 65 20 2a 6f 72 64 2a 20 ).(define *ord*
57b0: 23 66 29 0a 28 69 75 70 3a 61 74 74 72 69 62 75 #f).(iup:attribu
57c0: 74 65 2d 73 65 74 21 20 2a 74 69 6d 2a 20 22 54 te-set! *tim* "T
57d0: 49 4d 45 22 20 33 30 30 29 0a 28 69 75 70 3a 61 IME" 300).(iup:a
57e0: 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 2a 74 ttribute-set! *t
57f0: 69 6d 2a 20 22 52 55 4e 22 20 22 59 45 53 22 29 im* "RUN" "YES")
5800: 0a 0a 3b 3b 20 4d 6f 76 65 20 74 68 69 73 20 73 ..;; Move this s
5810: 74 75 66 66 20 74 6f 20 64 62 2e 73 63 6d 20 46 tuff to db.scm F
5820: 49 58 4d 45 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 IXME.;;.(define
5830: 2a 6c 61 73 74 2d 64 62 2d 75 70 64 61 74 65 2d *last-db-update-
5840: 74 69 6d 65 2a 20 28 66 69 6c 65 2d 6d 6f 64 69 time* (file-modi
5850: 66 69 63 61 74 69 6f 6e 2d 74 69 6d 65 20 28 63 fication-time (c
5860: 6f 6e 63 20 2a 74 6f 70 70 61 74 68 2a 20 22 2f onc *toppath* "/
5870: 6d 65 67 61 74 65 73 74 2e 64 62 22 29 29 29 0a megatest.db"))).
5880: 28 64 65 66 69 6e 65 20 28 64 62 3a 62 65 65 6e (define (db:been
5890: 2d 63 68 61 6e 67 65 64 29 0a 20 20 28 3e 20 28 -changed). (> (
58a0: 66 69 6c 65 2d 6d 6f 64 69 66 69 63 61 74 69 6f file-modificatio
58b0: 6e 2d 74 69 6d 65 20 28 63 6f 6e 63 20 2a 74 6f n-time (conc *to
58c0: 70 70 61 74 68 2a 20 22 2f 6d 65 67 61 74 65 73 ppath* "/megates
58d0: 74 2e 64 62 22 29 29 20 2a 6c 61 73 74 2d 64 62 t.db")) *last-db
58e0: 2d 75 70 64 61 74 65 2d 74 69 6d 65 2a 29 29 0a -update-time*)).
58f0: 28 64 65 66 69 6e 65 20 28 64 62 3a 73 65 74 2d (define (db:set-
5900: 64 62 2d 75 70 64 61 74 65 2d 74 69 6d 65 29 0a db-update-time).
5910: 20 20 28 73 65 74 21 20 2a 6c 61 73 74 2d 64 62 (set! *last-db
5920: 2d 75 70 64 61 74 65 2d 74 69 6d 65 2a 20 28 66 -update-time* (f
5930: 69 6c 65 2d 6d 6f 64 69 66 69 63 61 74 69 6f 6e ile-modification
5940: 2d 74 69 6d 65 20 28 63 6f 6e 63 20 2a 74 6f 70 -time (conc *top
5950: 70 61 74 68 2a 20 22 2f 6d 65 67 61 74 65 73 74 path* "/megatest
5960: 2e 64 62 22 29 29 29 29 0a 0a 28 64 65 66 69 6e .db"))))..(defin
5970: 65 20 28 72 75 6e 2d 75 70 64 61 74 65 20 78 29 e (run-update x)
5980: 0a 20 20 28 75 70 64 61 74 65 2d 62 75 74 74 6f . (update-butto
5990: 6e 73 20 75 69 64 61 74 20 2a 6e 75 6d 2d 72 75 ns uidat *num-ru
59a0: 6e 73 2a 20 2a 6e 75 6d 2d 74 65 73 74 73 2a 29 ns* *num-tests*)
59b0: 0a 20 20 3b 3b 20 28 69 66 20 28 64 62 3a 62 65 . ;; (if (db:be
59c0: 65 6e 2d 63 68 61 6e 67 65 64 29 0a 20 20 28 62 en-changed). (b
59d0: 65 67 69 6e 0a 20 20 20 20 28 75 70 64 61 74 65 egin. (update
59e0: 2d 72 75 6e 64 61 74 20 28 68 61 73 68 2d 74 61 -rundat (hash-ta
59f0: 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 ble-ref/default
5a00: 2a 73 65 61 72 63 68 70 61 74 74 73 2a 20 22 72 *searchpatts* "r
5a10: 75 6e 6e 61 6d 65 22 20 22 25 22 29 20 2a 6e 75 unname" "%") *nu
5a20: 6d 2d 72 75 6e 73 2a 0a 09 09 20 20 20 28 68 61 m-runs*... (ha
5a30: 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 sh-table-ref/def
5a40: 61 75 6c 74 20 2a 73 65 61 72 63 68 70 61 74 74 ault *searchpatt
5a50: 73 2a 20 22 74 65 73 74 2d 6e 61 6d 65 22 20 22 s* "test-name" "
5a60: 25 22 29 0a 09 09 20 20 20 28 68 61 73 68 2d 74 %")... (hash-t
5a70: 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 able-ref/default
5a80: 20 2a 73 65 61 72 63 68 70 61 74 74 73 2a 20 22 *searchpatts* "
5a90: 69 74 65 6d 2d 6e 61 6d 65 22 20 22 25 22 29 0a item-name" "%").
5aa0: 09 09 20 20 20 28 6c 65 74 20 28 28 72 65 73 20 .. (let ((res
5ab0: 27 28 29 29 29 0a 09 09 20 20 20 20 20 28 66 6f '()))... (fo
5ac0: 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 r-each (lambda (
5ad0: 6b 65 79 29 0a 09 09 09 09 20 28 6c 65 74 20 28 key)..... (let (
5ae0: 28 76 61 6c 20 28 68 61 73 68 2d 74 61 62 6c 65 (val (hash-table
5af0: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 2a 73 65 -ref/default *se
5b00: 61 72 63 68 70 61 74 74 73 2a 20 6b 65 79 20 23 archpatts* key #
5b10: 66 29 29 29 0a 09 09 09 09 20 20 20 28 69 66 20 f)))..... (if
5b20: 76 61 6c 20 28 73 65 74 21 20 72 65 73 20 28 63 val (set! res (c
5b30: 6f 6e 73 20 28 6c 69 73 74 20 6b 65 79 20 76 61 ons (list key va
5b40: 6c 29 20 72 65 73 29 29 29 29 29 0a 09 09 09 20 l) res)))))....
5b50: 20 20 20 20 20 20 2a 64 62 6b 65 79 73 2a 29 0a *dbkeys*).
5b60: 09 09 20 20 20 20 20 72 65 73 29 29 0a 20 20 20 .. res)).
5b70: 20 3b 20 28 64 62 3a 73 65 74 2d 64 62 2d 75 70 ; (db:set-db-up
5b80: 64 61 74 65 2d 74 69 6d 65 29 0a 20 20 20 20 29 date-time). )
5b90: 29 0a 0a 28 63 6f 6e 64 20 0a 20 28 28 61 72 67 )..(cond . ((arg
5ba0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 22 s:get-arg "-run"
5bb0: 29 0a 20 20 28 6c 65 74 20 28 28 72 75 6e 69 64 ). (let ((runid
5bc0: 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 (string->number
5bd0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
5be0: 2d 72 75 6e 22 29 29 29 29 0a 20 20 20 20 28 69 -run")))). (i
5bf0: 66 20 72 75 6e 69 64 0a 09 28 62 65 67 69 6e 0a f runid..(begin.
5c00: 09 20 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 . (lambda (x)..
5c10: 20 20 20 20 28 6f 6e 2d 65 78 69 74 20 28 6c 61 (on-exit (la
5c20: 6d 62 64 61 20 28 29 0a 09 09 20 20 20 20 20 20 mbda ()...
5c30: 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 (sqlite3:finali
5c40: 7a 65 21 20 2a 64 62 2a 29 29 29 0a 09 20 20 20 ze! *db*)))..
5c50: 20 28 65 78 61 6d 69 6e 65 2d 72 75 6e 20 2a 64 (examine-run *d
5c60: 62 2a 20 72 75 6e 69 64 29 29 29 0a 09 28 62 65 b* runid)))..(be
5c70: 67 69 6e 0a 09 20 20 28 70 72 69 6e 74 20 22 45 gin.. (print "E
5c80: 52 52 4f 52 3a 20 72 75 6e 69 64 20 69 73 20 6e RROR: runid is n
5c90: 6f 74 20 61 20 6e 75 6d 62 65 72 20 22 20 28 61 ot a number " (a
5ca0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 rgs:get-arg "-ru
5cb0: 6e 22 29 29 0a 09 20 20 28 65 78 69 74 20 31 29 n")).. (exit 1)
5cc0: 29 29 29 29 0a 20 28 28 61 72 67 73 3a 67 65 74 )))). ((args:get
5cd0: 2d 61 72 67 20 22 2d 74 65 73 74 22 29 0a 20 20 -arg "-test").
5ce0: 20 20 28 6c 65 74 20 28 28 74 65 73 74 69 64 20 (let ((testid
5cf0: 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 (string->number
5d00: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
5d10: 74 65 73 74 22 29 29 29 29 0a 20 20 20 20 28 69 test")))). (i
5d20: 66 20 74 65 73 74 69 64 0a 09 28 65 78 61 6d 69 f testid..(exami
5d30: 6e 65 2d 74 65 73 74 20 2a 64 62 2a 20 74 65 73 ne-test *db* tes
5d40: 74 69 64 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 tid)..(begin..
5d50: 28 70 72 69 6e 74 20 22 45 52 52 4f 52 3a 20 74 (print "ERROR: t
5d60: 65 73 74 69 64 20 69 73 20 6e 6f 74 20 61 20 6e estid is not a n
5d70: 75 6d 62 65 72 20 22 20 28 61 72 67 73 3a 67 65 umber " (args:ge
5d80: 74 2d 61 72 67 20 22 2d 74 65 73 74 22 29 29 0a t-arg "-test")).
5d90: 09 20 20 28 65 78 69 74 20 31 29 29 29 29 29 0a . (exit 1))))).
5da0: 20 28 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ((args:get-arg
5db0: 22 2d 67 75 69 6d 6f 6e 69 74 6f 72 22 29 0a 20 "-guimonitor").
5dc0: 20 28 67 75 69 2d 6d 6f 6e 69 74 6f 72 20 2a 64 (gui-monitor *d
5dd0: 62 2a 29 29 0a 20 28 28 61 72 67 73 3a 67 65 74 b*)). ((args:get
5de0: 2d 61 72 67 20 22 2d 6d 61 69 6e 22 29 0a 20 20 -arg "-main").
5df0: 28 69 75 70 3a 73 68 6f 77 20 28 6d 61 69 6e 2d (iup:show (main-
5e00: 70 61 6e 65 6c 29 29 29 0a 20 28 65 6c 73 65 0a panel))). (else.
5e10: 20 20 28 73 65 74 21 20 75 69 64 61 74 20 28 6d (set! uidat (m
5e20: 61 6b 65 2d 64 61 73 68 62 6f 61 72 64 2d 62 75 ake-dashboard-bu
5e30: 74 74 6f 6e 73 20 2a 6e 75 6d 2d 72 75 6e 73 2a ttons *num-runs*
5e40: 20 2a 6e 75 6d 2d 74 65 73 74 73 2a 20 2a 64 62 *num-tests* *db
5e50: 6b 65 79 73 2a 29 29 0a 20 20 28 69 75 70 3a 63 keys*)). (iup:c
5e60: 61 6c 6c 62 61 63 6b 2d 73 65 74 21 20 2a 74 69 allback-set! *ti
5e70: 6d 2a 0a 09 09 20 20 20 20 20 22 41 43 54 49 4f m*... "ACTIO
5e80: 4e 5f 43 42 22 0a 09 09 20 20 20 20 20 28 6c 61 N_CB"... (la
5e90: 6d 62 64 61 20 28 78 29 0a 09 09 20 20 20 20 20 mbda (x)...
5ea0: 20 20 28 72 75 6e 2d 75 70 64 61 74 65 20 78 29 (run-update x)
5eb0: 29 29 29 29 0a 09 09 20 20 20 20 20 20 20 3b 28 ))))... ;(
5ec0: 70 72 69 6e 74 20 78 29 29 29 29 29 0a 0a 28 69 print x)))))..(i
5ed0: 75 70 3a 6d 61 69 6e 2d 6c 6f 6f 70 29 0a up:main-loop).