Artifact
ecffa2c95e1f47346f7e2faffcf61a8e0b7dd8b4
File
dashboard.scm
— part of check-in
[0824b86fb8]
at
2011-10-11 23:08:07
on branch trunk
— Refactored radio buttons and added update on toggle
(user:
matt
size: 24020)
0000: 6b 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d k;;=============
0010: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0020: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0030: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0040: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 43 6f 70 =========.;; Cop
0050: 79 72 69 67 68 74 20 32 30 30 36 2d 32 30 31 31 yright 2006-2011
0060: 2c 20 4d 61 74 74 68 65 77 20 57 65 6c 6c 61 6e , Matthew Wellan
0070: 64 2e 0a 3b 3b 20 0a 3b 3b 20 20 54 68 69 73 20 d..;; .;; This
0080: 70 72 6f 67 72 61 6d 20 69 73 20 6d 61 64 65 20 program is made
0090: 61 76 61 69 6c 61 62 6c 65 20 75 6e 64 65 72 20 available under
00a0: 74 68 65 20 47 4e 55 20 47 50 4c 20 76 65 72 73 the GNU GPL vers
00b0: 69 6f 6e 20 32 2e 30 20 6f 72 0a 3b 3b 20 20 67 ion 2.0 or.;; g
00c0: 72 65 61 74 65 72 2e 20 53 65 65 20 74 68 65 20 reater. See the
00d0: 61 63 63 6f 6d 70 61 6e 79 69 6e 67 20 66 69 6c accompanying fil
00e0: 65 20 43 4f 50 59 49 4e 47 20 66 6f 72 20 64 65 e COPYING for de
00f0: 74 61 69 6c 73 2e 0a 3b 3b 20 0a 3b 3b 20 20 54 tails..;; .;; T
0100: 68 69 73 20 70 72 6f 67 72 61 6d 20 69 73 20 64 his program is d
0110: 69 73 74 72 69 62 75 74 65 64 20 57 49 54 48 4f istributed WITHO
0120: 55 54 20 41 4e 59 20 57 41 52 52 41 4e 54 59 3b UT ANY WARRANTY;
0130: 20 77 69 74 68 6f 75 74 20 65 76 65 6e 20 74 68 without even th
0140: 65 0a 3b 3b 20 20 69 6d 70 6c 69 65 64 20 77 61 e.;; implied wa
0150: 72 72 61 6e 74 79 20 6f 66 20 4d 45 52 43 48 41 rranty of MERCHA
0160: 4e 54 41 42 49 4c 49 54 59 20 6f 72 20 46 49 54 NTABILITY or FIT
0170: 4e 45 53 53 20 46 4f 52 20 41 20 50 41 52 54 49 NESS FOR A PARTI
0180: 43 55 4c 41 52 0a 3b 3b 20 20 50 55 52 50 4f 53 CULAR.;; PURPOS
0190: 45 2e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d E..;;===========
01a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 75 73 ===========..(us
01e0: 65 20 66 6f 72 6d 61 74 29 0a 28 72 65 71 75 69 e format).(requi
01f0: 72 65 2d 6c 69 62 72 61 72 79 20 69 75 70 29 0a re-library iup).
0200: 28 69 6d 70 6f 72 74 20 28 70 72 65 66 69 78 20 (import (prefix
0210: 69 75 70 20 69 75 70 3a 29 29 0a 0a 28 75 73 65 iup iup:))..(use
0220: 20 63 61 6e 76 61 73 2d 64 72 61 77 29 0a 0a 28 canvas-draw)..(
0230: 75 73 65 20 73 71 6c 69 74 65 33 20 73 72 66 69 use sqlite3 srfi
0240: 2d 31 20 70 6f 73 69 78 20 72 65 67 65 78 20 72 -1 posix regex r
0250: 65 67 65 78 2d 63 61 73 65 20 73 72 66 69 2d 36 egex-case srfi-6
0260: 39 29 0a 28 69 6d 70 6f 72 74 20 28 70 72 65 66 9).(import (pref
0270: 69 78 20 73 71 6c 69 74 65 33 20 73 71 6c 69 74 ix sqlite3 sqlit
0280: 65 33 3a 29 29 0a 0a 28 64 65 63 6c 61 72 65 20 e3:))..(declare
0290: 28 75 73 65 73 20 63 6f 6d 6d 6f 6e 29 29 0a 28 (uses common)).(
02a0: 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 6d 61 declare (uses ma
02b0: 72 67 73 29 29 0a 28 64 65 63 6c 61 72 65 20 28 rgs)).(declare (
02c0: 75 73 65 73 20 6b 65 79 73 29 29 0a 28 64 65 63 uses keys)).(dec
02d0: 6c 61 72 65 20 28 75 73 65 73 20 69 74 65 6d 73 lare (uses items
02e0: 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 )).(declare (use
02f0: 73 20 64 62 29 29 0a 28 64 65 63 6c 61 72 65 20 s db)).(declare
0300: 28 75 73 65 73 20 63 6f 6e 66 69 67 66 29 29 0a (uses configf)).
0310: 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 70 (declare (uses p
0320: 72 6f 63 65 73 73 29 29 0a 28 64 65 63 6c 61 72 rocess)).(declar
0330: 65 20 28 75 73 65 73 20 6c 61 75 6e 63 68 29 29 e (uses launch))
0340: 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 .(declare (uses
0350: 72 75 6e 73 29 29 0a 28 64 65 63 6c 61 72 65 20 runs)).(declare
0360: 28 75 73 65 73 20 64 61 73 68 62 6f 61 72 64 2d (uses dashboard-
0370: 74 65 73 74 73 29 29 0a 28 64 65 63 6c 61 72 65 tests)).(declare
0380: 20 28 75 73 65 73 20 6d 65 67 61 74 65 73 74 2d (uses megatest-
0390: 76 65 72 73 69 6f 6e 29 29 0a 0a 28 69 6e 63 6c version))..(incl
03a0: 75 64 65 20 22 63 6f 6d 6d 6f 6e 5f 72 65 63 6f ude "common_reco
03b0: 72 64 73 2e 73 63 6d 22 29 0a 28 69 6e 63 6c 75 rds.scm").(inclu
03c0: 64 65 20 22 64 62 5f 72 65 63 6f 72 64 73 2e 73 de "db_records.s
03d0: 63 6d 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 72 cm").(include "r
03e0: 75 6e 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 29 un_records.scm")
03f0: 0a 0a 28 64 65 66 69 6e 65 20 68 65 6c 70 20 28 ..(define help (
0400: 63 6f 6e 63 20 0a 22 4d 65 67 61 74 65 73 74 20 conc ."Megatest
0410: 44 61 73 68 62 6f 61 72 64 2c 20 64 6f 63 75 6d Dashboard, docum
0420: 65 6e 74 61 74 69 6f 6e 20 61 74 20 68 74 74 70 entation at http
0430: 3a 2f 2f 77 77 77 2e 6b 69 61 74 6f 61 2e 63 6f ://www.kiatoa.co
0440: 6d 2f 66 6f 73 73 69 6c 73 2f 6d 65 67 61 74 65 m/fossils/megate
0450: 73 74 0a 20 20 76 65 72 73 69 6f 6e 20 22 20 6d st. version " m
0460: 65 67 61 74 65 73 74 2d 76 65 72 73 69 6f 6e 20 egatest-version
0470: 22 0a 20 20 6c 69 63 65 6e 73 65 20 47 50 4c 2c ". license GPL,
0480: 20 43 6f 70 79 72 69 67 68 74 20 28 43 29 20 4d Copyright (C) M
0490: 61 74 74 20 57 65 6c 6c 61 6e 64 20 32 30 31 31 att Welland 2011
04a0: 0a 0a 55 73 61 67 65 3a 20 64 61 73 68 62 6f 61 ..Usage: dashboa
04b0: 72 64 20 5b 6f 70 74 69 6f 6e 73 5d 0a 20 20 2d rd [options]. -
04c0: 68 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a h :
04d0: 20 74 68 69 73 20 68 65 6c 70 0a 20 20 2d 72 75 this help. -ru
04e0: 6e 20 72 75 6e 69 64 20 20 20 20 20 20 3a 20 63 n runid : c
04f0: 6f 6e 74 72 6f 6c 20 72 75 6e 20 69 64 65 6e 74 ontrol run ident
0500: 69 66 69 65 64 20 62 79 20 72 75 6e 69 64 0a 20 ified by runid.
0510: 20 2d 74 65 73 74 20 74 65 73 74 69 64 20 20 20 -test testid
0520: 20 3a 20 63 6f 6e 74 72 6f 6c 20 74 65 73 74 20 : control test
0530: 69 64 65 6e 74 69 66 69 65 64 20 62 79 20 74 65 identified by te
0540: 73 74 69 64 0a 0a 4d 69 73 63 0a 20 20 2d 72 6f stid..Misc. -ro
0550: 77 73 20 4e 20 20 20 20 20 20 20 20 20 3a 20 73 ws N : s
0560: 65 74 20 6e 75 6d 62 65 72 20 6f 66 20 72 6f 77 et number of row
0570: 73 0a 22 29 29 0a 0a 3b 3b 20 70 72 6f 63 65 73 s."))..;; proces
0580: 73 20 61 72 67 73 0a 28 64 65 66 69 6e 65 20 72 s args.(define r
0590: 65 6d 61 72 67 73 20 28 61 72 67 73 3a 67 65 74 emargs (args:get
05a0: 2d 61 72 67 73 20 0a 09 09 20 28 61 72 67 76 29 -args ... (argv)
05b0: 0a 09 09 20 28 6c 69 73 74 20 20 22 2d 72 6f 77 ... (list "-row
05c0: 73 22 0a 09 09 09 22 2d 72 75 6e 22 0a 09 09 09 s"...."-run"....
05d0: 22 2d 74 65 73 74 22 0a 09 09 09 22 2d 64 65 62 "-test"...."-deb
05e0: 75 67 22 0a 09 09 09 29 20 0a 09 09 20 28 6c 69 ug"....) ... (li
05f0: 73 74 20 20 22 2d 68 22 0a 09 09 09 22 2d 76 22 st "-h"...."-v"
0600: 0a 09 09 09 22 2d 71 22 0a 09 09 20 20 20 20 20 ...."-q"...
0610: 20 20 29 0a 09 09 20 61 72 67 73 3a 61 72 67 2d )... args:arg-
0620: 68 61 73 68 0a 09 09 20 30 29 29 0a 0a 28 69 66 hash... 0))..(if
0630: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
0640: 2d 68 22 29 0a 20 20 20 20 28 62 65 67 69 6e 0a -h"). (begin.
0650: 20 20 20 20 20 20 28 70 72 69 6e 74 20 68 65 6c (print hel
0660: 70 29 0a 20 20 20 20 20 20 28 65 78 69 74 29 29 p). (exit))
0670: 29 0a 0a 28 69 66 20 28 6e 6f 74 20 28 73 65 74 )..(if (not (set
0680: 75 70 2d 66 6f 72 2d 72 75 6e 29 29 0a 20 20 20 up-for-run)).
0690: 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 70 (begin. (p
06a0: 72 69 6e 74 20 22 46 61 69 6c 65 64 20 74 6f 20 rint "Failed to
06b0: 66 69 6e 64 20 6d 65 67 61 74 65 73 74 2e 63 6f find megatest.co
06c0: 6e 66 69 67 2c 20 65 78 69 74 69 6e 67 22 29 20 nfig, exiting")
06d0: 0a 20 20 20 20 20 20 28 65 78 69 74 20 31 29 29 . (exit 1))
06e0: 29 0a 0a 28 64 65 66 69 6e 65 20 2a 64 62 2a 20 )..(define *db*
06f0: 28 6f 70 65 6e 2d 64 62 29 29 0a 0a 28 64 65 66 (open-db))..(def
0700: 69 6e 65 20 74 6f 70 6c 65 76 65 6c 20 23 66 29 ine toplevel #f)
0710: 0a 28 64 65 66 69 6e 65 20 64 6c 67 20 20 20 20 .(define dlg
0720: 20 20 23 66 29 0a 28 64 65 66 69 6e 65 20 6d 61 #f).(define ma
0730: 78 2d 74 65 73 74 2d 6e 75 6d 20 30 29 0a 28 64 x-test-num 0).(d
0740: 65 66 69 6e 65 20 2a 6b 65 79 73 2a 20 20 20 28 efine *keys* (
0750: 67 65 74 2d 6b 65 79 73 20 20 20 2a 64 62 2a 29 get-keys *db*)
0760: 29 0a 28 64 65 66 69 6e 65 20 2a 64 62 6b 65 79 ).(define *dbkey
0770: 73 2a 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 s* (map (lambda
0780: 20 28 78 29 28 76 65 63 74 6f 72 2d 72 65 66 20 (x)(vector-ref
0790: 78 20 30 29 29 0a 09 09 20 20 20 20 20 20 28 61 x 0))... (a
07a0: 70 70 65 6e 64 20 2a 6b 65 79 73 2a 20 28 6c 69 ppend *keys* (li
07b0: 73 74 20 28 76 65 63 74 6f 72 20 22 72 75 6e 6e st (vector "runn
07c0: 61 6d 65 22 20 22 62 6c 61 68 22 29 29 29 29 29 ame" "blah")))))
07d0: 0a 28 64 65 66 69 6e 65 20 2a 68 65 61 64 65 72 .(define *header
07e0: 2a 20 20 20 20 20 20 20 23 66 29 0a 28 64 65 66 * #f).(def
07f0: 69 6e 65 20 2a 61 6c 6c 72 75 6e 73 2a 20 20 20 ine *allruns*
0800: 20 20 27 28 29 29 0a 28 64 65 66 69 6e 65 20 2a '()).(define *
0810: 62 75 74 74 6f 6e 64 61 74 2a 20 20 20 20 28 6d buttondat* (m
0820: 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 ake-hash-table))
0830: 20 3b 3b 20 3c 72 75 6e 2d 69 64 20 63 6f 6c 6f ;; <run-id colo
0840: 72 20 74 65 78 74 20 74 65 73 74 20 72 75 6e 2d r text test run-
0850: 6b 65 79 3e 0a 28 64 65 66 69 6e 65 20 2a 61 6c key>.(define *al
0860: 6c 74 65 73 74 6e 61 6d 65 6c 73 74 2a 20 27 28 ltestnamelst* '(
0870: 29 29 0a 28 64 65 66 69 6e 65 20 2a 73 65 61 72 )).(define *sear
0880: 63 68 70 61 74 74 73 2a 20 20 28 6d 61 6b 65 2d chpatts* (make-
0890: 68 61 73 68 2d 74 61 62 6c 65 29 29 0a 28 64 65 hash-table)).(de
08a0: 66 69 6e 65 20 2a 6e 75 6d 2d 72 75 6e 73 2a 20 fine *num-runs*
08b0: 20 20 20 20 20 38 29 0a 28 64 65 66 69 6e 65 20 8).(define
08c0: 2a 74 6f 74 2d 72 75 6e 2d 63 6f 75 6e 74 2a 20 *tot-run-count*
08d0: 28 64 62 3a 67 65 74 2d 6e 75 6d 2d 72 75 6e 73 (db:get-num-runs
08e0: 20 2a 64 62 2a 20 22 25 22 29 29 0a 28 64 65 66 *db* "%")).(def
08f0: 69 6e 65 20 2a 6c 61 73 74 2d 75 70 64 61 74 65 ine *last-update
0900: 2a 20 20 20 28 63 75 72 72 65 6e 74 2d 73 65 63 * (current-sec
0910: 6f 6e 64 73 29 29 0a 28 64 65 66 69 6e 65 20 2a onds)).(define *
0920: 6e 75 6d 2d 74 65 73 74 73 2a 20 20 20 20 20 31 num-tests* 1
0930: 35 29 0a 28 64 65 66 69 6e 65 20 2a 73 74 61 72 5).(define *star
0940: 74 2d 72 75 6e 2d 6f 66 66 73 65 74 2a 20 20 30 t-run-offset* 0
0950: 29 0a 28 64 65 66 69 6e 65 20 2a 73 74 61 72 74 ).(define *start
0960: 2d 74 65 73 74 2d 6f 66 66 73 65 74 2a 20 30 29 -test-offset* 0)
0970: 0a 28 64 65 66 69 6e 65 20 2a 65 78 61 6d 69 6e .(define *examin
0980: 65 2d 74 65 73 74 2d 64 61 74 2a 20 28 6d 61 6b e-test-dat* (mak
0990: 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 0a 28 e-hash-table)).(
09a0: 64 65 66 69 6e 65 20 2a 65 78 69 74 2d 73 74 61 define *exit-sta
09b0: 72 74 65 64 2a 20 23 66 29 0a 28 64 65 66 69 6e rted* #f).(defin
09c0: 65 20 2a 73 74 61 74 75 73 2d 69 67 6e 6f 72 65 e *status-ignore
09d0: 2d 68 61 73 68 2a 20 28 6d 61 6b 65 2d 68 61 73 -hash* (make-has
09e0: 68 2d 74 61 62 6c 65 29 29 0a 28 64 65 66 69 6e h-table)).(defin
09f0: 65 20 2a 73 74 61 74 65 2d 69 67 6e 6f 72 65 2d e *state-ignore-
0a00: 68 61 73 68 2a 20 20 28 6d 61 6b 65 2d 68 61 73 hash* (make-has
0a10: 68 2d 74 61 62 6c 65 29 29 0a 0a 28 64 65 66 69 h-table))..(defi
0a20: 6e 65 20 2a 6c 61 73 74 2d 64 62 2d 75 70 64 61 ne *last-db-upda
0a30: 74 65 2d 74 69 6d 65 2a 20 30 29 0a 28 64 65 66 te-time* 0).(def
0a40: 69 6e 65 20 2a 70 6c 65 61 73 65 2d 75 70 64 61 ine *please-upda
0a50: 74 65 2d 62 75 74 74 6f 6e 73 2a 20 23 74 29 0a te-buttons* #t).
0a60: 28 64 65 66 69 6e 65 20 2a 64 62 2d 66 69 6c 65 (define *db-file
0a70: 2d 70 61 74 68 2a 20 28 63 6f 6e 63 20 2a 74 6f -path* (conc *to
0a80: 70 70 61 74 68 2a 20 22 2f 6d 65 67 61 74 65 73 ppath* "/megates
0a90: 74 2e 64 62 22 29 29 0a 0a 28 64 65 66 69 6e 65 t.db"))..(define
0aa0: 20 2a 76 65 72 62 6f 73 69 74 79 2a 20 28 63 6f *verbosity* (co
0ab0: 6e 64 0a 09 09 20 20 20 20 20 28 28 61 72 67 73 nd... ((args
0ac0: 3a 67 65 74 2d 61 72 67 20 22 2d 64 65 62 75 67 :get-arg "-debug
0ad0: 22 29 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 ")(string->numbe
0ae0: 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 r (args:get-arg
0af0: 22 2d 64 65 62 75 67 22 29 29 29 0a 09 09 20 20 "-debug")))...
0b00: 20 20 20 28 28 61 72 67 73 3a 67 65 74 2d 61 72 ((args:get-ar
0b10: 67 20 22 2d 76 22 29 20 20 20 20 32 29 0a 09 09 g "-v") 2)...
0b20: 20 20 20 20 20 28 28 61 72 67 73 3a 67 65 74 2d ((args:get-
0b30: 61 72 67 20 22 2d 71 22 29 20 20 20 20 30 29 0a arg "-q") 0).
0b40: 09 09 20 20 20 20 20 28 65 6c 73 65 20 20 20 20 .. (else
0b50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 31 1
0b60: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 75 69 64 )))..(define uid
0b70: 61 74 20 23 66 29 0a 3b 3b 20 28 6d 65 67 61 74 at #f).;; (megat
0b80: 65 73 74 2d 64 61 73 68 62 6f 61 72 64 29 0a 0a est-dashboard)..
0b90: 3b 28 64 65 66 69 6e 65 20 69 6d 67 31 20 28 69 ;(define img1 (i
0ba0: 75 70 3a 69 6d 61 67 65 2f 70 61 6c 65 74 74 65 up:image/palette
0bb0: 20 31 36 20 31 36 20 28 75 38 76 65 63 74 6f 72 16 16 (u8vector
0bc0: 2d 3e 62 6c 6f 62 20 28 75 38 76 65 63 74 6f 72 ->blob (u8vector
0bd0: 0a 3b 09 09 09 09 20 20 20 31 20 31 20 31 20 31 .;.... 1 1 1 1
0be0: 20 31 20 31 20 31 20 31 20 31 20 31 20 31 20 31 1 1 1 1 1 1 1 1
0bf0: 20 31 20 31 20 31 20 32 20 0a 3b 09 09 09 09 20 1 1 1 2 .;....
0c00: 20 20 31 20 31 20 31 20 31 20 31 20 31 20 31 20 1 1 1 1 1 1 1
0c10: 31 20 31 20 31 20 31 20 31 20 31 20 31 20 32 20 1 1 1 1 1 1 1 2
0c20: 32 20 0a 3b 09 09 09 09 20 20 20 31 20 31 20 31 2 .;.... 1 1 1
0c30: 20 31 20 31 20 31 20 31 20 31 20 31 20 31 20 31 1 1 1 1 1 1 1 1
0c40: 20 31 20 31 20 32 20 32 20 32 20 0a 3b 09 09 09 1 1 2 2 2 .;...
0c50: 09 20 20 20 31 20 31 20 31 20 31 20 31 20 31 20 . 1 1 1 1 1 1
0c60: 31 20 31 20 31 20 31 20 31 20 31 20 32 20 32 20 1 1 1 1 1 1 2 2
0c70: 32 20 32 20 0a 3b 09 09 09 09 20 20 20 31 20 31 2 2 .;.... 1 1
0c80: 20 31 20 31 20 31 20 31 20 31 20 31 20 31 20 31 1 1 1 1 1 1 1 1
0c90: 20 31 20 32 20 32 20 32 20 32 20 32 20 0a 3b 09 1 2 2 2 2 2 .;.
0ca0: 09 09 09 20 20 20 31 20 31 20 31 20 31 20 31 20 ... 1 1 1 1 1
0cb0: 31 20 31 20 31 20 31 20 31 20 32 20 32 20 32 20 1 1 1 1 1 2 2 2
0cc0: 32 20 32 20 32 20 0a 3b 09 09 09 09 20 20 20 31 2 2 2 .;.... 1
0cd0: 20 31 20 31 20 31 20 31 20 31 20 31 20 31 20 31 1 1 1 1 1 1 1 1
0ce0: 20 32 20 32 20 32 20 32 20 32 20 32 20 32 20 0a 2 2 2 2 2 2 2 .
0cf0: 3b 09 09 09 09 20 20 20 31 20 31 20 31 20 31 20 ;.... 1 1 1 1
0d00: 31 20 31 20 31 20 31 20 32 20 32 20 32 20 32 20 1 1 1 1 2 2 2 2
0d10: 32 20 32 20 32 20 32 20 0a 3b 09 09 09 09 20 20 2 2 2 2 .;....
0d20: 20 32 20 32 20 32 20 32 20 32 20 32 20 32 20 32 2 2 2 2 2 2 2 2
0d30: 20 32 20 32 20 32 20 32 20 32 20 32 20 32 20 32 2 2 2 2 2 2 2 2
0d40: 20 0a 3b 09 09 09 09 20 20 20 32 20 32 20 32 20 .;.... 2 2 2
0d50: 32 20 32 20 32 20 32 20 32 20 32 20 32 20 32 20 2 2 2 2 2 2 2 2
0d60: 32 20 32 20 32 20 32 20 32 20 0a 3b 09 09 09 09 2 2 2 2 2 .;....
0d70: 20 20 20 32 20 32 20 32 20 30 20 32 20 32 20 32 2 2 2 0 2 2 2
0d80: 20 32 20 32 20 32 20 32 20 32 20 32 20 32 20 32 2 2 2 2 2 2 2 2
0d90: 20 32 20 0a 3b 09 09 09 09 20 20 20 32 20 32 20 2 .;.... 2 2
0da0: 32 20 30 20 32 20 32 20 32 20 32 20 32 20 32 20 2 0 2 2 2 2 2 2
0db0: 32 20 32 20 32 20 32 20 32 20 32 20 0a 3b 09 09 2 2 2 2 2 2 .;..
0dc0: 09 09 20 20 20 32 20 32 20 32 20 30 20 32 20 30 .. 2 2 2 0 2 0
0dd0: 20 32 20 30 20 32 20 32 20 30 20 32 20 32 20 32 2 0 2 2 0 2 2 2
0de0: 20 30 20 30 20 0a 3b 09 09 09 09 20 20 20 32 20 0 0 .;.... 2
0df0: 32 20 32 20 30 20 32 20 30 20 30 20 32 20 30 20 2 2 0 2 0 0 2 0
0e00: 30 20 32 20 30 20 32 20 30 20 32 20 32 20 0a 3b 0 2 0 2 0 2 2 .;
0e10: 09 09 09 09 20 20 20 32 20 32 20 32 20 30 20 32 .... 2 2 2 0 2
0e20: 20 30 20 32 20 32 20 30 20 32 20 32 20 30 20 32 0 2 2 0 2 2 0 2
0e30: 20 32 20 32 20 32 20 0a 3b 09 09 09 09 20 20 20 2 2 2 .;....
0e40: 32 20 32 20 32 20 30 20 32 20 30 20 32 20 32 20 2 2 2 0 2 0 2 2
0e50: 30 20 32 20 32 20 30 20 32 20 32 20 30 20 30 20 0 2 2 0 2 2 0 0
0e60: 0a 3b 09 09 09 09 20 20 20 32 20 32 20 32 20 30 .;.... 2 2 2 0
0e70: 20 32 20 30 20 32 20 32 20 30 20 32 20 32 20 30 2 0 2 2 0 2 2 0
0e80: 20 32 20 30 20 32 20 31 29 29 29 29 0a 3b 0a 3b 2 0 2 1)))).;.;
0e90: 28 64 65 66 69 6e 65 20 69 6d 67 32 20 28 69 75 (define img2 (iu
0ea0: 70 3a 69 6d 61 67 65 2f 70 61 6c 65 74 74 65 20 p:image/palette
0eb0: 31 36 20 31 36 20 28 75 38 76 65 63 74 6f 72 2d 16 16 (u8vector-
0ec0: 3e 62 6c 6f 62 20 28 75 38 76 65 63 74 6f 72 0a >blob (u8vector.
0ed0: 3b 09 09 09 09 20 20 20 32 20 32 20 32 20 32 20 ;.... 2 2 2 2
0ee0: 32 20 32 20 32 20 32 20 32 20 32 20 32 20 32 20 2 2 2 2 2 2 2 2
0ef0: 32 20 32 20 32 20 31 20 0a 3b 09 09 09 09 20 20 2 2 2 1 .;....
0f00: 20 32 20 32 20 32 20 32 20 32 20 32 20 32 20 32 2 2 2 2 2 2 2 2
0f10: 20 32 20 32 20 32 20 32 20 32 20 32 20 31 20 31 2 2 2 2 2 2 1 1
0f20: 20 0a 3b 09 09 09 09 20 20 20 32 20 32 20 32 20 .;.... 2 2 2
0f30: 32 20 32 20 32 20 32 20 32 20 32 20 32 20 32 20 2 2 2 2 2 2 2 2
0f40: 32 20 32 20 31 20 31 20 31 20 0a 3b 09 09 09 09 2 2 1 1 1 .;....
0f50: 20 20 20 31 20 31 20 31 20 31 20 31 20 31 20 31 1 1 1 1 1 1 1
0f60: 20 31 20 31 20 31 20 31 20 31 20 32 20 32 20 32 1 1 1 1 1 2 2 2
0f70: 20 32 20 0a 3b 09 09 09 09 20 20 20 31 20 31 20 2 .;.... 1 1
0f80: 31 20 31 20 31 20 31 20 31 20 31 20 31 20 31 20 1 1 1 1 1 1 1 1
0f90: 31 20 32 20 32 20 32 20 32 20 32 20 0a 3b 09 09 1 2 2 2 2 2 .;..
0fa0: 09 09 20 20 20 31 20 31 20 31 20 31 20 31 20 31 .. 1 1 1 1 1 1
0fb0: 20 31 20 31 20 31 20 31 20 32 20 32 20 32 20 32 1 1 1 1 2 2 2 2
0fc0: 20 32 20 32 20 0a 3b 09 09 09 09 20 20 20 31 20 2 2 .;.... 1
0fd0: 31 20 31 20 31 20 31 20 31 20 31 20 31 20 31 20 1 1 1 1 1 1 1 1
0fe0: 32 20 32 20 32 20 32 20 32 20 32 20 32 20 0a 3b 2 2 2 2 2 2 2 .;
0ff0: 09 09 09 09 20 20 20 31 20 31 20 31 20 31 20 31 .... 1 1 1 1 1
1000: 20 31 20 31 20 31 20 32 20 32 20 32 20 32 20 32 1 1 1 2 2 2 2 2
1010: 20 32 20 32 20 32 20 0a 3b 09 09 09 09 20 20 20 2 2 2 .;....
1020: 32 20 32 20 32 20 32 20 32 20 32 20 32 20 32 20 2 2 2 2 2 2 2 2
1030: 32 20 32 20 32 20 32 20 32 20 32 20 32 20 32 20 2 2 2 2 2 2 2 2
1040: 0a 3b 09 09 09 09 20 20 20 32 20 32 20 32 20 32 .;.... 2 2 2 2
1050: 20 32 20 32 20 32 20 32 20 32 20 32 20 32 20 32 2 2 2 2 2 2 2 2
1060: 20 32 20 32 20 32 20 32 20 0a 3b 09 09 09 09 20 2 2 2 2 .;....
1070: 20 20 32 20 32 20 32 20 30 20 32 20 32 20 32 20 2 2 2 0 2 2 2
1080: 32 20 32 20 32 20 32 20 32 20 32 20 32 20 32 20 2 2 2 2 2 2 2 2
1090: 32 20 0a 3b 09 09 09 09 20 20 20 32 20 32 20 32 2 .;.... 2 2 2
10a0: 20 30 20 32 20 32 20 32 20 32 20 32 20 32 20 32 0 2 2 2 2 2 2 2
10b0: 20 32 20 32 20 32 20 32 20 32 20 0a 3b 09 09 09 2 2 2 2 2 .;...
10c0: 09 20 20 20 32 20 32 20 32 20 30 20 32 20 30 20 . 2 2 2 0 2 0
10d0: 32 20 30 20 32 20 32 20 30 20 32 20 32 20 32 20 2 0 2 2 0 2 2 2
10e0: 30 20 30 20 0a 3b 09 09 09 09 20 20 20 32 20 32 0 0 .;.... 2 2
10f0: 20 32 20 30 20 32 20 30 20 30 20 32 20 30 20 30 2 0 2 0 0 2 0 0
1100: 20 32 20 30 20 32 20 30 20 32 20 32 20 0a 3b 09 2 0 2 0 2 2 .;.
1110: 09 09 09 20 20 20 32 20 32 20 32 20 30 20 32 20 ... 2 2 2 0 2
1120: 30 20 32 20 32 20 30 20 32 20 32 20 30 20 32 20 0 2 2 0 2 2 0 2
1130: 32 20 32 20 32 20 0a 3b 09 09 09 09 20 20 20 32 2 2 2 .;.... 2
1140: 20 32 20 32 20 30 20 32 20 30 20 32 20 32 20 30 2 2 0 2 0 2 2 0
1150: 20 32 20 32 20 30 20 32 20 32 20 30 20 30 20 0a 2 2 0 2 2 0 0 .
1160: 3b 09 09 09 09 20 20 20 32 20 32 20 32 20 30 20 ;.... 2 2 2 0
1170: 32 20 30 20 32 20 32 20 30 20 32 20 32 20 30 20 2 0 2 2 0 2 2 0
1180: 32 20 30 20 32 20 31 29 29 29 29 0a 3b 0a 3b 28 2 0 2 1)))).;.;(
1190: 69 75 70 3a 68 61 6e 64 6c 65 2d 6e 61 6d 65 2d iup:handle-name-
11a0: 73 65 74 21 20 69 6d 67 31 20 22 69 6d 67 31 22 set! img1 "img1"
11b0: 29 0a 3b 28 69 75 70 3a 61 74 74 72 69 62 75 74 ).;(iup:attribut
11c0: 65 2d 73 65 74 21 20 69 6d 67 31 20 22 30 22 20 e-set! img1 "0"
11d0: 22 30 20 30 20 30 22 29 0a 3b 28 69 75 70 3a 61 "0 0 0").;(iup:a
11e0: 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 69 6d ttribute-set! im
11f0: 67 31 20 22 31 22 20 22 42 47 43 4f 4c 4f 52 22 g1 "1" "BGCOLOR"
1200: 29 0a 3b 28 69 75 70 3a 61 74 74 72 69 62 75 74 ).;(iup:attribut
1210: 65 2d 73 65 74 21 20 69 6d 67 31 20 22 32 22 20 e-set! img1 "2"
1220: 22 32 35 35 20 30 20 30 22 29 0a 3b 0a 3b 28 69 "255 0 0").;.;(i
1230: 75 70 3a 68 61 6e 64 6c 65 2d 6e 61 6d 65 2d 73 up:handle-name-s
1240: 65 74 21 20 69 6d 67 32 20 22 69 6d 67 32 22 29 et! img2 "img2")
1250: 0a 3b 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 .;(iup:attribute
1260: 2d 73 65 74 21 20 69 6d 67 32 20 22 30 22 20 22 -set! img2 "0" "
1270: 30 20 30 20 30 22 29 0a 3b 28 69 75 70 3a 61 74 0 0 0").;(iup:at
1280: 74 72 69 62 75 74 65 2d 73 65 74 21 20 69 6d 67 tribute-set! img
1290: 32 20 22 31 22 20 22 42 47 43 4f 4c 4f 52 22 29 2 "1" "BGCOLOR")
12a0: 0a 3b 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 .;(iup:attribute
12b0: 2d 73 65 74 21 20 69 6d 67 32 20 22 32 22 20 22 -set! img2 "2" "
12c0: 32 35 35 20 30 20 30 22 29 0a 0a 28 64 65 66 69 255 0 0")..(defi
12d0: 6e 65 20 28 6d 65 73 73 61 67 65 2d 77 69 6e 64 ne (message-wind
12e0: 6f 77 20 6d 73 67 29 0a 20 20 28 69 75 70 3a 73 ow msg). (iup:s
12f0: 68 6f 77 0a 20 20 20 28 69 75 70 3a 64 69 61 6c how. (iup:dial
1300: 6f 67 0a 20 20 20 20 28 69 75 70 3a 76 62 6f 78 og. (iup:vbox
1310: 20 0a 20 20 20 20 20 28 69 75 70 3a 6c 61 62 65 . (iup:labe
1320: 6c 20 6d 73 67 20 23 3a 6d 61 72 67 69 6e 20 22 l msg #:margin "
1330: 34 30 78 34 30 22 29 29 29 29 29 0a 0a 28 64 65 40x40")))))..(de
1340: 66 69 6e 65 20 28 69 75 70 6c 69 73 74 62 6f 78 fine (iuplistbox
1350: 2d 66 69 6c 6c 2d 6c 69 73 74 20 6c 62 20 69 74 -fill-list lb it
1360: 65 6d 73 20 2e 20 64 65 66 61 75 6c 74 29 0a 20 ems . default).
1370: 20 28 6c 65 74 20 28 28 69 20 31 29 0a 09 28 73 (let ((i 1)..(s
1380: 65 6c 65 63 74 65 64 2d 69 74 65 6d 20 28 69 66 elected-item (if
1390: 20 28 6e 75 6c 6c 3f 20 64 65 66 61 75 6c 74 29 (null? default)
13a0: 20 23 66 20 28 63 61 72 20 64 65 66 61 75 6c 74 #f (car default
13b0: 29 29 29 29 0a 20 20 20 20 28 69 75 70 3a 61 74 )))). (iup:at
13c0: 74 72 69 62 75 74 65 2d 73 65 74 21 20 6c 62 20 tribute-set! lb
13d0: 22 56 41 4c 55 45 22 20 28 69 66 20 73 65 6c 65 "VALUE" (if sele
13e0: 63 74 65 64 2d 69 74 65 6d 20 73 65 6c 65 63 74 cted-item select
13f0: 65 64 2d 69 74 65 6d 20 22 22 29 29 0a 20 20 20 ed-item "")).
1400: 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 (for-each (lamb
1410: 64 61 20 28 69 74 65 6d 29 0a 09 09 28 69 75 70 da (item)...(iup
1420: 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 :attribute-set!
1430: 6c 62 20 28 6e 75 6d 62 65 72 2d 3e 73 74 72 69 lb (number->stri
1440: 6e 67 20 69 29 20 69 74 65 6d 29 0a 09 09 28 69 ng i) item)...(i
1450: 66 20 73 65 6c 65 63 74 65 64 2d 69 74 65 6d 0a f selected-item.
1460: 09 09 20 20 20 20 28 69 66 20 28 65 71 75 61 6c .. (if (equal
1470: 3f 20 73 65 6c 65 63 74 65 64 2d 69 74 65 6d 20 ? selected-item
1480: 69 74 65 6d 29 0a 09 09 09 28 69 75 70 3a 61 74 item)....(iup:at
1490: 74 72 69 62 75 74 65 2d 73 65 74 21 20 6c 62 20 tribute-set! lb
14a0: 22 56 41 4c 55 45 22 20 69 74 65 6d 29 29 29 20 "VALUE" item)))
14b0: 3b 3b 20 28 6e 75 6d 62 65 72 2d 3e 73 74 72 69 ;; (number->stri
14c0: 6e 67 20 69 29 29 29 29 0a 09 09 28 73 65 74 21 ng i))))...(set!
14d0: 20 69 20 28 2b 20 69 20 31 29 29 29 0a 09 20 20 i (+ i 1)))..
14e0: 20 20 20 20 69 74 65 6d 73 29 0a 20 20 20 20 69 items). i
14f0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 70 61 64 ))..(define (pad
1500: 2d 6c 69 73 74 20 6c 20 6e 29 28 61 70 70 65 6e -list l n)(appen
1510: 64 20 6c 20 28 6d 61 6b 65 2d 6c 69 73 74 20 28 d l (make-list (
1520: 2d 20 6e 20 28 6c 65 6e 67 74 68 20 6c 29 29 29 - n (length l)))
1530: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 6f 6c ))..(define (col
1540: 6f 72 73 2d 73 69 6d 69 6c 61 72 3f 20 63 6f 6c ors-similar? col
1550: 6f 72 31 20 63 6f 6c 6f 72 32 29 0a 20 20 28 6c or1 color2). (l
1560: 65 74 2a 20 28 28 63 31 20 28 6d 61 70 20 73 74 et* ((c1 (map st
1570: 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 73 74 ring->number (st
1580: 72 69 6e 67 2d 73 70 6c 69 74 20 63 6f 6c 6f 72 ring-split color
1590: 31 29 29 29 0a 09 20 28 63 32 20 28 6d 61 70 20 1))).. (c2 (map
15a0: 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 string->number (
15b0: 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 63 6f 6c string-split col
15c0: 6f 72 32 29 29 29 0a 09 20 28 64 65 6c 74 61 20 or2))).. (delta
15d0: 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 61 20 (map (lambda (a
15e0: 62 29 28 61 62 73 20 28 2d 20 61 20 62 29 29 29 b)(abs (- a b)))
15f0: 20 63 31 20 63 32 29 29 29 0a 20 20 20 20 28 6e c1 c2))). (n
1600: 75 6c 6c 3f 20 28 66 69 6c 74 65 72 20 28 6c 61 ull? (filter (la
1610: 6d 62 64 61 20 28 78 29 28 3e 20 78 20 33 29 29 mbda (x)(> x 3))
1620: 20 64 65 6c 74 61 29 29 29 29 0a 0a 3b 3b 20 6b delta))))..;; k
1630: 65 79 70 61 74 74 73 3a 20 28 20 28 4b 45 59 31 eypatts: ( (KEY1
1640: 20 22 61 62 63 25 64 65 66 22 29 28 4b 45 59 32 "abc%def")(KEY2
1650: 20 22 25 22 29 20 29 0a 28 64 65 66 69 6e 65 20 "%") ).(define
1660: 28 75 70 64 61 74 65 2d 72 75 6e 64 61 74 20 72 (update-rundat r
1670: 75 6e 6e 61 6d 65 70 61 74 74 20 6e 75 6d 72 75 unnamepatt numru
1680: 6e 73 20 74 65 73 74 6e 61 6d 65 70 61 74 74 20 ns testnamepatt
1690: 69 74 65 6d 6e 61 6d 65 70 61 74 74 20 6b 65 79 itemnamepatt key
16a0: 70 61 74 74 73 29 0a 20 20 28 6c 65 74 20 28 28 patts). (let ((
16b0: 6d 6f 64 74 69 6d 65 20 28 66 69 6c 65 2d 6d 6f modtime (file-mo
16c0: 64 69 66 69 63 61 74 69 6f 6e 2d 74 69 6d 65 20 dification-time
16d0: 2a 64 62 2d 66 69 6c 65 2d 70 61 74 68 2a 29 29 *db-file-path*))
16e0: 29 0a 20 20 20 20 28 69 66 20 28 3e 20 6d 6f 64 ). (if (> mod
16f0: 74 69 6d 65 20 2a 6c 61 73 74 2d 64 62 2d 75 70 time *last-db-up
1700: 64 61 74 65 2d 74 69 6d 65 2a 29 0a 09 28 62 65 date-time*)..(be
1710: 67 69 6e 0a 09 20 20 28 73 65 74 21 20 2a 70 6c gin.. (set! *pl
1720: 65 61 73 65 2d 75 70 64 61 74 65 2d 62 75 74 74 ease-update-butt
1730: 6f 6e 73 2a 20 23 74 29 0a 09 20 20 28 73 65 74 ons* #t).. (set
1740: 21 20 2a 6c 61 73 74 2d 64 62 2d 75 70 64 61 74 ! *last-db-updat
1750: 65 2d 74 69 6d 65 2a 20 6d 6f 64 74 69 6d 65 29 e-time* modtime)
1760: 0a 09 20 20 28 6c 65 74 2a 20 28 28 61 6c 6c 72 .. (let* ((allr
1770: 75 6e 73 20 20 20 20 20 28 64 62 3a 67 65 74 2d uns (db:get-
1780: 72 75 6e 73 20 2a 64 62 2a 20 72 75 6e 6e 61 6d runs *db* runnam
1790: 65 70 61 74 74 20 6e 75 6d 72 75 6e 73 20 3b 3b epatt numruns ;;
17a0: 20 28 2b 20 6e 75 6d 72 75 6e 73 20 31 29 20 3b (+ numruns 1) ;
17b0: 3b 20 28 2f 20 6e 75 6d 72 75 6e 73 20 32 29 29 ; (/ numruns 2))
17c0: 0a 09 09 09 09 09 20 20 20 2a 73 74 61 72 74 2d ...... *start-
17d0: 72 75 6e 2d 6f 66 66 73 65 74 2a 20 6b 65 79 70 run-offset* keyp
17e0: 61 74 74 73 29 29 0a 09 09 20 28 68 65 61 64 65 atts))... (heade
17f0: 72 20 20 20 20 20 20 28 64 62 3a 67 65 74 2d 68 r (db:get-h
1800: 65 61 64 65 72 20 61 6c 6c 72 75 6e 73 29 29 0a eader allruns)).
1810: 09 09 20 28 72 75 6e 73 20 20 20 20 20 20 20 20 .. (runs
1820: 28 64 62 3a 67 65 74 2d 72 6f 77 73 20 20 20 61 (db:get-rows a
1830: 6c 6c 72 75 6e 73 29 29 0a 09 09 20 28 72 65 73 llruns))... (res
1840: 75 6c 74 20 20 20 20 20 20 27 28 29 29 0a 09 09 ult '())...
1850: 20 28 6d 61 78 74 65 73 74 73 20 20 20 20 30 29 (maxtests 0)
1860: 0a 09 09 20 28 73 74 61 74 65 73 20 20 20 20 20 ... (states
1870: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 (hash-table-key
1880: 73 20 2a 73 74 61 74 65 2d 69 67 6e 6f 72 65 2d s *state-ignore-
1890: 68 61 73 68 2a 29 29 0a 09 09 20 28 73 74 61 74 hash*))... (stat
18a0: 75 73 65 73 20 20 20 20 28 68 61 73 68 2d 74 61 uses (hash-ta
18b0: 62 6c 65 2d 6b 65 79 73 20 2a 73 74 61 74 75 73 ble-keys *status
18c0: 2d 69 67 6e 6f 72 65 2d 68 61 73 68 2a 29 29 29 -ignore-hash*)))
18d0: 0a 09 20 20 20 20 3b 3b 20 49 6e 73 74 65 61 64 .. ;; Instead
18e0: 20 6f 66 20 74 68 69 73 20 6d 65 63 68 61 6e 69 of this mechani
18f0: 73 6d 20 6c 65 74 73 20 74 72 79 20 73 65 74 74 sm lets try sett
1900: 69 6e 67 20 6e 75 6d 62 65 72 20 6f 66 20 72 75 ing number of ru
1910: 6e 73 20 62 61 73 65 64 20 6f 6e 20 22 72 65 73 ns based on "res
1920: 75 6c 74 22 20 62 65 6c 6f 77 0a 09 20 20 20 20 ult" below..
1930: 28 69 66 20 28 3e 20 28 2b 20 2a 6c 61 73 74 2d (if (> (+ *last-
1940: 75 70 64 61 74 65 2a 20 33 30 30 29 20 28 63 75 update* 300) (cu
1950: 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 29 20 rrent-seconds))
1960: 3b 3b 20 65 76 65 72 79 20 66 69 76 65 20 6d 69 ;; every five mi
1970: 6e 75 74 65 73 0a 09 09 28 62 65 67 69 6e 0a 09 nutes...(begin..
1980: 09 20 20 28 73 65 74 21 20 2a 6c 61 73 74 2d 75 . (set! *last-u
1990: 70 64 61 74 65 2a 20 28 63 75 72 72 65 6e 74 2d pdate* (current-
19a0: 73 65 63 6f 6e 64 73 29 29 0a 09 09 20 20 28 73 seconds))... (s
19b0: 65 74 21 20 2a 74 6f 74 2d 72 75 6e 2d 63 6f 75 et! *tot-run-cou
19c0: 6e 74 2a 20 28 64 62 3a 67 65 74 2d 6e 75 6d 2d nt* (db:get-num-
19d0: 72 75 6e 73 20 2a 64 62 2a 20 72 75 6e 6e 61 6d runs *db* runnam
19e0: 65 70 61 74 74 29 29 29 29 0a 09 20 20 20 20 28 epatt)))).. (
19f0: 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 for-each (lambda
1a00: 20 28 72 75 6e 29 0a 09 09 09 28 6c 65 74 2a 20 (run)....(let*
1a10: 28 28 72 75 6e 2d 69 64 20 20 20 28 64 62 3a 67 ((run-id (db:g
1a20: 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 et-value-by-head
1a30: 65 72 20 72 75 6e 20 68 65 61 64 65 72 20 22 69 er run header "i
1a40: 64 22 29 29 0a 09 09 09 20 20 20 20 20 20 20 28 d")).... (
1a50: 74 65 73 74 73 20 20 20 20 28 64 62 2d 67 65 74 tests (db-get
1a60: 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e 20 2a -tests-for-run *
1a70: 64 62 2a 20 72 75 6e 2d 69 64 20 74 65 73 74 6e db* run-id testn
1a80: 61 6d 65 70 61 74 74 20 69 74 65 6d 6e 61 6d 65 amepatt itemname
1a90: 70 61 74 74 20 73 74 61 74 65 73 20 73 74 61 74 patt states stat
1aa0: 75 73 65 73 29 29 0a 09 09 09 20 20 20 20 20 20 uses))....
1ab0: 20 28 6b 65 79 2d 76 61 6c 73 20 28 67 65 74 2d (key-vals (get-
1ac0: 6b 65 79 2d 76 61 6c 73 20 2a 64 62 2a 20 72 75 key-vals *db* ru
1ad0: 6e 2d 69 64 29 29 29 0a 09 09 09 20 20 28 69 66 n-id))).... (if
1ae0: 20 28 3e 20 28 6c 65 6e 67 74 68 20 74 65 73 74 (> (length test
1af0: 73 29 20 6d 61 78 74 65 73 74 73 29 0a 09 09 09 s) maxtests)....
1b00: 20 20 20 20 20 20 28 73 65 74 21 20 6d 61 78 74 (set! maxt
1b10: 65 73 74 73 20 28 6c 65 6e 67 74 68 20 74 65 73 ests (length tes
1b20: 74 73 29 29 29 0a 09 09 09 20 20 28 69 66 20 28 ts))).... (if (
1b30: 6e 6f 74 20 28 6e 75 6c 6c 3f 20 74 65 73 74 73 not (null? tests
1b40: 29 29 0a 09 09 09 20 20 20 20 20 20 28 73 65 74 )).... (set
1b50: 21 20 72 65 73 75 6c 74 20 28 63 6f 6e 73 20 28 ! result (cons (
1b60: 76 65 63 74 6f 72 20 72 75 6e 20 74 65 73 74 73 vector run tests
1b70: 20 6b 65 79 2d 76 61 6c 73 29 20 72 65 73 75 6c key-vals) resul
1b80: 74 29 29 29 29 29 0a 09 09 20 20 20 20 20 20 72 t)))))... r
1b90: 75 6e 73 29 0a 09 20 20 20 20 28 73 65 74 21 20 uns).. (set!
1ba0: 2a 68 65 61 64 65 72 2a 20 20 68 65 61 64 65 72 *header* header
1bb0: 29 0a 09 20 20 20 20 28 73 65 74 21 20 2a 61 6c ).. (set! *al
1bc0: 6c 72 75 6e 73 2a 20 72 65 73 75 6c 74 29 0a 09 lruns* result)..
1bd0: 20 20 20 20 3b 3b 20 28 73 65 74 21 20 2a 74 6f ;; (set! *to
1be0: 74 2d 72 75 6e 2d 63 6f 75 6e 74 2a 20 28 2b 20 t-run-count* (+
1bf0: 31 20 28 6c 65 6e 67 74 68 20 2a 61 6c 6c 72 75 1 (length *allru
1c00: 6e 73 2a 29 29 29 0a 09 20 20 20 20 6d 61 78 74 ns*))).. maxt
1c10: 65 73 74 73 29 29 0a 09 2a 6e 75 6d 2d 74 65 73 ests))..*num-tes
1c20: 74 73 2a 29 29 29 20 3b 3b 20 46 49 58 4d 45 2c ts*))) ;; FIXME,
1c30: 20 6e 61 75 67 68 74 79 20 63 6f 64 69 6e 67 20 naughty coding
1c40: 65 68 3f 0a 0a 28 64 65 66 69 6e 65 20 2a 63 6f eh?..(define *co
1c50: 6c 6c 61 70 73 65 64 2a 20 28 6d 61 6b 65 2d 68 llapsed* (make-h
1c60: 61 73 68 2d 74 61 62 6c 65 29 29 0a 3b 20 28 64 ash-table)).; (d
1c70: 65 66 69 6e 65 20 2a 72 6f 77 2d 6c 6f 6f 6b 75 efine *row-looku
1c80: 70 2a 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 p* (make-hash-ta
1c90: 62 6c 65 29 29 20 3b 3b 20 74 65 73 74 6e 61 6d ble)) ;; testnam
1ca0: 65 20 3d 3e 20 28 72 6f 77 6e 75 6d 20 6c 61 62 e => (rownum lab
1cb0: 6c 65 6f 62 6a 29 0a 0a 28 64 65 66 69 6e 65 20 leobj)..(define
1cc0: 28 74 6f 67 67 6c 65 2d 68 69 64 65 20 6c 6e 75 (toggle-hide lnu
1cd0: 6d 29 20 3b 20 66 75 6c 6c 74 65 73 74 6e 61 6d m) ; fulltestnam
1ce0: 65 29 0a 20 20 28 6c 65 74 2a 20 28 28 62 74 6e e). (let* ((btn
1cf0: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 28 76 65 (vector-ref (ve
1d00: 63 74 6f 72 2d 72 65 66 20 75 69 64 61 74 20 30 ctor-ref uidat 0
1d10: 29 20 6c 6e 75 6d 29 29 0a 09 20 28 66 75 6c 6c ) lnum)).. (full
1d20: 74 65 73 74 6e 61 6d 65 20 28 69 75 70 3a 61 74 testname (iup:at
1d30: 74 72 69 62 75 74 65 20 62 74 6e 20 22 54 49 54 tribute btn "TIT
1d40: 4c 45 22 29 29 0a 09 20 28 70 61 72 74 73 20 20 LE")).. (parts
1d50: 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d 73 70 (string-sp
1d60: 6c 69 74 20 66 75 6c 6c 74 65 73 74 6e 61 6d 65 lit fulltestname
1d70: 20 22 28 22 29 29 0a 09 20 28 62 61 73 65 74 65 "(")).. (basete
1d80: 73 74 6e 61 6d 65 20 28 69 66 20 28 6e 75 6c 6c stname (if (null
1d90: 3f 20 70 61 72 74 73 29 20 22 22 20 28 63 61 72 ? parts) "" (car
1da0: 20 70 61 72 74 73 29 29 29 29 0a 20 20 20 20 3b parts)))). ;
1db0: 28 70 72 69 6e 74 20 22 54 6f 67 67 6c 69 6e 67 (print "Toggling
1dc0: 20 22 20 62 61 73 65 74 65 73 74 6e 61 6d 65 20 " basetestname
1dd0: 22 20 63 75 72 72 65 6e 74 6c 79 20 22 20 28 68 " currently " (h
1de0: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de
1df0: 66 61 75 6c 74 20 2a 63 6f 6c 6c 61 70 73 65 64 fault *collapsed
1e00: 2a 20 62 61 73 65 74 65 73 74 6e 61 6d 65 20 23 * basetestname #
1e10: 66 29 29 0a 20 20 20 20 28 69 66 20 28 68 61 73 f)). (if (has
1e20: 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 h-table-ref/defa
1e30: 75 6c 74 20 2a 63 6f 6c 6c 61 70 73 65 64 2a 20 ult *collapsed*
1e40: 62 61 73 65 74 65 73 74 6e 61 6d 65 20 23 66 29 basetestname #f)
1e50: 0a 09 28 62 65 67 69 6e 0a 09 20 20 3b 28 69 75 ..(begin.. ;(iu
1e60: 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 p:attribute-set!
1e70: 20 62 74 6e 20 22 46 47 43 4f 4c 4f 52 22 20 22 btn "FGCOLOR" "
1e80: 30 20 30 20 30 22 29 0a 09 20 20 28 68 61 73 68 0 0 0").. (hash
1e90: 2d 74 61 62 6c 65 2d 64 65 6c 65 74 65 21 20 2a -table-delete! *
1ea0: 63 6f 6c 6c 61 70 73 65 64 2a 20 62 61 73 65 74 collapsed* baset
1eb0: 65 73 74 6e 61 6d 65 29 29 0a 09 28 62 65 67 69 estname))..(begi
1ec0: 6e 0a 09 20 20 3b 28 69 75 70 3a 61 74 74 72 69 n.. ;(iup:attri
1ed0: 62 75 74 65 2d 73 65 74 21 20 62 74 6e 20 22 46 bute-set! btn "F
1ee0: 47 43 4f 4c 4f 52 22 20 22 30 20 31 39 32 20 31 GCOLOR" "0 192 1
1ef0: 39 32 22 29 0a 09 20 20 28 68 61 73 68 2d 74 61 92").. (hash-ta
1f00: 62 6c 65 2d 73 65 74 21 20 2a 63 6f 6c 6c 61 70 ble-set! *collap
1f10: 73 65 64 2a 20 62 61 73 65 74 65 73 74 6e 61 6d sed* basetestnam
1f20: 65 20 23 74 29 29 29 29 29 0a 20 20 0a 28 64 65 e #t))))). .(de
1f30: 66 69 6e 65 20 62 6c 61 6e 6b 2d 6c 69 6e 65 2d fine blank-line-
1f40: 72 78 20 28 72 65 67 65 78 70 20 22 5e 5c 5c 73 rx (regexp "^\\s
1f50: 2a 24 22 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 *$"))..(define (
1f60: 72 75 6e 2d 69 74 65 6d 2d 6e 61 6d 65 2d 3e 76 run-item-name->v
1f70: 65 63 74 6f 72 73 20 6c 73 74 29 0a 20 20 28 6d ectors lst). (m
1f80: 61 70 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 ap (lambda (x)..
1f90: 20 28 6c 65 74 20 28 28 73 70 6c 73 74 20 28 73 (let ((splst (s
1fa0: 74 72 69 6e 67 2d 73 70 6c 69 74 20 78 20 22 28 tring-split x "(
1fb0: 22 29 29 0a 09 20 20 20 20 20 20 20 28 72 65 73 ")).. (res
1fc0: 20 20 20 28 76 65 63 74 6f 72 20 22 22 20 22 22 (vector "" ""
1fd0: 29 29 29 0a 09 20 20 20 28 76 65 63 74 6f 72 2d ))).. (vector-
1fe0: 73 65 74 21 20 72 65 73 20 30 20 28 63 61 72 20 set! res 0 (car
1ff0: 73 70 6c 73 74 29 29 0a 09 20 20 20 28 69 66 20 splst)).. (if
2000: 28 3e 20 28 6c 65 6e 67 74 68 20 73 70 6c 73 74 (> (length splst
2010: 29 20 31 29 0a 09 20 20 20 20 20 20 20 28 76 65 ) 1).. (ve
2020: 63 74 6f 72 2d 73 65 74 21 20 72 65 73 20 31 20 ctor-set! res 1
2030: 28 63 61 72 20 28 73 74 72 69 6e 67 2d 73 70 6c (car (string-spl
2040: 69 74 20 28 63 61 64 72 20 73 70 6c 73 74 29 20 it (cadr splst)
2050: 22 29 22 29 29 29 29 0a 09 20 20 20 72 65 73 29 ")")))).. res)
2060: 29 0a 20 20 20 20 20 20 20 6c 73 74 29 29 0a 0a ). lst))..
2070: 28 64 65 66 69 6e 65 20 28 63 6f 6c 6c 61 70 73 (define (collaps
2080: 65 2d 72 6f 77 73 20 69 6e 6c 73 74 29 0a 20 20 e-rows inlst).
2090: 28 6c 65 74 2a 20 28 28 6e 65 77 6c 73 74 20 28 (let* ((newlst (
20a0: 66 69 6c 74 65 72 20 28 6c 61 6d 62 64 61 20 28 filter (lambda (
20b0: 78 29 0a 09 09 09 20 20 28 6c 65 74 2a 20 28 28 x).... (let* ((
20c0: 74 70 61 72 74 73 20 20 20 20 28 73 74 72 69 6e tparts (strin
20d0: 67 2d 73 70 6c 69 74 20 78 20 22 28 22 29 29 0a g-split x "(")).
20e0: 09 09 09 09 20 28 62 61 73 65 74 6e 61 6d 65 20 .... (basetname
20f0: 28 69 66 20 28 6e 75 6c 6c 3f 20 74 70 61 72 74 (if (null? tpart
2100: 73 29 20 78 20 28 63 61 72 20 74 70 61 72 74 73 s) x (car tparts
2110: 29 29 29 29 0a 09 09 09 09 09 3b 28 70 72 69 6e ))))......;(prin
2120: 74 20 22 78 20 22 20 78 20 22 20 74 70 61 72 74 t "x " x " tpart
2130: 73 3a 20 22 20 74 70 61 72 74 73 20 22 20 62 61 s: " tparts " ba
2140: 73 65 74 6e 61 6d 65 3a 20 22 20 62 61 73 65 74 setname: " baset
2150: 6e 61 6d 65 29 0a 09 09 09 20 20 20 20 28 63 6f name).... (co
2160: 6e 64 0a 09 09 09 20 20 20 20 20 28 28 73 74 72 nd.... ((str
2170: 69 6e 67 2d 6d 61 74 63 68 20 62 6c 61 6e 6b 2d ing-match blank-
2180: 6c 69 6e 65 2d 72 78 20 78 29 20 23 66 29 0a 09 line-rx x) #f)..
2190: 09 09 20 20 20 20 20 28 28 65 71 75 61 6c 3f 20 .. ((equal?
21a0: 78 20 62 61 73 65 74 6e 61 6d 65 29 20 23 74 29 x basetname) #t)
21b0: 0a 09 09 09 20 20 20 20 20 28 28 68 61 73 68 2d .... ((hash-
21c0: 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c table-ref/defaul
21d0: 74 20 2a 63 6f 6c 6c 61 70 73 65 64 2a 20 62 61 t *collapsed* ba
21e0: 73 65 74 6e 61 6d 65 20 23 66 29 20 0a 09 09 09 setname #f) ....
21f0: 09 09 3b 28 70 72 69 6e 74 20 22 52 65 6d 6f 76 ..;(print "Remov
2200: 69 6e 67 20 22 20 62 61 73 65 74 6e 61 6d 65 20 ing " basetname
2210: 22 20 66 72 6f 6d 20 69 74 65 6d 73 22 29 0a 09 " from items")..
2220: 09 09 20 20 20 20 20 20 23 66 29 0a 09 09 09 20 .. #f)....
2230: 20 20 20 20 28 65 6c 73 65 20 23 74 29 29 29 29 (else #t))))
2240: 0a 09 09 09 69 6e 6c 73 74 29 29 0a 09 20 28 76 ....inlst)).. (v
2250: 6c 73 74 20 20 28 72 75 6e 2d 69 74 65 6d 2d 6e lst (run-item-n
2260: 61 6d 65 2d 3e 76 65 63 74 6f 72 73 20 6e 65 77 ame->vectors new
2270: 6c 73 74 29 29 0a 09 20 3b 3b 20 73 6f 72 74 20 lst)).. ;; sort
2280: 62 79 20 73 65 63 6f 6e 64 20 66 69 65 6c 64 0a by second field.
2290: 09 20 28 76 6c 73 74 2d 73 31 20 28 73 6f 72 74 . (vlst-s1 (sort
22a0: 20 76 6c 73 74 20 28 6c 61 6d 62 64 61 20 28 61 vlst (lambda (a
22b0: 20 62 29 0a 09 09 09 20 20 20 20 20 20 20 28 6c b).... (l
22c0: 65 74 20 28 28 61 73 74 72 20 28 76 65 63 74 6f et ((astr (vecto
22d0: 72 2d 72 65 66 20 61 20 31 29 29 0a 09 09 09 09 r-ref a 1)).....
22e0: 20 20 20 20 20 28 62 73 74 72 20 28 76 65 63 74 (bstr (vect
22f0: 6f 72 2d 72 65 66 20 62 20 31 29 29 29 0a 09 09 or-ref b 1)))...
2300: 09 09 20 28 69 66 20 28 73 74 72 69 6e 67 3d 3f .. (if (string=?
2310: 20 61 73 74 72 20 22 22 29 20 23 66 20 23 74 29 astr "") #f #t)
2320: 29 29 29 29 0a 09 09 09 3b 3b 20 28 3e 3d 20 28 ))))....;; (>= (
2330: 73 74 72 69 6e 67 2d 6c 65 6e 67 74 68 20 28 76 string-length (v
2340: 65 63 74 6f 72 2d 72 65 66 20 61 20 31 29 29 28 ector-ref a 1))(
2350: 73 74 72 69 6e 67 2d 6c 65 6e 67 74 68 20 28 76 string-length (v
2360: 65 63 74 6f 72 2d 72 65 66 20 62 20 31 29 29 29 ector-ref b 1)))
2370: 29 29 29 0a 09 20 28 76 6c 73 74 2d 73 32 20 28 ))).. (vlst-s2 (
2380: 73 6f 72 74 20 76 6c 73 74 2d 73 31 20 28 6c 61 sort vlst-s1 (la
2390: 6d 62 64 61 20 28 61 20 62 29 0a 09 09 09 09 20 mbda (a b).....
23a0: 20 28 73 74 72 69 6e 67 3e 3d 20 28 76 65 63 74 (string>= (vect
23b0: 6f 72 2d 72 65 66 20 61 20 30 29 28 76 65 63 74 or-ref a 0)(vect
23c0: 6f 72 2d 72 65 66 20 62 20 30 29 29 29 29 29 29 or-ref b 0))))))
23d0: 0a 20 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 . (map (lambd
23e0: 61 20 28 78 29 0a 09 20 20 20 28 69 66 20 28 65 a (x).. (if (e
23f0: 71 75 61 6c 3f 20 28 76 65 63 74 6f 72 2d 72 65 qual? (vector-re
2400: 66 20 78 20 31 29 20 22 22 29 0a 09 20 20 20 20 f x 1) "")..
2410: 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 78 (vector-ref x
2420: 20 30 29 0a 09 20 20 20 20 20 20 20 28 63 6f 6e 0).. (con
2430: 63 20 28 76 65 63 74 6f 72 2d 72 65 66 20 78 20 c (vector-ref x
2440: 30 29 20 22 28 22 20 28 76 65 63 74 6f 72 2d 72 0) "(" (vector-r
2450: 65 66 20 78 20 31 29 20 22 29 22 29 29 29 0a 09 ef x 1) ")")))..
2460: 20 76 6c 73 74 2d 73 32 29 29 29 0a 20 20 20 20 vlst-s2))).
2470: 0a 20 20 20 20 3b 3b 20 28 73 6f 72 74 20 6e 65 . ;; (sort ne
2480: 77 6c 73 74 20 28 6c 61 6d 62 64 61 20 28 61 20 wlst (lambda (a
2490: 62 29 0a 20 20 20 20 3b 3b 20 20 20 20 20 09 20 b). ;; .
24a0: 20 20 28 6c 65 74 2a 20 28 28 70 61 72 74 73 61 (let* ((partsa
24b0: 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 61 (string-split a
24c0: 20 22 28 22 29 29 0a 20 20 20 20 3b 3b 20 20 20 "(")). ;;
24d0: 20 20 09 09 20 20 28 70 61 72 74 73 62 20 28 73 .. (partsb (s
24e0: 74 72 69 6e 67 2d 73 70 6c 69 74 20 62 20 22 28 tring-split b "(
24f0: 22 29 29 0a 20 20 20 20 3b 3b 20 20 20 20 20 09 ")). ;; .
2500: 09 20 20 28 6c 65 6e 61 20 20 20 28 6c 65 6e 67 . (lena (leng
2510: 74 68 20 70 61 72 74 73 61 29 29 0a 20 20 20 20 th partsa)).
2520: 3b 3b 20 20 20 20 20 09 09 20 20 28 6c 65 6e 62 ;; .. (lenb
2530: 20 20 20 28 6c 65 6e 67 74 68 20 70 61 72 74 73 (length parts
2540: 62 29 29 29 0a 20 20 20 20 3b 3b 20 20 20 20 20 b))). ;;
2550: 09 20 20 20 20 20 28 69 66 20 28 6f 72 20 28 61 . (if (or (a
2560: 6e 64 20 28 65 71 3f 20 6c 65 6e 61 20 31 29 28 nd (eq? lena 1)(
2570: 3e 20 6c 65 6e 62 20 31 29 29 0a 20 20 20 20 3b > lenb 1)). ;
2580: 3b 20 20 20 20 20 09 09 20 20 20 20 20 28 61 6e ; .. (an
2590: 64 20 28 65 71 3f 20 6c 65 6e 62 20 31 29 28 3e d (eq? lenb 1)(>
25a0: 20 6c 65 6e 61 20 31 29 29 29 0a 20 20 20 20 3b lena 1))). ;
25b0: 3b 20 20 20 20 20 09 09 20 28 69 66 20 28 65 71 ; .. (if (eq
25c0: 75 61 6c 3f 20 28 63 61 72 20 70 61 72 74 73 61 ual? (car partsa
25d0: 29 28 63 61 72 20 70 61 72 74 73 62 29 29 20 3b )(car partsb)) ;
25e0: 3b 20 73 61 6d 65 20 74 65 73 74 0a 20 20 20 20 ; same test.
25f0: 3b 3b 20 20 20 20 20 09 09 20 20 20 20 20 28 3e ;; .. (>
2600: 20 6c 65 6e 62 20 6c 65 6e 61 29 0a 20 20 20 20 lenb lena).
2610: 3b 3b 20 20 20 20 20 09 09 20 20 20 20 20 23 74 ;; .. #t
2620: 29 0a 20 20 20 20 3b 3b 20 20 20 20 20 09 09 20 ). ;; ..
2630: 23 74 29 29 29 29 29 29 0a 09 09 09 20 20 20 20 #t))))))....
2640: 20 0a 28 64 65 66 69 6e 65 20 28 75 70 64 61 74 .(define (updat
2650: 65 2d 6c 61 62 65 6c 73 20 75 69 64 61 74 29 0a e-labels uidat).
2660: 20 20 28 6c 65 74 2a 20 28 28 72 6f 77 6e 20 20 (let* ((rown
2670: 20 20 30 29 0a 09 20 28 6c 66 74 63 6f 6c 20 20 0).. (lftcol
2680: 28 76 65 63 74 6f 72 2d 72 65 66 20 75 69 64 61 (vector-ref uida
2690: 74 20 30 29 29 0a 09 20 28 6e 75 6d 63 6f 6c 73 t 0)).. (numcols
26a0: 20 28 76 65 63 74 6f 72 2d 6c 65 6e 67 74 68 20 (vector-length
26b0: 6c 66 74 63 6f 6c 29 29 0a 09 20 28 6d 61 78 6e lftcol)).. (maxn
26c0: 20 20 20 20 28 2d 20 6e 75 6d 63 6f 6c 73 20 31 (- numcols 1
26d0: 29 29 0a 09 20 28 61 6c 6c 76 61 6c 73 20 28 6d )).. (allvals (m
26e0: 61 6b 65 2d 76 65 63 74 6f 72 20 6e 75 6d 63 6f ake-vector numco
26f0: 6c 73 20 22 22 29 29 29 0a 20 20 20 20 28 66 6f ls ""))). (fo
2700: 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 r-each (lambda (
2710: 6e 61 6d 65 29 0a 09 09 28 69 66 20 28 3c 3d 20 name)...(if (<=
2720: 72 6f 77 6e 20 6d 61 78 6e 29 0a 09 09 20 20 20 rown maxn)...
2730: 20 28 6c 65 74 20 28 28 6c 61 62 6c 20 28 76 65 (let ((labl (ve
2740: 63 74 6f 72 2d 72 65 66 20 6c 66 74 63 6f 6c 20 ctor-ref lftcol
2750: 72 6f 77 6e 29 29 29 0a 09 09 20 20 20 20 20 20 rown)))...
2760: 28 76 65 63 74 6f 72 2d 73 65 74 21 20 61 6c 6c (vector-set! all
2770: 76 61 6c 73 20 72 6f 77 6e 20 6e 61 6d 65 29 29 vals rown name))
2780: 29 0a 09 09 28 73 65 74 21 20 72 6f 77 6e 20 28 )...(set! rown (
2790: 2b 20 31 20 72 6f 77 6e 29 29 29 0a 09 20 20 20 + 1 rown)))..
27a0: 20 20 20 2a 61 6c 6c 74 65 73 74 6e 61 6d 65 6c *alltestnamel
27b0: 73 74 2a 29 0a 09 3b 20 20 20 20 20 20 28 69 66 st*)..; (if
27c0: 20 28 3e 20 28 6c 65 6e 67 74 68 20 2a 61 6c 6c (> (length *all
27d0: 74 65 73 74 6e 61 6d 65 6c 73 74 2a 29 20 2a 73 testnamelst*) *s
27e0: 74 61 72 74 2d 74 65 73 74 2d 6f 66 66 73 65 74 tart-test-offset
27f0: 2a 29 0a 09 3b 09 20 20 28 64 72 6f 70 20 2a 61 *)..;. (drop *a
2800: 6c 6c 74 65 73 74 6e 61 6d 65 6c 73 74 2a 20 2a lltestnamelst* *
2810: 73 74 61 72 74 2d 74 65 73 74 2d 6f 66 66 73 65 start-test-offse
2820: 74 2a 29 0a 09 3b 09 20 20 27 28 29 29 29 0a 20 t*)..;. '())).
2830: 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 69 (let loop ((i
2840: 20 30 29 29 0a 20 20 20 20 20 20 28 6c 65 74 2a 0)). (let*
2850: 20 28 28 6c 62 6c 20 20 20 20 28 76 65 63 74 6f ((lbl (vecto
2860: 72 2d 72 65 66 20 6c 66 74 63 6f 6c 20 69 29 29 r-ref lftcol i))
2870: 0a 09 20 20 20 20 20 28 6f 6c 64 76 61 6c 20 28 .. (oldval (
2880: 69 75 70 3a 61 74 74 72 69 62 75 74 65 20 6c 62 iup:attribute lb
2890: 6c 20 22 54 49 54 4c 45 22 29 29 0a 09 20 20 20 l "TITLE"))..
28a0: 20 20 28 6e 65 77 76 61 6c 20 28 76 65 63 74 6f (newval (vecto
28b0: 72 2d 72 65 66 20 61 6c 6c 76 61 6c 73 20 69 29 r-ref allvals i)
28c0: 29 29 0a 09 28 69 66 20 28 6e 6f 74 20 28 65 71 ))..(if (not (eq
28d0: 75 61 6c 3f 20 6f 6c 64 76 61 6c 20 6e 65 77 76 ual? oldval newv
28e0: 61 6c 29 29 0a 09 20 20 20 20 28 69 75 70 3a 61 al)).. (iup:a
28f0: 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 6c 62 ttribute-set! lb
2900: 6c 20 22 54 49 54 4c 45 22 20 6e 65 77 76 61 6c l "TITLE" newval
2910: 29 29 0a 09 28 69 75 70 3a 61 74 74 72 69 62 75 ))..(iup:attribu
2920: 74 65 2d 73 65 74 21 20 6c 62 6c 20 22 46 47 43 te-set! lbl "FGC
2930: 4f 4c 4f 52 22 20 28 69 66 20 28 68 61 73 68 2d OLOR" (if (hash-
2940: 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c table-ref/defaul
2950: 74 20 2a 63 6f 6c 6c 61 70 73 65 64 2a 20 6e 65 t *collapsed* ne
2960: 77 76 61 6c 20 23 66 29 20 22 30 20 31 31 32 20 wval #f) "0 112
2970: 31 31 32 22 20 22 30 20 30 20 30 22 29 29 0a 09 112" "0 0 0"))..
2980: 28 69 66 20 28 3c 20 69 20 6d 61 78 6e 29 0a 09 (if (< i maxn)..
2990: 20 20 20 20 28 6c 6f 6f 70 20 28 2b 20 69 20 31 (loop (+ i 1
29a0: 29 29 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 )))))))..(define
29b0: 20 28 67 65 74 2d 63 6f 6c 6f 72 2d 66 6f 72 2d (get-color-for-
29c0: 73 74 61 74 65 2d 73 74 61 74 75 73 20 73 74 61 state-status sta
29d0: 74 65 20 73 74 61 74 75 73 29 0a 20 20 28 63 61 te status). (ca
29e0: 73 65 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 se (string->symb
29f0: 6f 6c 20 73 74 61 74 65 29 0a 20 20 20 20 28 28 ol state). ((
2a00: 43 4f 4d 50 4c 45 54 45 44 29 0a 20 20 20 20 20 COMPLETED).
2a10: 28 69 66 20 28 65 71 75 61 6c 3f 20 73 74 61 74 (if (equal? stat
2a20: 75 73 20 22 50 41 53 53 22 29 0a 09 20 22 37 30 us "PASS").. "70
2a30: 20 32 34 39 20 37 33 22 0a 09 20 28 69 66 20 28 249 73".. (if (
2a40: 6f 72 20 28 65 71 75 61 6c 3f 20 73 74 61 74 75 or (equal? statu
2a50: 73 20 22 57 41 52 4e 22 29 0a 09 09 20 28 65 71 s "WARN")... (eq
2a60: 75 61 6c 3f 20 73 74 61 74 75 73 20 22 57 41 49 ual? status "WAI
2a70: 56 45 44 22 29 29 0a 09 20 20 20 20 20 22 32 35 VED")).. "25
2a80: 35 20 31 37 32 20 31 33 22 0a 09 20 20 20 20 20 5 172 13"..
2a90: 22 32 32 33 20 33 33 20 34 39 22 29 29 29 20 3b "223 33 49"))) ;
2aa0: 3b 20 67 72 65 65 6e 69 73 68 20 6f 72 61 6e 67 ; greenish orang
2ab0: 65 69 73 68 20 72 65 64 69 73 68 0a 20 20 20 20 eish redish.
2ac0: 28 28 4c 41 55 4e 43 48 45 44 29 20 20 20 20 20 ((LAUNCHED)
2ad0: 20 20 20 20 22 31 30 31 20 31 32 33 20 31 34 32 "101 123 142
2ae0: 22 29 0a 20 20 20 20 28 28 43 48 45 43 4b 29 20 "). ((CHECK)
2af0: 20 20 20 20 20 20 20 20 20 20 20 22 32 35 35 20 "255
2b00: 31 30 30 20 35 30 22 29 0a 20 20 20 20 28 28 52 100 50"). ((R
2b10: 45 4d 4f 54 45 48 4f 53 54 53 54 41 52 54 29 20 EMOTEHOSTSTART)
2b20: 20 22 35 30 20 31 33 30 20 31 39 35 22 29 0a 20 "50 130 195").
2b30: 20 20 20 28 28 52 55 4e 4e 49 4e 47 29 20 20 20 ((RUNNING)
2b40: 20 20 20 20 20 20 20 22 39 20 31 33 31 20 32 33 "9 131 23
2b50: 32 22 29 0a 20 20 20 20 28 28 4b 49 4c 4c 52 45 2"). ((KILLRE
2b60: 51 29 20 20 20 20 20 20 20 20 20 20 22 33 39 20 Q) "39
2b70: 38 32 20 32 30 36 22 29 0a 20 20 20 20 28 28 4b 82 206"). ((K
2b80: 49 4c 4c 45 44 29 20 20 20 20 20 20 20 20 20 20 ILLED)
2b90: 20 22 32 33 34 20 31 30 31 20 31 37 22 29 0a 20 "234 101 17").
2ba0: 20 20 20 28 28 4e 4f 54 5f 53 54 41 52 54 45 44 ((NOT_STARTED
2bb0: 29 20 20 20 20 20 20 22 32 34 30 20 32 34 30 20 ) "240 240
2bc0: 32 34 30 22 29 0a 20 20 20 20 28 65 6c 73 65 20 240"). (else
2bd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 22 31 "1
2be0: 39 32 20 31 39 32 20 31 39 32 22 29 29 29 0a 0a 92 192 192")))..
2bf0: 28 64 65 66 69 6e 65 20 28 75 70 64 61 74 65 2d (define (update-
2c00: 62 75 74 74 6f 6e 73 20 75 69 64 61 74 20 6e 75 buttons uidat nu
2c10: 6d 72 75 6e 73 20 6e 75 6d 74 65 73 74 73 29 0a mruns numtests).
2c20: 20 20 28 69 66 20 2a 70 6c 65 61 73 65 2d 75 70 (if *please-up
2c30: 64 61 74 65 2d 62 75 74 74 6f 6e 73 2a 0a 20 20 date-buttons*.
2c40: 20 20 20 20 28 6c 65 74 2a 20 28 28 72 75 6e 73 (let* ((runs
2c50: 20 20 20 20 20 20 20 20 28 69 66 20 28 3e 20 28 (if (> (
2c60: 6c 65 6e 67 74 68 20 2a 61 6c 6c 72 75 6e 73 2a length *allruns*
2c70: 29 20 6e 75 6d 72 75 6e 73 29 0a 09 09 09 20 20 ) numruns)....
2c80: 20 20 20 20 28 74 61 6b 65 2d 72 69 67 68 74 20 (take-right
2c90: 2a 61 6c 6c 72 75 6e 73 2a 20 6e 75 6d 72 75 6e *allruns* numrun
2ca0: 73 29 0a 09 09 09 20 20 20 20 20 20 28 70 61 64 s).... (pad
2cb0: 2d 6c 69 73 74 20 2a 61 6c 6c 72 75 6e 73 2a 20 -list *allruns*
2cc0: 6e 75 6d 72 75 6e 73 29 29 29 0a 09 20 20 20 20 numruns)))..
2cd0: 20 28 6c 66 74 63 6f 6c 20 20 20 20 20 20 28 76 (lftcol (v
2ce0: 65 63 74 6f 72 2d 72 65 66 20 75 69 64 61 74 20 ector-ref uidat
2cf0: 30 29 29 0a 09 20 20 20 20 20 28 74 61 62 6c 65 0)).. (table
2d00: 68 65 61 64 65 72 20 28 76 65 63 74 6f 72 2d 72 header (vector-r
2d10: 65 66 20 75 69 64 61 74 20 31 29 29 0a 09 20 20 ef uidat 1))..
2d20: 20 20 20 28 74 61 62 6c 65 20 20 20 20 20 20 20 (table
2d30: 28 76 65 63 74 6f 72 2d 72 65 66 20 75 69 64 61 (vector-ref uida
2d40: 74 20 32 29 29 0a 09 20 20 20 20 20 28 63 6f 6c t 2)).. (col
2d50: 6e 20 20 20 20 20 20 20 20 30 29 29 0a 09 28 73 n 0))..(s
2d60: 65 74 21 20 2a 70 6c 65 61 73 65 2d 75 70 64 61 et! *please-upda
2d70: 74 65 2d 62 75 74 74 6f 6e 73 2a 20 23 66 29 0a te-buttons* #f).
2d80: 09 28 73 65 74 21 20 2a 61 6c 6c 74 65 73 74 6e .(set! *alltestn
2d90: 61 6d 65 6c 73 74 2a 20 27 28 29 29 0a 09 3b 3b amelst* '())..;;
2da0: 20 63 72 65 61 74 65 20 61 20 63 6f 6e 63 69 73 create a concis
2db0: 65 20 6c 69 73 74 20 6f 66 20 74 65 73 74 20 6e e list of test n
2dc0: 61 6d 65 73 0a 09 28 66 6f 72 2d 65 61 63 68 0a ames..(for-each.
2dd0: 09 20 28 6c 61 6d 62 64 61 20 28 72 75 6e 64 61 . (lambda (runda
2de0: 74 29 0a 09 20 20 20 28 69 66 20 28 76 65 63 74 t).. (if (vect
2df0: 6f 72 3f 20 72 75 6e 64 61 74 29 0a 09 20 20 20 or? rundat)..
2e00: 20 20 20 20 28 6c 65 74 2a 20 28 28 74 65 73 74 (let* ((test
2e10: 64 61 74 20 20 20 28 76 65 63 74 6f 72 2d 72 65 dat (vector-re
2e20: 66 20 72 75 6e 64 61 74 20 31 29 29 0a 09 09 20 f rundat 1))...
2e30: 20 20 20 20 20 28 74 65 73 74 6e 61 6d 65 73 20 (testnames
2e40: 28 6d 61 70 20 74 65 73 74 3a 74 65 73 74 2d 67 (map test:test-g
2e50: 65 74 2d 66 75 6c 6c 6e 61 6d 65 20 74 65 73 74 et-fullname test
2e60: 64 61 74 29 29 29 0a 09 09 20 28 66 6f 72 2d 65 dat)))... (for-e
2e70: 61 63 68 20 28 6c 61 6d 62 64 61 20 28 74 65 73 ach (lambda (tes
2e80: 74 6e 61 6d 65 29 0a 09 09 09 20 20 20 20 20 28 tname).... (
2e90: 69 66 20 28 6e 6f 74 20 28 6d 65 6d 62 65 72 20 if (not (member
2ea0: 74 65 73 74 6e 61 6d 65 20 2a 61 6c 6c 74 65 73 testname *alltes
2eb0: 74 6e 61 6d 65 6c 73 74 2a 29 29 0a 09 09 09 09 tnamelst*)).....
2ec0: 20 28 62 65 67 69 6e 0a 09 09 09 09 20 20 20 28 (begin..... (
2ed0: 73 65 74 21 20 2a 61 6c 6c 74 65 73 74 6e 61 6d set! *alltestnam
2ee0: 65 6c 73 74 2a 20 28 61 70 70 65 6e 64 20 2a 61 elst* (append *a
2ef0: 6c 6c 74 65 73 74 6e 61 6d 65 6c 73 74 2a 20 28 lltestnamelst* (
2f00: 6c 69 73 74 20 74 65 73 74 6e 61 6d 65 29 29 29 list testname)))
2f10: 29 29 29 0a 09 09 09 20 20 20 74 65 73 74 6e 61 ))).... testna
2f20: 6d 65 73 29 29 29 29 0a 09 20 72 75 6e 73 29 0a mes)))).. runs).
2f30: 0a 09 28 73 65 74 21 20 2a 61 6c 6c 74 65 73 74 ..(set! *alltest
2f40: 6e 61 6d 65 6c 73 74 2a 20 28 63 6f 6c 6c 61 70 namelst* (collap
2f50: 73 65 2d 72 6f 77 73 20 2a 61 6c 6c 74 65 73 74 se-rows *alltest
2f60: 6e 61 6d 65 6c 73 74 2a 29 29 20 3b 3b 3b 20 61 namelst*)) ;;; a
2f70: 72 67 68 2e 20 70 6c 65 61 73 65 20 63 6c 65 61 rgh. please clea
2f80: 6e 20 75 70 20 74 68 69 73 20 73 69 6c 6c 79 6e n up this sillyn
2f90: 65 73 73 0a 09 28 73 65 74 21 20 2a 61 6c 6c 74 ess..(set! *allt
2fa0: 65 73 74 6e 61 6d 65 6c 73 74 2a 20 28 6c 65 74 estnamelst* (let
2fb0: 20 28 28 78 6c 20 28 69 66 20 28 3e 20 28 6c 65 ((xl (if (> (le
2fc0: 6e 67 74 68 20 2a 61 6c 6c 74 65 73 74 6e 61 6d ngth *alltestnam
2fd0: 65 6c 73 74 2a 29 20 2a 73 74 61 72 74 2d 74 65 elst*) *start-te
2fe0: 73 74 2d 6f 66 66 73 65 74 2a 29 0a 09 09 09 09 st-offset*).....
2ff0: 09 20 20 20 20 20 28 64 72 6f 70 20 2a 61 6c 6c . (drop *all
3000: 74 65 73 74 6e 61 6d 65 6c 73 74 2a 20 2a 73 74 testnamelst* *st
3010: 61 72 74 2d 74 65 73 74 2d 6f 66 66 73 65 74 2a art-test-offset*
3020: 29 0a 09 09 09 09 09 20 20 20 20 20 27 28 29 29 )...... '())
3030: 29 29 0a 09 09 09 09 20 28 61 70 70 65 6e 64 20 ))..... (append
3040: 78 6c 20 28 6d 61 6b 65 2d 6c 69 73 74 20 28 2d xl (make-list (-
3050: 20 2a 6e 75 6d 2d 74 65 73 74 73 2a 20 28 6c 65 *num-tests* (le
3060: 6e 67 74 68 20 78 6c 29 29 20 22 22 29 29 29 29 ngth xl)) ""))))
3070: 0a 09 28 75 70 64 61 74 65 2d 6c 61 62 65 6c 73 ..(update-labels
3080: 20 75 69 64 61 74 29 0a 09 28 66 6f 72 2d 65 61 uidat)..(for-ea
3090: 63 68 0a 09 20 28 6c 61 6d 62 64 61 20 28 72 75 ch.. (lambda (ru
30a0: 6e 64 61 74 29 0a 09 20 20 20 28 69 66 20 28 6e ndat).. (if (n
30b0: 6f 74 20 72 75 6e 64 61 74 29 20 3b 3b 20 68 61 ot rundat) ;; ha
30c0: 6e 64 6c 65 20 70 61 64 64 65 64 20 72 75 6e 73 ndle padded runs
30d0: 0a 09 20 20 20 20 20 20 20 3b 3b 20 20 20 20 20 .. ;;
30e0: 20 20 20 20 20 20 3b 3b 20 69 64 20 72 75 6e 2d ;; id run-
30f0: 69 64 20 74 65 73 74 6e 61 6d 65 20 73 74 61 74 id testname stat
3100: 65 20 73 74 61 74 75 73 20 65 76 65 6e 74 2d 74 e status event-t
3110: 69 6d 65 20 68 6f 73 74 20 63 70 75 6c 6f 61 64 ime host cpuload
3120: 20 64 69 73 6b 66 72 65 65 20 75 6e 61 6d 65 20 diskfree uname
3130: 72 75 6e 64 69 72 20 69 74 65 6d 2d 70 61 74 68 rundir item-path
3140: 20 72 75 6e 2d 64 75 72 61 74 69 6f 6e 0a 09 20 run-duration..
3150: 20 20 20 20 20 20 28 73 65 74 21 20 72 75 6e 64 (set! rund
3160: 61 74 20 28 76 65 63 74 6f 72 20 28 6d 61 6b 65 at (vector (make
3170: 2d 76 65 63 74 6f 72 20 32 30 20 23 66 29 20 27 -vector 20 #f) '
3180: 28 29 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 () (map (lambda
3190: 28 78 29 20 22 22 29 20 2a 6b 65 79 73 2a 29 29 (x) "") *keys*))
31a0: 29 29 3b 3b 20 33 29 29 29 0a 09 20 20 20 28 6c ));; 3))).. (l
31b0: 65 74 2a 20 28 28 72 75 6e 20 20 20 20 20 20 28 et* ((run (
31c0: 76 65 63 74 6f 72 2d 72 65 66 20 72 75 6e 64 61 vector-ref runda
31d0: 74 20 30 29 29 0a 09 09 20 20 28 74 65 73 74 73 t 0))... (tests
31e0: 64 61 74 20 28 76 65 63 74 6f 72 2d 72 65 66 20 dat (vector-ref
31f0: 72 75 6e 64 61 74 20 31 29 29 0a 09 09 20 20 28 rundat 1))... (
3200: 6b 65 79 2d 76 61 6c 2d 64 61 74 20 28 76 65 63 key-val-dat (vec
3210: 74 6f 72 2d 72 65 66 20 72 75 6e 64 61 74 20 32 tor-ref rundat 2
3220: 29 29 0a 09 09 20 20 28 72 75 6e 2d 69 64 20 20 ))... (run-id
3230: 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 (db:get-value-b
3240: 79 2d 68 65 61 64 65 72 20 72 75 6e 20 2a 68 65 y-header run *he
3250: 61 64 65 72 2a 20 22 69 64 22 29 29 0a 09 09 20 ader* "id"))...
3260: 20 28 6b 65 79 2d 76 61 6c 73 20 28 61 70 70 65 (key-vals (appe
3270: 6e 64 20 6b 65 79 2d 76 61 6c 2d 64 61 74 0a 09 nd key-val-dat..
3280: 09 09 09 20 20 20 20 28 6c 69 73 74 20 28 6c 65 ... (list (le
3290: 74 20 28 28 78 20 28 64 62 3a 67 65 74 2d 76 61 t ((x (db:get-va
32a0: 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 lue-by-header ru
32b0: 6e 20 2a 68 65 61 64 65 72 2a 20 22 72 75 6e 6e n *header* "runn
32c0: 61 6d 65 22 29 29 29 0a 09 09 09 09 09 20 20 20 ame")))......
32d0: 20 28 69 66 20 78 20 78 20 22 22 29 29 29 29 29 (if x x "")))))
32e0: 0a 09 09 20 20 28 72 75 6e 2d 6b 65 79 20 20 28 ... (run-key (
32f0: 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 string-intersper
3300: 73 65 20 6b 65 79 2d 76 61 6c 73 20 22 5c 6e 22 se key-vals "\n"
3310: 29 29 29 0a 0a 09 20 20 20 20 20 3b 3b 20 66 69 )))... ;; fi
3320: 6c 6c 20 69 6e 20 74 68 65 20 72 75 6e 20 68 65 ll in the run he
3330: 61 64 65 72 20 6b 65 79 20 76 61 6c 75 65 73 0a ader key values.
3340: 09 20 20 20 20 20 28 6c 65 74 20 28 28 72 6f 77 . (let ((row
3350: 6e 20 20 20 20 20 20 30 29 0a 09 09 20 20 20 28 n 0)... (
3360: 68 65 61 64 65 72 63 6f 6c 20 28 76 65 63 74 6f headercol (vecto
3370: 72 2d 72 65 66 20 74 61 62 6c 65 68 65 61 64 65 r-ref tableheade
3380: 72 20 63 6f 6c 6e 29 29 29 0a 09 20 20 20 20 20 r coln)))..
3390: 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d (for-each (lam
33a0: 62 64 61 20 28 6b 76 61 6c 29 0a 09 09 09 20 20 bda (kval)....
33b0: 20 28 6c 65 74 2a 20 28 28 6c 61 62 6c 20 20 20 (let* ((labl
33c0: 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 68 (vector-ref h
33d0: 65 61 64 65 72 63 6f 6c 20 72 6f 77 6e 29 29 29 eadercol rown)))
33e0: 0a 09 09 09 20 20 20 20 20 28 69 66 20 28 6e 6f .... (if (no
33f0: 74 20 28 65 71 75 61 6c 3f 20 6b 76 61 6c 20 28 t (equal? kval (
3400: 69 75 70 3a 61 74 74 72 69 62 75 74 65 20 6c 61 iup:attribute la
3410: 62 6c 20 22 54 49 54 4c 45 22 29 29 29 0a 09 09 bl "TITLE")))...
3420: 09 09 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 .. (iup:attribut
3430: 65 2d 73 65 74 21 20 28 76 65 63 74 6f 72 2d 72 e-set! (vector-r
3440: 65 66 20 68 65 61 64 65 72 63 6f 6c 20 72 6f 77 ef headercol row
3450: 6e 29 20 22 54 49 54 4c 45 22 20 6b 76 61 6c 29 n) "TITLE" kval)
3460: 29 0a 09 09 09 20 20 20 20 20 28 73 65 74 21 20 ).... (set!
3470: 72 6f 77 6e 20 28 2b 20 72 6f 77 6e 20 31 29 29 rown (+ rown 1))
3480: 29 29 0a 09 09 09 20 6b 65 79 2d 76 61 6c 73 29 )).... key-vals)
3490: 29 0a 0a 09 20 20 20 20 20 3b 3b 20 46 6f 72 20 )... ;; For
34a0: 74 68 69 73 20 72 75 6e 20 6e 6f 77 20 66 69 6c this run now fil
34b0: 6c 20 69 6e 20 74 68 65 20 62 75 74 74 6f 6e 73 l in the buttons
34c0: 20 66 6f 72 20 65 61 63 68 20 74 65 73 74 0a 09 for each test..
34d0: 20 20 20 20 20 28 6c 65 74 20 28 28 72 6f 77 6e (let ((rown
34e0: 20 30 29 0a 09 09 20 20 20 28 63 6f 6c 75 6d 6e 0)... (column
34f0: 64 61 74 20 20 28 76 65 63 74 6f 72 2d 72 65 66 dat (vector-ref
3500: 20 74 61 62 6c 65 20 63 6f 6c 6e 29 29 29 0a 09 table coln)))..
3510: 20 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 (for-each
3520: 0a 09 09 28 6c 61 6d 62 64 61 20 28 74 65 73 74 ...(lambda (test
3530: 6e 61 6d 65 29 0a 09 09 20 20 28 6c 65 74 20 28 name)... (let (
3540: 28 62 75 74 74 6f 6e 64 61 74 20 20 28 68 61 73 (buttondat (has
3550: 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 h-table-ref/defa
3560: 75 6c 74 20 2a 62 75 74 74 6f 6e 64 61 74 2a 20 ult *buttondat*
3570: 28 6d 6b 73 74 72 20 63 6f 6c 6e 20 72 6f 77 6e (mkstr coln rown
3580: 29 20 23 66 29 29 29 0a 09 09 20 20 20 20 28 69 ) #f)))... (i
3590: 66 20 62 75 74 74 6f 6e 64 61 74 0a 09 09 09 28 f buttondat....(
35a0: 6c 65 74 2a 20 28 28 74 65 73 74 20 20 20 20 20 let* ((test
35b0: 20 20 28 6c 65 74 20 28 28 6d 61 74 63 68 69 6e (let ((matchin
35c0: 67 20 28 66 69 6c 74 65 72 20 0a 09 09 09 09 09 g (filter ......
35d0: 09 09 20 20 20 20 28 6c 61 6d 62 64 61 20 28 78 .. (lambda (x
35e0: 29 28 65 71 75 61 6c 3f 20 28 74 65 73 74 3a 74 )(equal? (test:t
35f0: 65 73 74 2d 67 65 74 2d 66 75 6c 6c 6e 61 6d 65 est-get-fullname
3600: 20 78 29 20 74 65 73 74 6e 61 6d 65 29 29 0a 09 x) testname))..
3610: 09 09 09 09 09 09 20 20 20 20 74 65 73 74 73 64 ...... testsd
3620: 61 74 29 29 29 0a 09 09 09 09 09 20 20 20 20 20 at)))......
3630: 28 69 66 20 28 6e 75 6c 6c 3f 20 6d 61 74 63 68 (if (null? match
3640: 69 6e 67 29 0a 09 09 09 09 09 09 20 28 76 65 63 ing)....... (vec
3650: 74 6f 72 20 2d 31 20 2d 31 20 22 22 20 22 22 20 tor -1 -1 "" ""
3660: 22 22 20 30 20 22 22 20 22 22 20 30 20 22 22 20 "" 0 "" "" 0 ""
3670: 22 22 20 22 22 20 30 20 22 22 20 22 22 29 0a 09 "" "" 0 "" "")..
3680: 09 09 09 09 09 20 28 63 61 72 20 6d 61 74 63 68 ..... (car match
3690: 69 6e 67 29 29 29 29 0a 09 09 09 20 20 20 20 20 ing))))....
36a0: 20 20 28 74 65 73 74 6e 61 6d 65 20 20 20 28 64 (testname (d
36b0: 62 3a 74 65 73 74 2d 67 65 74 2d 74 65 73 74 6e b:test-get-testn
36c0: 61 6d 65 20 20 74 65 73 74 29 29 0a 09 09 09 20 ame test))....
36d0: 20 20 20 20 20 20 28 69 74 65 6d 70 61 74 68 20 (itempath
36e0: 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 (db:test-get-i
36f0: 74 65 6d 2d 70 61 74 68 20 74 65 73 74 29 29 0a tem-path test)).
3700: 09 09 09 20 20 20 20 20 20 20 28 74 65 73 74 66 ... (testf
3710: 75 6c 6c 6e 61 6d 65 20 28 74 65 73 74 3a 74 65 ullname (test:te
3720: 73 74 2d 67 65 74 2d 66 75 6c 6c 6e 61 6d 65 20 st-get-fullname
3730: 74 65 73 74 29 29 0a 09 09 09 20 20 20 20 20 20 test))....
3740: 20 28 74 65 73 74 73 74 61 74 75 73 20 28 64 62 (teststatus (db
3750: 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 75 73 :test-get-status
3760: 20 20 20 74 65 73 74 29 29 0a 09 09 09 20 20 20 test))....
3770: 20 20 20 20 28 74 65 73 74 73 74 61 74 65 20 20 (teststate
3780: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 (db:test-get-sta
3790: 74 65 20 20 20 20 74 65 73 74 29 29 0a 09 09 09 te test))....
37a0: 20 20 20 20 20 20 20 28 74 65 73 74 73 74 61 72 (teststar
37b0: 74 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d t (db:test-get-
37c0: 65 76 65 6e 74 5f 74 69 6d 65 20 74 65 73 74 29 event_time test)
37d0: 29 0a 09 09 09 20 20 20 20 20 20 20 28 72 75 6e ).... (run
37e0: 74 69 6d 65 20 20 20 20 28 64 62 3a 74 65 73 74 time (db:test
37f0: 2d 67 65 74 2d 72 75 6e 5f 64 75 72 61 74 69 6f -get-run_duratio
3800: 6e 20 74 65 73 74 29 29 0a 09 09 09 20 20 20 20 n test))....
3810: 20 20 20 28 62 75 74 74 6f 6e 74 78 74 20 20 28 (buttontxt (
3820: 69 66 20 28 65 71 75 61 6c 3f 20 74 65 73 74 73 if (equal? tests
3830: 74 61 74 65 20 22 43 4f 4d 50 4c 45 54 45 44 22 tate "COMPLETED"
3840: 29 20 74 65 73 74 73 74 61 74 75 73 20 74 65 73 ) teststatus tes
3850: 74 73 74 61 74 65 29 29 0a 09 09 09 20 20 20 20 tstate))....
3860: 20 20 20 28 62 75 74 74 6f 6e 20 20 20 20 20 28 (button (
3870: 76 65 63 74 6f 72 2d 72 65 66 20 63 6f 6c 75 6d vector-ref colum
3880: 6e 64 61 74 20 72 6f 77 6e 29 29 0a 09 09 09 20 ndat rown))....
3890: 20 20 20 20 20 20 28 63 6f 6c 6f 72 20 20 20 20 (color
38a0: 20 20 28 67 65 74 2d 63 6f 6c 6f 72 2d 66 6f 72 (get-color-for
38b0: 2d 73 74 61 74 65 2d 73 74 61 74 75 73 20 74 65 -state-status te
38c0: 73 74 73 74 61 74 65 20 74 65 73 74 73 74 61 74 ststate teststat
38d0: 75 73 29 29 0a 09 09 09 20 20 20 20 20 20 20 28 us)).... (
38e0: 63 75 72 72 2d 63 6f 6c 6f 72 20 28 76 65 63 74 curr-color (vect
38f0: 6f 72 2d 72 65 66 20 62 75 74 74 6f 6e 64 61 74 or-ref buttondat
3900: 20 31 29 29 20 3b 3b 20 28 69 75 70 3a 61 74 74 1)) ;; (iup:att
3910: 72 69 62 75 74 65 20 62 75 74 74 6f 6e 20 22 42 ribute button "B
3920: 47 43 4f 4c 4f 52 22 29 29 0a 09 09 09 20 20 20 GCOLOR"))....
3930: 20 20 20 20 28 63 75 72 72 2d 74 69 74 6c 65 20 (curr-title
3940: 28 76 65 63 74 6f 72 2d 72 65 66 20 62 75 74 74 (vector-ref butt
3950: 6f 6e 64 61 74 20 32 29 29 29 20 3b 3b 20 28 69 ondat 2))) ;; (i
3960: 75 70 3a 61 74 74 72 69 62 75 74 65 20 62 75 74 up:attribute but
3970: 74 6f 6e 20 22 54 49 54 4c 45 22 29 29 29 0a 09 ton "TITLE")))..
3980: 09 09 20 20 28 69 66 20 28 6e 6f 74 20 28 65 71 .. (if (not (eq
3990: 75 61 6c 3f 20 63 75 72 72 2d 63 6f 6c 6f 72 20 ual? curr-color
39a0: 63 6f 6c 6f 72 29 29 0a 09 09 09 20 20 20 20 20 color))....
39b0: 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d (iup:attribute-
39c0: 73 65 74 21 20 62 75 74 74 6f 6e 20 22 42 47 43 set! button "BGC
39d0: 4f 4c 4f 52 22 20 63 6f 6c 6f 72 29 29 0a 09 09 OLOR" color))...
39e0: 09 20 20 28 69 66 20 28 6e 6f 74 20 28 65 71 75 . (if (not (equ
39f0: 61 6c 3f 20 63 75 72 72 2d 74 69 74 6c 65 20 62 al? curr-title b
3a00: 75 74 74 6f 6e 74 78 74 29 29 0a 09 09 09 20 20 uttontxt))....
3a10: 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 (iup:attribu
3a20: 74 65 2d 73 65 74 21 20 62 75 74 74 6f 6e 20 22 te-set! button "
3a30: 54 49 54 4c 45 22 20 20 20 62 75 74 74 6f 6e 74 TITLE" buttont
3a40: 78 74 29 29 0a 09 09 09 20 20 28 76 65 63 74 6f xt)).... (vecto
3a50: 72 2d 73 65 74 21 20 62 75 74 74 6f 6e 64 61 74 r-set! buttondat
3a60: 20 30 20 72 75 6e 2d 69 64 29 0a 09 09 09 20 20 0 run-id)....
3a70: 28 76 65 63 74 6f 72 2d 73 65 74 21 20 62 75 74 (vector-set! but
3a80: 74 6f 6e 64 61 74 20 31 20 63 6f 6c 6f 72 29 0a tondat 1 color).
3a90: 09 09 09 20 20 28 76 65 63 74 6f 72 2d 73 65 74 ... (vector-set
3aa0: 21 20 62 75 74 74 6f 6e 64 61 74 20 32 20 62 75 ! buttondat 2 bu
3ab0: 74 74 6f 6e 74 78 74 29 0a 09 09 09 20 20 28 76 ttontxt).... (v
3ac0: 65 63 74 6f 72 2d 73 65 74 21 20 62 75 74 74 6f ector-set! butto
3ad0: 6e 64 61 74 20 33 20 74 65 73 74 29 0a 09 09 09 ndat 3 test)....
3ae0: 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 62 (vector-set! b
3af0: 75 74 74 6f 6e 64 61 74 20 34 20 72 75 6e 2d 6b uttondat 4 run-k
3b00: 65 79 29 29 29 0a 09 09 20 20 20 20 28 73 65 74 ey)))... (set
3b10: 21 20 72 6f 77 6e 20 28 2b 20 72 6f 77 6e 20 31 ! rown (+ rown 1
3b20: 29 29 29 29 0a 09 09 2a 61 6c 6c 74 65 73 74 6e ))))...*alltestn
3b30: 61 6d 65 6c 73 74 2a 29 29 0a 09 20 20 20 20 20 amelst*))..
3b40: 28 73 65 74 21 20 63 6f 6c 6e 20 28 2b 20 63 6f (set! coln (+ co
3b50: 6c 6e 20 31 29 29 29 29 0a 09 20 72 75 6e 73 29 ln 1)))).. runs)
3b60: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 6d 6b )))..(define (mk
3b70: 73 74 72 20 2e 20 78 29 0a 20 20 28 73 74 72 69 str . x). (stri
3b80: 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 ng-intersperse (
3b90: 6d 61 70 20 63 6f 6e 63 20 78 29 20 22 2c 22 29 map conc x) ",")
3ba0: 29 0a 0a 28 64 65 66 69 6e 65 20 28 75 70 64 61 )..(define (upda
3bb0: 74 65 2d 73 65 61 72 63 68 20 78 20 76 61 6c 29 te-search x val)
3bc0: 0a 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 53 65 . ;; (print "Se
3bd0: 74 74 69 6e 67 20 73 65 61 72 63 68 20 66 6f 72 tting search for
3be0: 20 22 20 78 20 22 20 74 6f 20 22 20 76 61 6c 29 " x " to " val)
3bf0: 0a 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 . (hash-table-s
3c00: 65 74 21 20 2a 73 65 61 72 63 68 70 61 74 74 73 et! *searchpatts
3c10: 2a 20 78 20 76 61 6c 29 29 0a 0a 28 64 65 66 69 * x val))..(defi
3c20: 6e 65 20 28 6d 61 6b 65 2d 64 61 73 68 62 6f 61 ne (make-dashboa
3c30: 72 64 2d 62 75 74 74 6f 6e 73 20 6e 72 75 6e 73 rd-buttons nruns
3c40: 20 6e 74 65 73 74 73 20 6b 65 79 6e 61 6d 65 73 ntests keynames
3c50: 29 0a 20 20 28 6c 65 74 2a 20 28 28 6e 6b 65 79 ). (let* ((nkey
3c60: 73 20 20 20 28 6c 65 6e 67 74 68 20 6b 65 79 6e s (length keyn
3c70: 61 6d 65 73 29 29 0a 09 20 28 72 75 6e 73 76 65 ames)).. (runsve
3c80: 63 20 28 6d 61 6b 65 2d 76 65 63 74 6f 72 20 6e c (make-vector n
3c90: 72 75 6e 73 29 29 0a 09 20 28 68 65 61 64 65 72 runs)).. (header
3ca0: 20 20 28 6d 61 6b 65 2d 76 65 63 74 6f 72 20 6e (make-vector n
3cb0: 72 75 6e 73 29 29 0a 09 20 28 6c 66 74 63 6f 6c runs)).. (lftcol
3cc0: 20 20 28 6d 61 6b 65 2d 76 65 63 74 6f 72 20 6e (make-vector n
3cd0: 74 65 73 74 73 29 29 0a 09 20 28 63 6f 6e 74 72 tests)).. (contr
3ce0: 6f 6c 73 20 27 28 29 29 0a 09 20 28 6c 66 74 6c ols '()).. (lftl
3cf0: 73 74 20 20 27 28 29 29 0a 09 20 28 68 64 72 6c st '()).. (hdrl
3d00: 73 74 20 20 27 28 29 29 0a 09 20 28 62 64 79 6c st '()).. (bdyl
3d10: 73 74 20 20 27 28 29 29 0a 09 20 28 72 65 73 75 st '()).. (resu
3d20: 6c 74 20 20 27 28 29 29 0a 09 20 28 69 20 20 20 lt '()).. (i
3d30: 20 20 20 20 30 29 29 0a 20 20 20 20 3b 3b 20 63 0)). ;; c
3d40: 6f 6e 74 72 6f 6c 73 20 28 61 6c 6f 6e 67 20 62 ontrols (along b
3d50: 6f 74 74 6f 6d 29 0a 20 20 20 20 28 73 65 74 21 ottom). (set!
3d60: 20 63 6f 6e 74 72 6f 6c 73 0a 09 20 20 28 69 75 controls.. (iu
3d70: 70 3a 68 62 6f 78 0a 09 20 20 20 28 69 75 70 3a p:hbox.. (iup:
3d80: 76 62 6f 78 0a 09 20 20 20 20 28 69 75 70 3a 66 vbox.. (iup:f
3d90: 72 61 6d 65 20 0a 09 20 20 20 20 20 23 3a 74 69 rame .. #:ti
3da0: 74 6c 65 20 22 66 69 6c 74 65 72 20 74 65 73 74 tle "filter test
3db0: 20 61 6e 64 20 69 74 65 6d 73 22 0a 09 20 20 20 and items"..
3dc0: 20 20 28 69 75 70 3a 68 62 6f 78 0a 09 20 20 20 (iup:hbox..
3dd0: 20 20 20 28 69 75 70 3a 74 65 78 74 62 6f 78 20 (iup:textbox
3de0: 23 3a 73 69 7a 65 20 22 36 30 78 31 35 22 20 23 #:size "60x15" #
3df0: 3a 66 6f 6e 74 73 69 7a 65 20 22 31 30 22 20 23 :fontsize "10" #
3e00: 3a 76 61 6c 75 65 20 22 25 22 0a 09 09 09 20 20 :value "%"....
3e10: 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 #:action (lambd
3e20: 61 20 28 6f 62 6a 20 75 6e 6b 20 76 61 6c 29 0a a (obj unk val).
3e30: 09 09 09 09 20 20 20 20 20 20 28 75 70 64 61 74 .... (updat
3e40: 65 2d 73 65 61 72 63 68 20 22 74 65 73 74 2d 6e e-search "test-n
3e50: 61 6d 65 22 20 76 61 6c 29 29 29 0a 09 20 20 20 ame" val)))..
3e60: 20 20 20 28 69 75 70 3a 74 65 78 74 62 6f 78 20 (iup:textbox
3e70: 23 3a 73 69 7a 65 20 22 36 30 78 31 35 22 20 23 #:size "60x15" #
3e80: 3a 66 6f 6e 74 73 69 7a 65 20 22 31 30 22 20 23 :fontsize "10" #
3e90: 3a 76 61 6c 75 65 20 22 25 22 0a 09 09 09 20 20 :value "%"....
3ea0: 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 #:action (lambd
3eb0: 61 20 28 6f 62 6a 20 75 6e 6b 20 76 61 6c 29 0a a (obj unk val).
3ec0: 09 09 09 09 20 20 20 20 20 20 28 75 70 64 61 74 .... (updat
3ed0: 65 2d 73 65 61 72 63 68 20 22 69 74 65 6d 2d 6e e-search "item-n
3ee0: 61 6d 65 22 20 76 61 6c 29 29 29 29 29 0a 09 20 ame" val)))))..
3ef0: 20 20 20 28 69 75 70 3a 68 62 6f 78 0a 09 20 20 (iup:hbox..
3f00: 20 20 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 (iup:button "
3f10: 51 75 69 74 22 20 23 3a 61 63 74 69 6f 6e 20 28 Quit" #:action (
3f20: 6c 61 6d 62 64 61 20 28 6f 62 6a 29 28 73 71 6c lambda (obj)(sql
3f30: 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 2a ite3:finalize! *
3f40: 64 62 2a 29 28 65 78 69 74 29 29 29 0a 09 20 20 db*)(exit)))..
3f50: 20 20 20 29 29 0a 09 20 20 20 3b 3b 20 28 69 75 )).. ;; (iu
3f60: 70 3a 62 75 74 74 6f 6e 20 22 3c 2d 20 20 4c 65 p:button "<- Le
3f70: 66 74 22 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 ft" #:action (la
3f80: 6d 62 64 61 20 28 6f 62 6a 29 28 73 65 74 21 20 mbda (obj)(set!
3f90: 2a 73 74 61 72 74 2d 72 75 6e 2d 6f 66 66 73 65 *start-run-offse
3fa0: 74 2a 20 20 28 2b 20 2a 73 74 61 72 74 2d 72 75 t* (+ *start-ru
3fb0: 6e 2d 6f 66 66 73 65 74 2a 20 31 29 29 29 29 0a n-offset* 1)))).
3fc0: 09 20 20 20 3b 3b 20 28 69 75 70 3a 62 75 74 74 . ;; (iup:butt
3fd0: 6f 6e 20 22 55 70 20 20 20 20 20 5e 22 20 23 3a on "Up ^" #:
3fe0: 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 action (lambda (
3ff0: 6f 62 6a 29 28 73 65 74 21 20 2a 73 74 61 72 74 obj)(set! *start
4000: 2d 74 65 73 74 2d 6f 66 66 73 65 74 2a 20 28 69 -test-offset* (i
4010: 66 20 28 3e 20 2a 73 74 61 72 74 2d 74 65 73 74 f (> *start-test
4020: 2d 6f 66 66 73 65 74 2a 20 30 29 28 2d 20 2a 73 -offset* 0)(- *s
4030: 74 61 72 74 2d 74 65 73 74 2d 6f 66 66 73 65 74 tart-test-offset
4040: 2a 20 31 29 20 30 29 29 29 29 0a 09 20 20 20 3b * 1) 0)))).. ;
4050: 3b 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 44 ; (iup:button "D
4060: 6f 77 6e 20 20 20 76 22 20 23 3a 61 63 74 69 6f own v" #:actio
4070: 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 29 28 n (lambda (obj)(
4080: 73 65 74 21 20 2a 73 74 61 72 74 2d 74 65 73 74 set! *start-test
4090: 2d 6f 66 66 73 65 74 2a 20 28 69 66 20 28 3e 3d -offset* (if (>=
40a0: 20 2a 73 74 61 72 74 2d 74 65 73 74 2d 6f 66 66 *start-test-off
40b0: 73 65 74 2a 20 28 6c 65 6e 67 74 68 20 2a 61 6c set* (length *al
40c0: 6c 74 65 73 74 6e 61 6d 65 6c 73 74 2a 29 29 28 ltestnamelst*))(
40d0: 6c 65 6e 67 74 68 20 2a 61 6c 6c 74 65 73 74 6e length *alltestn
40e0: 61 6d 65 6c 73 74 2a 29 28 2b 20 2a 73 74 61 72 amelst*)(+ *star
40f0: 74 2d 74 65 73 74 2d 6f 66 66 73 65 74 2a 20 31 t-test-offset* 1
4100: 29 29 29 29 29 0a 09 20 20 20 3b 3b 20 28 69 75 ))))).. ;; (iu
4110: 70 3a 62 75 74 74 6f 6e 20 22 52 69 67 68 74 20 p:button "Right
4120: 2d 3e 22 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 ->" #:action (la
4130: 6d 62 64 61 20 28 6f 62 6a 29 28 73 65 74 21 20 mbda (obj)(set!
4140: 2a 73 74 61 72 74 2d 72 75 6e 2d 6f 66 66 73 65 *start-run-offse
4150: 74 2a 20 20 28 69 66 20 28 3e 20 2a 73 74 61 72 t* (if (> *star
4160: 74 2d 72 75 6e 2d 6f 66 66 73 65 74 2a 20 30 29 t-run-offset* 0)
4170: 28 2d 20 2a 73 74 61 72 74 2d 72 75 6e 2d 6f 66 (- *start-run-of
4180: 66 73 65 74 2a 20 31 29 20 30 29 29 29 29 0a 09 fset* 1) 0))))..
4190: 20 20 20 28 69 75 70 3a 66 72 61 6d 65 20 0a 09 (iup:frame ..
41a0: 20 20 20 20 23 3a 74 69 74 6c 65 20 22 68 69 64 #:title "hid
41b0: 65 22 0a 09 20 20 20 20 28 69 75 70 3a 76 62 6f e".. (iup:vbo
41c0: 78 0a 09 20 20 20 20 20 28 61 70 70 6c 79 20 0a x.. (apply .
41d0: 09 20 20 20 20 20 20 69 75 70 3a 68 62 6f 78 0a . iup:hbox.
41e0: 09 20 20 20 20 20 20 28 6d 61 70 20 28 6c 61 6d . (map (lam
41f0: 62 64 61 20 28 73 74 61 74 75 73 29 0a 09 09 20 bda (status)...
4200: 20 20 20 20 28 69 75 70 3a 74 6f 67 67 6c 65 20 (iup:toggle
4210: 73 74 61 74 75 73 20 20 23 3a 61 63 74 69 6f 6e status #:action
4220: 20 20 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 20 (lambda (obj
4230: 76 61 6c 29 0a 09 09 09 09 09 09 20 20 20 20 20 val).......
4240: 20 28 73 65 74 21 20 2a 6c 61 73 74 2d 64 62 2d (set! *last-db-
4250: 75 70 64 61 74 65 2d 74 69 6d 65 2a 20 30 29 0a update-time* 0).
4260: 09 09 09 09 09 09 20 20 20 20 20 20 28 69 66 20 ...... (if
4270: 28 65 71 3f 20 76 61 6c 20 31 29 0a 09 09 09 09 (eq? val 1).....
4280: 09 09 09 20 20 28 68 61 73 68 2d 74 61 62 6c 65 ... (hash-table
4290: 2d 73 65 74 21 20 2a 73 74 61 74 75 73 2d 69 67 -set! *status-ig
42a0: 6e 6f 72 65 2d 68 61 73 68 2a 20 73 74 61 74 75 nore-hash* statu
42b0: 73 20 23 74 29 0a 09 09 09 09 09 09 09 20 20 28 s #t)........ (
42c0: 68 61 73 68 2d 74 61 62 6c 65 2d 64 65 6c 65 74 hash-table-delet
42d0: 65 21 20 2a 73 74 61 74 75 73 2d 69 67 6e 6f 72 e! *status-ignor
42e0: 65 2d 68 61 73 68 2a 20 73 74 61 74 75 73 29 29 e-hash* status))
42f0: 29 29 29 0a 09 20 20 20 20 20 20 27 28 22 50 41 ))).. '("PA
4300: 53 53 22 20 22 46 41 49 4c 22 20 22 57 41 52 4e SS" "FAIL" "WARN
4310: 22 20 22 43 48 45 43 4b 22 20 22 57 41 49 56 45 " "CHECK" "WAIVE
4320: 44 22 20 22 53 54 55 43 4b 2f 44 45 41 44 22 29 D" "STUCK/DEAD")
4330: 29 29 0a 09 20 20 20 20 20 28 61 70 70 6c 79 20 )).. (apply
4340: 0a 09 20 20 20 20 20 20 69 75 70 3a 68 62 6f 78 .. iup:hbox
4350: 0a 09 20 20 20 20 20 20 28 6d 61 70 20 28 6c 61 .. (map (la
4360: 6d 62 64 61 20 28 73 74 61 74 65 29 0a 09 09 20 mbda (state)...
4370: 20 20 20 20 28 69 75 70 3a 74 6f 67 67 6c 65 20 (iup:toggle
4380: 73 74 61 74 65 20 20 20 23 3a 61 63 74 69 6f 6e state #:action
4390: 20 20 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 20 (lambda (obj
43a0: 76 61 6c 29 0a 09 09 09 09 09 09 20 20 20 20 20 val).......
43b0: 20 28 73 65 74 21 20 2a 6c 61 73 74 2d 64 62 2d (set! *last-db-
43c0: 75 70 64 61 74 65 2d 74 69 6d 65 2a 20 30 29 0a update-time* 0).
43d0: 09 09 09 09 09 09 20 20 20 20 20 20 28 69 66 20 ...... (if
43e0: 28 65 71 3f 20 76 61 6c 20 31 29 0a 09 09 09 09 (eq? val 1).....
43f0: 09 09 09 20 20 28 68 61 73 68 2d 74 61 62 6c 65 ... (hash-table
4400: 2d 73 65 74 21 20 2a 73 74 61 74 65 2d 69 67 6e -set! *state-ign
4410: 6f 72 65 2d 68 61 73 68 2a 20 73 74 61 74 65 20 ore-hash* state
4420: 23 74 29 0a 09 09 09 09 09 09 09 20 20 28 68 61 #t)........ (ha
4430: 73 68 2d 74 61 62 6c 65 2d 64 65 6c 65 74 65 21 sh-table-delete!
4440: 20 2a 73 74 61 74 65 2d 69 67 6e 6f 72 65 2d 68 *state-ignore-h
4450: 61 73 68 2a 20 73 74 61 74 65 29 29 29 29 29 0a ash* state))))).
4460: 09 09 20 20 20 27 28 22 52 55 4e 4e 49 4e 47 22 .. '("RUNNING"
4470: 20 22 43 4f 4d 50 4c 45 54 45 44 22 20 22 49 4e "COMPLETED" "IN
4480: 43 4f 4d 50 4c 45 54 45 22 20 22 4c 41 55 4e 43 COMPLETE" "LAUNC
4490: 48 45 44 22 20 22 4e 4f 54 5f 53 54 41 52 54 45 HED" "NOT_STARTE
44a0: 44 22 20 22 4b 49 4c 4c 45 44 22 29 29 29 29 29 D" "KILLED")))))
44b0: 0a 09 20 20 20 28 69 75 70 3a 76 61 6c 75 61 74 .. (iup:valuat
44c0: 6f 72 20 23 3a 76 61 6c 75 65 63 68 61 6e 67 65 or #:valuechange
44d0: 64 5f 63 62 20 28 6c 61 6d 62 64 61 20 28 6f 62 d_cb (lambda (ob
44e0: 6a 29 0a 09 09 09 09 09 20 20 20 20 20 28 6c 65 j)...... (le
44f0: 74 20 28 28 76 61 6c 20 28 69 6e 65 78 61 63 74 t ((val (inexact
4500: 2d 3e 65 78 61 63 74 20 28 72 6f 75 6e 64 20 28 ->exact (round (
4510: 2b 20 30 2e 30 20 28 73 74 72 69 6e 67 2d 3e 6e + 0.0 (string->n
4520: 75 6d 62 65 72 20 28 69 75 70 3a 61 74 74 72 69 umber (iup:attri
4530: 62 75 74 65 20 6f 62 6a 20 22 56 41 4c 55 45 22 bute obj "VALUE"
4540: 29 29 29 29 29 29 0a 09 09 09 09 09 09 20 20 20 )))))).......
4550: 28 6d 61 78 72 75 6e 73 20 20 2a 74 6f 74 2d 72 (maxruns *tot-r
4560: 75 6e 2d 63 6f 75 6e 74 2a 29 29 20 3b 3b 3b 20 un-count*)) ;;;
4570: 28 2b 20 2a 6e 75 6d 2d 72 75 6e 73 2a 20 28 6c (+ *num-runs* (l
4580: 65 6e 67 74 68 20 2a 61 6c 6c 72 75 6e 73 2a 29 ength *allruns*)
4590: 29 29 29 0a 09 09 09 09 09 20 20 20 20 20 20 20 )))......
45a0: 28 73 65 74 21 20 2a 73 74 61 72 74 2d 72 75 6e (set! *start-run
45b0: 2d 6f 66 66 73 65 74 2a 20 76 61 6c 29 0a 09 09 -offset* val)...
45c0: 09 09 09 20 20 20 20 20 20 20 28 73 65 74 21 20 ... (set!
45d0: 2a 6c 61 73 74 2d 64 62 2d 75 70 64 61 74 65 2d *last-db-update-
45e0: 74 69 6d 65 2a 20 30 29 0a 09 09 09 09 09 20 20 time* 0)......
45f0: 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
4600: 74 20 33 20 22 6d 61 78 72 75 6e 73 3a 20 22 20 t 3 "maxruns: "
4610: 6d 61 78 72 75 6e 73 20 22 2c 20 76 61 6c 3a 20 maxruns ", val:
4620: 22 20 76 61 6c 29 0a 09 09 09 09 09 20 20 20 20 " val)......
4630: 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 (iup:attribut
4640: 65 2d 73 65 74 21 20 6f 62 6a 20 22 4d 41 58 22 e-set! obj "MAX"
4650: 20 6d 61 78 72 75 6e 73 29 29 29 0a 09 09 09 20 maxruns)))....
4660: 23 3a 65 78 70 61 6e 64 20 22 59 45 53 22 0a 09 #:expand "YES"..
4670: 09 09 20 23 3a 6d 61 78 20 28 2b 20 3b 3b 20 2a .. #:max (+ ;; *
4680: 6e 75 6d 2d 72 75 6e 73 2a 0a 09 09 09 09 28 6c num-runs*.....(l
4690: 65 6e 67 74 68 20 2a 61 6c 6c 72 75 6e 73 2a 29 ength *allruns*)
46a0: 29 29 0a 09 20 20 20 3b 28 69 75 70 3a 62 75 74 )).. ;(iup:but
46b0: 74 6f 6e 20 22 69 6e 63 20 72 6f 77 73 22 20 23 ton "inc rows" #
46c0: 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 :action (lambda
46d0: 28 6f 62 6a 29 28 73 65 74 21 20 2a 6e 75 6d 2d (obj)(set! *num-
46e0: 74 65 73 74 73 2a 20 28 2b 20 2a 6e 75 6d 2d 74 tests* (+ *num-t
46f0: 65 73 74 73 2a 20 31 29 29 29 29 0a 09 20 20 20 ests* 1))))..
4700: 3b 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 64 65 ;(iup:button "de
4710: 63 20 72 6f 77 73 22 20 23 3a 61 63 74 69 6f 6e c rows" #:action
4720: 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 29 28 73 (lambda (obj)(s
4730: 65 74 21 20 2a 6e 75 6d 2d 74 65 73 74 73 2a 20 et! *num-tests*
4740: 28 69 66 20 28 3e 20 2a 6e 75 6d 2d 74 65 73 74 (if (> *num-test
4750: 73 2a 20 30 29 28 2d 20 2a 6e 75 6d 2d 74 65 73 s* 0)(- *num-tes
4760: 74 73 2a 20 31 29 20 30 29 29 29 29 0a 09 20 20 ts* 1) 0))))..
4770: 20 29 0a 09 20 20 29 0a 20 20 20 20 0a 20 20 20 ).. ). .
4780: 20 3b 3b 20 63 72 65 61 74 65 20 74 68 65 20 6c ;; create the l
4790: 65 66 74 20 6d 6f 73 74 20 63 6f 6c 75 6d 6e 20 eft most column
47a0: 66 6f 72 20 74 68 65 20 72 75 6e 20 6b 65 79 20 for the run key
47b0: 6e 61 6d 65 73 20 61 6e 64 20 74 68 65 20 74 65 names and the te
47c0: 73 74 20 6e 61 6d 65 73 20 0a 20 20 20 20 28 73 st names . (s
47d0: 65 74 21 20 6c 66 74 6c 73 74 20 28 6c 69 73 74 et! lftlst (list
47e0: 20 28 69 75 70 3a 68 62 6f 78 0a 09 09 09 28 69 (iup:hbox....(i
47f0: 75 70 3a 6c 61 62 65 6c 29 20 3b 3b 20 28 69 75 up:label) ;; (iu
4800: 70 3a 76 61 6c 75 61 74 6f 72 29 0a 09 09 09 28 p:valuator)....(
4810: 61 70 70 6c 79 20 69 75 70 3a 76 62 6f 78 20 0a apply iup:vbox .
4820: 09 09 09 20 20 20 20 20 20 20 28 6d 61 70 20 28 ... (map (
4830: 6c 61 6d 62 64 61 20 28 78 29 09 09 0a 09 09 09 lambda (x)......
4840: 09 20 20 20 20 20 20 28 6c 65 74 20 28 28 72 65 . (let ((re
4850: 73 20 28 69 75 70 3a 68 62 6f 78 0a 09 09 09 09 s (iup:hbox.....
4860: 09 09 20 20 28 69 75 70 3a 6c 61 62 65 6c 20 78 .. (iup:label x
4870: 20 23 3a 73 69 7a 65 20 22 34 30 78 31 35 22 20 #:size "40x15"
4880: 23 3a 66 6f 6e 74 73 69 7a 65 20 22 31 30 22 29 #:fontsize "10")
4890: 20 3b 3b 20 20 23 3a 65 78 70 61 6e 64 20 22 48 ;; #:expand "H
48a0: 4f 52 49 5a 4f 4e 54 41 4c 22 29 0a 09 09 09 09 ORIZONTAL").....
48b0: 09 09 20 20 28 69 75 70 3a 74 65 78 74 62 6f 78 .. (iup:textbox
48c0: 20 23 3a 73 69 7a 65 20 22 36 30 78 31 35 22 20 #:size "60x15"
48d0: 23 3a 66 6f 6e 74 73 69 7a 65 20 22 31 30 22 20 #:fontsize "10"
48e0: 23 3a 76 61 6c 75 65 20 22 25 22 20 3b 3b 20 23 #:value "%" ;; #
48f0: 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e :expand "HORIZON
4900: 54 41 4c 22 0a 09 09 09 09 09 09 09 20 20 20 20 TAL"........
4910: 20 20 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d #:action (lam
4920: 62 64 61 20 28 6f 62 6a 20 75 6e 6b 20 76 61 6c bda (obj unk val
4930: 29 0a 09 09 09 09 09 09 09 09 09 20 20 28 75 70 ).......... (up
4940: 64 61 74 65 2d 73 65 61 72 63 68 20 78 20 76 61 date-search x va
4950: 6c 29 29 29 29 29 29 0a 09 09 09 09 09 28 73 65 l))))))......(se
4960: 74 21 20 69 20 28 2b 20 69 20 31 29 29 0a 09 09 t! i (+ i 1))...
4970: 09 09 09 72 65 73 29 29 0a 09 09 09 09 20 20 20 ...res)).....
4980: 20 6b 65 79 6e 61 6d 65 73 29 29 29 29 29 0a 20 keynames))))).
4990: 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 74 (let loop ((t
49a0: 65 73 74 6e 75 6d 20 20 30 29 0a 09 20 20 20 20 estnum 0)..
49b0: 20 20 20 28 72 65 73 20 20 20 20 20 20 27 28 29 (res '()
49c0: 29 29 0a 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 )). (cond.
49d0: 20 20 20 20 20 20 28 28 3e 3d 20 74 65 73 74 6e ((>= testn
49e0: 75 6d 20 6e 74 65 73 74 73 29 0a 09 3b 3b 20 6e um ntests)..;; n
49f0: 6f 77 20 6c 66 74 6c 73 74 20 77 69 6c 6c 20 62 ow lftlst will b
4a00: 65 20 61 6e 20 68 62 6f 78 20 77 69 74 68 20 74 e an hbox with t
4a10: 68 65 20 74 65 73 74 20 6b 65 79 73 20 61 6e 64 he test keys and
4a20: 20 74 68 65 20 74 65 73 74 20 6e 61 6d 65 20 6c the test name l
4a30: 61 62 65 6c 73 0a 09 28 73 65 74 21 20 6c 66 74 abels..(set! lft
4a40: 6c 73 74 20 28 61 70 70 65 6e 64 20 6c 66 74 6c lst (append lftl
4a50: 73 74 20 28 6c 69 73 74 20 28 69 75 70 3a 68 62 st (list (iup:hb
4a60: 6f 78 20 0a 09 09 09 09 09 20 20 20 28 69 75 70 ox ...... (iup
4a70: 3a 76 61 6c 75 61 74 6f 72 20 23 3a 76 61 6c 75 :valuator #:valu
4a80: 65 63 68 61 6e 67 65 64 5f 63 62 20 28 6c 61 6d echanged_cb (lam
4a90: 62 64 61 20 28 6f 62 6a 29 0a 09 09 09 09 09 09 bda (obj).......
4aa0: 09 09 09 20 20 20 20 20 28 6c 65 74 20 28 28 76 ... (let ((v
4ab0: 61 6c 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 al (iup:attribut
4ac0: 65 20 6f 62 6a 20 22 56 41 4c 55 45 22 29 29 29 e obj "VALUE")))
4ad0: 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 20 20 ..........
4ae0: 20 28 73 65 74 21 20 2a 70 6c 65 61 73 65 2d 75 (set! *please-u
4af0: 70 64 61 74 65 2d 62 75 74 74 6f 6e 73 2a 20 23 pdate-buttons* #
4b00: 74 29 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 t)..........
4b10: 20 20 20 28 73 65 74 21 20 2a 73 74 61 72 74 2d (set! *start-
4b20: 74 65 73 74 2d 6f 66 66 73 65 74 2a 20 28 69 6e test-offset* (in
4b30: 65 78 61 63 74 2d 3e 65 78 61 63 74 20 28 72 6f exact->exact (ro
4b40: 75 6e 64 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d und (string->num
4b50: 62 65 72 20 76 61 6c 29 29 29 29 0a 09 09 09 09 ber val)))).....
4b60: 09 09 09 09 09 20 20 20 20 20 20 20 28 69 75 70 ..... (iup
4b70: 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 :attribute-set!
4b80: 6f 62 6a 20 22 4d 41 58 22 20 28 6c 65 6e 67 74 obj "MAX" (lengt
4b90: 68 20 2a 61 6c 6c 74 65 73 74 6e 61 6d 65 6c 73 h *alltestnamels
4ba0: 74 2a 29 29 0a 09 09 09 09 09 09 09 09 09 20 20 t*))..........
4bb0: 20 20 20 20 20 29 20 29 0a 09 09 09 09 09 09 09 ) )........
4bc0: 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53 22 20 #:expand "YES"
4bd0: 0a 09 09 09 09 09 09 09 20 23 3a 6f 72 69 65 6e ........ #:orien
4be0: 74 61 74 69 6f 6e 20 22 56 45 52 54 49 43 41 4c tation "VERTICAL
4bf0: 22 29 0a 09 09 09 09 09 20 20 20 28 61 70 70 6c ")...... (appl
4c00: 79 20 69 75 70 3a 76 62 6f 78 20 28 72 65 76 65 y iup:vbox (reve
4c10: 72 73 65 20 72 65 73 29 29 29 29 29 29 29 0a 20 rse res))))))).
4c20: 20 20 20 20 20 20 28 65 6c 73 65 0a 09 28 6c 65 (else..(le
4c30: 74 20 28 28 6c 61 62 6c 20 20 28 69 75 70 3a 62 t ((labl (iup:b
4c40: 75 74 74 6f 6e 20 22 22 20 0a 09 09 09 09 20 23 utton "" ..... #
4c50: 3a 66 6c 61 74 20 22 59 45 53 22 20 0a 09 09 09 :flat "YES" ....
4c60: 09 20 3b 20 23 3a 69 6d 61 67 65 20 69 6d 67 31 . ; #:image img1
4c70: 0a 09 09 09 09 20 3b 20 23 3a 69 6d 70 72 65 73 ..... ; #:impres
4c80: 73 20 69 6d 67 32 0a 09 09 09 09 20 23 3a 73 69 s img2..... #:si
4c90: 7a 65 20 22 31 30 30 78 31 35 22 0a 09 09 09 09 ze "100x15".....
4ca0: 20 23 3a 66 6f 6e 74 73 69 7a 65 20 22 31 30 22 #:fontsize "10"
4cb0: 0a 09 09 09 09 20 23 3a 61 63 74 69 6f 6e 20 28 ..... #:action (
4cc0: 6c 61 6d 62 64 61 20 28 6f 62 6a 29 0a 09 09 09 lambda (obj)....
4cd0: 09 09 20 20 20 20 20 20 28 74 6f 67 67 6c 65 2d .. (toggle-
4ce0: 68 69 64 65 20 74 65 73 74 6e 75 6d 29 29 29 29 hide testnum))))
4cf0: 29 20 3b 3b 20 28 69 75 70 3a 61 74 74 72 69 62 ) ;; (iup:attrib
4d00: 75 74 65 20 6f 62 6a 20 22 54 49 54 4c 45 22 29 ute obj "TITLE")
4d10: 29 29 29 0a 09 20 20 28 76 65 63 74 6f 72 2d 73 ))).. (vector-s
4d20: 65 74 21 20 6c 66 74 63 6f 6c 20 74 65 73 74 6e et! lftcol testn
4d30: 75 6d 20 6c 61 62 6c 29 0a 09 20 20 28 6c 6f 6f um labl).. (loo
4d40: 70 20 28 2b 20 74 65 73 74 6e 75 6d 20 31 29 28 p (+ testnum 1)(
4d50: 63 6f 6e 73 20 6c 61 62 6c 20 72 65 73 29 29 29 cons labl res)))
4d60: 29 29 29 0a 20 20 20 20 3b 3b 20 0a 20 20 20 20 ))). ;; .
4d70: 28 6c 65 74 20 6c 6f 6f 70 20 28 28 72 75 6e 6e (let loop ((runn
4d80: 75 6d 20 20 30 29 0a 09 20 20 20 20 20 20 20 28 um 0).. (
4d90: 6b 65 79 6e 75 6d 20 20 30 29 0a 09 20 20 20 20 keynum 0)..
4da0: 20 20 20 28 6b 65 79 76 65 63 20 20 28 6d 61 6b (keyvec (mak
4db0: 65 2d 76 65 63 74 6f 72 20 6e 6b 65 79 73 29 29 e-vector nkeys))
4dc0: 0a 09 20 20 20 20 20 20 20 28 72 65 73 20 20 20 .. (res
4dd0: 20 27 28 29 29 29 0a 20 20 20 20 20 20 28 63 6f '())). (co
4de0: 6e 64 20 3b 3b 20 6e 62 2f 2f 20 6e 6f 20 65 6c nd ;; nb// no el
4df0: 73 65 20 66 6f 72 20 74 68 69 73 20 61 70 70 72 se for this appr
4e00: 6f 61 63 68 2e 0a 20 20 20 20 20 20 20 28 28 3e oach.. ((>
4e10: 3d 20 72 75 6e 6e 75 6d 20 6e 72 75 6e 73 29 20 = runnum nruns)
4e20: 23 66 29 0a 20 20 20 20 20 20 20 28 28 3e 3d 20 #f). ((>=
4e30: 6b 65 79 6e 75 6d 20 6e 6b 65 79 73 29 20 0a 09 keynum nkeys) ..
4e40: 28 76 65 63 74 6f 72 2d 73 65 74 21 20 68 65 61 (vector-set! hea
4e50: 64 65 72 20 72 75 6e 6e 75 6d 20 6b 65 79 76 65 der runnum keyve
4e60: 63 29 0a 09 28 73 65 74 21 20 68 64 72 6c 73 74 c)..(set! hdrlst
4e70: 20 28 63 6f 6e 73 20 28 61 70 70 6c 79 20 69 75 (cons (apply iu
4e80: 70 3a 76 62 6f 78 20 28 72 65 76 65 72 73 65 20 p:vbox (reverse
4e90: 72 65 73 29 29 20 68 64 72 6c 73 74 29 29 0a 09 res)) hdrlst))..
4ea0: 28 6c 6f 6f 70 20 28 2b 20 72 75 6e 6e 75 6d 20 (loop (+ runnum
4eb0: 31 29 20 30 20 28 6d 61 6b 65 2d 76 65 63 74 6f 1) 0 (make-vecto
4ec0: 72 20 6e 6b 65 79 73 29 20 27 28 29 29 29 0a 20 r nkeys) '())).
4ed0: 20 20 20 20 20 20 28 65 6c 73 65 0a 09 28 6c 65 (else..(le
4ee0: 74 20 28 28 6c 61 62 6c 20 20 28 69 75 70 3a 6c t ((labl (iup:l
4ef0: 61 62 65 6c 20 22 22 20 23 3a 73 69 7a 65 20 22 abel "" #:size "
4f00: 36 30 78 31 35 22 20 23 3a 66 6f 6e 74 73 69 7a 60x15" #:fontsiz
4f10: 65 20 22 31 30 22 29 29 29 20 3b 3b 20 23 3a 65 e "10"))) ;; #:e
4f20: 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 xpand "HORIZONTA
4f30: 4c 22 0a 09 20 20 28 76 65 63 74 6f 72 2d 73 65 L".. (vector-se
4f40: 74 21 20 6b 65 79 76 65 63 20 6b 65 79 6e 75 6d t! keyvec keynum
4f50: 20 6c 61 62 6c 29 0a 09 20 20 28 6c 6f 6f 70 20 labl).. (loop
4f60: 72 75 6e 6e 75 6d 20 28 2b 20 6b 65 79 6e 75 6d runnum (+ keynum
4f70: 20 31 29 20 6b 65 79 76 65 63 20 28 63 6f 6e 73 1) keyvec (cons
4f80: 20 6c 61 62 6c 20 72 65 73 29 29 29 29 29 29 0a labl res)))))).
4f90: 20 20 20 20 3b 3b 20 42 79 20 68 65 72 65 20 74 ;; By here t
4fa0: 68 65 20 68 64 72 6c 73 74 20 63 6f 6e 74 61 69 he hdrlst contai
4fb0: 6e 73 20 61 20 6c 69 73 74 20 6f 66 20 76 62 6f ns a list of vbo
4fc0: 78 65 73 20 63 6f 6e 74 61 69 6e 69 6e 67 20 6e xes containing n
4fd0: 6b 65 79 73 20 6c 61 62 65 6c 73 0a 20 20 20 20 keys labels.
4fe0: 28 6c 65 74 20 6c 6f 6f 70 20 28 28 72 75 6e 6e (let loop ((runn
4ff0: 75 6d 20 20 30 29 0a 09 20 20 20 20 20 20 20 28 um 0).. (
5000: 74 65 73 74 6e 75 6d 20 30 29 0a 09 20 20 20 20 testnum 0)..
5010: 20 20 20 28 74 65 73 74 76 65 63 20 20 28 6d 61 (testvec (ma
5020: 6b 65 2d 76 65 63 74 6f 72 20 6e 74 65 73 74 73 ke-vector ntests
5030: 29 29 0a 09 20 20 20 20 20 20 20 28 72 65 73 20 )).. (res
5040: 20 20 20 27 28 29 29 29 0a 20 20 20 20 20 20 28 '())). (
5050: 63 6f 6e 64 0a 20 20 20 20 20 20 20 28 28 3e 3d cond. ((>=
5060: 20 72 75 6e 6e 75 6d 20 6e 72 75 6e 73 29 20 23 runnum nruns) #
5070: 66 29 20 3b 3b 20 20 28 76 65 63 74 6f 72 20 74 f) ;; (vector t
5080: 61 62 6c 65 68 65 61 64 65 72 20 72 75 6e 73 76 ableheader runsv
5090: 65 63 29 29 0a 20 20 20 20 20 20 20 28 28 3e 3d ec)). ((>=
50a0: 20 74 65 73 74 6e 75 6d 20 6e 74 65 73 74 73 29 testnum ntests)
50b0: 20 0a 09 28 76 65 63 74 6f 72 2d 73 65 74 21 20 ..(vector-set!
50c0: 72 75 6e 73 76 65 63 20 72 75 6e 6e 75 6d 20 74 runsvec runnum t
50d0: 65 73 74 76 65 63 29 0a 09 28 73 65 74 21 20 62 estvec)..(set! b
50e0: 64 79 6c 73 74 20 28 63 6f 6e 73 20 28 61 70 70 dylst (cons (app
50f0: 6c 79 20 69 75 70 3a 76 62 6f 78 20 28 72 65 76 ly iup:vbox (rev
5100: 65 72 73 65 20 72 65 73 29 29 20 62 64 79 6c 73 erse res)) bdyls
5110: 74 29 29 0a 09 28 6c 6f 6f 70 20 28 2b 20 72 75 t))..(loop (+ ru
5120: 6e 6e 75 6d 20 31 29 20 30 20 28 6d 61 6b 65 2d nnum 1) 0 (make-
5130: 76 65 63 74 6f 72 20 6e 74 65 73 74 73 29 20 27 vector ntests) '
5140: 28 29 29 29 0a 20 20 20 20 20 20 20 28 65 6c 73 ())). (els
5150: 65 0a 09 28 6c 65 74 2a 20 28 28 62 75 74 74 6f e..(let* ((butto
5160: 6e 2d 6b 65 79 20 28 6d 6b 73 74 72 20 72 75 6e n-key (mkstr run
5170: 6e 75 6d 20 74 65 73 74 6e 75 6d 29 29 0a 09 20 num testnum))..
5180: 20 20 20 20 20 20 28 62 75 74 6e 20 20 20 20 20 (butn
5190: 20 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 22 (iup:button ""
51a0: 20 3b 3b 20 62 75 74 74 6f 6e 2d 6b 65 79 20 0a ;; button-key .
51b0: 09 09 09 09 20 20 20 20 20 20 20 23 3a 73 69 7a .... #:siz
51c0: 65 20 22 36 30 78 31 35 22 20 0a 09 09 09 09 20 e "60x15" .....
51d0: 20 20 20 20 20 20 3b 3b 20 23 3a 65 78 70 61 6e ;; #:expan
51e0: 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 0a 09 d "HORIZONTAL"..
51f0: 09 09 09 20 20 20 20 20 20 20 23 3a 66 6f 6e 74 ... #:font
5200: 73 69 7a 65 20 22 31 30 22 20 0a 09 09 09 09 20 size "10" .....
5210: 20 20 20 20 20 20 23 3a 61 63 74 69 6f 6e 20 28 #:action (
5220: 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 09 09 09 lambda (x)......
5230: 09 20 20 28 6c 65 74 2a 20 28 28 74 6f 6f 6c 70 . (let* ((toolp
5240: 61 74 68 20 28 63 61 72 20 28 61 72 67 76 29 29 ath (car (argv))
5250: 29 0a 09 09 09 09 09 09 09 20 28 62 75 74 74 6e )........ (buttn
5260: 64 61 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d dat (hash-table-
5270: 72 65 66 20 2a 62 75 74 74 6f 6e 64 61 74 2a 20 ref *buttondat*
5280: 62 75 74 74 6f 6e 2d 6b 65 79 29 29 0a 09 09 09 button-key))....
5290: 09 09 09 09 20 28 74 65 73 74 2d 69 64 20 20 28 .... (test-id (
52a0: 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 64 20 28 db:test-get-id (
52b0: 76 65 63 74 6f 72 2d 72 65 66 20 62 75 74 74 6e vector-ref buttn
52c0: 64 61 74 20 33 29 29 29 0a 09 09 09 09 09 09 09 dat 3)))........
52d0: 20 28 63 6d 64 20 20 28 63 6f 6e 63 20 74 6f 6f (cmd (conc too
52e0: 6c 70 61 74 68 20 22 20 2d 74 65 73 74 20 22 20 lpath " -test "
52f0: 74 65 73 74 2d 69 64 20 22 26 22 29 29 29 0a 09 test-id "&")))..
5300: 09 09 09 09 09 20 20 20 20 3b 28 70 72 69 6e 74 ..... ;(print
5310: 20 22 4c 61 75 6e 63 68 69 6e 67 20 22 20 63 6d "Launching " cm
5320: 64 29 0a 09 09 09 09 09 09 20 20 20 20 28 73 79 d)....... (sy
5330: 73 74 65 6d 20 63 6d 64 29 29 29 29 29 29 0a 09 stem cmd))))))..
5340: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 (hash-table-se
5350: 74 21 20 2a 62 75 74 74 6f 6e 64 61 74 2a 20 62 t! *buttondat* b
5360: 75 74 74 6f 6e 2d 6b 65 79 20 28 76 65 63 74 6f utton-key (vecto
5370: 72 20 30 20 22 31 30 30 20 31 30 30 20 31 30 30 r 0 "100 100 100
5380: 22 20 62 75 74 74 6f 6e 2d 6b 65 79 20 23 66 20 " button-key #f
5390: 23 66 29 29 20 0a 09 20 20 28 76 65 63 74 6f 72 #f)) .. (vector
53a0: 2d 73 65 74 21 20 74 65 73 74 76 65 63 20 74 65 -set! testvec te
53b0: 73 74 6e 75 6d 20 62 75 74 6e 29 0a 09 20 20 28 stnum butn).. (
53c0: 6c 6f 6f 70 20 72 75 6e 6e 75 6d 20 28 2b 20 74 loop runnum (+ t
53d0: 65 73 74 6e 75 6d 20 31 29 20 74 65 73 74 76 65 estnum 1) testve
53e0: 63 20 28 63 6f 6e 73 20 62 75 74 6e 20 72 65 73 c (cons butn res
53f0: 29 29 29 29 29 29 0a 20 20 20 20 3b 3b 20 6e 6f )))))). ;; no
5400: 77 20 61 73 73 65 6d 62 6c 65 20 74 68 65 20 68 w assemble the h
5410: 64 72 6c 73 74 20 61 6e 64 20 62 64 79 6c 73 74 drlst and bdylst
5420: 20 61 6e 64 20 6b 69 63 6b 20 6f 66 66 20 74 68 and kick off th
5430: 65 20 64 69 61 6c 6f 67 0a 20 20 20 20 28 69 75 e dialog. (iu
5440: 70 3a 73 68 6f 77 0a 20 20 20 20 20 28 69 75 70 p:show. (iup
5450: 3a 64 69 61 6c 6f 67 20 0a 20 20 20 20 20 20 23 :dialog . #
5460: 3a 74 69 74 6c 65 20 22 4d 65 67 61 74 65 73 74 :title "Megatest
5470: 20 64 61 73 68 62 6f 61 72 64 22 0a 20 20 20 20 dashboard".
5480: 20 20 28 69 75 70 3a 76 62 6f 78 0a 09 28 61 70 (iup:vbox..(ap
5490: 70 6c 79 20 69 75 70 3a 68 62 6f 78 20 0a 09 20 ply iup:hbox ..
54a0: 20 20 20 20 20 20 28 63 6f 6e 73 20 28 61 70 70 (cons (app
54b0: 6c 79 20 69 75 70 3a 76 62 6f 78 20 6c 66 74 6c ly iup:vbox lftl
54c0: 73 74 29 0a 09 09 20 20 20 20 20 28 6c 69 73 74 st)... (list
54d0: 20 0a 09 09 20 20 20 20 20 20 28 69 75 70 3a 76 ... (iup:v
54e0: 62 6f 78 0a 09 09 20 20 20 20 20 20 20 3b 3b 20 box... ;;
54f0: 74 68 65 20 68 65 61 64 65 72 0a 09 09 20 20 20 the header...
5500: 20 20 20 20 28 61 70 70 6c 79 20 69 75 70 3a 68 (apply iup:h
5510: 62 6f 78 20 28 72 65 76 65 72 73 65 20 68 64 72 box (reverse hdr
5520: 6c 73 74 29 29 0a 09 09 20 20 20 20 20 20 20 28 lst))... (
5530: 61 70 70 6c 79 20 69 75 70 3a 68 62 6f 78 20 28 apply iup:hbox (
5540: 72 65 76 65 72 73 65 20 62 64 79 6c 73 74 29 29 reverse bdylst))
5550: 29 29 29 29 0a 20 20 20 20 20 20 20 63 6f 6e 74 )))). cont
5560: 72 6f 6c 73 29 29 29 0a 20 20 20 20 28 76 65 63 rols))). (vec
5570: 74 6f 72 20 6c 66 74 63 6f 6c 20 68 65 61 64 65 tor lftcol heade
5580: 72 20 72 75 6e 73 76 65 63 29 29 29 0a 0a 28 69 r runsvec)))..(i
5590: 66 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d f (or (args:get-
55a0: 61 72 67 20 22 2d 72 6f 77 73 22 29 0a 09 28 67 arg "-rows")..(g
55b0: 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 et-environment-v
55c0: 61 72 69 61 62 6c 65 20 22 44 41 53 48 42 4f 41 ariable "DASHBOA
55d0: 52 44 52 4f 57 53 22 20 29 29 0a 20 20 20 20 28 RDROWS" )). (
55e0: 62 65 67 69 6e 0a 20 20 20 20 20 20 20 20 28 73 begin. (s
55f0: 65 74 21 20 2a 6e 75 6d 2d 74 65 73 74 73 2a 20 et! *num-tests*
5600: 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 (string->number
5610: 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (or (args:get-ar
5620: 67 20 22 2d 72 6f 77 73 22 29 0a 09 09 09 09 09 g "-rows")......
5630: 20 20 20 20 20 20 28 67 65 74 2d 65 6e 76 69 72 (get-envir
5640: 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 onment-variable
5650: 22 44 41 53 48 42 4f 41 52 44 52 4f 57 53 22 29 "DASHBOARDROWS")
5660: 29 29 29 0a 09 28 75 70 64 61 74 65 2d 72 75 6e )))..(update-run
5670: 64 61 74 20 22 25 22 20 2a 6e 75 6d 2d 72 75 6e dat "%" *num-run
5680: 73 2a 20 22 25 22 20 22 25 22 20 27 28 29 29 29 s* "%" "%" '()))
5690: 0a 20 20 20 20 28 73 65 74 21 20 2a 6e 75 6d 2d . (set! *num-
56a0: 74 65 73 74 73 2a 20 28 6d 69 6e 20 28 6d 61 78 tests* (min (max
56b0: 20 28 75 70 64 61 74 65 2d 72 75 6e 64 61 74 20 (update-rundat
56c0: 22 25 22 20 2a 6e 75 6d 2d 72 75 6e 73 2a 20 22 "%" *num-runs* "
56d0: 25 22 20 22 25 22 20 27 28 29 29 20 38 29 20 32 %" "%" '()) 8) 2
56e0: 30 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 2a 74 0)))..(define *t
56f0: 69 6d 2a 20 28 69 75 70 3a 74 69 6d 65 72 29 29 im* (iup:timer))
5700: 0a 28 64 65 66 69 6e 65 20 2a 6f 72 64 2a 20 23 .(define *ord* #
5710: 66 29 0a 28 69 75 70 3a 61 74 74 72 69 62 75 74 f).(iup:attribut
5720: 65 2d 73 65 74 21 20 2a 74 69 6d 2a 20 22 54 49 e-set! *tim* "TI
5730: 4d 45 22 20 33 30 30 29 0a 28 69 75 70 3a 61 74 ME" 300).(iup:at
5740: 74 72 69 62 75 74 65 2d 73 65 74 21 20 2a 74 69 tribute-set! *ti
5750: 6d 2a 20 22 52 55 4e 22 20 22 59 45 53 22 29 0a m* "RUN" "YES").
5760: 0a 3b 3b 20 4d 6f 76 65 20 74 68 69 73 20 73 74 .;; Move this st
5770: 75 66 66 20 74 6f 20 64 62 2e 73 63 6d 20 46 49 uff to db.scm FI
5780: 58 4d 45 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 2a XME.;;.(define *
5790: 6c 61 73 74 2d 64 62 2d 75 70 64 61 74 65 2d 74 last-db-update-t
57a0: 69 6d 65 2a 20 28 66 69 6c 65 2d 6d 6f 64 69 66 ime* (file-modif
57b0: 69 63 61 74 69 6f 6e 2d 74 69 6d 65 20 28 63 6f ication-time (co
57c0: 6e 63 20 2a 74 6f 70 70 61 74 68 2a 20 22 2f 6d nc *toppath* "/m
57d0: 65 67 61 74 65 73 74 2e 64 62 22 29 29 29 0a 28 egatest.db"))).(
57e0: 64 65 66 69 6e 65 20 28 64 62 3a 62 65 65 6e 2d define (db:been-
57f0: 63 68 61 6e 67 65 64 29 0a 20 20 28 3e 20 28 66 changed). (> (f
5800: 69 6c 65 2d 6d 6f 64 69 66 69 63 61 74 69 6f 6e ile-modification
5810: 2d 74 69 6d 65 20 28 63 6f 6e 63 20 2a 74 6f 70 -time (conc *top
5820: 70 61 74 68 2a 20 22 2f 6d 65 67 61 74 65 73 74 path* "/megatest
5830: 2e 64 62 22 29 29 20 2a 6c 61 73 74 2d 64 62 2d .db")) *last-db-
5840: 75 70 64 61 74 65 2d 74 69 6d 65 2a 29 29 0a 28 update-time*)).(
5850: 64 65 66 69 6e 65 20 28 64 62 3a 73 65 74 2d 64 define (db:set-d
5860: 62 2d 75 70 64 61 74 65 2d 74 69 6d 65 29 0a 20 b-update-time).
5870: 20 28 73 65 74 21 20 2a 6c 61 73 74 2d 64 62 2d (set! *last-db-
5880: 75 70 64 61 74 65 2d 74 69 6d 65 2a 20 28 66 69 update-time* (fi
5890: 6c 65 2d 6d 6f 64 69 66 69 63 61 74 69 6f 6e 2d le-modification-
58a0: 74 69 6d 65 20 28 63 6f 6e 63 20 2a 74 6f 70 70 time (conc *topp
58b0: 61 74 68 2a 20 22 2f 6d 65 67 61 74 65 73 74 2e ath* "/megatest.
58c0: 64 62 22 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 db"))))..(define
58d0: 20 28 72 75 6e 2d 75 70 64 61 74 65 20 78 29 0a (run-update x).
58e0: 20 20 28 75 70 64 61 74 65 2d 62 75 74 74 6f 6e (update-button
58f0: 73 20 75 69 64 61 74 20 2a 6e 75 6d 2d 72 75 6e s uidat *num-run
5900: 73 2a 20 2a 6e 75 6d 2d 74 65 73 74 73 2a 29 0a s* *num-tests*).
5910: 20 20 3b 3b 20 28 69 66 20 28 64 62 3a 62 65 65 ;; (if (db:bee
5920: 6e 2d 63 68 61 6e 67 65 64 29 0a 20 20 28 62 65 n-changed). (be
5930: 67 69 6e 0a 20 20 20 20 28 75 70 64 61 74 65 2d gin. (update-
5940: 72 75 6e 64 61 74 20 28 68 61 73 68 2d 74 61 62 rundat (hash-tab
5950: 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 2a le-ref/default *
5960: 73 65 61 72 63 68 70 61 74 74 73 2a 20 22 72 75 searchpatts* "ru
5970: 6e 6e 61 6d 65 22 20 22 25 22 29 20 2a 6e 75 6d nname" "%") *num
5980: 2d 72 75 6e 73 2a 0a 09 09 20 20 20 28 68 61 73 -runs*... (has
5990: 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 h-table-ref/defa
59a0: 75 6c 74 20 2a 73 65 61 72 63 68 70 61 74 74 73 ult *searchpatts
59b0: 2a 20 22 74 65 73 74 2d 6e 61 6d 65 22 20 22 25 * "test-name" "%
59c0: 22 29 0a 09 09 20 20 20 28 68 61 73 68 2d 74 61 ")... (hash-ta
59d0: 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 ble-ref/default
59e0: 2a 73 65 61 72 63 68 70 61 74 74 73 2a 20 22 69 *searchpatts* "i
59f0: 74 65 6d 2d 6e 61 6d 65 22 20 22 25 22 29 0a 09 tem-name" "%")..
5a00: 09 20 20 20 28 6c 65 74 20 28 28 72 65 73 20 27 . (let ((res '
5a10: 28 29 29 29 0a 09 09 20 20 20 20 20 28 66 6f 72 ()))... (for
5a20: 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 6b -each (lambda (k
5a30: 65 79 29 0a 09 09 09 09 20 28 6c 65 74 20 28 28 ey)..... (let ((
5a40: 76 61 6c 20 28 68 61 73 68 2d 74 61 62 6c 65 2d val (hash-table-
5a50: 72 65 66 2f 64 65 66 61 75 6c 74 20 2a 73 65 61 ref/default *sea
5a60: 72 63 68 70 61 74 74 73 2a 20 6b 65 79 20 23 66 rchpatts* key #f
5a70: 29 29 29 0a 09 09 09 09 20 20 20 28 69 66 20 76 )))..... (if v
5a80: 61 6c 20 28 73 65 74 21 20 72 65 73 20 28 63 6f al (set! res (co
5a90: 6e 73 20 28 6c 69 73 74 20 6b 65 79 20 76 61 6c ns (list key val
5aa0: 29 20 72 65 73 29 29 29 29 29 0a 09 09 09 20 20 ) res)))))....
5ab0: 20 20 20 20 20 2a 64 62 6b 65 79 73 2a 29 0a 09 *dbkeys*)..
5ac0: 09 20 20 20 20 20 72 65 73 29 29 0a 20 20 20 20 . res)).
5ad0: 3b 20 28 64 62 3a 73 65 74 2d 64 62 2d 75 70 64 ; (db:set-db-upd
5ae0: 61 74 65 2d 74 69 6d 65 29 0a 20 20 20 20 29 29 ate-time). ))
5af0: 0a 0a 28 63 6f 6e 64 20 0a 20 28 28 61 72 67 73 ..(cond . ((args
5b00: 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 22 29 :get-arg "-run")
5b10: 0a 20 20 28 6c 65 74 20 28 28 72 75 6e 69 64 20 . (let ((runid
5b20: 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 (string->number
5b30: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
5b40: 72 75 6e 22 29 29 29 29 0a 20 20 20 20 28 69 66 run")))). (if
5b50: 20 72 75 6e 69 64 0a 09 28 62 65 67 69 6e 0a 09 runid..(begin..
5b60: 20 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 20 (lambda (x)..
5b70: 20 20 20 28 6f 6e 2d 65 78 69 74 20 28 6c 61 6d (on-exit (lam
5b80: 62 64 61 20 28 29 0a 09 09 20 20 20 20 20 20 20 bda ()...
5b90: 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a (sqlite3:finaliz
5ba0: 65 21 20 2a 64 62 2a 29 29 29 0a 09 20 20 20 20 e! *db*)))..
5bb0: 28 65 78 61 6d 69 6e 65 2d 72 75 6e 20 2a 64 62 (examine-run *db
5bc0: 2a 20 72 75 6e 69 64 29 29 29 0a 09 28 62 65 67 * runid)))..(beg
5bd0: 69 6e 0a 09 20 20 28 70 72 69 6e 74 20 22 45 52 in.. (print "ER
5be0: 52 4f 52 3a 20 72 75 6e 69 64 20 69 73 20 6e 6f ROR: runid is no
5bf0: 74 20 61 20 6e 75 6d 62 65 72 20 22 20 28 61 72 t a number " (ar
5c00: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e gs:get-arg "-run
5c10: 22 29 29 0a 09 20 20 28 65 78 69 74 20 31 29 29 ")).. (exit 1))
5c20: 29 29 29 0a 20 28 28 61 72 67 73 3a 67 65 74 2d ))). ((args:get-
5c30: 61 72 67 20 22 2d 74 65 73 74 22 29 0a 20 20 20 arg "-test").
5c40: 20 28 6c 65 74 20 28 28 74 65 73 74 69 64 20 28 (let ((testid (
5c50: 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 string->number (
5c60: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 args:get-arg "-t
5c70: 65 73 74 22 29 29 29 29 0a 20 20 20 20 28 69 66 est")))). (if
5c80: 20 74 65 73 74 69 64 0a 09 28 65 78 61 6d 69 6e testid..(examin
5c90: 65 2d 74 65 73 74 20 2a 64 62 2a 20 74 65 73 74 e-test *db* test
5ca0: 69 64 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 id)..(begin.. (
5cb0: 70 72 69 6e 74 20 22 45 52 52 4f 52 3a 20 74 65 print "ERROR: te
5cc0: 73 74 69 64 20 69 73 20 6e 6f 74 20 61 20 6e 75 stid is not a nu
5cd0: 6d 62 65 72 20 22 20 28 61 72 67 73 3a 67 65 74 mber " (args:get
5ce0: 2d 61 72 67 20 22 2d 74 65 73 74 22 29 29 0a 09 -arg "-test"))..
5cf0: 20 20 28 65 78 69 74 20 31 29 29 29 29 29 0a 20 (exit 1))))).
5d00: 28 65 6c 73 65 0a 20 20 28 73 65 74 21 20 75 69 (else. (set! ui
5d10: 64 61 74 20 28 6d 61 6b 65 2d 64 61 73 68 62 6f dat (make-dashbo
5d20: 61 72 64 2d 62 75 74 74 6f 6e 73 20 2a 6e 75 6d ard-buttons *num
5d30: 2d 72 75 6e 73 2a 20 2a 6e 75 6d 2d 74 65 73 74 -runs* *num-test
5d40: 73 2a 20 2a 64 62 6b 65 79 73 2a 29 29 0a 20 20 s* *dbkeys*)).
5d50: 28 69 75 70 3a 63 61 6c 6c 62 61 63 6b 2d 73 65 (iup:callback-se
5d60: 74 21 20 2a 74 69 6d 2a 0a 09 09 20 20 20 20 20 t! *tim*...
5d70: 22 41 43 54 49 4f 4e 5f 43 42 22 0a 09 09 20 20 "ACTION_CB"...
5d80: 20 20 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 (lambda (x)..
5d90: 09 20 20 20 20 20 20 20 28 72 75 6e 2d 75 70 64 . (run-upd
5da0: 61 74 65 20 78 29 29 29 29 29 0a 09 09 20 20 20 ate x)))))...
5db0: 20 20 20 20 3b 28 70 72 69 6e 74 20 78 29 29 29 ;(print x)))
5dc0: 29 29 0a 0a 28 69 75 70 3a 6d 61 69 6e 2d 6c 6f ))..(iup:main-lo
5dd0: 6f 70 29 0a op).