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