Artifact
130b7aaa067b0f2816f554fbf29fc58d4fa63a37:
0000: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
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 0a 3b 3b 20 43 6f 70 79 ========.;; Copy
0050: 72 69 67 68 74 20 32 30 30 36 2d 32 30 31 32 2c right 2006-2012,
0060: 20 4d 61 74 74 68 65 77 20 57 65 6c 6c 61 6e 64 Matthew Welland
0070: 2e 0a 3b 3b 20 0a 3b 3b 20 20 54 68 69 73 20 70 ..;; .;; This p
0080: 72 6f 67 72 61 6d 20 69 73 20 6d 61 64 65 20 61 rogram is made a
0090: 76 61 69 6c 61 62 6c 65 20 75 6e 64 65 72 20 74 vailable under t
00a0: 68 65 20 47 4e 55 20 47 50 4c 20 76 65 72 73 69 he GNU GPL versi
00b0: 6f 6e 20 32 2e 30 20 6f 72 0a 3b 3b 20 20 67 72 on 2.0 or.;; gr
00c0: 65 61 74 65 72 2e 20 53 65 65 20 74 68 65 20 61 eater. See the a
00d0: 63 63 6f 6d 70 61 6e 79 69 6e 67 20 66 69 6c 65 ccompanying file
00e0: 20 43 4f 50 59 49 4e 47 20 66 6f 72 20 64 65 74 COPYING for det
00f0: 61 69 6c 73 2e 0a 3b 3b 20 0a 3b 3b 20 20 54 68 ails..;; .;; Th
0100: 69 73 20 70 72 6f 67 72 61 6d 20 69 73 20 64 69 is program is di
0110: 73 74 72 69 62 75 74 65 64 20 57 49 54 48 4f 55 stributed WITHOU
0120: 54 20 41 4e 59 20 57 41 52 52 41 4e 54 59 3b 20 T ANY WARRANTY;
0130: 77 69 74 68 6f 75 74 20 65 76 65 6e 20 74 68 65 without even the
0140: 0a 3b 3b 20 20 69 6d 70 6c 69 65 64 20 77 61 72 .;; implied war
0150: 72 61 6e 74 79 20 6f 66 20 4d 45 52 43 48 41 4e ranty of MERCHAN
0160: 54 41 42 49 4c 49 54 59 20 6f 72 20 46 49 54 4e TABILITY or FITN
0170: 45 53 53 20 46 4f 52 20 41 20 50 41 52 54 49 43 ESS FOR A PARTIC
0180: 55 4c 41 52 0a 3b 3b 20 20 50 55 52 50 4f 53 45 ULAR.;; PURPOSE
0190: 2e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
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 0a 0a 28 75 73 65 ==========..(use
01e0: 20 66 6f 72 6d 61 74 29 0a 28 72 65 71 75 69 72 format).(requir
01f0: 65 2d 6c 69 62 72 61 72 79 20 69 75 70 29 0a 28 e-library iup).(
0200: 69 6d 70 6f 72 74 20 28 70 72 65 66 69 78 20 69 import (prefix i
0210: 75 70 20 69 75 70 3a 29 29 0a 0a 28 75 73 65 20 up iup:))..(use
0220: 63 61 6e 76 61 73 2d 64 72 61 77 29 0a 28 69 6d canvas-draw).(im
0230: 70 6f 72 74 20 63 61 6e 76 61 73 2d 64 72 61 77 port canvas-draw
0240: 2d 69 75 70 29 0a 0a 28 75 73 65 20 73 71 6c 69 -iup)..(use sqli
0250: 74 65 33 20 73 72 66 69 2d 31 20 70 6f 73 69 78 te3 srfi-1 posix
0260: 20 72 65 67 65 78 20 72 65 67 65 78 2d 63 61 73 regex regex-cas
0270: 65 20 73 72 66 69 2d 36 39 29 0a 28 69 6d 70 6f e srfi-69).(impo
0280: 72 74 20 28 70 72 65 66 69 78 20 73 71 6c 69 74 rt (prefix sqlit
0290: 65 33 20 73 71 6c 69 74 65 33 3a 29 29 0a 28 75 e3 sqlite3:)).(u
02a0: 73 65 20 74 72 61 63 65 29 0a 0a 28 64 65 63 6c se trace)..(decl
02b0: 61 72 65 20 28 75 73 65 73 20 63 6f 6d 6d 6f 6e are (uses common
02c0: 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 )).(declare (use
02d0: 73 20 6d 61 72 67 73 29 29 0a 28 64 65 63 6c 61 s margs)).(decla
02e0: 72 65 20 28 75 73 65 73 20 6b 65 79 73 29 29 0a re (uses keys)).
02f0: 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 69 (declare (uses i
0300: 74 65 6d 73 29 29 0a 28 64 65 63 6c 61 72 65 20 tems)).(declare
0310: 28 75 73 65 73 20 64 62 29 29 0a 28 64 65 63 6c (uses db)).(decl
0320: 61 72 65 20 28 75 73 65 73 20 63 6f 6e 66 69 67 are (uses config
0330: 66 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 f)).(declare (us
0340: 65 73 20 70 72 6f 63 65 73 73 29 29 0a 28 64 65 es process)).(de
0350: 63 6c 61 72 65 20 28 75 73 65 73 20 6c 61 75 6e clare (uses laun
0360: 63 68 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 ch)).(declare (u
0370: 73 65 73 20 72 75 6e 73 29 29 0a 28 64 65 63 6c ses runs)).(decl
0380: 61 72 65 20 28 75 73 65 73 20 64 61 73 68 62 6f are (uses dashbo
0390: 61 72 64 2d 74 65 73 74 73 29 29 0a 28 64 65 63 ard-tests)).(dec
03a0: 6c 61 72 65 20 28 75 73 65 73 20 64 61 73 68 62 lare (uses dashb
03b0: 6f 61 72 64 2d 67 75 69 6d 6f 6e 69 74 6f 72 29 oard-guimonitor)
03c0: 29 0a 3b 3b 20 28 64 65 63 6c 61 72 65 20 28 75 ).;; (declare (u
03d0: 73 65 73 20 64 61 73 68 62 6f 61 72 64 2d 6d 61 ses dashboard-ma
03e0: 69 6e 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 in)).(declare (u
03f0: 73 65 73 20 6d 65 67 61 74 65 73 74 2d 76 65 72 ses megatest-ver
0400: 73 69 6f 6e 29 29 0a 28 64 65 63 6c 61 72 65 20 sion)).(declare
0410: 28 75 73 65 73 20 6d 74 29 29 0a 0a 28 69 6e 63 (uses mt))..(inc
0420: 6c 75 64 65 20 22 63 6f 6d 6d 6f 6e 5f 72 65 63 lude "common_rec
0430: 6f 72 64 73 2e 73 63 6d 22 29 0a 28 69 6e 63 6c ords.scm").(incl
0440: 75 64 65 20 22 64 62 5f 72 65 63 6f 72 64 73 2e ude "db_records.
0450: 73 63 6d 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 scm").(include "
0460: 72 75 6e 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 run_records.scm"
0470: 29 0a 0a 28 64 65 66 69 6e 65 20 68 65 6c 70 20 )..(define help
0480: 28 63 6f 6e 63 20 0a 22 4d 65 67 61 74 65 73 74 (conc ."Megatest
0490: 20 44 61 73 68 62 6f 61 72 64 2c 20 64 6f 63 75 Dashboard, docu
04a0: 6d 65 6e 74 61 74 69 6f 6e 20 61 74 20 68 74 74 mentation at htt
04b0: 70 3a 2f 2f 77 77 77 2e 6b 69 61 74 6f 61 2e 63 p://www.kiatoa.c
04c0: 6f 6d 2f 66 6f 73 73 69 6c 73 2f 6d 65 67 61 74 om/fossils/megat
04d0: 65 73 74 0a 20 20 76 65 72 73 69 6f 6e 20 22 20 est. version "
04e0: 6d 65 67 61 74 65 73 74 2d 76 65 72 73 69 6f 6e megatest-version
04f0: 20 22 0a 20 20 6c 69 63 65 6e 73 65 20 47 50 4c ". license GPL
0500: 2c 20 43 6f 70 79 72 69 67 68 74 20 28 43 29 20 , Copyright (C)
0510: 4d 61 74 74 20 57 65 6c 6c 61 6e 64 20 32 30 31 Matt Welland 201
0520: 31 0a 0a 55 73 61 67 65 3a 20 64 61 73 68 62 6f 1..Usage: dashbo
0530: 61 72 64 20 5b 6f 70 74 69 6f 6e 73 5d 0a 20 20 ard [options].
0540: 2d 68 20 20 20 20 20 20 20 20 20 20 20 20 20 20 -h
0550: 20 20 3a 20 74 68 69 73 20 68 65 6c 70 0a 20 20 : this help.
0560: 2d 73 65 72 76 65 72 20 68 6f 73 74 3a 70 6f 72 -server host:por
0570: 74 20 3a 20 63 6f 6e 6e 65 63 74 20 74 6f 20 68 t : connect to h
0580: 6f 73 74 3a 70 6f 72 74 20 69 6e 73 74 65 61 64 ost:port instead
0590: 20 6f 66 20 64 62 20 61 63 63 65 73 73 0a 20 20 of db access.
05a0: 2d 74 65 73 74 20 74 65 73 74 69 64 20 20 20 20 -test testid
05b0: 20 20 3a 20 63 6f 6e 74 72 6f 6c 20 74 65 73 74 : control test
05c0: 20 69 64 65 6e 74 69 66 69 65 64 20 62 79 20 74 identified by t
05d0: 65 73 74 69 64 0a 20 20 2d 67 75 69 6d 6f 6e 69 estid. -guimoni
05e0: 74 6f 72 20 20 20 20 20 20 20 3a 20 63 6f 6e 74 tor : cont
05f0: 72 6f 6c 20 70 61 6e 65 6c 20 66 6f 72 20 72 75 rol panel for ru
0600: 6e 73 0a 0a 4d 69 73 63 0a 20 20 2d 72 6f 77 73 ns..Misc. -rows
0610: 20 4e 20 20 20 20 20 20 20 20 20 3a 20 73 65 74 N : set
0620: 20 6e 75 6d 62 65 72 20 6f 66 20 72 6f 77 73 0a number of rows.
0630: 22 29 29 0a 0a 3b 3b 20 70 72 6f 63 65 73 73 20 "))..;; process
0640: 61 72 67 73 0a 28 64 65 66 69 6e 65 20 72 65 6d args.(define rem
0650: 61 72 67 73 20 28 61 72 67 73 3a 67 65 74 2d 61 args (args:get-a
0660: 72 67 73 20 0a 09 09 20 28 61 72 67 76 29 0a 09 rgs ... (argv)..
0670: 09 20 28 6c 69 73 74 20 20 22 2d 72 6f 77 73 22 . (list "-rows"
0680: 0a 09 09 09 22 2d 72 75 6e 22 0a 09 09 09 22 2d ...."-run"...."-
0690: 74 65 73 74 22 0a 09 09 09 22 2d 64 65 62 75 67 test"...."-debug
06a0: 22 0a 09 09 09 22 2d 68 6f 73 74 22 20 0a 09 09 "...."-host" ...
06b0: 09 29 20 0a 09 09 20 28 6c 69 73 74 20 20 22 2d .) ... (list "-
06c0: 68 22 0a 09 09 09 22 2d 75 73 65 2d 73 65 72 76 h"...."-use-serv
06d0: 65 72 22 0a 09 09 09 22 2d 67 75 69 6d 6f 6e 69 er"...."-guimoni
06e0: 74 6f 72 22 0a 09 09 09 22 2d 6d 61 69 6e 22 0a tor"...."-main".
06f0: 09 09 09 22 2d 76 22 0a 09 09 09 22 2d 71 22 0a ..."-v"...."-q".
0700: 09 09 20 20 20 20 20 20 20 29 0a 09 09 20 61 72 .. )... ar
0710: 67 73 3a 61 72 67 2d 68 61 73 68 0a 09 09 20 30 gs:arg-hash... 0
0720: 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 ))..(if (args:ge
0730: 74 2d 61 72 67 20 22 2d 68 22 29 0a 20 20 20 20 t-arg "-h").
0740: 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 70 72 (begin. (pr
0750: 69 6e 74 20 68 65 6c 70 29 0a 20 20 20 20 20 20 int help).
0760: 28 65 78 69 74 29 29 29 0a 0a 28 69 66 20 28 6e (exit)))..(if (n
0770: 6f 74 20 28 73 65 74 75 70 2d 66 6f 72 2d 72 75 ot (setup-for-ru
0780: 6e 29 29 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 n)). (begin.
0790: 20 20 20 20 20 28 70 72 69 6e 74 20 22 46 61 69 (print "Fai
07a0: 6c 65 64 20 74 6f 20 66 69 6e 64 20 6d 65 67 61 led to find mega
07b0: 74 65 73 74 2e 63 6f 6e 66 69 67 2c 20 65 78 69 test.config, exi
07c0: 74 69 6e 67 22 29 20 0a 20 20 20 20 20 20 28 65 ting") . (e
07d0: 78 69 74 20 31 29 29 29 0a 0a 28 64 65 66 69 6e xit 1)))..(defin
07e0: 65 20 2a 64 62 2a 20 23 66 29 20 3b 3b 20 28 6f e *db* #f) ;; (o
07f0: 70 65 6e 2d 64 62 29 29 0a 0a 28 69 66 20 28 61 pen-db))..(if (a
0800: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 68 6f rgs:get-arg "-ho
0810: 73 74 22 29 0a 20 20 20 20 28 62 65 67 69 6e 0a st"). (begin.
0820: 20 20 20 20 20 20 28 73 65 74 21 20 2a 72 75 6e (set! *run
0830: 72 65 6d 6f 74 65 2a 20 28 73 74 72 69 6e 67 2d remote* (string-
0840: 73 70 6c 69 74 20 28 61 72 67 73 3a 67 65 74 2d split (args:get-
0850: 61 72 67 20 22 2d 68 6f 73 74 22 20 22 3a 22 29 arg "-host" ":")
0860: 29 29 0a 20 20 20 20 20 20 28 63 6c 69 65 6e 74 )). (client
0870: 3a 6c 61 75 6e 63 68 29 29 0a 20 20 20 20 28 69 :launch)). (i
0880: 66 20 28 6e 6f 74 20 28 61 72 67 73 3a 67 65 74 f (not (args:get
0890: 2d 61 72 67 20 22 2d 75 73 65 2d 73 65 72 76 65 -arg "-use-serve
08a0: 72 22 29 29 0a 09 28 73 65 74 21 20 2a 74 72 61 r"))..(set! *tra
08b0: 6e 73 70 6f 72 74 2d 74 79 70 65 2a 20 27 66 73 nsport-type* 'fs
08c0: 29 20 3b 3b 20 66 6f 72 63 65 20 66 73 20 61 63 ) ;; force fs ac
08d0: 63 65 73 73 0a 09 28 63 6c 69 65 6e 74 3a 6c 61 cess..(client:la
08e0: 75 6e 63 68 29 29 29 0a 0a 3b 3b 20 48 41 43 4b unch)))..;; HACK
08f0: 20 41 4c 45 52 54 3a 20 74 68 69 73 20 69 73 20 ALERT: this is
0900: 61 20 68 61 63 6b 2c 20 70 6c 65 61 73 65 20 66 a hack, please f
0910: 69 78 2e 0a 28 64 65 66 69 6e 65 20 2a 72 65 61 ix..(define *rea
0920: 64 2d 6f 6e 6c 79 2a 20 28 6e 6f 74 20 28 66 69 d-only* (not (fi
0930: 6c 65 2d 72 65 61 64 2d 61 63 63 65 73 73 3f 20 le-read-access?
0940: 28 63 6f 6e 63 20 2a 74 6f 70 70 61 74 68 2a 20 (conc *toppath*
0950: 22 2f 6d 65 67 61 74 65 73 74 2e 64 62 22 29 29 "/megatest.db"))
0960: 29 29 0a 3b 3b 20 28 63 6c 69 65 6e 74 3a 73 65 )).;; (client:se
0970: 74 75 70 20 2a 64 62 2a 29 0a 0a 28 64 65 66 69 tup *db*)..(defi
0980: 6e 65 20 74 6f 70 6c 65 76 65 6c 20 23 66 29 0a ne toplevel #f).
0990: 28 64 65 66 69 6e 65 20 64 6c 67 20 20 20 20 20 (define dlg
09a0: 20 23 66 29 0a 28 64 65 66 69 6e 65 20 6d 61 78 #f).(define max
09b0: 2d 74 65 73 74 2d 6e 75 6d 20 30 29 0a 3b 3b 20 -test-num 0).;;
09c0: 28 64 65 66 69 6e 65 20 2a 6b 65 79 73 2a 20 20 (define *keys*
09d0: 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 (open-run-close
09e0: 20 64 62 3a 67 65 74 2d 6b 65 79 73 20 23 66 29 db:get-keys #f)
09f0: 29 0a 28 64 65 66 69 6e 65 20 2a 6b 65 79 73 2a ).(define *keys*
0a00: 20 20 20 28 63 64 62 3a 72 65 6d 6f 74 65 2d 72 (cdb:remote-r
0a10: 75 6e 20 64 62 3a 67 65 74 2d 6b 65 79 73 20 23 un db:get-keys #
0a20: 66 29 29 0a 3b 3b 20 28 64 65 66 69 6e 65 20 2a f)).;; (define *
0a30: 6b 65 79 73 2a 20 20 20 28 64 62 3a 67 65 74 2d keys* (db:get-
0a40: 6b 65 79 73 20 20 20 2a 64 62 2a 29 29 0a 0a 28 keys *db*))..(
0a50: 64 65 66 69 6e 65 20 2a 64 62 6b 65 79 73 2a 20 define *dbkeys*
0a60: 20 28 61 70 70 65 6e 64 20 2a 6b 65 79 73 2a 20 (append *keys*
0a70: 28 6c 69 73 74 20 22 72 75 6e 6e 61 6d 65 22 29 (list "runname")
0a80: 29 29 0a 0a 28 64 65 66 69 6e 65 20 2a 68 65 61 ))..(define *hea
0a90: 64 65 72 2a 20 20 20 20 20 20 20 23 66 29 0a 28 der* #f).(
0aa0: 64 65 66 69 6e 65 20 2a 61 6c 6c 72 75 6e 73 2a define *allruns*
0ab0: 20 20 20 20 20 27 28 29 29 0a 28 64 65 66 69 6e '()).(defin
0ac0: 65 20 2a 61 6c 6c 72 75 6e 73 2d 62 79 2d 69 64 e *allruns-by-id
0ad0: 2a 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 * (make-hash-tab
0ae0: 6c 65 29 29 20 3b 3b 20 0a 28 64 65 66 69 6e 65 le)) ;; .(define
0af0: 20 2a 72 75 6e 63 68 61 6e 67 65 72 61 74 65 2a *runchangerate*
0b00: 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c (make-hash-tabl
0b10: 65 29 29 0a 0a 28 64 65 66 69 6e 65 20 2a 62 75 e))..(define *bu
0b20: 74 74 6f 6e 64 61 74 2a 20 20 20 20 28 6d 61 6b ttondat* (mak
0b30: 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 20 3b e-hash-table)) ;
0b40: 3b 20 3c 72 75 6e 2d 69 64 20 63 6f 6c 6f 72 20 ; <run-id color
0b50: 74 65 78 74 20 74 65 73 74 20 72 75 6e 2d 6b 65 text test run-ke
0b60: 79 3e 0a 28 64 65 66 69 6e 65 20 2a 61 6c 6c 74 y>.(define *allt
0b70: 65 73 74 6e 61 6d 65 6c 73 74 2a 20 27 28 29 29 estnamelst* '())
0b80: 0a 28 64 65 66 69 6e 65 20 2a 73 65 61 72 63 68 .(define *search
0b90: 70 61 74 74 73 2a 20 20 28 6d 61 6b 65 2d 68 61 patts* (make-ha
0ba0: 73 68 2d 74 61 62 6c 65 29 29 0a 28 64 65 66 69 sh-table)).(defi
0bb0: 6e 65 20 2a 6e 75 6d 2d 72 75 6e 73 2a 20 20 20 ne *num-runs*
0bc0: 20 20 20 38 29 0a 28 64 65 66 69 6e 65 20 2a 74 8).(define *t
0bd0: 6f 74 2d 72 75 6e 2d 63 6f 75 6e 74 2a 20 28 63 ot-run-count* (c
0be0: 64 62 3a 72 65 6d 6f 74 65 2d 72 75 6e 20 64 62 db:remote-run db
0bf0: 3a 67 65 74 2d 6e 75 6d 2d 72 75 6e 73 20 23 66 :get-num-runs #f
0c00: 20 22 25 22 29 29 0a 3b 3b 20 28 64 65 66 69 6e "%")).;; (defin
0c10: 65 20 2a 74 6f 74 2d 72 75 6e 2d 63 6f 75 6e 74 e *tot-run-count
0c20: 2a 20 28 64 62 3a 67 65 74 2d 6e 75 6d 2d 72 75 * (db:get-num-ru
0c30: 6e 73 20 2a 64 62 2a 20 22 25 22 29 29 0a 28 64 ns *db* "%")).(d
0c40: 65 66 69 6e 65 20 2a 6c 61 73 74 2d 75 70 64 61 efine *last-upda
0c50: 74 65 2a 20 20 20 28 63 75 72 72 65 6e 74 2d 73 te* (current-s
0c60: 65 63 6f 6e 64 73 29 29 0a 28 64 65 66 69 6e 65 econds)).(define
0c70: 20 2a 6e 75 6d 2d 74 65 73 74 73 2a 20 20 20 20 *num-tests*
0c80: 20 31 35 29 0a 28 64 65 66 69 6e 65 20 2a 73 74 15).(define *st
0c90: 61 72 74 2d 72 75 6e 2d 6f 66 66 73 65 74 2a 20 art-run-offset*
0ca0: 20 30 29 0a 28 64 65 66 69 6e 65 20 2a 73 74 61 0).(define *sta
0cb0: 72 74 2d 74 65 73 74 2d 6f 66 66 73 65 74 2a 20 rt-test-offset*
0cc0: 30 29 0a 28 64 65 66 69 6e 65 20 2a 65 78 61 6d 0).(define *exam
0cd0: 69 6e 65 2d 74 65 73 74 2d 64 61 74 2a 20 28 6d ine-test-dat* (m
0ce0: 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 ake-hash-table))
0cf0: 0a 28 64 65 66 69 6e 65 20 2a 65 78 69 74 2d 73 .(define *exit-s
0d00: 74 61 72 74 65 64 2a 20 23 66 29 0a 28 64 65 66 tarted* #f).(def
0d10: 69 6e 65 20 2a 73 74 61 74 75 73 2d 69 67 6e 6f ine *status-igno
0d20: 72 65 2d 68 61 73 68 2a 20 28 6d 61 6b 65 2d 68 re-hash* (make-h
0d30: 61 73 68 2d 74 61 62 6c 65 29 29 0a 28 64 65 66 ash-table)).(def
0d40: 69 6e 65 20 2a 73 74 61 74 65 2d 69 67 6e 6f 72 ine *state-ignor
0d50: 65 2d 68 61 73 68 2a 20 20 28 6d 61 6b 65 2d 68 e-hash* (make-h
0d60: 61 73 68 2d 74 61 62 6c 65 29 29 0a 0a 28 64 65 ash-table))..(de
0d70: 66 69 6e 65 20 2a 6c 61 73 74 2d 64 62 2d 75 70 fine *last-db-up
0d80: 64 61 74 65 2d 74 69 6d 65 2a 20 30 29 0a 28 64 date-time* 0).(d
0d90: 65 66 69 6e 65 20 2a 70 6c 65 61 73 65 2d 75 70 efine *please-up
0da0: 64 61 74 65 2d 62 75 74 74 6f 6e 73 2a 20 23 74 date-buttons* #t
0db0: 29 0a 28 64 65 66 69 6e 65 20 2a 64 65 6c 61 79 ).(define *delay
0dc0: 65 64 2d 75 70 64 61 74 65 2a 20 30 29 0a 0a 28 ed-update* 0)..(
0dd0: 64 65 66 69 6e 65 20 2a 64 62 2d 66 69 6c 65 2d define *db-file-
0de0: 70 61 74 68 2a 20 28 63 6f 6e 63 20 2a 74 6f 70 path* (conc *top
0df0: 70 61 74 68 2a 20 22 2f 6d 65 67 61 74 65 73 74 path* "/megatest
0e00: 2e 64 62 22 29 29 0a 0a 28 64 65 66 69 6e 65 20 .db"))..(define
0e10: 2a 74 65 73 74 73 2d 73 6f 72 74 2d 72 65 76 65 *tests-sort-reve
0e20: 72 73 65 2a 20 23 66 29 0a 28 64 65 66 69 6e 65 rse* #f).(define
0e30: 20 2a 68 69 64 65 2d 65 6d 70 74 79 2d 72 75 6e *hide-empty-run
0e40: 73 2a 20 23 66 29 0a 0a 28 64 65 62 75 67 3a 73 s* #f)..(debug:s
0e50: 65 74 75 70 29 0a 0a 28 64 65 66 69 6e 65 20 75 etup)..(define u
0e60: 69 64 61 74 20 23 66 29 0a 0a 28 64 65 66 69 6e idat #f)..(defin
0e70: 65 2d 69 6e 6c 69 6e 65 20 28 64 62 6f 61 72 64 e-inline (dboard
0e80: 3a 75 69 64 61 74 2d 67 65 74 2d 6b 65 79 63 6f :uidat-get-keyco
0e90: 6c 20 20 76 65 63 29 28 76 65 63 74 6f 72 2d 72 l vec)(vector-r
0ea0: 65 66 20 76 65 63 20 30 29 29 0a 28 64 65 66 69 ef vec 0)).(defi
0eb0: 6e 65 2d 69 6e 6c 69 6e 65 20 28 64 62 6f 61 72 ne-inline (dboar
0ec0: 64 3a 75 69 64 61 74 2d 67 65 74 2d 6c 66 74 63 d:uidat-get-lftc
0ed0: 6f 6c 20 20 76 65 63 29 28 76 65 63 74 6f 72 2d ol vec)(vector-
0ee0: 72 65 66 20 76 65 63 20 31 29 29 0a 28 64 65 66 ref vec 1)).(def
0ef0: 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 64 62 6f 61 ine-inline (dboa
0f00: 72 64 3a 75 69 64 61 74 2d 67 65 74 2d 68 65 61 rd:uidat-get-hea
0f10: 64 65 72 20 20 76 65 63 29 28 76 65 63 74 6f 72 der vec)(vector
0f20: 2d 72 65 66 20 76 65 63 20 32 29 29 0a 28 64 65 -ref vec 2)).(de
0f30: 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 64 62 6f fine-inline (dbo
0f40: 61 72 64 3a 75 69 64 61 74 2d 67 65 74 2d 72 75 ard:uidat-get-ru
0f50: 6e 73 76 65 63 20 76 65 63 29 28 76 65 63 74 6f nsvec vec)(vecto
0f60: 72 2d 72 65 66 20 76 65 63 20 33 29 29 0a 0a 0a r-ref vec 3))...
0f70: 28 64 65 66 69 6e 65 20 28 6d 65 73 73 61 67 65 (define (message
0f80: 2d 77 69 6e 64 6f 77 20 6d 73 67 29 0a 20 20 28 -window msg). (
0f90: 69 75 70 3a 73 68 6f 77 0a 20 20 20 28 69 75 70 iup:show. (iup
0fa0: 3a 64 69 61 6c 6f 67 0a 20 20 20 20 28 69 75 70 :dialog. (iup
0fb0: 3a 76 62 6f 78 20 0a 20 20 20 20 20 28 69 75 70 :vbox . (iup
0fc0: 3a 6c 61 62 65 6c 20 6d 73 67 20 23 3a 6d 61 72 :label msg #:mar
0fd0: 67 69 6e 20 22 34 30 78 34 30 22 29 29 29 29 29 gin "40x40")))))
0fe0: 0a 0a 28 64 65 66 69 6e 65 20 28 69 75 70 6c 69 ..(define (iupli
0ff0: 73 74 62 6f 78 2d 66 69 6c 6c 2d 6c 69 73 74 20 stbox-fill-list
1000: 6c 62 20 69 74 65 6d 73 20 2e 20 64 65 66 61 75 lb items . defau
1010: 6c 74 29 0a 20 20 28 6c 65 74 20 28 28 69 20 31 lt). (let ((i 1
1020: 29 0a 09 28 73 65 6c 65 63 74 65 64 2d 69 74 65 )..(selected-ite
1030: 6d 20 28 69 66 20 28 6e 75 6c 6c 3f 20 64 65 66 m (if (null? def
1040: 61 75 6c 74 29 20 23 66 20 28 63 61 72 20 64 65 ault) #f (car de
1050: 66 61 75 6c 74 29 29 29 29 0a 20 20 20 20 28 69 fault)))). (i
1060: 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 up:attribute-set
1070: 21 20 6c 62 20 22 56 41 4c 55 45 22 20 28 69 66 ! lb "VALUE" (if
1080: 20 73 65 6c 65 63 74 65 64 2d 69 74 65 6d 20 73 selected-item s
1090: 65 6c 65 63 74 65 64 2d 69 74 65 6d 20 22 22 29 elected-item "")
10a0: 29 0a 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 ). (for-each
10b0: 28 6c 61 6d 62 64 61 20 28 69 74 65 6d 29 0a 09 (lambda (item)..
10c0: 09 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d .(iup:attribute-
10d0: 73 65 74 21 20 6c 62 20 28 6e 75 6d 62 65 72 2d set! lb (number-
10e0: 3e 73 74 72 69 6e 67 20 69 29 20 69 74 65 6d 29 >string i) item)
10f0: 0a 09 09 28 69 66 20 73 65 6c 65 63 74 65 64 2d ...(if selected-
1100: 69 74 65 6d 0a 09 09 20 20 20 20 28 69 66 20 28 item... (if (
1110: 65 71 75 61 6c 3f 20 73 65 6c 65 63 74 65 64 2d equal? selected-
1120: 69 74 65 6d 20 69 74 65 6d 29 0a 09 09 09 28 69 item item)....(i
1130: 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 up:attribute-set
1140: 21 20 6c 62 20 22 56 41 4c 55 45 22 20 69 74 65 ! lb "VALUE" ite
1150: 6d 29 29 29 20 3b 3b 20 28 6e 75 6d 62 65 72 2d m))) ;; (number-
1160: 3e 73 74 72 69 6e 67 20 69 29 29 29 29 0a 09 09 >string i))))...
1170: 28 73 65 74 21 20 69 20 28 2b 20 69 20 31 29 29 (set! i (+ i 1))
1180: 29 0a 09 20 20 20 20 20 20 69 74 65 6d 73 29 0a ).. items).
1190: 20 20 20 20 69 29 29 0a 0a 28 64 65 66 69 6e 65 i))..(define
11a0: 20 28 70 61 64 2d 6c 69 73 74 20 6c 20 6e 29 28 (pad-list l n)(
11b0: 61 70 70 65 6e 64 20 6c 20 28 6d 61 6b 65 2d 6c append l (make-l
11c0: 69 73 74 20 28 2d 20 6e 20 28 6c 65 6e 67 74 68 ist (- n (length
11d0: 20 6c 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 l)))))..(define
11e0: 20 28 63 6f 6c 6f 72 73 2d 73 69 6d 69 6c 61 72 (colors-similar
11f0: 3f 20 63 6f 6c 6f 72 31 20 63 6f 6c 6f 72 32 29 ? color1 color2)
1200: 0a 20 20 28 6c 65 74 2a 20 28 28 63 31 20 28 6d . (let* ((c1 (m
1210: 61 70 20 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 ap string->numbe
1220: 72 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 r (string-split
1230: 63 6f 6c 6f 72 31 29 29 29 0a 09 20 28 63 32 20 color1))).. (c2
1240: 28 6d 61 70 20 73 74 72 69 6e 67 2d 3e 6e 75 6d (map string->num
1250: 62 65 72 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 ber (string-spli
1260: 74 20 63 6f 6c 6f 72 32 29 29 29 0a 09 20 28 64 t color2))).. (d
1270: 65 6c 74 61 20 28 6d 61 70 20 28 6c 61 6d 62 64 elta (map (lambd
1280: 61 20 28 61 20 62 29 28 61 62 73 20 28 2d 20 61 a (a b)(abs (- a
1290: 20 62 29 29 29 20 63 31 20 63 32 29 29 29 0a 20 b))) c1 c2))).
12a0: 20 20 20 28 6e 75 6c 6c 3f 20 28 66 69 6c 74 65 (null? (filte
12b0: 72 20 28 6c 61 6d 62 64 61 20 28 78 29 28 3e 20 r (lambda (x)(>
12c0: 78 20 33 29 29 20 64 65 6c 74 61 29 29 29 29 0a x 3)) delta)))).
12d0: 0a 3b 3b 20 6b 65 79 70 61 74 74 73 3a 20 28 20 .;; keypatts: (
12e0: 28 4b 45 59 31 20 22 61 62 63 25 64 65 66 22 29 (KEY1 "abc%def")
12f0: 28 4b 45 59 32 20 22 25 22 29 20 29 0a 28 64 65 (KEY2 "%") ).(de
1300: 66 69 6e 65 20 28 75 70 64 61 74 65 2d 72 75 6e fine (update-run
1310: 64 61 74 20 72 75 6e 6e 61 6d 65 70 61 74 74 20 dat runnamepatt
1320: 6e 75 6d 72 75 6e 73 20 74 65 73 74 6e 61 6d 65 numruns testname
1330: 70 61 74 74 20 6b 65 79 70 61 74 74 73 29 0a 20 patt keypatts).
1340: 20 28 6c 65 74 20 28 28 6d 6f 64 74 69 6d 65 20 (let ((modtime
1350: 20 20 20 20 20 20 20 20 20 20 20 20 28 66 69 6c (fil
1360: 65 2d 6d 6f 64 69 66 69 63 61 74 69 6f 6e 2d 74 e-modification-t
1370: 69 6d 65 20 2a 64 62 2d 66 69 6c 65 2d 70 61 74 ime *db-file-pat
1380: 68 2a 29 29 0a 09 28 72 65 66 65 72 65 6e 63 65 h*))..(reference
1390: 64 2d 72 75 6e 2d 69 64 73 20 27 28 29 29 29 0a d-run-ids '())).
13a0: 20 20 20 20 28 69 66 20 28 6f 72 20 28 61 6e 64 (if (or (and
13b0: 20 28 3e 20 6d 6f 64 74 69 6d 65 20 2a 6c 61 73 (> modtime *las
13c0: 74 2d 64 62 2d 75 70 64 61 74 65 2d 74 69 6d 65 t-db-update-time
13d0: 2a 29 0a 09 09 20 28 3e 20 28 63 75 72 72 65 6e *)... (> (curren
13e0: 74 2d 73 65 63 6f 6e 64 73 29 28 2b 20 2a 6c 61 t-seconds)(+ *la
13f0: 73 74 2d 64 62 2d 75 70 64 61 74 65 2d 74 69 6d st-db-update-tim
1400: 65 2a 20 35 29 29 29 0a 09 20 20 20 20 28 3e 20 e* 5))).. (>
1410: 2a 64 65 6c 61 79 65 64 2d 75 70 64 61 74 65 2a *delayed-update*
1420: 20 30 29 29 0a 09 3b 3b 0a 09 3b 3b 20 52 75 6e 0))..;;..;; Run
1430: 20 74 68 69 73 20 73 74 75 66 66 20 6f 6e 6c 79 this stuff only
1440: 20 77 68 65 6e 20 74 68 65 20 6d 65 67 61 74 65 when the megate
1450: 73 74 2e 64 62 20 66 69 6c 65 20 68 61 73 20 63 st.db file has c
1460: 68 61 6e 67 65 64 0a 09 3b 3b 0a 09 28 6c 65 74 hanged..;;..(let
1470: 20 28 28 66 75 6c 6c 2d 72 75 6e 20 28 3e 20 28 ((full-run (> (
1480: 72 61 6e 64 6f 6d 20 31 30 30 29 20 37 35 29 29 random 100) 75))
1490: 29 20 3b 3b 20 32 35 25 20 6f 66 20 74 68 65 20 ) ;; 25% of the
14a0: 74 69 6d 65 20 64 6f 20 61 20 66 75 6c 6c 20 72 time do a full r
14b0: 65 66 72 65 73 68 0a 09 20 20 28 64 65 62 75 67 efresh.. (debug
14c0: 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 34 20 22 75 :print-info 4 "u
14d0: 70 64 61 74 65 2d 72 75 6e 64 61 74 20 72 75 6e pdate-rundat run
14e0: 6e 61 6d 65 70 61 74 74 3a 20 22 20 72 75 6e 6e namepatt: " runn
14f0: 61 6d 65 70 61 74 74 20 22 20 6e 75 6d 72 75 6e amepatt " numrun
1500: 73 3a 20 22 20 6e 75 6d 72 75 6e 73 20 22 20 74 s: " numruns " t
1510: 65 73 74 6e 61 6d 65 70 61 74 74 3a 20 22 20 74 estnamepatt: " t
1520: 65 73 74 6e 61 6d 65 70 61 74 74 20 22 20 6b 65 estnamepatt " ke
1530: 79 70 61 74 74 73 3a 20 22 20 6b 65 79 70 61 74 ypatts: " keypat
1540: 74 73 29 0a 09 20 20 28 73 65 74 21 20 2a 70 6c ts).. (set! *pl
1550: 65 61 73 65 2d 75 70 64 61 74 65 2d 62 75 74 74 ease-update-butt
1560: 6f 6e 73 2a 20 23 74 29 0a 09 20 20 28 73 65 74 ons* #t).. (set
1570: 21 20 2a 6c 61 73 74 2d 64 62 2d 75 70 64 61 74 ! *last-db-updat
1580: 65 2d 74 69 6d 65 2a 20 6d 6f 64 74 69 6d 65 29 e-time* modtime)
1590: 0a 09 20 20 28 73 65 74 21 20 2a 64 65 6c 61 79 .. (set! *delay
15a0: 65 64 2d 75 70 64 61 74 65 2a 20 28 2d 20 2a 64 ed-update* (- *d
15b0: 65 6c 61 79 65 64 2d 75 70 64 61 74 65 2a 20 31 elayed-update* 1
15c0: 29 29 0a 09 20 20 28 6c 65 74 2a 20 28 28 61 6c )).. (let* ((al
15d0: 6c 72 75 6e 73 20 20 20 20 20 28 63 64 62 3a 72 lruns (cdb:r
15e0: 65 6d 6f 74 65 2d 72 75 6e 20 64 62 3a 67 65 74 emote-run db:get
15f0: 2d 72 75 6e 73 20 23 66 20 72 75 6e 6e 61 6d 65 -runs #f runname
1600: 70 61 74 74 20 6e 75 6d 72 75 6e 73 20 3b 3b 20 patt numruns ;;
1610: 28 2b 20 6e 75 6d 72 75 6e 73 20 31 29 20 3b 3b (+ numruns 1) ;;
1620: 20 28 2f 20 6e 75 6d 72 75 6e 73 20 32 29 29 0a (/ numruns 2)).
1630: 09 09 09 09 09 20 20 20 2a 73 74 61 72 74 2d 72 ..... *start-r
1640: 75 6e 2d 6f 66 66 73 65 74 2a 20 6b 65 79 70 61 un-offset* keypa
1650: 74 74 73 29 29 0a 09 09 20 28 68 65 61 64 65 72 tts))... (header
1660: 20 20 20 20 20 20 28 64 62 3a 67 65 74 2d 68 65 (db:get-he
1670: 61 64 65 72 20 61 6c 6c 72 75 6e 73 29 29 0a 09 ader allruns))..
1680: 09 20 28 72 75 6e 73 20 20 20 20 20 20 20 20 28 . (runs (
1690: 64 62 3a 67 65 74 2d 72 6f 77 73 20 20 20 61 6c db:get-rows al
16a0: 6c 72 75 6e 73 29 29 0a 09 09 20 28 72 65 73 75 lruns))... (resu
16b0: 6c 74 20 20 20 20 20 20 27 28 29 29 0a 09 09 20 lt '())...
16c0: 28 6d 61 78 74 65 73 74 73 20 20 20 20 30 29 0a (maxtests 0).
16d0: 09 09 20 28 73 74 61 74 65 73 20 20 20 20 20 20 .. (states
16e0: 28 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 (hash-table-keys
16f0: 20 2a 73 74 61 74 65 2d 69 67 6e 6f 72 65 2d 68 *state-ignore-h
1700: 61 73 68 2a 29 29 0a 09 09 20 28 73 74 61 74 75 ash*))... (statu
1710: 73 65 73 20 20 20 20 28 68 61 73 68 2d 74 61 62 ses (hash-tab
1720: 6c 65 2d 6b 65 79 73 20 2a 73 74 61 74 75 73 2d le-keys *status-
1730: 69 67 6e 6f 72 65 2d 68 61 73 68 2a 29 29 29 0a ignore-hash*))).
1740: 09 20 20 20 20 3b 3b 20 28 74 68 72 65 61 64 2d . ;; (thread-
1750: 73 6c 65 65 70 21 20 30 2e 31 29 20 3b 3b 20 67 sleep! 0.1) ;; g
1760: 69 76 65 20 73 6f 6d 65 20 74 69 6d 65 20 74 6f ive some time to
1770: 20 6f 74 68 65 72 20 74 68 72 65 61 64 73 0a 09 other threads..
1780: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
1790: 20 36 20 22 75 70 64 61 74 65 2d 72 75 6e 64 61 6 "update-runda
17a0: 74 2c 20 67 6f 74 20 22 20 28 6c 65 6e 67 74 68 t, got " (length
17b0: 20 72 75 6e 73 29 20 22 20 72 75 6e 73 22 29 0a runs) " runs").
17c0: 09 20 20 20 20 28 69 66 20 28 3e 20 28 2b 20 2a . (if (> (+ *
17d0: 6c 61 73 74 2d 75 70 64 61 74 65 2a 20 33 30 30 last-update* 300
17e0: 29 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e ) (current-secon
17f0: 64 73 29 29 20 3b 3b 20 65 76 65 72 79 20 66 69 ds)) ;; every fi
1800: 76 65 20 6d 69 6e 75 74 65 73 0a 09 09 28 62 65 ve minutes...(be
1810: 67 69 6e 0a 09 09 20 20 28 73 65 74 21 20 2a 6c gin... (set! *l
1820: 61 73 74 2d 75 70 64 61 74 65 2a 20 28 63 75 72 ast-update* (cur
1830: 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 29 0a 09 rent-seconds))..
1840: 09 20 20 28 73 65 74 21 20 2a 74 6f 74 2d 72 75 . (set! *tot-ru
1850: 6e 2d 63 6f 75 6e 74 2a 20 28 6c 65 6e 67 74 68 n-count* (length
1860: 20 72 75 6e 73 29 29 29 29 0a 09 20 20 20 20 3b runs)))).. ;
1870: 3b 20 0a 09 20 20 20 20 3b 3b 20 74 72 69 6d 20 ; .. ;; trim
1880: 72 75 6e 73 20 74 6f 20 6f 6e 6c 79 20 74 68 6f runs to only tho
1890: 73 65 20 74 68 61 74 20 61 72 65 20 63 68 61 6e se that are chan
18a0: 67 69 6e 67 20 6f 66 74 65 6e 20 68 65 72 65 0a ging often here.
18b0: 09 20 20 20 20 3b 3b 20 0a 09 20 20 20 20 28 66 . ;; .. (f
18c0: 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 or-each (lambda
18d0: 28 72 75 6e 29 0a 09 09 09 28 6c 65 74 2a 20 28 (run)....(let* (
18e0: 28 72 75 6e 2d 69 64 20 20 20 28 64 62 3a 67 65 (run-id (db:ge
18f0: 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 t-value-by-heade
1900: 72 20 72 75 6e 20 68 65 61 64 65 72 20 22 69 64 r run header "id
1910: 22 29 29 0a 09 09 09 20 20 20 20 20 20 20 28 74 ")).... (t
1920: 65 73 74 73 20 20 20 20 28 6c 65 74 20 28 28 74 ests (let ((t
1930: 73 74 73 20 28 6d 74 3a 67 65 74 2d 74 65 73 74 sts (mt:get-test
1940: 73 2d 66 6f 72 2d 72 75 6e 20 72 75 6e 2d 69 64 s-for-run run-id
1950: 20 74 65 73 74 6e 61 6d 65 70 61 74 74 20 73 74 testnamepatt st
1960: 61 74 65 73 20 73 74 61 74 75 73 65 73 29 29 29 ates statuses)))
1970: 0a 09 09 09 09 09 20 20 20 28 69 66 20 2a 74 65 ...... (if *te
1980: 73 74 73 2d 73 6f 72 74 2d 72 65 76 65 72 73 65 sts-sort-reverse
1990: 2a 20 28 72 65 76 65 72 73 65 20 74 73 74 73 29 * (reverse tsts)
19a0: 20 74 73 74 73 29 29 29 0a 09 09 09 20 20 20 20 tsts)))....
19b0: 20 20 20 28 6b 65 79 2d 76 61 6c 73 20 28 63 64 (key-vals (cd
19c0: 62 3a 72 65 6d 6f 74 65 2d 72 75 6e 20 64 62 3a b:remote-run db:
19d0: 67 65 74 2d 6b 65 79 2d 76 61 6c 73 20 23 66 20 get-key-vals #f
19e0: 72 75 6e 2d 69 64 29 29 29 0a 09 09 09 20 20 3b run-id))).... ;
19f0: 3b 20 4e 6f 74 20 73 75 72 65 20 74 68 69 73 20 ; Not sure this
1a00: 69 73 20 6e 65 65 64 65 64 3f 0a 09 09 09 20 20 is needed?....
1a10: 28 73 65 74 21 20 72 65 66 65 72 65 6e 63 65 64 (set! referenced
1a20: 2d 72 75 6e 2d 69 64 73 20 28 63 6f 6e 73 20 72 -run-ids (cons r
1a30: 75 6e 2d 69 64 20 72 65 66 65 72 65 6e 63 65 64 un-id referenced
1a40: 2d 72 75 6e 2d 69 64 73 29 29 0a 09 09 09 20 20 -run-ids))....
1a50: 28 69 66 20 28 3e 20 28 6c 65 6e 67 74 68 20 74 (if (> (length t
1a60: 65 73 74 73 29 20 6d 61 78 74 65 73 74 73 29 0a ests) maxtests).
1a70: 09 09 09 20 20 20 20 20 20 28 73 65 74 21 20 6d ... (set! m
1a80: 61 78 74 65 73 74 73 20 28 6c 65 6e 67 74 68 20 axtests (length
1a90: 74 65 73 74 73 29 29 29 0a 09 09 09 20 20 28 69 tests))).... (i
1aa0: 66 20 28 6f 72 20 28 6e 6f 74 20 2a 68 69 64 65 f (or (not *hide
1ab0: 2d 65 6d 70 74 79 2d 72 75 6e 73 2a 29 20 3b 3b -empty-runs*) ;;
1ac0: 20 74 68 69 73 20 72 65 64 75 63 65 73 20 74 68 this reduces th
1ad0: 65 20 64 61 74 61 20 62 75 72 64 65 6e 20 77 68 e data burden wh
1ae0: 65 6e 20 73 65 74 0a 09 09 09 09 20 20 28 6e 6f en set..... (no
1af0: 74 20 28 6e 75 6c 6c 3f 20 74 65 73 74 73 29 29 t (null? tests))
1b00: 29 0a 09 09 09 20 20 20 20 20 20 28 6c 65 74 20 ).... (let
1b10: 28 28 64 73 74 72 75 63 74 20 28 76 65 63 74 6f ((dstruct (vecto
1b20: 72 20 72 75 6e 20 74 65 73 74 73 20 6b 65 79 2d r run tests key-
1b30: 76 61 6c 73 29 29 29 0a 09 09 09 09 3b 3b 0a 09 vals))).....;;..
1b40: 09 09 09 3b 3b 20 63 6f 6d 70 61 72 65 20 74 68 ...;; compare th
1b50: 65 20 74 65 73 74 73 20 77 69 74 68 20 74 68 65 e tests with the
1b60: 20 74 65 73 74 73 20 69 6e 20 2a 61 6c 6c 72 75 tests in *allru
1b70: 6e 73 2d 62 79 2d 69 64 2a 20 73 61 6d 65 20 72 ns-by-id* same r
1b80: 75 6e 2d 69 64 20 0a 09 09 09 09 3b 3b 20 69 66 un-id .....;; if
1b90: 20 64 69 66 66 65 72 65 6e 74 20 74 68 65 6e 20 different then
1ba0: 69 6e 63 72 65 6d 65 6e 74 20 76 61 6c 75 65 20 increment value
1bb0: 69 6e 20 2a 72 75 6e 63 68 61 6e 67 65 72 61 74 in *runchangerat
1bc0: 65 2a 0a 09 09 09 09 3b 3b 0a 09 09 09 09 28 68 e*.....;;.....(h
1bd0: 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 2a ash-table-set! *
1be0: 61 6c 6c 72 75 6e 73 2d 62 79 2d 69 64 2a 20 72 allruns-by-id* r
1bf0: 75 6e 2d 69 64 20 64 73 74 72 75 63 74 29 0a 09 un-id dstruct)..
1c00: 09 09 09 28 73 65 74 21 20 72 65 73 75 6c 74 20 ...(set! result
1c10: 28 63 6f 6e 73 20 64 73 74 72 75 63 74 20 72 65 (cons dstruct re
1c20: 73 75 6c 74 29 29 29 29 29 29 0a 09 09 20 20 20 sult))))))...
1c30: 20 20 20 72 75 6e 73 29 0a 09 20 20 20 20 0a 09 runs).. ..
1c40: 20 20 20 20 3b 3b 0a 09 20 20 20 20 3b 3b 20 69 ;;.. ;; i
1c50: 66 20 66 75 6c 6c 2d 72 75 6e 20 75 73 65 20 72 f full-run use r
1c60: 65 66 65 72 65 6e 63 65 64 2d 72 75 6e 2d 69 64 eferenced-run-id
1c70: 73 20 74 6f 20 64 65 6c 65 74 65 20 64 61 74 61 s to delete data
1c80: 20 69 6e 20 2a 61 6c 6c 2d 72 75 6e 73 2d 62 79 in *all-runs-by
1c90: 2d 69 64 2a 20 61 6e 64 20 2a 72 75 6e 63 68 61 -id* and *runcha
1ca0: 6e 67 65 72 61 74 65 2a 0a 09 20 20 20 20 3b 3b ngerate*.. ;;
1cb0: 0a 0a 09 20 20 20 20 28 73 65 74 21 20 2a 68 65 ... (set! *he
1cc0: 61 64 65 72 2a 20 20 68 65 61 64 65 72 29 0a 09 ader* header)..
1cd0: 20 20 20 20 28 73 65 74 21 20 2a 61 6c 6c 72 75 (set! *allru
1ce0: 6e 73 2a 20 72 65 73 75 6c 74 29 0a 09 20 20 20 ns* result)..
1cf0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 36 20 (debug:print 6
1d00: 22 2a 61 6c 6c 72 75 6e 73 2a 20 68 61 73 20 22 "*allruns* has "
1d10: 20 28 6c 65 6e 67 74 68 20 2a 61 6c 6c 72 75 6e (length *allrun
1d20: 73 2a 29 20 22 20 72 75 6e 73 22 29 0a 09 20 20 s*) " runs")..
1d30: 20 20 3b 3b 20 28 73 65 74 21 20 2a 74 6f 74 2d ;; (set! *tot-
1d40: 72 75 6e 2d 63 6f 75 6e 74 2a 20 28 2b 20 31 20 run-count* (+ 1
1d50: 28 6c 65 6e 67 74 68 20 2a 61 6c 6c 72 75 6e 73 (length *allruns
1d60: 2a 29 29 29 0a 09 20 20 20 20 6d 61 78 74 65 73 *))).. maxtes
1d70: 74 73 29 29 0a 09 3b 3b 20 0a 09 3b 3b 20 52 75 ts))..;; ..;; Ru
1d80: 6e 20 74 68 69 73 20 69 66 20 74 68 65 20 6d 65 n this if the me
1d90: 67 61 74 65 73 74 2e 64 62 20 66 69 6c 65 20 64 gatest.db file d
1da0: 69 64 20 6e 6f 74 20 67 65 74 20 74 6f 75 63 68 id not get touch
1db0: 65 64 0a 09 3b 3b 0a 09 28 62 65 67 69 6e 0a 09 ed..;;..(begin..
1dc0: 20 20 0a 09 20 20 2a 6e 75 6d 2d 74 65 73 74 73 .. *num-tests
1dd0: 2a 29 29 29 29 20 3b 3b 20 46 49 58 4d 45 2c 20 *)))) ;; FIXME,
1de0: 6e 61 75 67 68 74 79 20 63 6f 64 69 6e 67 20 65 naughty coding e
1df0: 68 3f 0a 0a 28 64 65 66 69 6e 65 20 2a 63 6f 6c h?..(define *col
1e00: 6c 61 70 73 65 64 2a 20 28 6d 61 6b 65 2d 68 61 lapsed* (make-ha
1e10: 73 68 2d 74 61 62 6c 65 29 29 0a 3b 20 28 64 65 sh-table)).; (de
1e20: 66 69 6e 65 20 2a 72 6f 77 2d 6c 6f 6f 6b 75 70 fine *row-lookup
1e30: 2a 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 * (make-hash-tab
1e40: 6c 65 29 29 20 3b 3b 20 74 65 73 74 6e 61 6d 65 le)) ;; testname
1e50: 20 3d 3e 20 28 72 6f 77 6e 75 6d 20 6c 61 62 6c => (rownum labl
1e60: 65 6f 62 6a 29 0a 0a 28 64 65 66 69 6e 65 20 28 eobj)..(define (
1e70: 74 6f 67 67 6c 65 2d 68 69 64 65 20 6c 6e 75 6d toggle-hide lnum
1e80: 29 20 3b 20 66 75 6c 6c 74 65 73 74 6e 61 6d 65 ) ; fulltestname
1e90: 29 0a 20 20 28 6c 65 74 2a 20 28 28 62 74 6e 20 ). (let* ((btn
1ea0: 28 76 65 63 74 6f 72 2d 72 65 66 20 28 64 62 6f (vector-ref (dbo
1eb0: 61 72 64 3a 75 69 64 61 74 2d 67 65 74 2d 6c 66 ard:uidat-get-lf
1ec0: 74 63 6f 6c 20 75 69 64 61 74 29 20 6c 6e 75 6d tcol uidat) lnum
1ed0: 29 29 0a 09 20 28 66 75 6c 6c 74 65 73 74 6e 61 )).. (fulltestna
1ee0: 6d 65 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 me (iup:attribut
1ef0: 65 20 62 74 6e 20 22 54 49 54 4c 45 22 29 29 0a e btn "TITLE")).
1f00: 09 20 28 70 61 72 74 73 20 20 20 20 20 20 20 20 . (parts
1f10: 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 66 75 (string-split fu
1f20: 6c 6c 74 65 73 74 6e 61 6d 65 20 22 28 22 29 29 lltestname "("))
1f30: 0a 09 20 28 62 61 73 65 74 65 73 74 6e 61 6d 65 .. (basetestname
1f40: 20 28 69 66 20 28 6e 75 6c 6c 3f 20 70 61 72 74 (if (null? part
1f50: 73 29 20 22 22 20 28 63 61 72 20 70 61 72 74 73 s) "" (car parts
1f60: 29 29 29 29 0a 20 20 20 20 3b 28 70 72 69 6e 74 )))). ;(print
1f70: 20 22 54 6f 67 67 6c 69 6e 67 20 22 20 62 61 73 "Toggling " bas
1f80: 65 74 65 73 74 6e 61 6d 65 20 22 20 63 75 72 72 etestname " curr
1f90: 65 6e 74 6c 79 20 22 20 28 68 61 73 68 2d 74 61 ently " (hash-ta
1fa0: 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 ble-ref/default
1fb0: 2a 63 6f 6c 6c 61 70 73 65 64 2a 20 62 61 73 65 *collapsed* base
1fc0: 74 65 73 74 6e 61 6d 65 20 23 66 29 29 0a 20 20 testname #f)).
1fd0: 20 20 28 69 66 20 28 68 61 73 68 2d 74 61 62 6c (if (hash-tabl
1fe0: 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 2a 63 e-ref/default *c
1ff0: 6f 6c 6c 61 70 73 65 64 2a 20 62 61 73 65 74 65 ollapsed* basete
2000: 73 74 6e 61 6d 65 20 23 66 29 0a 09 28 62 65 67 stname #f)..(beg
2010: 69 6e 0a 09 20 20 3b 28 69 75 70 3a 61 74 74 72 in.. ;(iup:attr
2020: 69 62 75 74 65 2d 73 65 74 21 20 62 74 6e 20 22 ibute-set! btn "
2030: 46 47 43 4f 4c 4f 52 22 20 22 30 20 30 20 30 22 FGCOLOR" "0 0 0"
2040: 29 0a 09 20 20 28 68 61 73 68 2d 74 61 62 6c 65 ).. (hash-table
2050: 2d 64 65 6c 65 74 65 21 20 2a 63 6f 6c 6c 61 70 -delete! *collap
2060: 73 65 64 2a 20 62 61 73 65 74 65 73 74 6e 61 6d sed* basetestnam
2070: 65 29 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 3b e))..(begin.. ;
2080: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 (iup:attribute-s
2090: 65 74 21 20 62 74 6e 20 22 46 47 43 4f 4c 4f 52 et! btn "FGCOLOR
20a0: 22 20 22 30 20 31 39 32 20 31 39 32 22 29 0a 09 " "0 192 192")..
20b0: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 (hash-table-se
20c0: 74 21 20 2a 63 6f 6c 6c 61 70 73 65 64 2a 20 62 t! *collapsed* b
20d0: 61 73 65 74 65 73 74 6e 61 6d 65 20 23 74 29 29 asetestname #t))
20e0: 29 29 29 0a 20 20 0a 28 64 65 66 69 6e 65 20 62 ))). .(define b
20f0: 6c 61 6e 6b 2d 6c 69 6e 65 2d 72 78 20 28 72 65 lank-line-rx (re
2100: 67 65 78 70 20 22 5e 5c 5c 73 2a 24 22 29 29 0a gexp "^\\s*$")).
2110: 0a 28 64 65 66 69 6e 65 20 28 72 75 6e 2d 69 74 .(define (run-it
2120: 65 6d 2d 6e 61 6d 65 2d 3e 76 65 63 74 6f 72 73 em-name->vectors
2130: 20 6c 73 74 29 0a 20 20 28 6d 61 70 20 28 6c 61 lst). (map (la
2140: 6d 62 64 61 20 28 78 29 0a 09 20 28 6c 65 74 20 mbda (x).. (let
2150: 28 28 73 70 6c 73 74 20 28 73 74 72 69 6e 67 2d ((splst (string-
2160: 73 70 6c 69 74 20 78 20 22 28 22 29 29 0a 09 20 split x "("))..
2170: 20 20 20 20 20 20 28 72 65 73 20 20 20 28 76 65 (res (ve
2180: 63 74 6f 72 20 22 22 20 22 22 29 29 29 0a 09 20 ctor "" "")))..
2190: 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 72 (vector-set! r
21a0: 65 73 20 30 20 28 63 61 72 20 73 70 6c 73 74 29 es 0 (car splst)
21b0: 29 0a 09 20 20 20 28 69 66 20 28 3e 20 28 6c 65 ).. (if (> (le
21c0: 6e 67 74 68 20 73 70 6c 73 74 29 20 31 29 0a 09 ngth splst) 1)..
21d0: 20 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d 73 (vector-s
21e0: 65 74 21 20 72 65 73 20 31 20 28 63 61 72 20 28 et! res 1 (car (
21f0: 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 28 63 61 string-split (ca
2200: 64 72 20 73 70 6c 73 74 29 20 22 29 22 29 29 29 dr splst) ")")))
2210: 29 0a 09 20 20 20 72 65 73 29 29 0a 20 20 20 20 ).. res)).
2220: 20 20 20 6c 73 74 29 29 0a 0a 28 64 65 66 69 6e lst))..(defin
2230: 65 20 28 63 6f 6c 6c 61 70 73 65 2d 72 6f 77 73 e (collapse-rows
2240: 20 69 6e 6c 73 74 29 0a 20 20 28 6c 65 74 2a 20 inlst). (let*
2250: 28 28 6e 65 77 6c 73 74 20 28 66 69 6c 74 65 72 ((newlst (filter
2260: 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 09 (lambda (x)....
2270: 20 20 28 6c 65 74 2a 20 28 28 74 70 61 72 74 73 (let* ((tparts
2280: 20 20 20 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 (string-spli
2290: 74 20 78 20 22 28 22 29 29 0a 09 09 09 09 20 28 t x "("))..... (
22a0: 62 61 73 65 74 6e 61 6d 65 20 28 69 66 20 28 6e basetname (if (n
22b0: 75 6c 6c 3f 20 74 70 61 72 74 73 29 20 78 20 28 ull? tparts) x (
22c0: 63 61 72 20 74 70 61 72 74 73 29 29 29 29 0a 09 car tparts))))..
22d0: 09 09 09 09 3b 28 70 72 69 6e 74 20 22 78 20 22 ....;(print "x "
22e0: 20 78 20 22 20 74 70 61 72 74 73 3a 20 22 20 74 x " tparts: " t
22f0: 70 61 72 74 73 20 22 20 62 61 73 65 74 6e 61 6d parts " basetnam
2300: 65 3a 20 22 20 62 61 73 65 74 6e 61 6d 65 29 0a e: " basetname).
2310: 09 09 09 20 20 20 20 28 63 6f 6e 64 0a 09 09 09 ... (cond....
2320: 20 20 20 20 20 28 28 73 74 72 69 6e 67 2d 6d 61 ((string-ma
2330: 74 63 68 20 62 6c 61 6e 6b 2d 6c 69 6e 65 2d 72 tch blank-line-r
2340: 78 20 78 29 20 23 66 29 0a 09 09 09 20 20 20 20 x x) #f)....
2350: 20 28 28 65 71 75 61 6c 3f 20 78 20 62 61 73 65 ((equal? x base
2360: 74 6e 61 6d 65 29 20 23 74 29 0a 09 09 09 20 20 tname) #t)....
2370: 20 20 20 28 28 68 61 73 68 2d 74 61 62 6c 65 2d ((hash-table-
2380: 72 65 66 2f 64 65 66 61 75 6c 74 20 2a 63 6f 6c ref/default *col
2390: 6c 61 70 73 65 64 2a 20 62 61 73 65 74 6e 61 6d lapsed* basetnam
23a0: 65 20 23 66 29 20 0a 09 09 09 09 09 3b 28 70 72 e #f) ......;(pr
23b0: 69 6e 74 20 22 52 65 6d 6f 76 69 6e 67 20 22 20 int "Removing "
23c0: 62 61 73 65 74 6e 61 6d 65 20 22 20 66 72 6f 6d basetname " from
23d0: 20 69 74 65 6d 73 22 29 0a 09 09 09 20 20 20 20 items")....
23e0: 20 20 23 66 29 0a 09 09 09 20 20 20 20 20 28 65 #f).... (e
23f0: 6c 73 65 20 23 74 29 29 29 29 0a 09 09 09 69 6e lse #t))))....in
2400: 6c 73 74 29 29 0a 09 20 28 76 6c 73 74 20 20 28 lst)).. (vlst (
2410: 72 75 6e 2d 69 74 65 6d 2d 6e 61 6d 65 2d 3e 76 run-item-name->v
2420: 65 63 74 6f 72 73 20 6e 65 77 6c 73 74 29 29 0a ectors newlst)).
2430: 09 20 3b 3b 20 73 6f 72 74 20 62 79 20 73 65 63 . ;; sort by sec
2440: 6f 6e 64 20 66 69 65 6c 64 0a 09 20 28 76 6c 73 ond field.. (vls
2450: 74 2d 73 31 20 28 73 6f 72 74 20 76 6c 73 74 20 t-s1 (sort vlst
2460: 28 6c 61 6d 62 64 61 20 28 61 20 62 29 0a 09 09 (lambda (a b)...
2470: 09 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 61 . (let ((a
2480: 73 74 72 20 28 76 65 63 74 6f 72 2d 72 65 66 20 str (vector-ref
2490: 61 20 31 29 29 0a 09 09 09 09 20 20 20 20 20 28 a 1))..... (
24a0: 62 73 74 72 20 28 76 65 63 74 6f 72 2d 72 65 66 bstr (vector-ref
24b0: 20 62 20 31 29 29 29 0a 09 09 09 09 20 28 69 66 b 1)))..... (if
24c0: 20 28 73 74 72 69 6e 67 3d 3f 20 61 73 74 72 20 (string=? astr
24d0: 22 22 29 20 23 66 20 23 74 29 29 29 29 29 0a 09 "") #f #t)))))..
24e0: 09 09 3b 3b 20 28 3e 3d 20 28 73 74 72 69 6e 67 ..;; (>= (string
24f0: 2d 6c 65 6e 67 74 68 20 28 76 65 63 74 6f 72 2d -length (vector-
2500: 72 65 66 20 61 20 31 29 29 28 73 74 72 69 6e 67 ref a 1))(string
2510: 2d 6c 65 6e 67 74 68 20 28 76 65 63 74 6f 72 2d -length (vector-
2520: 72 65 66 20 62 20 31 29 29 29 29 29 29 0a 09 20 ref b 1))))))..
2530: 28 76 6c 73 74 2d 73 32 20 28 73 6f 72 74 20 76 (vlst-s2 (sort v
2540: 6c 73 74 2d 73 31 20 28 6c 61 6d 62 64 61 20 28 lst-s1 (lambda (
2550: 61 20 62 29 0a 09 09 09 20 20 20 09 20 20 28 73 a b).... . (s
2560: 74 72 69 6e 67 3e 3d 20 28 76 65 63 74 6f 72 2d tring>= (vector-
2570: 72 65 66 20 61 20 30 29 28 76 65 63 74 6f 72 2d ref a 0)(vector-
2580: 72 65 66 20 62 20 30 29 29 29 29 29 29 0a 20 20 ref b 0)))))).
2590: 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 (map (lambda (
25a0: 78 29 0a 09 20 20 20 28 69 66 20 28 65 71 75 61 x).. (if (equa
25b0: 6c 3f 20 28 76 65 63 74 6f 72 2d 72 65 66 20 78 l? (vector-ref x
25c0: 20 31 29 20 22 22 29 0a 09 20 20 20 20 20 20 20 1) "")..
25d0: 28 76 65 63 74 6f 72 2d 72 65 66 20 78 20 30 29 (vector-ref x 0)
25e0: 0a 09 20 20 20 20 20 20 20 28 63 6f 6e 63 20 28 .. (conc (
25f0: 76 65 63 74 6f 72 2d 72 65 66 20 78 20 30 29 20 vector-ref x 0)
2600: 22 28 22 20 28 76 65 63 74 6f 72 2d 72 65 66 20 "(" (vector-ref
2610: 78 20 31 29 20 22 29 22 29 29 29 0a 09 20 76 6c x 1) ")"))).. vl
2620: 73 74 2d 73 32 29 29 29 0a 20 20 20 20 0a 28 64 st-s2))). .(d
2630: 65 66 69 6e 65 20 28 75 70 64 61 74 65 2d 6c 61 efine (update-la
2640: 62 65 6c 73 20 75 69 64 61 74 29 0a 20 20 28 6c bels uidat). (l
2650: 65 74 2a 20 28 28 72 6f 77 6e 20 20 20 20 30 29 et* ((rown 0)
2660: 0a 09 20 28 6b 65 79 63 6f 6c 20 20 28 64 62 6f .. (keycol (dbo
2670: 61 72 64 3a 75 69 64 61 74 2d 67 65 74 2d 6b 65 ard:uidat-get-ke
2680: 79 63 6f 6c 20 75 69 64 61 74 29 29 0a 09 20 28 ycol uidat)).. (
2690: 6c 66 74 63 6f 6c 20 20 28 64 62 6f 61 72 64 3a lftcol (dboard:
26a0: 75 69 64 61 74 2d 67 65 74 2d 6c 66 74 63 6f 6c uidat-get-lftcol
26b0: 20 75 69 64 61 74 29 29 0a 09 20 28 6e 75 6d 63 uidat)).. (numc
26c0: 6f 6c 73 20 28 76 65 63 74 6f 72 2d 6c 65 6e 67 ols (vector-leng
26d0: 74 68 20 6c 66 74 63 6f 6c 29 29 0a 09 20 28 6d th lftcol)).. (m
26e0: 61 78 6e 20 20 20 20 28 2d 20 6e 75 6d 63 6f 6c axn (- numcol
26f0: 73 20 31 29 29 0a 09 20 28 61 6c 6c 76 61 6c 73 s 1)).. (allvals
2700: 20 28 6d 61 6b 65 2d 76 65 63 74 6f 72 20 6e 75 (make-vector nu
2710: 6d 63 6f 6c 73 20 22 22 29 29 29 0a 20 20 20 20 mcols ""))).
2720: 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 (for-each (lambd
2730: 61 20 28 6e 61 6d 65 29 0a 09 09 28 69 66 20 28 a (name)...(if (
2740: 3c 3d 20 72 6f 77 6e 20 6d 61 78 6e 29 0a 09 09 <= rown maxn)...
2750: 20 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 (vector-set!
2760: 20 61 6c 6c 76 61 6c 73 20 72 6f 77 6e 20 6e 61 allvals rown na
2770: 6d 65 29 29 20 3b 29 0a 09 09 28 73 65 74 21 20 me)) ;)...(set!
2780: 72 6f 77 6e 20 28 2b 20 31 20 72 6f 77 6e 29 29 rown (+ 1 rown))
2790: 29 0a 09 20 20 20 20 20 20 2a 61 6c 6c 74 65 73 ).. *alltes
27a0: 74 6e 61 6d 65 6c 73 74 2a 29 0a 20 20 20 20 28 tnamelst*). (
27b0: 6c 65 74 20 6c 6f 6f 70 20 28 28 69 20 30 29 29 let loop ((i 0))
27c0: 0a 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 6c . (let* ((l
27d0: 62 6c 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 bl (vector-re
27e0: 66 20 6c 66 74 63 6f 6c 20 69 29 29 0a 09 20 20 f lftcol i))..
27f0: 20 20 20 28 6b 65 79 76 61 6c 20 28 76 65 63 74 (keyval (vect
2800: 6f 72 2d 72 65 66 20 6b 65 79 63 6f 6c 20 69 29 or-ref keycol i)
2810: 29 0a 09 20 20 20 20 20 28 6f 6c 64 76 61 6c 20 ).. (oldval
2820: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 20 6c (iup:attribute l
2830: 62 6c 20 22 54 49 54 4c 45 22 29 29 0a 09 20 20 bl "TITLE"))..
2840: 20 20 20 28 6e 65 77 76 61 6c 20 28 76 65 63 74 (newval (vect
2850: 6f 72 2d 72 65 66 20 61 6c 6c 76 61 6c 73 20 69 or-ref allvals i
2860: 29 29 29 0a 09 28 69 66 20 28 6e 6f 74 20 28 65 )))..(if (not (e
2870: 71 75 61 6c 3f 20 6f 6c 64 76 61 6c 20 6e 65 77 qual? oldval new
2880: 76 61 6c 29 29 0a 09 20 20 20 20 28 6c 65 74 20 val)).. (let
2890: 28 28 6d 75 6e 67 65 64 2d 76 61 6c 20 28 6c 65 ((munged-val (le
28a0: 74 20 28 28 70 61 72 74 73 20 28 73 74 72 69 6e t ((parts (strin
28b0: 67 2d 73 70 6c 69 74 20 6e 65 77 76 61 6c 20 22 g-split newval "
28c0: 28 22 29 29 29 0a 09 09 09 09 28 69 66 20 28 3e ("))).....(if (>
28d0: 20 28 6c 65 6e 67 74 68 20 70 61 72 74 73 29 20 (length parts)
28e0: 31 29 28 63 6f 6e 63 20 22 20 20 22 20 28 63 61 1)(conc " " (ca
28f0: 72 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 r (string-split
2900: 28 63 61 64 72 20 70 61 72 74 73 29 20 22 29 22 (cadr parts) ")"
2910: 29 29 29 20 6e 65 77 76 61 6c 29 29 29 29 0a 09 ))) newval))))..
2920: 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d 73 65 (vector-se
2930: 74 21 20 6b 65 79 63 6f 6c 20 69 20 6e 65 77 76 t! keycol i newv
2940: 61 6c 29 0a 09 20 20 20 20 20 20 28 69 75 70 3a al).. (iup:
2950: 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 6c attribute-set! l
2960: 62 6c 20 22 54 49 54 4c 45 22 20 6d 75 6e 67 65 bl "TITLE" munge
2970: 64 2d 76 61 6c 29 29 29 0a 09 28 69 75 70 3a 61 d-val)))..(iup:a
2980: 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 6c 62 ttribute-set! lb
2990: 6c 20 22 46 47 43 4f 4c 4f 52 22 20 28 69 66 20 l "FGCOLOR" (if
29a0: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f (hash-table-ref/
29b0: 64 65 66 61 75 6c 74 20 2a 63 6f 6c 6c 61 70 73 default *collaps
29c0: 65 64 2a 20 6e 65 77 76 61 6c 20 23 66 29 20 22 ed* newval #f) "
29d0: 30 20 31 31 32 20 31 31 32 22 20 22 30 20 30 20 0 112 112" "0 0
29e0: 30 22 29 29 0a 09 28 69 66 20 28 3c 20 69 20 6d 0"))..(if (< i m
29f0: 61 78 6e 29 0a 09 20 20 20 20 28 6c 6f 6f 70 20 axn).. (loop
2a00: 28 2b 20 69 20 31 29 29 29 29 29 29 29 0a 0a 28 (+ i 1)))))))..(
2a10: 64 65 66 69 6e 65 20 28 75 70 64 61 74 65 2d 62 define (update-b
2a20: 75 74 74 6f 6e 73 20 75 69 64 61 74 20 6e 75 6d uttons uidat num
2a30: 72 75 6e 73 20 6e 75 6d 74 65 73 74 73 29 0a 20 runs numtests).
2a40: 20 28 69 66 20 2a 70 6c 65 61 73 65 2d 75 70 64 (if *please-upd
2a50: 61 74 65 2d 62 75 74 74 6f 6e 73 2a 0a 20 20 20 ate-buttons*.
2a60: 20 20 20 28 6c 65 74 2a 20 28 28 72 75 6e 73 20 (let* ((runs
2a70: 20 20 20 20 20 20 20 28 69 66 20 28 3e 20 28 6c (if (> (l
2a80: 65 6e 67 74 68 20 2a 61 6c 6c 72 75 6e 73 2a 29 ength *allruns*)
2a90: 20 6e 75 6d 72 75 6e 73 29 0a 09 09 09 20 20 20 numruns)....
2aa0: 20 20 20 28 74 61 6b 65 2d 72 69 67 68 74 20 2a (take-right *
2ab0: 61 6c 6c 72 75 6e 73 2a 20 6e 75 6d 72 75 6e 73 allruns* numruns
2ac0: 29 0a 09 09 09 20 20 20 20 20 20 28 70 61 64 2d ).... (pad-
2ad0: 6c 69 73 74 20 2a 61 6c 6c 72 75 6e 73 2a 20 6e list *allruns* n
2ae0: 75 6d 72 75 6e 73 29 29 29 0a 09 20 20 20 20 20 umruns)))..
2af0: 28 6c 66 74 63 6f 6c 20 20 20 20 20 20 28 64 62 (lftcol (db
2b00: 6f 61 72 64 3a 75 69 64 61 74 2d 67 65 74 2d 6c oard:uidat-get-l
2b10: 66 74 63 6f 6c 20 75 69 64 61 74 29 29 0a 09 20 ftcol uidat))..
2b20: 20 20 20 20 28 74 61 62 6c 65 68 65 61 64 65 72 (tableheader
2b30: 20 28 64 62 6f 61 72 64 3a 75 69 64 61 74 2d 67 (dboard:uidat-g
2b40: 65 74 2d 68 65 61 64 65 72 20 75 69 64 61 74 29 et-header uidat)
2b50: 29 0a 09 20 20 20 20 20 28 74 61 62 6c 65 20 20 ).. (table
2b60: 20 20 20 20 20 28 64 62 6f 61 72 64 3a 75 69 64 (dboard:uid
2b70: 61 74 2d 67 65 74 2d 72 75 6e 73 76 65 63 20 75 at-get-runsvec u
2b80: 69 64 61 74 29 29 0a 09 20 20 20 20 20 28 63 6f idat)).. (co
2b90: 6c 6e 20 20 20 20 20 20 20 20 30 29 29 0a 09 28 ln 0))..(
2ba0: 73 65 74 21 20 2a 70 6c 65 61 73 65 2d 75 70 64 set! *please-upd
2bb0: 61 74 65 2d 62 75 74 74 6f 6e 73 2a 20 23 66 29 ate-buttons* #f)
2bc0: 0a 09 28 73 65 74 21 20 2a 61 6c 6c 74 65 73 74 ..(set! *alltest
2bd0: 6e 61 6d 65 6c 73 74 2a 20 27 28 29 29 0a 09 3b namelst* '())..;
2be0: 3b 20 63 72 65 61 74 65 20 61 20 63 6f 6e 63 69 ; create a conci
2bf0: 73 65 20 6c 69 73 74 20 6f 66 20 74 65 73 74 20 se list of test
2c00: 6e 61 6d 65 73 0a 09 28 66 6f 72 2d 65 61 63 68 names..(for-each
2c10: 0a 09 20 28 6c 61 6d 62 64 61 20 28 72 75 6e 64 .. (lambda (rund
2c20: 61 74 29 0a 09 20 20 20 28 69 66 20 28 76 65 63 at).. (if (vec
2c30: 74 6f 72 3f 20 72 75 6e 64 61 74 29 0a 09 20 20 tor? rundat)..
2c40: 20 20 20 20 20 28 6c 65 74 2a 20 28 28 74 65 73 (let* ((tes
2c50: 74 64 61 74 20 20 20 28 76 65 63 74 6f 72 2d 72 tdat (vector-r
2c60: 65 66 20 72 75 6e 64 61 74 20 31 29 29 0a 09 09 ef rundat 1))...
2c70: 20 20 20 20 20 20 28 74 65 73 74 6e 61 6d 65 73 (testnames
2c80: 20 28 6d 61 70 20 74 65 73 74 3a 74 65 73 74 2d (map test:test-
2c90: 67 65 74 2d 66 75 6c 6c 6e 61 6d 65 20 74 65 73 get-fullname tes
2ca0: 74 64 61 74 29 29 29 0a 09 09 20 28 69 66 20 28 tdat)))... (if (
2cb0: 6e 6f 74 20 28 61 6e 64 20 2a 68 69 64 65 2d 65 not (and *hide-e
2cc0: 6d 70 74 79 2d 72 75 6e 73 2a 0a 09 09 09 20 20 mpty-runs*....
2cd0: 20 20 20 20 20 28 6e 75 6c 6c 3f 20 74 65 73 74 (null? test
2ce0: 6e 61 6d 65 73 29 29 29 0a 09 09 20 20 20 20 20 names)))...
2cf0: 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 (for-each (lambd
2d00: 61 20 28 74 65 73 74 6e 61 6d 65 29 0a 09 09 09 a (testname)....
2d10: 09 20 28 69 66 20 28 6e 6f 74 20 28 6d 65 6d 62 . (if (not (memb
2d20: 65 72 20 74 65 73 74 6e 61 6d 65 20 2a 61 6c 6c er testname *all
2d30: 74 65 73 74 6e 61 6d 65 6c 73 74 2a 29 29 0a 09 testnamelst*))..
2d40: 09 09 09 20 20 20 20 20 28 62 65 67 69 6e 0a 09 ... (begin..
2d50: 09 09 09 20 20 20 20 20 20 20 28 73 65 74 21 20 ... (set!
2d60: 2a 61 6c 6c 74 65 73 74 6e 61 6d 65 6c 73 74 2a *alltestnamelst*
2d70: 20 28 61 70 70 65 6e 64 20 2a 61 6c 6c 74 65 73 (append *alltes
2d80: 74 6e 61 6d 65 6c 73 74 2a 20 28 6c 69 73 74 20 tnamelst* (list
2d90: 74 65 73 74 6e 61 6d 65 29 29 29 29 29 29 0a 09 testname))))))..
2da0: 09 09 20 20 20 20 20 20 20 74 65 73 74 6e 61 6d .. testnam
2db0: 65 73 29 29 29 29 29 0a 09 20 72 75 6e 73 29 0a es))))).. runs).
2dc0: 0a 09 28 73 65 74 21 20 2a 61 6c 6c 74 65 73 74 ..(set! *alltest
2dd0: 6e 61 6d 65 6c 73 74 2a 20 28 63 6f 6c 6c 61 70 namelst* (collap
2de0: 73 65 2d 72 6f 77 73 20 2a 61 6c 6c 74 65 73 74 se-rows *alltest
2df0: 6e 61 6d 65 6c 73 74 2a 29 29 20 3b 3b 3b 20 61 namelst*)) ;;; a
2e00: 72 67 68 2e 20 70 6c 65 61 73 65 20 63 6c 65 61 rgh. please clea
2e10: 6e 20 75 70 20 74 68 69 73 20 73 69 6c 6c 79 6e n up this sillyn
2e20: 65 73 73 0a 09 28 73 65 74 21 20 2a 61 6c 6c 74 ess..(set! *allt
2e30: 65 73 74 6e 61 6d 65 6c 73 74 2a 20 28 6c 65 74 estnamelst* (let
2e40: 20 28 28 78 6c 20 28 69 66 20 28 3e 20 28 6c 65 ((xl (if (> (le
2e50: 6e 67 74 68 20 2a 61 6c 6c 74 65 73 74 6e 61 6d ngth *alltestnam
2e60: 65 6c 73 74 2a 29 20 2a 73 74 61 72 74 2d 74 65 elst*) *start-te
2e70: 73 74 2d 6f 66 66 73 65 74 2a 29 0a 09 09 09 09 st-offset*).....
2e80: 09 20 20 20 20 20 28 64 72 6f 70 20 2a 61 6c 6c . (drop *all
2e90: 74 65 73 74 6e 61 6d 65 6c 73 74 2a 20 2a 73 74 testnamelst* *st
2ea0: 61 72 74 2d 74 65 73 74 2d 6f 66 66 73 65 74 2a art-test-offset*
2eb0: 29 0a 09 09 09 09 09 20 20 20 20 20 27 28 29 29 )...... '())
2ec0: 29 29 0a 09 09 09 09 20 28 61 70 70 65 6e 64 20 ))..... (append
2ed0: 78 6c 20 28 6d 61 6b 65 2d 6c 69 73 74 20 28 2d xl (make-list (-
2ee0: 20 2a 6e 75 6d 2d 74 65 73 74 73 2a 20 28 6c 65 *num-tests* (le
2ef0: 6e 67 74 68 20 78 6c 29 29 20 22 22 29 29 29 29 ngth xl)) ""))))
2f00: 0a 09 28 75 70 64 61 74 65 2d 6c 61 62 65 6c 73 ..(update-labels
2f10: 20 75 69 64 61 74 29 0a 09 28 66 6f 72 2d 65 61 uidat)..(for-ea
2f20: 63 68 0a 09 20 28 6c 61 6d 62 64 61 20 28 72 75 ch.. (lambda (ru
2f30: 6e 64 61 74 29 0a 09 20 20 20 28 69 66 20 28 6e ndat).. (if (n
2f40: 6f 74 20 72 75 6e 64 61 74 29 20 3b 3b 20 68 61 ot rundat) ;; ha
2f50: 6e 64 6c 65 20 70 61 64 64 65 64 20 72 75 6e 73 ndle padded runs
2f60: 0a 09 20 20 20 20 20 20 20 3b 3b 20 20 20 20 20 .. ;;
2f70: 20 20 20 20 20 20 3b 3b 20 69 64 20 72 75 6e 2d ;; id run-
2f80: 69 64 20 74 65 73 74 6e 61 6d 65 20 73 74 61 74 id testname stat
2f90: 65 20 73 74 61 74 75 73 20 65 76 65 6e 74 2d 74 e status event-t
2fa0: 69 6d 65 20 68 6f 73 74 20 63 70 75 6c 6f 61 64 ime host cpuload
2fb0: 20 64 69 73 6b 66 72 65 65 20 75 6e 61 6d 65 20 diskfree uname
2fc0: 72 75 6e 64 69 72 20 69 74 65 6d 2d 70 61 74 68 rundir item-path
2fd0: 20 72 75 6e 2d 64 75 72 61 74 69 6f 6e 0a 09 20 run-duration..
2fe0: 20 20 20 20 20 20 28 73 65 74 21 20 72 75 6e 64 (set! rund
2ff0: 61 74 20 28 76 65 63 74 6f 72 20 28 6d 61 6b 65 at (vector (make
3000: 2d 76 65 63 74 6f 72 20 32 30 20 23 66 29 20 27 -vector 20 #f) '
3010: 28 29 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 () (map (lambda
3020: 28 78 29 20 22 22 29 20 2a 6b 65 79 73 2a 29 29 (x) "") *keys*))
3030: 29 29 3b 3b 20 33 29 29 29 0a 09 20 20 20 28 6c ));; 3))).. (l
3040: 65 74 2a 20 28 28 72 75 6e 20 20 20 20 20 20 28 et* ((run (
3050: 76 65 63 74 6f 72 2d 72 65 66 20 72 75 6e 64 61 vector-ref runda
3060: 74 20 30 29 29 0a 09 09 20 20 28 74 65 73 74 73 t 0))... (tests
3070: 64 61 74 20 28 76 65 63 74 6f 72 2d 72 65 66 20 dat (vector-ref
3080: 72 75 6e 64 61 74 20 31 29 29 0a 09 09 20 20 28 rundat 1))... (
3090: 6b 65 79 2d 76 61 6c 2d 64 61 74 20 28 76 65 63 key-val-dat (vec
30a0: 74 6f 72 2d 72 65 66 20 72 75 6e 64 61 74 20 32 tor-ref rundat 2
30b0: 29 29 0a 09 09 20 20 28 72 75 6e 2d 69 64 20 20 ))... (run-id
30c0: 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 (db:get-value-b
30d0: 79 2d 68 65 61 64 65 72 20 72 75 6e 20 2a 68 65 y-header run *he
30e0: 61 64 65 72 2a 20 22 69 64 22 29 29 0a 09 09 20 ader* "id"))...
30f0: 20 28 6b 65 79 2d 76 61 6c 73 20 28 61 70 70 65 (key-vals (appe
3100: 6e 64 20 6b 65 79 2d 76 61 6c 2d 64 61 74 0a 09 nd key-val-dat..
3110: 09 09 09 20 20 20 20 28 6c 69 73 74 20 28 6c 65 ... (list (le
3120: 74 20 28 28 78 20 28 64 62 3a 67 65 74 2d 76 61 t ((x (db:get-va
3130: 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 lue-by-header ru
3140: 6e 20 2a 68 65 61 64 65 72 2a 20 22 72 75 6e 6e n *header* "runn
3150: 61 6d 65 22 29 29 29 0a 09 09 09 09 09 20 20 20 ame")))......
3160: 20 28 69 66 20 78 20 78 20 22 22 29 29 29 29 29 (if x x "")))))
3170: 0a 09 09 20 20 28 72 75 6e 2d 6b 65 79 20 20 28 ... (run-key (
3180: 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 string-intersper
3190: 73 65 20 6b 65 79 2d 76 61 6c 73 20 22 5c 6e 22 se key-vals "\n"
31a0: 29 29 29 0a 0a 09 20 20 20 20 20 3b 3b 20 66 69 )))... ;; fi
31b0: 6c 6c 20 69 6e 20 74 68 65 20 72 75 6e 20 68 65 ll in the run he
31c0: 61 64 65 72 20 6b 65 79 20 76 61 6c 75 65 73 0a ader key values.
31d0: 09 20 20 20 20 20 28 6c 65 74 20 28 28 72 6f 77 . (let ((row
31e0: 6e 20 20 20 20 20 20 30 29 0a 09 09 20 20 20 28 n 0)... (
31f0: 68 65 61 64 65 72 63 6f 6c 20 28 76 65 63 74 6f headercol (vecto
3200: 72 2d 72 65 66 20 74 61 62 6c 65 68 65 61 64 65 r-ref tableheade
3210: 72 20 63 6f 6c 6e 29 29 29 0a 09 20 20 20 20 20 r coln)))..
3220: 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d (for-each (lam
3230: 62 64 61 20 28 6b 76 61 6c 29 0a 09 09 09 20 20 bda (kval)....
3240: 20 28 6c 65 74 2a 20 28 28 6c 61 62 6c 20 20 20 (let* ((labl
3250: 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 68 (vector-ref h
3260: 65 61 64 65 72 63 6f 6c 20 72 6f 77 6e 29 29 29 eadercol rown)))
3270: 0a 09 09 09 20 20 20 20 20 28 69 66 20 28 6e 6f .... (if (no
3280: 74 20 28 65 71 75 61 6c 3f 20 6b 76 61 6c 20 28 t (equal? kval (
3290: 69 75 70 3a 61 74 74 72 69 62 75 74 65 20 6c 61 iup:attribute la
32a0: 62 6c 20 22 54 49 54 4c 45 22 29 29 29 0a 09 09 bl "TITLE")))...
32b0: 09 09 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 .. (iup:attribut
32c0: 65 2d 73 65 74 21 20 28 76 65 63 74 6f 72 2d 72 e-set! (vector-r
32d0: 65 66 20 68 65 61 64 65 72 63 6f 6c 20 72 6f 77 ef headercol row
32e0: 6e 29 20 22 54 49 54 4c 45 22 20 6b 76 61 6c 29 n) "TITLE" kval)
32f0: 29 0a 09 09 09 20 20 20 20 20 28 73 65 74 21 20 ).... (set!
3300: 72 6f 77 6e 20 28 2b 20 72 6f 77 6e 20 31 29 29 rown (+ rown 1))
3310: 29 29 0a 09 09 09 20 6b 65 79 2d 76 61 6c 73 29 )).... key-vals)
3320: 29 0a 0a 09 20 20 20 20 20 3b 3b 20 46 6f 72 20 )... ;; For
3330: 74 68 69 73 20 72 75 6e 20 6e 6f 77 20 66 69 6c this run now fil
3340: 6c 20 69 6e 20 74 68 65 20 62 75 74 74 6f 6e 73 l in the buttons
3350: 20 66 6f 72 20 65 61 63 68 20 74 65 73 74 0a 09 for each test..
3360: 20 20 20 20 20 28 6c 65 74 20 28 28 72 6f 77 6e (let ((rown
3370: 20 30 29 0a 09 09 20 20 20 28 63 6f 6c 75 6d 6e 0)... (column
3380: 64 61 74 20 20 28 76 65 63 74 6f 72 2d 72 65 66 dat (vector-ref
3390: 20 74 61 62 6c 65 20 63 6f 6c 6e 29 29 29 0a 09 table coln)))..
33a0: 20 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 (for-each
33b0: 0a 09 09 28 6c 61 6d 62 64 61 20 28 74 65 73 74 ...(lambda (test
33c0: 6e 61 6d 65 29 0a 09 09 20 20 28 6c 65 74 20 28 name)... (let (
33d0: 28 62 75 74 74 6f 6e 64 61 74 20 20 28 68 61 73 (buttondat (has
33e0: 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 h-table-ref/defa
33f0: 75 6c 74 20 2a 62 75 74 74 6f 6e 64 61 74 2a 20 ult *buttondat*
3400: 28 6d 6b 73 74 72 20 63 6f 6c 6e 20 72 6f 77 6e (mkstr coln rown
3410: 29 20 23 66 29 29 29 0a 09 09 20 20 20 20 28 69 ) #f)))... (i
3420: 66 20 62 75 74 74 6f 6e 64 61 74 0a 09 09 09 28 f buttondat....(
3430: 6c 65 74 2a 20 28 28 74 65 73 74 20 20 20 20 20 let* ((test
3440: 20 20 28 6c 65 74 20 28 28 6d 61 74 63 68 69 6e (let ((matchin
3450: 67 20 28 66 69 6c 74 65 72 20 0a 09 09 09 09 09 g (filter ......
3460: 09 09 20 20 20 20 28 6c 61 6d 62 64 61 20 28 78 .. (lambda (x
3470: 29 28 65 71 75 61 6c 3f 20 28 74 65 73 74 3a 74 )(equal? (test:t
3480: 65 73 74 2d 67 65 74 2d 66 75 6c 6c 6e 61 6d 65 est-get-fullname
3490: 20 78 29 20 74 65 73 74 6e 61 6d 65 29 29 0a 09 x) testname))..
34a0: 09 09 09 09 09 09 20 20 20 20 74 65 73 74 73 64 ...... testsd
34b0: 61 74 29 29 29 0a 09 09 09 09 09 20 20 20 20 20 at)))......
34c0: 28 69 66 20 28 6e 75 6c 6c 3f 20 6d 61 74 63 68 (if (null? match
34d0: 69 6e 67 29 0a 09 09 09 09 09 09 20 28 76 65 63 ing)....... (vec
34e0: 74 6f 72 20 2d 31 20 2d 31 20 22 22 20 22 22 20 tor -1 -1 "" ""
34f0: 22 22 20 30 20 22 22 20 22 22 20 30 20 22 22 20 "" 0 "" "" 0 ""
3500: 22 22 20 22 22 20 30 20 22 22 20 22 22 29 0a 09 "" "" 0 "" "")..
3510: 09 09 09 09 09 20 28 63 61 72 20 6d 61 74 63 68 ..... (car match
3520: 69 6e 67 29 29 29 29 0a 09 09 09 20 20 20 20 20 ing))))....
3530: 20 20 28 74 65 73 74 6e 61 6d 65 20 20 20 28 64 (testname (d
3540: 62 3a 74 65 73 74 2d 67 65 74 2d 74 65 73 74 6e b:test-get-testn
3550: 61 6d 65 20 20 74 65 73 74 29 29 0a 09 09 09 20 ame test))....
3560: 20 20 20 20 20 20 28 69 74 65 6d 70 61 74 68 20 (itempath
3570: 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 (db:test-get-i
3580: 74 65 6d 2d 70 61 74 68 20 74 65 73 74 29 29 0a tem-path test)).
3590: 09 09 09 20 20 20 20 20 20 20 28 74 65 73 74 66 ... (testf
35a0: 75 6c 6c 6e 61 6d 65 20 28 74 65 73 74 3a 74 65 ullname (test:te
35b0: 73 74 2d 67 65 74 2d 66 75 6c 6c 6e 61 6d 65 20 st-get-fullname
35c0: 74 65 73 74 29 29 0a 09 09 09 20 20 20 20 20 20 test))....
35d0: 20 28 74 65 73 74 73 74 61 74 75 73 20 28 64 62 (teststatus (db
35e0: 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 75 73 :test-get-status
35f0: 20 20 20 74 65 73 74 29 29 0a 09 09 09 20 20 20 test))....
3600: 20 20 20 20 28 74 65 73 74 73 74 61 74 65 20 20 (teststate
3610: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 (db:test-get-sta
3620: 74 65 20 20 20 20 74 65 73 74 29 29 0a 09 09 09 te test))....
3630: 20 20 20 20 20 20 20 28 74 65 73 74 73 74 61 72 (teststar
3640: 74 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d t (db:test-get-
3650: 65 76 65 6e 74 5f 74 69 6d 65 20 74 65 73 74 29 event_time test)
3660: 29 0a 09 09 09 20 20 20 20 20 20 20 28 72 75 6e ).... (run
3670: 74 69 6d 65 20 20 20 20 28 64 62 3a 74 65 73 74 time (db:test
3680: 2d 67 65 74 2d 72 75 6e 5f 64 75 72 61 74 69 6f -get-run_duratio
3690: 6e 20 74 65 73 74 29 29 0a 09 09 09 20 20 20 20 n test))....
36a0: 20 20 20 28 62 75 74 74 6f 6e 74 78 74 20 20 28 (buttontxt (
36b0: 69 66 20 28 65 71 75 61 6c 3f 20 74 65 73 74 73 if (equal? tests
36c0: 74 61 74 65 20 22 43 4f 4d 50 4c 45 54 45 44 22 tate "COMPLETED"
36d0: 29 20 74 65 73 74 73 74 61 74 75 73 20 74 65 73 ) teststatus tes
36e0: 74 73 74 61 74 65 29 29 0a 09 09 09 20 20 20 20 tstate))....
36f0: 20 20 20 28 62 75 74 74 6f 6e 20 20 20 20 20 28 (button (
3700: 76 65 63 74 6f 72 2d 72 65 66 20 63 6f 6c 75 6d vector-ref colum
3710: 6e 64 61 74 20 72 6f 77 6e 29 29 0a 09 09 09 20 ndat rown))....
3720: 20 20 20 20 20 20 28 63 6f 6c 6f 72 20 20 20 20 (color
3730: 20 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 63 6f (common:get-co
3740: 6c 6f 72 2d 66 6f 72 2d 73 74 61 74 65 2d 73 74 lor-for-state-st
3750: 61 74 75 73 20 74 65 73 74 73 74 61 74 65 20 74 atus teststate t
3760: 65 73 74 73 74 61 74 75 73 29 29 0a 09 09 09 20 eststatus))....
3770: 20 20 20 20 20 20 28 63 75 72 72 2d 63 6f 6c 6f (curr-colo
3780: 72 20 28 76 65 63 74 6f 72 2d 72 65 66 20 62 75 r (vector-ref bu
3790: 74 74 6f 6e 64 61 74 20 31 29 29 20 3b 3b 20 28 ttondat 1)) ;; (
37a0: 69 75 70 3a 61 74 74 72 69 62 75 74 65 20 62 75 iup:attribute bu
37b0: 74 74 6f 6e 20 22 42 47 43 4f 4c 4f 52 22 29 29 tton "BGCOLOR"))
37c0: 0a 09 09 09 20 20 20 20 20 20 20 28 63 75 72 72 .... (curr
37d0: 2d 74 69 74 6c 65 20 28 76 65 63 74 6f 72 2d 72 -title (vector-r
37e0: 65 66 20 62 75 74 74 6f 6e 64 61 74 20 32 29 29 ef buttondat 2))
37f0: 29 20 3b 3b 20 28 69 75 70 3a 61 74 74 72 69 62 ) ;; (iup:attrib
3800: 75 74 65 20 62 75 74 74 6f 6e 20 22 54 49 54 4c ute button "TITL
3810: 45 22 29 29 29 0a 09 09 09 20 20 28 69 66 20 28 E"))).... (if (
3820: 6e 6f 74 20 28 65 71 75 61 6c 3f 20 63 75 72 72 not (equal? curr
3830: 2d 63 6f 6c 6f 72 20 63 6f 6c 6f 72 29 29 0a 09 -color color))..
3840: 09 09 20 20 20 20 20 20 28 69 75 70 3a 61 74 74 .. (iup:att
3850: 72 69 62 75 74 65 2d 73 65 74 21 20 62 75 74 74 ribute-set! butt
3860: 6f 6e 20 22 42 47 43 4f 4c 4f 52 22 20 63 6f 6c on "BGCOLOR" col
3870: 6f 72 29 29 0a 09 09 09 20 20 28 69 66 20 28 6e or)).... (if (n
3880: 6f 74 20 28 65 71 75 61 6c 3f 20 63 75 72 72 2d ot (equal? curr-
3890: 74 69 74 6c 65 20 62 75 74 74 6f 6e 74 78 74 29 title buttontxt)
38a0: 29 0a 09 09 09 20 20 20 20 20 20 28 69 75 70 3a ).... (iup:
38b0: 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 62 attribute-set! b
38c0: 75 74 74 6f 6e 20 22 54 49 54 4c 45 22 20 20 20 utton "TITLE"
38d0: 62 75 74 74 6f 6e 74 78 74 29 29 0a 09 09 09 20 buttontxt))....
38e0: 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 62 75 (vector-set! bu
38f0: 74 74 6f 6e 64 61 74 20 30 20 72 75 6e 2d 69 64 ttondat 0 run-id
3900: 29 0a 09 09 09 20 20 28 76 65 63 74 6f 72 2d 73 ).... (vector-s
3910: 65 74 21 20 62 75 74 74 6f 6e 64 61 74 20 31 20 et! buttondat 1
3920: 63 6f 6c 6f 72 29 0a 09 09 09 20 20 28 76 65 63 color).... (vec
3930: 74 6f 72 2d 73 65 74 21 20 62 75 74 74 6f 6e 64 tor-set! buttond
3940: 61 74 20 32 20 62 75 74 74 6f 6e 74 78 74 29 0a at 2 buttontxt).
3950: 09 09 09 20 20 28 76 65 63 74 6f 72 2d 73 65 74 ... (vector-set
3960: 21 20 62 75 74 74 6f 6e 64 61 74 20 33 20 74 65 ! buttondat 3 te
3970: 73 74 29 0a 09 09 09 20 20 28 76 65 63 74 6f 72 st).... (vector
3980: 2d 73 65 74 21 20 62 75 74 74 6f 6e 64 61 74 20 -set! buttondat
3990: 34 20 72 75 6e 2d 6b 65 79 29 29 29 0a 09 09 20 4 run-key)))...
39a0: 20 20 20 28 73 65 74 21 20 72 6f 77 6e 20 28 2b (set! rown (+
39b0: 20 72 6f 77 6e 20 31 29 29 29 29 0a 09 09 2a 61 rown 1))))...*a
39c0: 6c 6c 74 65 73 74 6e 61 6d 65 6c 73 74 2a 29 29 lltestnamelst*))
39d0: 0a 09 20 20 20 20 20 28 73 65 74 21 20 63 6f 6c .. (set! col
39e0: 6e 20 28 2b 20 63 6f 6c 6e 20 31 29 29 29 29 0a n (+ coln 1)))).
39f0: 09 20 72 75 6e 73 29 29 29 29 0a 0a 28 64 65 66 . runs))))..(def
3a00: 69 6e 65 20 28 6d 6b 73 74 72 20 2e 20 78 29 0a ine (mkstr . x).
3a10: 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 (string-inters
3a20: 70 65 72 73 65 20 28 6d 61 70 20 63 6f 6e 63 20 perse (map conc
3a30: 78 29 20 22 2c 22 29 29 0a 0a 28 64 65 66 69 6e x) ","))..(defin
3a40: 65 20 28 75 70 64 61 74 65 2d 73 65 61 72 63 68 e (update-search
3a50: 20 78 20 76 61 6c 29 0a 20 20 3b 3b 20 28 70 72 x val). ;; (pr
3a60: 69 6e 74 20 22 53 65 74 74 69 6e 67 20 73 65 61 int "Setting sea
3a70: 72 63 68 20 66 6f 72 20 22 20 78 20 22 20 74 6f rch for " x " to
3a80: 20 22 20 76 61 6c 29 0a 20 20 28 68 61 73 68 2d " val). (hash-
3a90: 74 61 62 6c 65 2d 73 65 74 21 20 2a 73 65 61 72 table-set! *sear
3aa0: 63 68 70 61 74 74 73 2a 20 78 20 76 61 6c 29 29 chpatts* x val))
3ab0: 0a 0a 28 64 65 66 69 6e 65 20 28 6d 61 72 6b 2d ..(define (mark-
3ac0: 66 6f 72 2d 75 70 64 61 74 65 29 0a 20 20 28 73 for-update). (s
3ad0: 65 74 21 20 2a 6c 61 73 74 2d 64 62 2d 75 70 64 et! *last-db-upd
3ae0: 61 74 65 2d 74 69 6d 65 2a 20 30 29 0a 20 20 28 ate-time* 0). (
3af0: 73 65 74 21 20 2a 64 65 6c 61 79 65 64 2d 75 70 set! *delayed-up
3b00: 64 61 74 65 2a 20 31 29 29 0a 0a 3b 3b 3d 3d 3d date* 1))..;;===
3b10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3b20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3b30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3b40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3b50: 3d 3d 3d 0a 3b 3b 20 52 20 55 20 4e 20 43 20 4f ===.;; R U N C O
3b60: 20 4e 20 54 20 52 20 4f 20 4c 0a 3b 3b 3d 3d 3d N T R O L.;;===
3b70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3b80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3b90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3ba0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3bb0: 3d 3d 3d 0a 0a 3b 3b 20 74 61 72 67 65 74 20 70 ===..;; target p
3bc0: 6f 70 75 6c 61 74 69 6e 67 20 6c 6f 67 69 63 0a opulating logic.
3bd0: 3b 3b 20 20 0a 3b 3b 20 6c 62 20 20 20 20 20 20 ;; .;; lb
3be0: 20 20 20 20 20 20 3d 20 3c 76 65 63 74 6f 72 20 = <vector
3bf0: 63 75 72 72 2d 6c 61 62 65 6c 2d 6f 62 6a 65 63 curr-label-objec
3c00: 74 20 6e 65 78 74 2d 6c 61 62 65 6c 2d 6f 62 6a t next-label-obj
3c10: 65 63 74 3e 0a 3b 3b 20 66 69 65 6c 64 20 20 20 ect>.;; field
3c20: 20 20 20 20 20 20 3d 20 74 61 72 67 65 74 20 66 = target f
3c30: 69 65 6c 64 20 6e 61 6d 65 20 66 6f 72 20 74 68 ield name for th
3c40: 69 73 20 64 72 6f 70 64 6f 77 6e 0a 3b 3b 20 72 is dropdown.;; r
3c50: 65 66 65 72 65 6e 74 2d 76 61 6c 73 20 3d 20 73 eferent-vals = s
3c60: 65 6c 65 63 74 65 64 20 76 61 6c 75 65 20 69 6e elected value in
3c70: 20 74 68 65 20 6c 65 66 74 20 64 72 6f 70 64 6f the left dropdo
3c80: 77 6e 0a 3b 3b 20 74 61 72 67 65 74 73 20 20 20 wn.;; targets
3c90: 20 20 20 20 3d 20 6c 69 73 74 20 6f 66 20 74 61 = list of ta
3ca0: 72 67 65 74 73 20 74 6f 20 75 73 65 20 74 6f 20 rgets to use to
3cb0: 62 75 69 6c 64 20 74 68 65 20 64 72 6f 70 64 6f build the dropdo
3cc0: 77 6e 0a 3b 3b 20 0a 3b 3b 20 65 61 63 68 20 6e wn.;; .;; each n
3cd0: 6f 64 65 20 69 73 20 63 68 61 69 6e 65 64 3a 20 ode is chained:
3ce0: 6b 65 79 31 20 2d 3e 20 6b 65 79 32 20 2d 3e 20 key1 -> key2 ->
3cf0: 6b 65 79 33 0a 3b 3b 0a 3b 3b 20 6d 75 73 74 20 key3.;;.;; must
3d00: 73 65 6c 65 63 74 20 76 61 6c 75 65 73 20 66 72 select values fr
3d10: 6f 6d 20 6f 6e 6c 79 20 61 70 72 6f 70 72 69 61 om only apropria
3d20: 74 65 20 74 61 72 67 65 74 73 0a 3b 3b 20 20 20 te targets.;;
3d30: 61 20 62 20 63 0a 3b 3b 20 20 20 61 20 64 20 65 a b c.;; a d e
3d40: 0a 3b 3b 20 20 20 61 20 62 20 66 0a 3b 3b 20 20 .;; a b f.;;
3d50: 20 20 20 20 20 20 61 2f 62 20 3d 3e 20 63 20 66 a/b => c f
3d60: 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 64 61 73 .;;.(define (das
3d70: 68 62 6f 61 72 64 3a 70 6f 70 75 6c 61 74 65 2d hboard:populate-
3d80: 74 61 72 67 65 74 2d 64 72 6f 70 64 6f 77 6e 20 target-dropdown
3d90: 6c 62 20 72 65 66 65 72 65 6e 74 2d 76 61 6c 73 lb referent-vals
3da0: 20 74 61 72 67 65 74 73 29 0a 20 20 3b 3b 20 69 targets). ;; i
3db0: 73 20 74 68 65 20 63 75 72 72 65 6e 74 20 76 61 s the current va
3dc0: 6c 75 65 20 69 6e 20 74 68 65 20 6e 65 77 20 6c lue in the new l
3dd0: 69 73 74 3f 20 63 68 6f 6f 73 65 20 6e 65 77 20 ist? choose new
3de0: 64 65 66 61 75 6c 74 20 69 66 20 6e 6f 74 0a 20 default if not.
3df0: 20 28 6c 65 74 2a 20 28 28 72 65 6d 76 61 6c 75 (let* ((remvalu
3e00: 65 73 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 es (map (lambda
3e10: 20 28 72 6f 77 29 0a 09 09 09 20 20 20 20 28 63 (row).... (c
3e20: 6f 6d 6d 6f 6e 3a 6c 69 73 74 2d 69 73 2d 73 75 ommon:list-is-su
3e30: 62 6c 69 73 74 20 72 65 66 65 72 65 6e 74 2d 76 blist referent-v
3e40: 61 6c 73 20 28 76 65 63 74 6f 72 2d 3e 6c 69 73 als (vector->lis
3e50: 74 20 72 6f 77 29 29 29 0a 09 09 09 20 20 74 61 t row))).... ta
3e60: 72 67 65 74 73 29 29 0a 09 20 28 76 61 6c 75 65 rgets)).. (value
3e70: 73 20 20 20 20 20 28 64 65 6c 65 74 65 2d 64 75 s (delete-du
3e80: 70 6c 69 63 61 74 65 73 20 28 6d 61 70 20 63 61 plicates (map ca
3e90: 72 20 28 66 69 6c 74 65 72 20 6c 69 73 74 3f 20 r (filter list?
3ea0: 72 65 6d 76 61 6c 75 65 73 29 29 29 29 0a 09 20 remvalues))))..
3eb0: 28 73 65 6c 2d 76 61 6c 6e 75 6d 20 28 69 75 70 (sel-valnum (iup
3ec0: 3a 61 74 74 72 69 62 75 74 65 20 6c 62 20 22 56 :attribute lb "V
3ed0: 41 4c 55 45 22 29 29 0a 09 20 28 73 65 6c 2d 76 ALUE")).. (sel-v
3ee0: 61 6c 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 al (iup:attri
3ef0: 62 75 74 65 20 6c 62 20 73 65 6c 2d 76 61 6c 6e bute lb sel-valn
3f00: 75 6d 29 29 0a 09 20 28 76 61 6c 2d 6e 75 6d 20 um)).. (val-num
3f10: 20 20 20 31 29 29 0a 20 20 20 20 3b 3b 20 66 69 1)). ;; fi
3f20: 72 73 74 20 63 68 65 63 6b 20 69 66 20 74 68 65 rst check if the
3f30: 20 63 75 72 72 65 6e 74 20 76 61 6c 75 65 20 69 current value i
3f40: 73 20 69 6e 20 74 68 65 20 6e 65 77 20 6c 69 73 s in the new lis
3f50: 74 2c 20 6f 74 68 65 72 77 69 73 65 20 72 65 70 t, otherwise rep
3f60: 6c 61 63 65 20 77 69 74 68 20 0a 20 20 20 20 3b lace with . ;
3f70: 3b 20 66 69 72 73 74 20 76 61 6c 75 65 20 66 72 ; first value fr
3f80: 6f 6d 20 76 61 6c 75 65 73 0a 20 20 20 20 28 69 om values. (i
3f90: 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 up:attribute-set
3fa0: 21 20 6c 62 20 22 52 45 4d 4f 56 45 49 54 45 4d ! lb "REMOVEITEM
3fb0: 22 20 22 41 4c 4c 22 29 0a 20 20 20 20 28 66 6f " "ALL"). (fo
3fc0: 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 r-each (lambda (
3fd0: 76 61 6c 29 0a 09 09 3b 3b 20 28 69 75 70 3a 61 val)...;; (iup:a
3fe0: 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 6c 62 ttribute-set! lb
3ff0: 20 22 41 50 50 45 4e 44 49 54 45 4d 22 20 76 61 "APPENDITEM" va
4000: 6c 29 0a 09 09 28 69 75 70 3a 61 74 74 72 69 62 l)...(iup:attrib
4010: 75 74 65 2d 73 65 74 21 20 6c 62 20 28 63 6f 6e ute-set! lb (con
4020: 63 20 76 61 6c 2d 6e 75 6d 29 20 76 61 6c 29 0a c val-num) val).
4030: 09 09 28 69 66 20 28 65 71 75 61 6c 3f 20 73 65 ..(if (equal? se
4040: 6c 2d 76 61 6c 20 76 61 6c 29 0a 09 09 20 20 20 l-val val)...
4050: 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d (iup:attribute-
4060: 73 65 74 21 20 6c 62 20 22 56 41 4c 55 45 22 20 set! lb "VALUE"
4070: 76 61 6c 2d 6e 75 6d 29 29 0a 09 09 28 73 65 74 val-num))...(set
4080: 21 20 76 61 6c 2d 6e 75 6d 20 28 2b 20 76 61 6c ! val-num (+ val
4090: 2d 6e 75 6d 20 31 29 29 29 0a 09 20 20 20 20 20 -num 1)))..
40a0: 20 76 61 6c 75 65 73 29 0a 20 20 20 20 28 6c 65 values). (le
40b0: 74 20 28 28 76 61 6c 20 28 69 75 70 3a 61 74 74 t ((val (iup:att
40c0: 72 69 62 75 74 65 20 6c 62 20 22 56 41 4c 55 45 ribute lb "VALUE
40d0: 22 29 29 29 0a 20 20 20 20 20 20 28 69 66 20 76 "))). (if v
40e0: 61 6c 0a 09 20 20 76 61 6c 0a 09 20 20 28 69 66 al.. val.. (if
40f0: 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 76 61 6c (not (null? val
4100: 75 65 73 29 29 0a 09 20 20 20 20 20 20 28 6c 65 ues)).. (le
4110: 74 20 28 28 6e 65 77 76 61 6c 20 28 63 61 72 20 t ((newval (car
4120: 76 61 6c 75 65 73 29 29 29 0a 09 09 28 69 75 70 values)))...(iup
4130: 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 :attribute-set!
4140: 6c 62 20 22 56 41 4c 55 45 22 20 6e 65 77 76 61 lb "VALUE" newva
4150: 6c 29 0a 09 09 6e 65 77 76 61 6c 29 29 29 29 29 l)...newval)))))
4160: 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 61 73 68 )..(define (dash
4170: 62 6f 61 72 64 3a 75 70 64 61 74 65 2d 74 61 72 board:update-tar
4180: 67 65 74 2d 73 65 6c 65 63 74 6f 72 20 6b 65 79 get-selector key
4190: 2d 6c 62 73 20 23 21 6b 65 79 20 28 61 63 74 69 -lbs #!key (acti
41a0: 6f 6e 2d 70 72 6f 63 20 23 66 29 29 0a 20 20 28 on-proc #f)). (
41b0: 6c 65 74 2a 20 28 28 64 62 2d 74 61 72 67 65 74 let* ((db-target
41c0: 2d 64 61 74 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 -dat (open-run-c
41d0: 6c 6f 73 65 20 64 62 3a 67 65 74 2d 74 61 72 67 lose db:get-targ
41e0: 65 74 73 20 23 66 29 29 0a 09 20 28 68 65 61 64 ets #f)).. (head
41f0: 65 72 20 20 20 20 20 20 20 20 28 76 65 63 74 6f er (vecto
4200: 72 2d 72 65 66 20 64 62 2d 74 61 72 67 65 74 2d r-ref db-target-
4210: 64 61 74 20 30 29 29 0a 09 20 28 64 62 2d 74 61 dat 0)).. (db-ta
4220: 72 67 65 74 73 20 20 20 20 28 76 65 63 74 6f 72 rgets (vector
4230: 2d 72 65 66 20 64 62 2d 74 61 72 67 65 74 2d 64 -ref db-target-d
4240: 61 74 20 31 29 29 0a 09 20 28 6b 65 79 2d 6c 69 at 1)).. (key-li
4250: 73 74 62 6f 78 65 73 20 28 69 66 20 6b 65 79 2d stboxes (if key-
4260: 6c 62 73 20 6b 65 79 2d 6c 62 73 20 28 6d 61 6b lbs key-lbs (mak
4270: 65 2d 6c 69 73 74 20 28 6c 65 6e 67 74 68 20 68 e-list (length h
4280: 65 61 64 65 72 29 20 23 66 29 29 29 29 0a 20 20 eader) #f)))).
4290: 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 6b 65 (let loop ((ke
42a0: 79 20 20 20 20 20 28 63 61 72 20 68 65 61 64 65 y (car heade
42b0: 72 29 29 0a 09 20 20 20 20 20 20 20 28 72 65 6d r)).. (rem
42c0: 6b 65 79 73 20 28 63 64 72 20 68 65 61 64 65 72 keys (cdr header
42d0: 29 29 0a 09 20 20 20 20 20 20 20 28 72 65 66 76 )).. (refv
42e0: 61 6c 73 20 27 28 29 29 0a 09 20 20 20 20 20 20 als '())..
42f0: 20 28 69 6e 64 78 20 20 20 20 30 29 0a 09 20 20 (indx 0)..
4300: 20 20 20 20 20 28 6c 62 73 20 20 20 20 20 27 28 (lbs '(
4310: 29 29 29 0a 20 20 20 20 20 20 28 6c 65 74 2a 20 ))). (let*
4320: 28 28 6c 62 20 28 6c 65 74 20 28 28 6c 62 20 28 ((lb (let ((lb (
4330: 6c 69 73 74 2d 72 65 66 20 6b 65 79 2d 6c 69 73 list-ref key-lis
4340: 74 62 6f 78 65 73 20 69 6e 64 78 29 29 29 0a 09 tboxes indx)))..
4350: 09 20 20 20 28 69 66 20 6c 62 0a 09 09 20 20 20 . (if lb...
4360: 20 20 20 20 6c 62 0a 09 09 20 20 20 20 20 20 20 lb...
4370: 28 69 75 70 3a 6c 69 73 74 62 6f 78 20 0a 09 09 (iup:listbox ...
4380: 09 23 3a 73 69 7a 65 20 22 78 31 30 22 20 0a 09 .#:size "x10" ..
4390: 09 09 23 3a 66 6f 6e 74 73 69 7a 65 20 22 31 30 ..#:fontsize "10
43a0: 22 0a 09 09 09 23 3a 65 78 70 61 6e 64 20 22 56 "....#:expand "V
43b0: 45 52 54 49 43 41 4c 22 0a 09 09 09 3b 3b 20 23 ERTICAL"....;; #
43c0: 3a 64 72 6f 70 64 6f 77 6e 20 22 59 45 53 22 0a :dropdown "YES".
43d0: 09 09 09 23 3a 65 64 69 74 62 6f 78 20 22 59 45 ...#:editbox "YE
43e0: 53 22 0a 09 09 09 23 3a 61 63 74 69 6f 6e 20 61 S"....#:action a
43f0: 63 74 69 6f 6e 2d 70 72 6f 63 0a 09 09 09 29 29 ction-proc....))
4400: 29 29 0a 09 20 20 20 20 20 3b 3b 20 6c 6f 6f 70 )).. ;; loop
4410: 20 74 68 6f 75 67 68 20 61 6c 6c 20 74 68 65 20 though all the
4420: 74 61 72 67 65 74 73 20 61 6e 64 20 62 75 69 6c targets and buil
4430: 64 20 74 68 65 20 6c 69 73 74 20 66 6f 72 20 74 d the list for t
4440: 68 69 73 20 64 72 6f 70 64 6f 77 6e 0a 09 20 20 his dropdown..
4450: 20 20 20 28 73 65 6c 65 63 74 65 64 2d 76 61 6c (selected-val
4460: 75 65 20 28 64 61 73 68 62 6f 61 72 64 3a 70 6f ue (dashboard:po
4470: 70 75 6c 61 74 65 2d 74 61 72 67 65 74 2d 64 72 pulate-target-dr
4480: 6f 70 64 6f 77 6e 20 6c 62 20 72 65 66 76 61 6c opdown lb refval
4490: 73 20 64 62 2d 74 61 72 67 65 74 73 29 29 29 0a s db-targets))).
44a0: 09 28 69 66 20 28 6e 75 6c 6c 3f 20 72 65 6d 6b .(if (null? remk
44b0: 65 79 73 29 0a 09 20 20 20 20 3b 3b 20 72 65 74 eys).. ;; ret
44c0: 75 72 6e 20 61 20 6c 69 73 74 20 6f 66 20 74 68 urn a list of th
44d0: 65 20 6c 69 73 74 62 6f 78 20 69 74 65 6d 73 20 e listbox items
44e0: 61 6e 64 20 61 6e 20 69 75 70 3a 68 62 6f 78 20 and an iup:hbox
44f0: 77 69 74 68 20 74 68 65 20 6c 61 62 65 6c 73 20 with the labels
4500: 61 6e 64 20 6c 69 73 74 62 6f 78 65 73 0a 09 20 and listboxes..
4510: 20 20 20 28 6c 65 74 20 28 28 6c 69 73 74 62 6f (let ((listbo
4520: 78 65 73 20 28 61 70 70 65 6e 64 20 6c 62 73 20 xes (append lbs
4530: 28 6c 69 73 74 20 6c 62 29 29 29 29 0a 09 20 20 (list lb))))..
4540: 20 20 20 20 28 6c 69 73 74 20 6c 69 73 74 62 6f (list listbo
4550: 78 65 73 0a 09 09 20 20 20 20 28 6d 61 70 20 28 xes... (map (
4560: 6c 61 6d 62 64 61 20 28 68 74 78 74 20 6c 62 29 lambda (htxt lb)
4570: 0a 09 09 09 20 20 20 28 69 75 70 3a 76 62 6f 78 .... (iup:vbox
4580: 0a 09 09 09 20 20 20 20 28 69 75 70 3a 6c 61 62 .... (iup:lab
4590: 65 6c 20 68 74 78 74 29 0a 09 09 09 20 20 20 20 el htxt)....
45a0: 6c 62 29 29 0a 09 09 09 20 68 65 61 64 65 72 0a lb)).... header.
45b0: 09 09 09 20 6c 69 73 74 62 6f 78 65 73 29 29 29 ... listboxes)))
45c0: 0a 09 20 20 20 20 28 6c 6f 6f 70 20 28 63 61 72 .. (loop (car
45d0: 20 72 65 6d 6b 65 79 73 29 0a 09 09 20 20 28 63 remkeys)... (c
45e0: 64 72 20 72 65 6d 6b 65 79 73 29 0a 09 09 20 20 dr remkeys)...
45f0: 28 61 70 70 65 6e 64 20 72 65 66 76 61 6c 73 20 (append refvals
4600: 28 6c 69 73 74 20 73 65 6c 65 63 74 65 64 2d 76 (list selected-v
4610: 61 6c 75 65 29 29 0a 09 09 20 20 28 2b 20 69 6e alue))... (+ in
4620: 64 78 20 31 29 0a 09 09 20 20 28 61 70 70 65 6e dx 1)... (appen
4630: 64 20 6c 62 73 20 28 6c 69 73 74 20 6c 62 29 29 d lbs (list lb))
4640: 29 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 ))))))..(define
4650: 28 64 61 73 68 62 6f 61 72 64 3a 64 72 61 77 2d (dashboard:draw-
4660: 74 65 73 74 73 20 63 6e 76 20 78 61 64 6a 20 79 tests cnv xadj y
4670: 61 64 6a 20 74 65 73 74 2d 64 72 61 77 2d 73 74 adj test-draw-st
4680: 61 74 65 20 73 6f 72 74 65 64 2d 74 65 73 74 6e ate sorted-testn
4690: 61 6d 65 73 29 0a 20 20 28 63 61 6e 76 61 73 2d ames). (canvas-
46a0: 63 6c 65 61 72 21 20 63 6e 76 29 0a 20 20 28 63 clear! cnv). (c
46b0: 61 6e 76 61 73 2d 66 6f 6e 74 2d 73 65 74 21 20 anvas-font-set!
46c0: 63 6e 76 20 22 43 6f 75 72 69 65 72 20 4e 65 77 cnv "Courier New
46d0: 2c 20 2d 31 30 22 29 0a 20 20 28 6c 65 74 2d 76 , -10"). (let-v
46e0: 61 6c 75 65 73 20 28 28 28 73 69 7a 65 78 20 73 alues (((sizex s
46f0: 69 7a 65 79 20 73 69 7a 65 78 6d 6d 20 73 69 7a izey sizexmm siz
4700: 65 79 6d 6d 29 20 28 63 61 6e 76 61 73 2d 73 69 eymm) (canvas-si
4710: 7a 65 20 63 6e 76 29 29 0a 09 20 20 20 20 20 20 ze cnv))..
4720: 20 28 28 6f 72 69 67 69 6e 78 20 6f 72 69 67 69 ((originx origi
4730: 6e 79 29 20 20 20 20 20 20 20 20 20 20 20 20 20 ny)
4740: 28 63 61 6e 76 61 73 2d 6f 72 69 67 69 6e 20 63 (canvas-origin c
4750: 6e 76 29 29 29 0a 20 20 20 20 20 20 28 69 66 20 nv))). (if
4760: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f (hash-table-ref/
4770: 64 65 66 61 75 6c 74 20 74 65 73 74 2d 64 72 61 default test-dra
4780: 77 2d 73 74 61 74 65 20 27 66 69 72 73 74 2d 74 w-state 'first-t
4790: 69 6d 65 20 23 74 29 0a 09 20 20 28 62 65 67 69 ime #t).. (begi
47a0: 6e 0a 09 20 20 20 20 28 68 61 73 68 2d 74 61 62 n.. (hash-tab
47b0: 6c 65 2d 73 65 74 21 20 74 65 73 74 2d 64 72 61 le-set! test-dra
47c0: 77 2d 73 74 61 74 65 20 27 66 69 72 73 74 2d 74 w-state 'first-t
47d0: 69 6d 65 20 23 66 29 0a 09 20 20 20 20 28 68 61 ime #f).. (ha
47e0: 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 74 65 sh-table-set! te
47f0: 73 74 2d 64 72 61 77 2d 73 74 61 74 65 20 27 73 st-draw-state 's
4800: 63 61 6c 65 66 20 38 29 0a 09 20 20 20 20 3b 3b calef 8).. ;;
4810: 20 73 65 74 20 74 68 65 73 65 20 0a 09 20 20 20 set these ..
4820: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 (hash-table-set
4830: 21 20 74 65 73 74 2d 64 72 61 77 2d 73 74 61 74 ! test-draw-stat
4840: 65 20 27 74 65 73 74 2d 62 72 6f 77 73 65 2d 78 e 'test-browse-x
4850: 6f 66 66 73 65 74 20 32 30 29 20 3b 3b 20 28 2d offset 20) ;; (-
4860: 20 30 20 28 2a 20 28 2f 20 73 69 7a 65 78 20 32 0 (* (/ sizex 2
4870: 29 20 28 2a 20 38 20 78 61 64 6a 29 29 29 29 0a ) (* 8 xadj)))).
4880: 09 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 . (hash-table
4890: 2d 73 65 74 21 20 74 65 73 74 2d 64 72 61 77 2d -set! test-draw-
48a0: 73 74 61 74 65 20 27 74 65 73 74 2d 62 72 6f 77 state 'test-brow
48b0: 73 65 2d 79 6f 66 66 73 65 74 20 32 30 29 29 29 se-yoffset 20)))
48c0: 20 3b 3b 20 28 2d 20 30 20 28 2a 20 28 2f 20 73 ;; (- 0 (* (/ s
48d0: 69 7a 65 79 20 32 29 20 28 2a 20 38 20 28 2d 20 izey 2) (* 8 (-
48e0: 31 20 79 61 64 6a 29 29 29 29 29 29 29 0a 20 20 1 yadj))))))).
48f0: 20 20 20 20 28 6c 65 74 2a 20 28 28 73 63 61 6c (let* ((scal
4900: 65 66 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 ef (hash-table-r
4910: 65 66 2f 64 65 66 61 75 6c 74 20 74 65 73 74 2d ef/default test-
4920: 64 72 61 77 2d 73 74 61 74 65 20 27 73 63 61 6c draw-state 'scal
4930: 65 66 20 38 29 29 0a 09 20 20 20 20 20 28 74 65 ef 8)).. (te
4940: 73 74 2d 62 72 6f 77 73 65 2d 78 6f 66 66 73 65 st-browse-xoffse
4950: 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 t (hash-table-re
4960: 66 20 74 65 73 74 2d 64 72 61 77 2d 73 74 61 74 f test-draw-stat
4970: 65 20 27 74 65 73 74 2d 62 72 6f 77 73 65 2d 78 e 'test-browse-x
4980: 6f 66 66 73 65 74 29 29 0a 09 20 20 20 20 20 28 offset)).. (
4990: 74 65 73 74 2d 62 72 6f 77 73 65 2d 79 6f 66 66 test-browse-yoff
49a0: 73 65 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d set (hash-table-
49b0: 72 65 66 20 74 65 73 74 2d 64 72 61 77 2d 73 74 ref test-draw-st
49c0: 61 74 65 20 27 74 65 73 74 2d 62 72 6f 77 73 65 ate 'test-browse
49d0: 2d 79 6f 66 66 73 65 74 29 29 0a 09 20 20 20 20 -yoffset))..
49e0: 20 28 78 74 6f 72 69 67 20 28 2b 20 74 65 73 74 (xtorig (+ test
49f0: 2d 62 72 6f 77 73 65 2d 78 6f 66 66 73 65 74 20 -browse-xoffset
4a00: 28 2a 20 28 2f 20 73 69 7a 65 78 20 32 29 20 73 (* (/ sizex 2) s
4a10: 63 61 6c 65 66 20 28 2d 20 30 2e 35 20 78 61 64 calef (- 0.5 xad
4a20: 6a 29 29 29 29 20 3b 3b 20 20 28 2d 20 78 61 64 j)))) ;; (- xad
4a30: 6a 20 31 29 29 29 29 0a 09 20 20 20 20 20 28 79 j 1)))).. (y
4a40: 74 6f 72 69 67 20 28 2b 20 74 65 73 74 2d 62 72 torig (+ test-br
4a50: 6f 77 73 65 2d 79 6f 66 66 73 65 74 20 28 2a 20 owse-yoffset (*
4a60: 28 2f 20 73 69 7a 65 79 20 32 29 20 73 63 61 6c (/ sizey 2) scal
4a70: 65 66 20 28 2d 20 79 61 64 6a 20 30 2e 35 29 29 ef (- yadj 0.5))
4a80: 29 29 0a 09 20 20 20 20 20 28 62 6f 78 77 20 20 )).. (boxw
4a90: 20 39 30 29 0a 09 20 20 20 20 20 28 62 6f 78 68 90).. (boxh
4aa0: 20 20 20 32 35 29 0a 09 20 20 20 20 20 28 67 61 25).. (ga
4ab0: 70 78 20 20 20 32 30 29 0a 09 20 20 20 20 20 28 px 20).. (
4ac0: 67 61 70 79 20 20 20 33 30 29 29 0a 09 28 70 72 gapy 30))..(pr
4ad0: 69 6e 74 20 22 73 69 7a 65 78 3a 20 22 20 73 69 int "sizex: " si
4ae0: 7a 65 78 20 22 20 73 69 7a 65 79 3a 20 22 20 73 zex " sizey: " s
4af0: 69 7a 65 79 20 22 20 66 6f 6e 74 3a 20 22 20 28 izey " font: " (
4b00: 63 61 6e 76 61 73 2d 66 6f 6e 74 20 63 6e 76 29 canvas-font cnv)
4b10: 20 22 20 6f 72 69 67 69 6e 78 3a 20 22 20 6f 72 " originx: " or
4b20: 69 67 69 6e 78 20 22 20 6f 72 69 67 69 6e 79 3a iginx " originy:
4b30: 20 22 20 6f 72 69 67 69 6e 79 20 22 20 78 74 6f " originy " xto
4b40: 72 69 67 3a 20 22 20 78 74 6f 72 69 67 20 22 20 rig: " xtorig "
4b50: 79 74 6f 72 69 67 3a 20 22 20 79 74 6f 72 69 67 ytorig: " ytorig
4b60: 20 22 20 78 61 64 6a 3a 20 22 20 78 61 64 6a 20 " xadj: " xadj
4b70: 22 20 79 61 64 6a 3a 20 22 20 79 61 64 6a 29 0a " yadj: " yadj).
4b80: 09 28 6c 65 74 20 6c 6f 6f 70 20 28 28 68 65 64 .(let loop ((hed
4b90: 20 28 63 61 72 20 28 72 65 76 65 72 73 65 20 73 (car (reverse s
4ba0: 6f 72 74 65 64 2d 74 65 73 74 6e 61 6d 65 73 29 orted-testnames)
4bb0: 29 29 0a 09 09 20 20 20 28 74 61 6c 20 28 63 64 ))... (tal (cd
4bc0: 72 20 28 72 65 76 65 72 73 65 20 73 6f 72 74 65 r (reverse sorte
4bd0: 64 2d 74 65 73 74 6e 61 6d 65 73 29 29 29 0a 09 d-testnames)))..
4be0: 09 20 20 20 28 6c 6c 78 20 78 74 6f 72 69 67 29 . (llx xtorig)
4bf0: 0a 09 09 20 20 20 28 6c 6c 79 20 79 74 6f 72 69 ... (lly ytori
4c00: 67 29 0a 09 09 20 20 20 28 75 72 78 20 28 2b 20 g)... (urx (+
4c10: 78 74 6f 72 69 67 20 62 6f 78 77 29 29 0a 09 09 xtorig boxw))...
4c20: 20 20 20 28 75 72 79 20 28 2b 20 79 74 6f 72 69 (ury (+ ytori
4c30: 67 20 62 6f 78 68 29 29 29 0a 09 20 20 3b 20 28 g boxh))).. ; (
4c40: 70 72 69 6e 74 20 22 68 65 64 20 22 20 68 65 64 print "hed " hed
4c50: 20 22 20 6c 6c 78 20 22 20 6c 6c 78 20 22 20 6c " llx " llx " l
4c60: 6c 79 20 22 20 6c 6c 79 20 22 20 75 72 78 20 22 ly " lly " urx "
4c70: 20 75 72 78 20 22 20 75 72 79 20 22 20 75 72 79 urx " ury " ury
4c80: 29 0a 09 20 20 28 63 61 6e 76 61 73 2d 74 65 78 ).. (canvas-tex
4c90: 74 21 20 63 6e 76 20 28 2b 20 6c 6c 78 20 35 29 t! cnv (+ llx 5)
4ca0: 28 2b 20 6c 6c 79 20 35 29 20 68 65 64 29 20 3b (+ lly 5) hed) ;
4cb0: 3b 20 28 63 6f 6e 63 20 74 65 73 74 6e 61 6d 65 ; (conc testname
4cc0: 20 22 20 28 22 20 78 74 6f 72 69 67 20 22 2c 22 " (" xtorig ","
4cd0: 20 79 74 6f 72 69 67 20 22 29 22 29 29 0a 09 20 ytorig ")"))..
4ce0: 20 28 63 61 6e 76 61 73 2d 72 65 63 74 61 6e 67 (canvas-rectang
4cf0: 6c 65 21 20 63 6e 76 20 6c 6c 78 20 75 72 78 20 le! cnv llx urx
4d00: 6c 6c 79 20 75 72 79 29 0a 09 20 20 28 69 66 20 lly ury).. (if
4d10: 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 (not (null? tal)
4d20: 29 0a 09 20 20 20 20 20 20 3b 3b 20 6c 65 61 76 ).. ;; leav
4d30: 65 20 61 20 63 6f 6c 75 6d 6e 20 6f 66 20 73 70 e a column of sp
4d40: 61 63 65 20 74 6f 20 74 68 65 20 72 69 67 68 74 ace to the right
4d50: 20 74 6f 20 6c 69 73 74 20 69 74 65 6d 73 0a 09 to list items..
4d60: 20 20 20 20 20 20 28 6c 65 74 20 28 28 68 61 76 (let ((hav
4d70: 65 2d 72 6f 6f 6d 20 0a 09 09 20 20 20 20 20 28 e-room ... (
4d80: 69 66 20 23 74 20 3b 3b 20 70 75 74 20 22 61 75 if #t ;; put "au
4d90: 74 6f 22 20 68 65 72 65 20 77 68 65 72 65 20 73 to" here where s
4da0: 6f 6d 65 20 66 6f 72 6d 20 6f 66 20 61 75 74 6f ome form of auto
4db0: 20 72 65 61 72 61 6e 67 69 6e 67 20 63 61 6e 20 rearanging can
4dc0: 62 65 20 64 6f 6e 65 0a 09 09 09 20 28 3e 20 28 be done.... (> (
4dd0: 2a 20 33 20 28 2b 20 62 6f 78 77 20 67 61 70 78 * 3 (+ boxw gapx
4de0: 29 29 20 28 2d 20 75 72 78 20 78 74 6f 72 69 67 )) (- urx xtorig
4df0: 29 29 0a 09 09 09 20 28 3c 20 75 72 78 20 28 2d )).... (< urx (-
4e00: 20 73 69 7a 65 78 20 62 6f 78 77 20 67 61 70 78 sizex boxw gapx
4e10: 20 62 6f 78 77 29 29 29 29 29 20 20 3b 3b 20 69 boxw))))) ;; i
4e20: 73 20 74 68 65 72 65 20 72 6f 6f 6d 20 66 6f 72 s there room for
4e30: 20 61 6e 6f 74 68 65 72 20 63 6f 6c 75 6d 6e 3f another column?
4e40: 0a 09 09 28 6c 6f 6f 70 20 28 63 61 72 20 74 61 ...(loop (car ta
4e50: 6c 29 0a 09 09 20 20 20 20 20 20 28 63 64 72 20 l)... (cdr
4e60: 74 61 6c 29 0a 09 09 20 20 20 20 20 20 28 69 66 tal)... (if
4e70: 20 68 61 76 65 2d 72 6f 6f 6d 20 28 2b 20 6c 6c have-room (+ ll
4e80: 78 20 62 6f 78 77 20 67 61 70 78 29 20 78 74 6f x boxw gapx) xto
4e90: 72 69 67 29 20 3b 3b 20 68 61 76 65 20 72 6f 6f rig) ;; have roo
4ea0: 6d 2c 20 0a 09 09 20 20 20 20 20 20 28 69 66 20 m, ... (if
4eb0: 68 61 76 65 2d 72 6f 6f 6d 20 6c 6c 79 20 28 2b have-room lly (+
4ec0: 20 6c 6c 79 20 62 6f 78 68 20 67 61 70 79 29 29 lly boxh gapy))
4ed0: 0a 09 09 20 20 20 20 20 20 28 69 66 20 68 61 76 ... (if hav
4ee0: 65 2d 72 6f 6f 6d 20 28 2b 20 75 72 78 20 62 6f e-room (+ urx bo
4ef0: 78 77 20 67 61 70 78 29 20 28 2b 20 78 74 6f 72 xw gapx) (+ xtor
4f00: 69 67 20 62 6f 78 77 29 29 0a 09 09 20 20 20 20 ig boxw))...
4f10: 20 20 28 69 66 20 68 61 76 65 2d 72 6f 6f 6d 20 (if have-room
4f20: 75 72 79 20 28 2b 20 75 72 79 20 62 6f 78 68 20 ury (+ ury boxh
4f30: 67 61 70 79 29 29 29 29 29 29 29 29 29 0a 0a 28 gapy)))))))))..(
4f40: 64 65 66 69 6e 65 20 28 64 61 73 68 62 6f 61 72 define (dashboar
4f50: 64 3a 72 75 6e 2d 63 6f 6e 74 72 6f 6c 73 29 0a d:run-controls).
4f60: 20 20 28 6c 65 74 2a 20 28 28 74 61 72 67 65 74 (let* ((target
4f70: 73 20 20 20 20 20 20 20 28 6d 61 6b 65 2d 68 61 s (make-ha
4f80: 73 68 2d 74 61 62 6c 65 29 29 0a 09 20 28 72 75 sh-table)).. (ru
4f90: 6e 63 6f 6e 66 2d 74 61 72 67 73 20 28 63 6f 6d nconf-targs (com
4fa0: 6d 6f 6e 3a 67 65 74 2d 72 75 6e 63 6f 6e 66 69 mon:get-runconfi
4fb0: 67 2d 74 61 72 67 65 74 73 29 29 0a 09 20 28 74 g-targets)).. (t
4fc0: 65 73 74 2d 72 65 63 6f 72 64 73 20 20 28 6d 61 est-records (ma
4fd0: 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 0a ke-hash-table)).
4fe0: 09 20 28 74 65 73 74 2d 6e 61 6d 65 73 20 20 20 . (test-names
4ff0: 20 28 74 65 73 74 73 3a 67 65 74 2d 76 61 6c 69 (tests:get-vali
5000: 64 2d 74 65 73 74 73 20 2a 74 6f 70 70 61 74 68 d-tests *toppath
5010: 2a 20 27 28 29 29 29 0a 09 20 28 73 6f 72 74 65 * '())).. (sorte
5020: 64 2d 74 65 73 74 6e 61 6d 65 73 20 23 66 29 0a d-testnames #f).
5030: 09 20 28 61 63 74 69 6f 6e 20 20 20 20 20 20 20 . (action
5040: 20 22 2d 72 75 6e 74 65 73 74 73 22 29 0a 09 20 "-runtests")..
5050: 28 63 6d 64 6c 6e 20 20 20 20 20 20 20 20 20 22 (cmdln "
5060: 22 29 0a 09 20 28 72 75 6e 6c 6f 67 73 20 20 20 ").. (runlogs
5070: 20 20 20 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 (make-hash-t
5080: 61 62 6c 65 29 29 0a 09 20 28 6b 65 79 2d 6c 69 able)).. (key-li
5090: 73 74 62 6f 78 65 73 20 23 66 29 0a 09 20 28 75 stboxes #f).. (u
50a0: 70 64 61 74 65 2d 6b 65 79 76 61 6c 73 20 28 6c pdate-keyvals (l
50b0: 61 6d 62 64 61 20 28 6f 62 6a 20 62 20 63 20 64 ambda (obj b c d
50c0: 29 0a 09 09 09 20 20 20 3b 3b 20 28 70 72 69 6e ).... ;; (prin
50d0: 74 20 22 6f 62 6a 3a 20 22 20 6f 62 6a 20 22 2c t "obj: " obj ",
50e0: 20 62 20 22 20 62 20 22 2c 20 63 20 22 20 63 20 b " b ", c " c
50f0: 22 2c 20 64 20 22 20 64 29 0a 09 09 09 20 20 20 ", d " d)....
5100: 28 64 61 73 68 62 6f 61 72 64 3a 75 70 64 61 74 (dashboard:updat
5110: 65 2d 74 61 72 67 65 74 2d 73 65 6c 65 63 74 6f e-target-selecto
5120: 72 20 6b 65 79 2d 6c 69 73 74 62 6f 78 65 73 29 r key-listboxes)
5130: 0a 09 09 09 20 20 20 29 29 0a 09 20 28 74 65 73 .... )).. (tes
5140: 74 73 2d 64 72 61 77 2d 73 74 61 74 65 20 28 6d ts-draw-state (m
5150: 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 ake-hash-table))
5160: 29 20 3b 3b 20 75 73 65 20 66 6f 72 20 6b 65 65 ) ;; use for kee
5170: 70 69 6e 67 20 73 74 61 74 65 20 6f 66 20 74 68 ping state of th
5180: 65 20 74 65 73 74 20 63 61 6e 76 61 73 0a 20 20 e test canvas.
5190: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 (hash-table-se
51a0: 74 21 20 74 65 73 74 73 2d 64 72 61 77 2d 73 74 t! tests-draw-st
51b0: 61 74 65 20 27 66 69 72 73 74 2d 74 69 6d 65 20 ate 'first-time
51c0: 23 74 29 0a 20 20 20 20 28 68 61 73 68 2d 74 61 #t). (hash-ta
51d0: 62 6c 65 2d 73 65 74 21 20 74 65 73 74 73 2d 64 ble-set! tests-d
51e0: 72 61 77 2d 73 74 61 74 65 20 27 73 63 61 6c 65 raw-state 'scale
51f0: 66 20 38 29 0a 20 20 20 20 28 74 65 73 74 73 3a f 8). (tests:
5200: 67 65 74 2d 66 75 6c 6c 2d 64 61 74 61 20 74 65 get-full-data te
5210: 73 74 2d 6e 61 6d 65 73 20 74 65 73 74 2d 72 65 st-names test-re
5220: 63 6f 72 64 73 20 27 28 29 29 0a 20 20 20 20 28 cords '()). (
5230: 73 65 74 21 20 73 6f 72 74 65 64 2d 74 65 73 74 set! sorted-test
5240: 6e 61 6d 65 73 20 28 74 65 73 74 73 3a 73 6f 72 names (tests:sor
5250: 74 2d 62 79 2d 70 72 69 6f 72 69 74 79 2d 61 6e t-by-priority-an
5260: 64 2d 77 61 69 74 6f 6e 20 74 65 73 74 2d 72 65 d-waiton test-re
5270: 63 6f 72 64 73 29 29 0a 20 20 20 20 0a 20 20 20 cords)). .
5280: 20 3b 3b 20 72 65 66 65 72 20 74 6f 20 2a 6b 65 ;; refer to *ke
5290: 79 73 2a 2c 20 2a 64 62 6b 65 79 73 2a 20 66 6f ys*, *dbkeys* fo
52a0: 72 20 6b 65 79 73 0a 20 20 20 20 28 69 75 70 3a r keys. (iup:
52b0: 76 62 6f 78 0a 20 20 20 20 20 28 69 75 70 3a 68 vbox. (iup:h
52c0: 62 6f 78 0a 20 20 20 20 20 20 20 3b 3b 20 54 61 box. ;; Ta
52d0: 72 67 65 74 20 61 6e 64 20 61 63 74 69 6f 6e 0a rget and action.
52e0: 20 20 20 20 20 20 28 69 75 70 3a 66 72 61 6d 65 (iup:frame
52f0: 0a 20 20 20 20 20 20 20 23 3a 74 69 74 6c 65 20 . #:title
5300: 22 54 61 72 67 65 74 22 0a 20 20 20 20 20 20 20 "Target".
5310: 28 69 75 70 3a 76 62 6f 78 0a 20 20 20 20 20 20 (iup:vbox.
5320: 20 20 3b 3b 20 54 61 72 67 65 74 20 73 65 6c 65 ;; Target sele
5330: 63 74 6f 72 73 0a 20 20 20 20 20 20 20 20 28 61 ctors. (a
5340: 70 70 6c 79 20 69 75 70 3a 68 62 6f 78 0a 09 20 pply iup:hbox..
5350: 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 64 61 (let* ((da
5360: 74 20 20 20 20 20 20 28 64 61 73 68 62 6f 61 72 t (dashboar
5370: 64 3a 75 70 64 61 74 65 2d 74 61 72 67 65 74 2d d:update-target-
5380: 73 65 6c 65 63 74 6f 72 20 6b 65 79 2d 6c 69 73 selector key-lis
5390: 74 62 6f 78 65 73 20 61 63 74 69 6f 6e 2d 70 72 tboxes action-pr
53a0: 6f 63 3a 20 75 70 64 61 74 65 2d 6b 65 79 76 61 oc: update-keyva
53b0: 6c 73 29 29 0a 09 09 20 20 20 20 20 20 28 6b 65 ls))... (ke
53c0: 79 2d 6c 62 20 20 20 28 63 61 72 20 64 61 74 29 y-lb (car dat)
53d0: 29 0a 09 09 20 20 20 20 20 20 28 63 6f 6d 62 6f )... (combo
53e0: 73 20 20 20 28 63 61 64 72 20 64 61 74 29 29 29 s (cadr dat)))
53f0: 0a 09 09 20 28 73 65 74 21 20 6b 65 79 2d 6c 69 ... (set! key-li
5400: 73 74 62 6f 78 65 73 20 6b 65 79 2d 6c 62 29 0a stboxes key-lb).
5410: 09 09 20 63 6f 6d 62 6f 73 29 29 29 29 0a 20 20 .. combos)))).
5420: 20 20 20 20 28 69 75 70 3a 66 72 61 6d 65 0a 20 (iup:frame.
5430: 20 20 20 20 20 20 23 3a 74 69 74 6c 65 20 22 54 #:title "T
5440: 65 73 74 73 20 61 6e 64 20 54 61 73 6b 73 22 0a ests and Tasks".
5450: 20 20 20 20 20 20 20 28 69 75 70 3a 76 62 6f 78 (iup:vbox
5460: 0a 09 28 69 75 70 3a 63 61 6e 76 61 73 20 23 3a ..(iup:canvas #:
5470: 61 63 74 69 6f 6e 20 28 6d 61 6b 65 2d 63 61 6e action (make-can
5480: 76 61 73 2d 61 63 74 69 6f 6e 0a 09 09 09 20 20 vas-action....
5490: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 63 6e 76 (lambda (cnv
54a0: 20 78 61 64 6a 20 79 61 64 6a 29 0a 09 09 09 09 xadj yadj).....
54b0: 3b 3b 20 28 70 72 69 6e 74 20 22 63 6e 76 3a 20 ;; (print "cnv:
54c0: 22 20 63 6e 76 20 22 20 78 3a 20 22 20 78 20 22 " cnv " x: " x "
54d0: 20 79 3a 20 22 20 79 29 0a 09 09 09 09 28 64 61 y: " y).....(da
54e0: 73 68 62 6f 61 72 64 3a 64 72 61 77 2d 74 65 73 shboard:draw-tes
54f0: 74 73 20 63 6e 76 20 78 61 64 6a 20 79 61 64 6a ts cnv xadj yadj
5500: 20 74 65 73 74 73 2d 64 72 61 77 2d 73 74 61 74 tests-draw-stat
5510: 65 20 73 6f 72 74 65 64 2d 74 65 73 74 6e 61 6d e sorted-testnam
5520: 65 73 29 29 29 0a 09 09 20 20 20 20 23 3a 73 69 es)))... #:si
5530: 7a 65 20 22 31 35 30 78 31 35 30 22 0a 09 09 20 ze "150x150"...
5540: 20 20 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53 #:expand "YES
5550: 22 0a 09 09 20 20 20 20 23 3a 73 63 72 6f 6c 6c "... #:scroll
5560: 62 61 72 20 22 59 45 53 22 0a 09 09 20 20 20 20 bar "YES"...
5570: 23 3a 70 6f 73 78 20 22 30 2e 35 22 0a 09 09 20 #:posx "0.5"...
5580: 20 20 20 23 3a 70 6f 73 79 20 22 30 2e 35 22 29 #:posy "0.5")
5590: 29 29 29 29 29 29 0a 0a 0a 28 74 72 61 63 65 20 ))))))...(trace
55a0: 64 61 73 68 62 6f 61 72 64 3a 70 6f 70 75 6c 61 dashboard:popula
55b0: 74 65 2d 74 61 72 67 65 74 2d 64 72 6f 70 64 6f te-target-dropdo
55c0: 77 6e 0a 20 20 20 20 20 20 20 63 6f 6d 6d 6f 6e wn. common
55d0: 3a 6c 69 73 74 2d 69 73 2d 73 75 62 6c 69 73 74 :list-is-sublist
55e0: 29 0a 0a 3b 3b 20 20 20 20 20 20 20 3b 3b 20 6b )..;; ;; k
55f0: 65 79 31 20 6b 65 79 32 20 6b 65 79 33 20 2e 2e ey1 key2 key3 ..
5600: 2e 0a 3b 3b 20 20 20 20 20 20 20 3b 3b 20 74 61 ..;; ;; ta
5610: 72 67 65 74 20 65 6e 74 72 79 20 28 77 69 6c 64 rget entry (wild
5620: 20 63 61 72 64 73 20 61 6c 6c 6f 77 65 64 29 0a cards allowed).
5630: 3b 3b 20 20 20 20 20 20 20 0a 3b 3b 20 20 20 20 ;; .;;
5640: 20 20 20 3b 3b 20 54 68 65 20 61 63 74 69 6f 6e ;; The action
5650: 0a 3b 3b 20 20 20 20 20 20 20 28 69 75 70 3a 68 .;; (iup:h
5660: 62 6f 78 0a 3b 3b 20 20 20 20 20 20 20 20 3b 3b box.;; ;;
5670: 20 6c 61 62 65 6c 20 41 63 74 69 6f 6e 20 7c 20 label Action |
5680: 61 63 74 69 6f 6e 20 73 65 6c 65 63 74 6f 72 0a action selector.
5690: 3b 3b 20 20 20 20 20 20 20 20 29 29 0a 3b 3b 20 ;; )).;;
56a0: 20 20 20 20 20 3b 3b 20 54 65 73 74 2f 69 74 65 ;; Test/ite
56b0: 6d 73 20 73 65 6c 65 63 74 6f 72 0a 3b 3b 20 20 ms selector.;;
56c0: 20 20 20 20 28 69 75 70 3a 68 62 6f 78 0a 3b 3b (iup:hbox.;;
56d0: 20 20 20 20 20 20 20 3b 3b 20 74 65 73 74 73 0a ;; tests.
56e0: 3b 3b 20 20 20 20 20 20 20 3b 3b 20 69 74 65 6d ;; ;; item
56f0: 73 0a 3b 3b 20 20 20 20 20 20 20 29 29 0a 3b 3b s.;; )).;;
5700: 20 20 20 20 20 3b 3b 20 54 68 65 20 63 6f 6d 6d ;; The comm
5710: 61 6e 64 20 6c 69 6e 65 0a 3b 3b 20 20 20 20 20 and line.;;
5720: 28 69 75 70 3a 68 62 6f 78 0a 3b 3b 20 20 20 20 (iup:hbox.;;
5730: 20 20 3b 3b 20 63 6f 6d 6d 61 6e 64 6c 69 6e 65 ;; commandline
5740: 20 65 6e 74 72 79 0a 3b 3b 20 20 20 20 20 20 3b entry.;; ;
5750: 3b 20 47 4f 20 62 75 74 74 6f 6e 0a 3b 3b 20 20 ; GO button.;;
5760: 20 20 20 20 29 0a 3b 3b 20 20 20 20 20 3b 3b 20 ).;; ;;
5770: 54 68 65 20 63 6f 6d 6d 61 6e 64 20 6c 6f 67 20 The command log
5780: 6d 6f 6e 69 74 6f 72 0a 3b 3b 20 20 20 20 20 28 monitor.;; (
5790: 69 75 70 3a 74 61 62 73 0a 3b 3b 20 20 20 20 20 iup:tabs.;;
57a0: 20 3b 3b 20 6c 6f 67 20 6d 6f 6e 69 74 6f 72 0a ;; log monitor.
57b0: 3b 3b 20 20 20 20 20 20 29 29 29 0a 20 20 20 0a ;; ))). .
57c0: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
57d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
57e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
57f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5800: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 52 20 55 20 ========.;; R U
5810: 4e 20 53 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d N S .;;=========
5820: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5830: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5840: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5850: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 =============..(
5860: 64 65 66 69 6e 65 20 28 6d 61 6b 65 2d 64 61 73 define (make-das
5870: 68 62 6f 61 72 64 2d 62 75 74 74 6f 6e 73 20 6e hboard-buttons n
5880: 72 75 6e 73 20 6e 74 65 73 74 73 20 6b 65 79 6e runs ntests keyn
5890: 61 6d 65 73 29 0a 20 20 28 6c 65 74 2a 20 28 28 ames). (let* ((
58a0: 6e 6b 65 79 73 20 20 20 28 6c 65 6e 67 74 68 20 nkeys (length
58b0: 6b 65 79 6e 61 6d 65 73 29 29 0a 09 20 28 72 75 keynames)).. (ru
58c0: 6e 73 76 65 63 20 28 6d 61 6b 65 2d 76 65 63 74 nsvec (make-vect
58d0: 6f 72 20 6e 72 75 6e 73 29 29 0a 09 20 28 68 65 or nruns)).. (he
58e0: 61 64 65 72 20 20 28 6d 61 6b 65 2d 76 65 63 74 ader (make-vect
58f0: 6f 72 20 6e 72 75 6e 73 29 29 0a 09 20 28 6c 66 or nruns)).. (lf
5900: 74 63 6f 6c 20 20 28 6d 61 6b 65 2d 76 65 63 74 tcol (make-vect
5910: 6f 72 20 6e 74 65 73 74 73 29 29 0a 09 20 28 6b or ntests)).. (k
5920: 65 79 63 6f 6c 20 20 28 6d 61 6b 65 2d 76 65 63 eycol (make-vec
5930: 74 6f 72 20 6e 74 65 73 74 73 29 29 0a 09 20 28 tor ntests)).. (
5940: 63 6f 6e 74 72 6f 6c 73 20 27 28 29 29 0a 09 20 controls '())..
5950: 28 6c 66 74 6c 73 74 20 20 27 28 29 29 0a 09 20 (lftlst '())..
5960: 28 68 64 72 6c 73 74 20 20 27 28 29 29 0a 09 20 (hdrlst '())..
5970: 28 62 64 79 6c 73 74 20 20 27 28 29 29 0a 09 20 (bdylst '())..
5980: 28 72 65 73 75 6c 74 20 20 27 28 29 29 0a 09 20 (result '())..
5990: 28 69 20 20 20 20 20 20 20 30 29 29 0a 20 20 20 (i 0)).
59a0: 20 3b 3b 20 63 6f 6e 74 72 6f 6c 73 20 28 61 6c ;; controls (al
59b0: 6f 6e 67 20 62 6f 74 74 6f 6d 29 0a 20 20 20 20 ong bottom).
59c0: 28 73 65 74 21 20 63 6f 6e 74 72 6f 6c 73 0a 09 (set! controls..
59d0: 20 20 28 69 75 70 3a 68 62 6f 78 0a 09 20 20 20 (iup:hbox..
59e0: 28 69 75 70 3a 76 62 6f 78 0a 09 20 20 20 20 28 (iup:vbox.. (
59f0: 69 75 70 3a 66 72 61 6d 65 20 0a 09 20 20 20 20 iup:frame ..
5a00: 20 23 3a 74 69 74 6c 65 20 22 66 69 6c 74 65 72 #:title "filter
5a10: 20 74 65 73 74 20 61 6e 64 20 69 74 65 6d 73 22 test and items"
5a20: 0a 09 20 20 20 20 20 28 69 75 70 3a 68 62 6f 78 .. (iup:hbox
5a30: 0a 09 20 20 20 20 20 20 28 69 75 70 3a 74 65 78 .. (iup:tex
5a40: 74 62 6f 78 20 23 3a 73 69 7a 65 20 22 31 32 30 tbox #:size "120
5a50: 78 31 35 22 20 23 3a 66 6f 6e 74 73 69 7a 65 20 x15" #:fontsize
5a60: 22 31 30 22 20 23 3a 76 61 6c 75 65 20 22 25 22 "10" #:value "%"
5a70: 0a 09 09 09 20 20 20 23 3a 61 63 74 69 6f 6e 20 .... #:action
5a80: 28 6c 61 6d 62 64 61 20 28 6f 62 6a 20 75 6e 6b (lambda (obj unk
5a90: 20 76 61 6c 29 0a 09 09 09 09 20 20 20 20 20 20 val).....
5aa0: 28 6d 61 72 6b 2d 66 6f 72 2d 75 70 64 61 74 65 (mark-for-update
5ab0: 29 0a 09 09 09 09 20 20 20 20 20 20 28 75 70 64 )..... (upd
5ac0: 61 74 65 2d 73 65 61 72 63 68 20 22 74 65 73 74 ate-search "test
5ad0: 2d 6e 61 6d 65 22 20 76 61 6c 29 29 29 0a 09 20 -name" val)))..
5ae0: 20 20 20 20 20 3b 3b 28 69 75 70 3a 74 65 78 74 ;;(iup:text
5af0: 62 6f 78 20 23 3a 73 69 7a 65 20 22 36 30 78 31 box #:size "60x1
5b00: 35 22 20 23 3a 66 6f 6e 74 73 69 7a 65 20 22 31 5" #:fontsize "1
5b10: 30 22 20 23 3a 76 61 6c 75 65 20 22 25 22 0a 09 0" #:value "%"..
5b20: 20 20 20 20 20 20 3b 3b 20 20 09 20 20 20 23 3a ;; . #:
5b30: 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 action (lambda (
5b40: 6f 62 6a 20 75 6e 6b 20 76 61 6c 29 0a 09 20 20 obj unk val)..
5b50: 20 20 20 20 3b 3b 20 20 09 09 20 20 20 20 20 20 ;; ..
5b60: 28 6d 61 72 6b 2d 66 6f 72 2d 75 70 64 61 74 65 (mark-for-update
5b70: 29 0a 09 20 20 20 20 20 20 3b 3b 20 20 09 09 20 ).. ;; ..
5b80: 20 20 20 20 20 28 75 70 64 61 74 65 2d 73 65 61 (update-sea
5b90: 72 63 68 20 22 69 74 65 6d 2d 6e 61 6d 65 22 20 rch "item-name"
5ba0: 76 61 6c 29 29 0a 09 20 20 20 20 20 20 29 29 0a val)).. )).
5bb0: 09 20 20 20 20 28 69 75 70 3a 76 62 6f 78 0a 09 . (iup:vbox..
5bc0: 20 20 20 20 20 28 69 75 70 3a 68 62 6f 78 0a 09 (iup:hbox..
5bd0: 20 20 20 20 20 20 28 69 75 70 3a 62 75 74 74 6f (iup:butto
5be0: 6e 20 22 53 6f 72 74 22 20 23 3a 61 63 74 69 6f n "Sort" #:actio
5bf0: 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 29 0a n (lambda (obj).
5c00: 09 09 09 09 09 20 20 20 20 28 73 65 74 21 20 2a ..... (set! *
5c10: 74 65 73 74 73 2d 73 6f 72 74 2d 72 65 76 65 72 tests-sort-rever
5c20: 73 65 2a 20 28 6e 6f 74 20 2a 74 65 73 74 73 2d se* (not *tests-
5c30: 73 6f 72 74 2d 72 65 76 65 72 73 65 2a 29 29 0a sort-reverse*)).
5c40: 09 09 09 09 09 20 20 20 20 28 69 75 70 3a 61 74 ..... (iup:at
5c50: 74 72 69 62 75 74 65 2d 73 65 74 21 20 6f 62 6a tribute-set! obj
5c60: 20 22 54 49 54 4c 45 22 20 28 69 66 20 2a 74 65 "TITLE" (if *te
5c70: 73 74 73 2d 73 6f 72 74 2d 72 65 76 65 72 73 65 sts-sort-reverse
5c80: 2a 20 22 2b 53 6f 72 74 22 20 22 2d 53 6f 72 74 * "+Sort" "-Sort
5c90: 22 29 29 0a 09 09 09 09 09 20 20 20 20 28 6d 61 "))...... (ma
5ca0: 72 6b 2d 66 6f 72 2d 75 70 64 61 74 65 29 29 29 rk-for-update)))
5cb0: 0a 09 20 20 20 20 20 20 28 69 75 70 3a 62 75 74 .. (iup:but
5cc0: 74 6f 6e 20 22 48 69 64 65 45 6d 70 74 79 22 20 ton "HideEmpty"
5cd0: 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 #:action (lambda
5ce0: 20 28 6f 62 6a 29 0a 09 09 09 09 09 09 20 28 73 (obj)....... (s
5cf0: 65 74 21 20 2a 68 69 64 65 2d 65 6d 70 74 79 2d et! *hide-empty-
5d00: 72 75 6e 73 2a 20 28 6e 6f 74 20 2a 68 69 64 65 runs* (not *hide
5d10: 2d 65 6d 70 74 79 2d 72 75 6e 73 2a 29 29 0a 09 -empty-runs*))..
5d20: 09 09 09 09 09 20 28 69 75 70 3a 61 74 74 72 69 ..... (iup:attri
5d30: 62 75 74 65 2d 73 65 74 21 20 6f 62 6a 20 22 54 bute-set! obj "T
5d40: 49 54 4c 45 22 20 28 69 66 20 2a 68 69 64 65 2d ITLE" (if *hide-
5d50: 65 6d 70 74 79 2d 72 75 6e 73 2a 20 22 2b 48 69 empty-runs* "+Hi
5d60: 64 65 22 20 22 2d 48 69 64 65 22 29 29 0a 09 09 de" "-Hide"))...
5d70: 09 09 09 09 20 28 6d 61 72 6b 2d 66 6f 72 2d 75 .... (mark-for-u
5d80: 70 64 61 74 65 29 29 29 0a 09 20 20 20 20 20 20 pdate)))..
5d90: 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 52 65 66 (iup:button "Ref
5da0: 72 65 73 68 22 20 20 20 23 3a 61 63 74 69 6f 6e resh" #:action
5db0: 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 29 0a 09 (lambda (obj)..
5dc0: 09 09 09 09 09 20 28 6d 61 72 6b 2d 66 6f 72 2d ..... (mark-for-
5dd0: 75 70 64 61 74 65 29 29 29 29 0a 09 20 20 20 20 update))))..
5de0: 20 28 69 75 70 3a 68 62 6f 78 0a 09 20 20 20 20 (iup:hbox..
5df0: 20 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 51 (iup:button "Q
5e00: 75 69 74 22 20 23 3a 61 63 74 69 6f 6e 20 28 6c uit" #:action (l
5e10: 61 6d 62 64 61 20 28 6f 62 6a 29 28 69 66 20 2a ambda (obj)(if *
5e20: 64 62 2a 20 28 73 71 6c 69 74 65 33 3a 66 69 6e db* (sqlite3:fin
5e30: 61 6c 69 7a 65 21 20 2a 64 62 2a 29 29 28 65 78 alize! *db*))(ex
5e40: 69 74 29 29 29 0a 09 20 20 20 20 20 20 28 69 75 it))).. (iu
5e50: 70 3a 62 75 74 74 6f 6e 20 22 4d 6f 6e 69 74 6f p:button "Monito
5e60: 72 22 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d r" #:action (lam
5e70: 62 64 61 20 28 6f 62 6a 29 28 73 79 73 74 65 6d bda (obj)(system
5e80: 20 28 63 6f 6e 63 20 28 63 61 72 20 28 61 72 67 (conc (car (arg
5e90: 76 29 29 22 20 2d 67 75 69 6d 6f 6e 69 74 6f 72 v))" -guimonitor
5ea0: 20 26 22 29 29 29 29 29 0a 09 20 20 20 20 20 29 &"))))).. )
5eb0: 29 0a 09 20 20 20 3b 3b 20 28 69 75 70 3a 62 75 ).. ;; (iup:bu
5ec0: 74 74 6f 6e 20 22 3c 2d 20 20 4c 65 66 74 22 20 tton "<- Left"
5ed0: 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 #:action (lambda
5ee0: 20 28 6f 62 6a 29 28 73 65 74 21 20 2a 73 74 61 (obj)(set! *sta
5ef0: 72 74 2d 72 75 6e 2d 6f 66 66 73 65 74 2a 20 20 rt-run-offset*
5f00: 28 2b 20 2a 73 74 61 72 74 2d 72 75 6e 2d 6f 66 (+ *start-run-of
5f10: 66 73 65 74 2a 20 31 29 29 29 29 0a 09 20 20 20 fset* 1))))..
5f20: 3b 3b 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 ;; (iup:button "
5f30: 55 70 20 20 20 20 20 5e 22 20 23 3a 61 63 74 69 Up ^" #:acti
5f40: 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 29 on (lambda (obj)
5f50: 28 73 65 74 21 20 2a 73 74 61 72 74 2d 74 65 73 (set! *start-tes
5f60: 74 2d 6f 66 66 73 65 74 2a 20 28 69 66 20 28 3e t-offset* (if (>
5f70: 20 2a 73 74 61 72 74 2d 74 65 73 74 2d 6f 66 66 *start-test-off
5f80: 73 65 74 2a 20 30 29 28 2d 20 2a 73 74 61 72 74 set* 0)(- *start
5f90: 2d 74 65 73 74 2d 6f 66 66 73 65 74 2a 20 31 29 -test-offset* 1)
5fa0: 20 30 29 29 29 29 0a 09 20 20 20 3b 3b 20 28 69 0)))).. ;; (i
5fb0: 75 70 3a 62 75 74 74 6f 6e 20 22 44 6f 77 6e 20 up:button "Down
5fc0: 20 20 76 22 20 23 3a 61 63 74 69 6f 6e 20 28 6c v" #:action (l
5fd0: 61 6d 62 64 61 20 28 6f 62 6a 29 28 73 65 74 21 ambda (obj)(set!
5fe0: 20 2a 73 74 61 72 74 2d 74 65 73 74 2d 6f 66 66 *start-test-off
5ff0: 73 65 74 2a 20 28 69 66 20 28 3e 3d 20 2a 73 74 set* (if (>= *st
6000: 61 72 74 2d 74 65 73 74 2d 6f 66 66 73 65 74 2a art-test-offset*
6010: 20 28 6c 65 6e 67 74 68 20 2a 61 6c 6c 74 65 73 (length *alltes
6020: 74 6e 61 6d 65 6c 73 74 2a 29 29 28 6c 65 6e 67 tnamelst*))(leng
6030: 74 68 20 2a 61 6c 6c 74 65 73 74 6e 61 6d 65 6c th *alltestnamel
6040: 73 74 2a 29 28 2b 20 2a 73 74 61 72 74 2d 74 65 st*)(+ *start-te
6050: 73 74 2d 6f 66 66 73 65 74 2a 20 31 29 29 29 29 st-offset* 1))))
6060: 29 0a 09 20 20 20 3b 3b 20 28 69 75 70 3a 62 75 ).. ;; (iup:bu
6070: 74 74 6f 6e 20 22 52 69 67 68 74 20 2d 3e 22 20 tton "Right ->"
6080: 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 #:action (lambda
6090: 20 28 6f 62 6a 29 28 73 65 74 21 20 2a 73 74 61 (obj)(set! *sta
60a0: 72 74 2d 72 75 6e 2d 6f 66 66 73 65 74 2a 20 20 rt-run-offset*
60b0: 28 69 66 20 28 3e 20 2a 73 74 61 72 74 2d 72 75 (if (> *start-ru
60c0: 6e 2d 6f 66 66 73 65 74 2a 20 30 29 28 2d 20 2a n-offset* 0)(- *
60d0: 73 74 61 72 74 2d 72 75 6e 2d 6f 66 66 73 65 74 start-run-offset
60e0: 2a 20 31 29 20 30 29 29 29 29 0a 09 20 20 20 28 * 1) 0)))).. (
60f0: 69 75 70 3a 66 72 61 6d 65 20 0a 09 20 20 20 20 iup:frame ..
6100: 23 3a 74 69 74 6c 65 20 22 68 69 64 65 22 0a 09 #:title "hide"..
6110: 20 20 20 20 28 69 75 70 3a 76 62 6f 78 0a 09 20 (iup:vbox..
6120: 20 20 20 20 28 61 70 70 6c 79 20 0a 09 20 20 20 (apply ..
6130: 20 20 20 69 75 70 3a 68 62 6f 78 0a 09 20 20 20 iup:hbox..
6140: 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 (map (lambda
6150: 28 73 74 61 74 75 73 29 0a 09 09 20 20 20 20 20 (status)...
6160: 28 69 75 70 3a 74 6f 67 67 6c 65 20 73 74 61 74 (iup:toggle stat
6170: 75 73 20 20 23 3a 61 63 74 69 6f 6e 20 20 20 28 us #:action (
6180: 6c 61 6d 62 64 61 20 28 6f 62 6a 20 76 61 6c 29 lambda (obj val)
6190: 0a 09 09 09 09 09 09 20 20 20 20 20 20 28 6d 61 ....... (ma
61a0: 72 6b 2d 66 6f 72 2d 75 70 64 61 74 65 29 0a 09 rk-for-update)..
61b0: 09 09 09 09 09 20 20 20 20 20 20 28 69 66 20 28 ..... (if (
61c0: 65 71 3f 20 76 61 6c 20 31 29 0a 09 09 09 09 09 eq? val 1)......
61d0: 09 09 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d .. (hash-table-
61e0: 73 65 74 21 20 2a 73 74 61 74 75 73 2d 69 67 6e set! *status-ign
61f0: 6f 72 65 2d 68 61 73 68 2a 20 73 74 61 74 75 73 ore-hash* status
6200: 20 23 74 29 0a 09 09 09 09 09 09 09 20 20 28 68 #t)........ (h
6210: 61 73 68 2d 74 61 62 6c 65 2d 64 65 6c 65 74 65 ash-table-delete
6220: 21 20 2a 73 74 61 74 75 73 2d 69 67 6e 6f 72 65 ! *status-ignore
6230: 2d 68 61 73 68 2a 20 73 74 61 74 75 73 29 29 29 -hash* status)))
6240: 29 29 0a 09 20 20 20 20 20 20 27 28 22 50 41 53 )).. '("PAS
6250: 53 22 20 22 46 41 49 4c 22 20 22 57 41 52 4e 22 S" "FAIL" "WARN"
6260: 20 22 43 48 45 43 4b 22 20 22 57 41 49 56 45 44 "CHECK" "WAIVED
6270: 22 20 22 53 54 55 43 4b 2f 44 45 41 44 22 20 22 " "STUCK/DEAD" "
6280: 6e 2f 61 22 20 22 53 4b 49 50 22 29 29 29 0a 09 n/a" "SKIP")))..
6290: 20 20 20 20 20 28 61 70 70 6c 79 20 0a 09 20 20 (apply ..
62a0: 20 20 20 20 69 75 70 3a 68 62 6f 78 0a 09 20 20 iup:hbox..
62b0: 20 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 (map (lambda
62c0: 20 28 73 74 61 74 65 29 0a 09 09 20 20 20 20 20 (state)...
62d0: 28 69 75 70 3a 74 6f 67 67 6c 65 20 73 74 61 74 (iup:toggle stat
62e0: 65 20 20 20 23 3a 61 63 74 69 6f 6e 20 20 20 28 e #:action (
62f0: 6c 61 6d 62 64 61 20 28 6f 62 6a 20 76 61 6c 29 lambda (obj val)
6300: 0a 09 09 09 09 09 09 20 20 20 20 20 20 28 6d 61 ....... (ma
6310: 72 6b 2d 66 6f 72 2d 75 70 64 61 74 65 29 0a 09 rk-for-update)..
6320: 09 09 09 09 09 20 20 20 20 20 20 28 69 66 20 28 ..... (if (
6330: 65 71 3f 20 76 61 6c 20 31 29 0a 09 09 09 09 09 eq? val 1)......
6340: 09 09 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d .. (hash-table-
6350: 73 65 74 21 20 2a 73 74 61 74 65 2d 69 67 6e 6f set! *state-igno
6360: 72 65 2d 68 61 73 68 2a 20 73 74 61 74 65 20 23 re-hash* state #
6370: 74 29 0a 09 09 09 09 09 09 09 20 20 28 68 61 73 t)........ (has
6380: 68 2d 74 61 62 6c 65 2d 64 65 6c 65 74 65 21 20 h-table-delete!
6390: 2a 73 74 61 74 65 2d 69 67 6e 6f 72 65 2d 68 61 *state-ignore-ha
63a0: 73 68 2a 20 73 74 61 74 65 29 29 29 29 29 0a 09 sh* state)))))..
63b0: 09 20 20 20 27 28 22 52 55 4e 4e 49 4e 47 22 20 . '("RUNNING"
63c0: 22 43 4f 4d 50 4c 45 54 45 44 22 20 22 49 4e 43 "COMPLETED" "INC
63d0: 4f 4d 50 4c 45 54 45 22 20 22 4c 41 55 4e 43 48 OMPLETE" "LAUNCH
63e0: 45 44 22 20 22 4e 4f 54 5f 53 54 41 52 54 45 44 ED" "NOT_STARTED
63f0: 22 20 22 4b 49 4c 4c 45 44 22 20 22 44 45 4c 45 " "KILLED" "DELE
6400: 54 45 44 22 29 29 29 0a 09 20 20 20 20 20 28 69 TED"))).. (i
6410: 75 70 3a 76 61 6c 75 61 74 6f 72 20 23 3a 76 61 up:valuator #:va
6420: 6c 75 65 63 68 61 6e 67 65 64 5f 63 62 20 28 6c luechanged_cb (l
6430: 61 6d 62 64 61 20 28 6f 62 6a 29 0a 09 09 09 09 ambda (obj).....
6440: 09 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 76 . (let ((v
6450: 61 6c 20 28 69 6e 65 78 61 63 74 2d 3e 65 78 61 al (inexact->exa
6460: 63 74 20 28 72 6f 75 6e 64 20 28 2f 20 28 73 74 ct (round (/ (st
6470: 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 69 75 ring->number (iu
6480: 70 3a 61 74 74 72 69 62 75 74 65 20 6f 62 6a 20 p:attribute obj
6490: 22 56 41 4c 55 45 22 29 29 20 31 30 29 29 29 29 "VALUE")) 10))))
64a0: 0a 09 09 09 09 09 09 20 20 20 20 20 28 6f 6c 64 ....... (old
64b0: 6d 61 78 20 20 20 28 73 74 72 69 6e 67 2d 3e 6e max (string->n
64c0: 75 6d 62 65 72 20 28 69 75 70 3a 61 74 74 72 69 umber (iup:attri
64d0: 62 75 74 65 20 6f 62 6a 20 22 4d 41 58 22 29 29 bute obj "MAX"))
64e0: 29 0a 09 09 09 09 09 09 20 20 20 20 20 28 6d 61 )....... (ma
64f0: 78 72 75 6e 73 20 20 2a 74 6f 74 2d 72 75 6e 2d xruns *tot-run-
6500: 63 6f 75 6e 74 2a 29 29 0a 09 09 09 09 09 09 20 count*)).......
6510: 28 73 65 74 21 20 2a 73 74 61 72 74 2d 72 75 6e (set! *start-run
6520: 2d 6f 66 66 73 65 74 2a 20 76 61 6c 29 0a 09 09 -offset* val)...
6530: 09 09 09 09 20 28 6d 61 72 6b 2d 66 6f 72 2d 75 .... (mark-for-u
6540: 70 64 61 74 65 29 0a 09 09 09 09 09 09 20 28 64 pdate)....... (d
6550: 65 62 75 67 3a 70 72 69 6e 74 20 36 20 22 2a 73 ebug:print 6 "*s
6560: 74 61 72 74 2d 72 75 6e 2d 6f 66 66 73 65 74 2a tart-run-offset*
6570: 20 22 20 2a 73 74 61 72 74 2d 72 75 6e 2d 6f 66 " *start-run-of
6580: 66 73 65 74 2a 20 22 20 6d 61 78 72 75 6e 73 3a fset* " maxruns:
6590: 20 22 20 6d 61 78 72 75 6e 73 20 22 2c 20 76 61 " maxruns ", va
65a0: 6c 3a 20 22 20 76 61 6c 20 22 20 6f 6c 64 6d 61 l: " val " oldma
65b0: 78 3a 20 22 20 6f 6c 64 6d 61 78 29 0a 09 09 09 x: " oldmax)....
65c0: 09 09 09 20 28 69 75 70 3a 61 74 74 72 69 62 75 ... (iup:attribu
65d0: 74 65 2d 73 65 74 21 20 6f 62 6a 20 22 4d 41 58 te-set! obj "MAX
65e0: 22 20 28 2a 20 6d 61 78 72 75 6e 73 20 31 30 29 " (* maxruns 10)
65f0: 29 29 29 0a 09 09 09 20 20 20 23 3a 65 78 70 61 ))).... #:expa
6600: 6e 64 20 22 59 45 53 22 0a 09 09 09 20 20 20 23 nd "YES".... #
6610: 3a 6d 61 78 20 28 2a 20 31 30 20 28 6c 65 6e 67 :max (* 10 (leng
6620: 74 68 20 2a 61 6c 6c 72 75 6e 73 2a 29 29 29 29 th *allruns*))))
6630: 29 0a 09 20 20 20 3b 28 69 75 70 3a 62 75 74 74 ).. ;(iup:butt
6640: 6f 6e 20 22 69 6e 63 20 72 6f 77 73 22 20 23 3a on "inc rows" #:
6650: 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 action (lambda (
6660: 6f 62 6a 29 28 73 65 74 21 20 2a 6e 75 6d 2d 74 obj)(set! *num-t
6670: 65 73 74 73 2a 20 28 2b 20 2a 6e 75 6d 2d 74 65 ests* (+ *num-te
6680: 73 74 73 2a 20 31 29 29 29 29 0a 09 20 20 20 3b sts* 1)))).. ;
6690: 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 64 65 63 (iup:button "dec
66a0: 20 72 6f 77 73 22 20 23 3a 61 63 74 69 6f 6e 20 rows" #:action
66b0: 28 6c 61 6d 62 64 61 20 28 6f 62 6a 29 28 73 65 (lambda (obj)(se
66c0: 74 21 20 2a 6e 75 6d 2d 74 65 73 74 73 2a 20 28 t! *num-tests* (
66d0: 69 66 20 28 3e 20 2a 6e 75 6d 2d 74 65 73 74 73 if (> *num-tests
66e0: 2a 20 30 29 28 2d 20 2a 6e 75 6d 2d 74 65 73 74 * 0)(- *num-test
66f0: 73 2a 20 31 29 20 30 29 29 29 29 0a 09 20 20 20 s* 1) 0))))..
6700: 29 0a 09 20 20 29 0a 20 20 20 20 0a 20 20 20 20 ).. ). .
6710: 3b 3b 20 63 72 65 61 74 65 20 74 68 65 20 6c 65 ;; create the le
6720: 66 74 20 6d 6f 73 74 20 63 6f 6c 75 6d 6e 20 66 ft most column f
6730: 6f 72 20 74 68 65 20 72 75 6e 20 6b 65 79 20 6e or the run key n
6740: 61 6d 65 73 20 61 6e 64 20 74 68 65 20 74 65 73 ames and the tes
6750: 74 20 6e 61 6d 65 73 20 0a 20 20 20 20 28 73 65 t names . (se
6760: 74 21 20 6c 66 74 6c 73 74 20 28 6c 69 73 74 20 t! lftlst (list
6770: 28 69 75 70 3a 68 62 6f 78 0a 09 09 09 28 69 75 (iup:hbox....(iu
6780: 70 3a 6c 61 62 65 6c 29 20 3b 3b 20 28 69 75 70 p:label) ;; (iup
6790: 3a 76 61 6c 75 61 74 6f 72 29 0a 09 09 09 28 61 :valuator)....(a
67a0: 70 70 6c 79 20 69 75 70 3a 76 62 6f 78 20 0a 09 pply iup:vbox ..
67b0: 09 09 20 20 20 20 20 20 20 28 6d 61 70 20 28 6c .. (map (l
67c0: 61 6d 62 64 61 20 28 78 29 09 09 0a 09 09 09 09 ambda (x).......
67d0: 20 20 20 20 20 20 28 6c 65 74 20 28 28 72 65 73 (let ((res
67e0: 20 28 69 75 70 3a 68 62 6f 78 20 23 3a 65 78 70 (iup:hbox #:exp
67f0: 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 and "HORIZONTAL"
6800: 0a 09 09 09 09 09 09 20 20 28 69 75 70 3a 6c 61 ....... (iup:la
6810: 62 65 6c 20 78 20 23 3a 73 69 7a 65 20 22 78 31 bel x #:size "x1
6820: 35 22 20 23 3a 66 6f 6e 74 73 69 7a 65 20 22 31 5" #:fontsize "1
6830: 30 22 20 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 0" #:expand "HOR
6840: 49 5a 4f 4e 54 41 4c 22 29 0a 09 09 09 09 09 09 IZONTAL").......
6850: 20 20 28 69 75 70 3a 74 65 78 74 62 6f 78 20 23 (iup:textbox #
6860: 3a 73 69 7a 65 20 22 78 31 35 22 20 23 3a 66 6f :size "x15" #:fo
6870: 6e 74 73 69 7a 65 20 22 31 30 22 20 23 3a 76 61 ntsize "10" #:va
6880: 6c 75 65 20 22 25 22 20 23 3a 65 78 70 61 6e 64 lue "%" #:expand
6890: 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 0a 09 09 "HORIZONTAL"...
68a0: 09 09 09 09 09 20 20 20 20 20 20 20 23 3a 61 63 ..... #:ac
68b0: 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 tion (lambda (ob
68c0: 6a 20 75 6e 6b 20 76 61 6c 29 0a 09 09 09 09 09 j unk val)......
68d0: 09 09 09 09 20 20 28 6d 61 72 6b 2d 66 6f 72 2d .... (mark-for-
68e0: 75 70 64 61 74 65 29 0a 09 09 09 09 09 09 09 09 update).........
68f0: 09 20 20 28 75 70 64 61 74 65 2d 73 65 61 72 63 . (update-searc
6900: 68 20 78 20 76 61 6c 29 29 29 29 29 29 0a 09 09 h x val))))))...
6910: 09 09 09 28 73 65 74 21 20 69 20 28 2b 20 69 20 ...(set! i (+ i
6920: 31 29 29 0a 09 09 09 09 09 72 65 73 29 29 0a 09 1))......res))..
6930: 09 09 09 20 20 20 20 6b 65 79 6e 61 6d 65 73 29 ... keynames)
6940: 29 29 29 29 0a 20 20 20 20 28 6c 65 74 20 6c 6f )))). (let lo
6950: 6f 70 20 28 28 74 65 73 74 6e 75 6d 20 20 30 29 op ((testnum 0)
6960: 0a 09 20 20 20 20 20 20 20 28 72 65 73 20 20 20 .. (res
6970: 20 20 20 27 28 29 29 29 0a 20 20 20 20 20 20 28 '())). (
6980: 63 6f 6e 64 0a 20 20 20 20 20 20 20 28 28 3e 3d cond. ((>=
6990: 20 74 65 73 74 6e 75 6d 20 6e 74 65 73 74 73 29 testnum ntests)
69a0: 0a 09 3b 3b 20 6e 6f 77 20 6c 66 74 6c 73 74 20 ..;; now lftlst
69b0: 77 69 6c 6c 20 62 65 20 61 6e 20 68 62 6f 78 20 will be an hbox
69c0: 77 69 74 68 20 74 68 65 20 74 65 73 74 20 6b 65 with the test ke
69d0: 79 73 20 61 6e 64 20 74 68 65 20 74 65 73 74 20 ys and the test
69e0: 6e 61 6d 65 20 6c 61 62 65 6c 73 0a 09 28 73 65 name labels..(se
69f0: 74 21 20 6c 66 74 6c 73 74 20 28 61 70 70 65 6e t! lftlst (appen
6a00: 64 20 6c 66 74 6c 73 74 20 28 6c 69 73 74 20 28 d lftlst (list (
6a10: 69 75 70 3a 68 62 6f 78 20 20 23 3a 65 78 70 61 iup:hbox #:expa
6a20: 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 0a nd "HORIZONTAL".
6a30: 09 09 09 09 09 20 20 20 28 69 75 70 3a 76 61 6c ..... (iup:val
6a40: 75 61 74 6f 72 20 23 3a 76 61 6c 75 65 63 68 61 uator #:valuecha
6a50: 6e 67 65 64 5f 63 62 20 28 6c 61 6d 62 64 61 20 nged_cb (lambda
6a60: 28 6f 62 6a 29 0a 09 09 09 09 09 09 09 09 09 20 (obj)..........
6a70: 20 20 20 20 28 6c 65 74 20 28 28 76 61 6c 20 28 (let ((val (
6a80: 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 string->number (
6a90: 69 75 70 3a 61 74 74 72 69 62 75 74 65 20 6f 62 iup:attribute ob
6aa0: 6a 20 22 56 41 4c 55 45 22 29 29 29 0a 09 09 09 j "VALUE")))....
6ab0: 09 09 09 09 09 09 09 20 20 20 28 6f 6c 64 6d 61 ....... (oldma
6ac0: 78 20 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 x (string->numb
6ad0: 65 72 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 er (iup:attribut
6ae0: 65 20 6f 62 6a 20 22 4d 41 58 22 29 29 29 0a 09 e obj "MAX")))..
6af0: 09 09 09 09 09 09 09 09 09 20 20 20 28 6e 65 77 ......... (new
6b00: 6d 61 78 20 20 28 2a 20 31 30 20 28 6c 65 6e 67 max (* 10 (leng
6b10: 74 68 20 2a 61 6c 6c 74 65 73 74 6e 61 6d 65 6c th *alltestnamel
6b20: 73 74 2a 29 29 29 29 0a 09 09 09 09 09 09 09 09 st*)))).........
6b30: 09 20 20 20 20 20 20 20 28 73 65 74 21 20 2a 70 . (set! *p
6b40: 6c 65 61 73 65 2d 75 70 64 61 74 65 2d 62 75 74 lease-update-but
6b50: 74 6f 6e 73 2a 20 23 74 29 0a 09 09 09 09 09 09 tons* #t).......
6b60: 09 09 09 20 20 20 20 20 20 20 28 73 65 74 21 20 ... (set!
6b70: 2a 73 74 61 72 74 2d 74 65 73 74 2d 6f 66 66 73 *start-test-offs
6b80: 65 74 2a 20 28 69 6e 65 78 61 63 74 2d 3e 65 78 et* (inexact->ex
6b90: 61 63 74 20 28 72 6f 75 6e 64 20 28 2f 20 76 61 act (round (/ va
6ba0: 6c 20 31 30 29 29 29 29 0a 09 09 09 09 09 09 09 l 10))))........
6bb0: 09 09 20 20 20 20 20 20 20 28 64 65 62 75 67 3a .. (debug:
6bc0: 70 72 69 6e 74 20 36 20 22 2a 73 74 61 72 74 2d print 6 "*start-
6bd0: 74 65 73 74 2d 6f 66 66 73 65 74 2a 20 22 20 2a test-offset* " *
6be0: 73 74 61 72 74 2d 74 65 73 74 2d 6f 66 66 73 65 start-test-offse
6bf0: 74 2a 20 22 20 76 61 6c 3a 20 22 20 76 61 6c 20 t* " val: " val
6c00: 22 20 6e 65 77 6d 61 78 3a 20 22 20 6e 65 77 6d " newmax: " newm
6c10: 61 78 20 22 20 6f 6c 64 6d 61 78 3a 20 22 20 6f ax " oldmax: " o
6c20: 6c 64 6d 61 78 29 0a 09 09 09 09 09 09 09 09 09 ldmax)..........
6c30: 20 20 20 20 20 20 20 28 69 66 20 28 3c 20 76 61 (if (< va
6c40: 6c 20 31 30 29 0a 09 09 09 09 09 09 09 09 09 09 l 10)...........
6c50: 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 (iup:attribut
6c60: 65 2d 73 65 74 21 20 6f 62 6a 20 22 4d 41 58 22 e-set! obj "MAX"
6c70: 20 6e 65 77 6d 61 78 29 29 0a 09 09 09 09 09 09 newmax)).......
6c80: 09 09 09 20 20 20 20 20 20 20 29 29 0a 09 09 09 ... ))....
6c90: 09 09 09 09 20 23 3a 65 78 70 61 6e 64 20 22 56 .... #:expand "V
6ca0: 45 52 54 49 43 41 4c 22 20 0a 09 09 09 09 09 09 ERTICAL" .......
6cb0: 09 20 23 3a 6f 72 69 65 6e 74 61 74 69 6f 6e 20 . #:orientation
6cc0: 22 56 45 52 54 49 43 41 4c 22 29 0a 09 09 09 09 "VERTICAL").....
6cd0: 09 20 20 20 28 61 70 70 6c 79 20 69 75 70 3a 76 . (apply iup:v
6ce0: 62 6f 78 20 28 72 65 76 65 72 73 65 20 72 65 73 box (reverse res
6cf0: 29 29 29 29 29 29 29 0a 20 20 20 20 20 20 20 28 ))))))). (
6d00: 65 6c 73 65 0a 09 28 6c 65 74 20 28 28 6c 61 62 else..(let ((lab
6d10: 6c 20 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 l (iup:button "
6d20: 22 20 0a 09 09 09 09 20 23 3a 66 6c 61 74 20 22 " ..... #:flat "
6d30: 59 45 53 22 20 0a 09 09 09 09 20 23 3a 61 6c 69 YES" ..... #:ali
6d40: 67 6e 6d 65 6e 74 20 22 41 4c 45 46 54 22 0a 09 gnment "ALEFT"..
6d50: 09 09 09 20 3b 20 23 3a 69 6d 61 67 65 20 69 6d ... ; #:image im
6d60: 67 31 0a 09 09 09 09 20 3b 20 23 3a 69 6d 70 72 g1..... ; #:impr
6d70: 65 73 73 20 69 6d 67 32 0a 09 09 09 09 20 23 3a ess img2..... #:
6d80: 73 69 7a 65 20 22 78 31 35 22 0a 09 09 09 09 20 size "x15".....
6d90: 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f #:expand "HORIZO
6da0: 4e 54 41 4c 22 0a 09 09 09 09 20 23 3a 66 6f 6e NTAL"..... #:fon
6db0: 74 73 69 7a 65 20 22 31 30 22 0a 09 09 09 09 20 tsize "10".....
6dc0: 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 #:action (lambda
6dd0: 20 28 6f 62 6a 29 0a 09 09 09 09 09 20 20 20 20 (obj)......
6de0: 28 6d 61 72 6b 2d 66 6f 72 2d 75 70 64 61 74 65 (mark-for-update
6df0: 29 0a 09 09 09 09 09 20 20 20 20 28 74 6f 67 67 )...... (togg
6e00: 6c 65 2d 68 69 64 65 20 74 65 73 74 6e 75 6d 29 le-hide testnum)
6e10: 29 29 29 29 20 3b 3b 20 28 69 75 70 3a 61 74 74 )))) ;; (iup:att
6e20: 72 69 62 75 74 65 20 6f 62 6a 20 22 54 49 54 4c ribute obj "TITL
6e30: 45 22 29 29 29 29 0a 09 20 20 28 76 65 63 74 6f E")))).. (vecto
6e40: 72 2d 73 65 74 21 20 6c 66 74 63 6f 6c 20 74 65 r-set! lftcol te
6e50: 73 74 6e 75 6d 20 6c 61 62 6c 29 0a 09 20 20 28 stnum labl).. (
6e60: 6c 6f 6f 70 20 28 2b 20 74 65 73 74 6e 75 6d 20 loop (+ testnum
6e70: 31 29 28 63 6f 6e 73 20 6c 61 62 6c 20 72 65 73 1)(cons labl res
6e80: 29 29 29 29 29 29 0a 20 20 20 20 3b 3b 20 0a 20 )))))). ;; .
6e90: 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 72 (let loop ((r
6ea0: 75 6e 6e 75 6d 20 20 30 29 0a 09 20 20 20 20 20 unnum 0)..
6eb0: 20 20 28 6b 65 79 6e 75 6d 20 20 30 29 0a 09 20 (keynum 0)..
6ec0: 20 20 20 20 20 20 28 6b 65 79 76 65 63 20 20 28 (keyvec (
6ed0: 6d 61 6b 65 2d 76 65 63 74 6f 72 20 6e 6b 65 79 make-vector nkey
6ee0: 73 29 29 0a 09 20 20 20 20 20 20 20 28 72 65 73 s)).. (res
6ef0: 20 20 20 20 27 28 29 29 29 0a 20 20 20 20 20 20 '())).
6f00: 28 63 6f 6e 64 20 3b 3b 20 6e 62 2f 2f 20 6e 6f (cond ;; nb// no
6f10: 20 65 6c 73 65 20 66 6f 72 20 74 68 69 73 20 61 else for this a
6f20: 70 70 72 6f 61 63 68 2e 0a 20 20 20 20 20 20 20 pproach..
6f30: 28 28 3e 3d 20 72 75 6e 6e 75 6d 20 6e 72 75 6e ((>= runnum nrun
6f40: 73 29 20 23 66 29 0a 20 20 20 20 20 20 20 28 28 s) #f). ((
6f50: 3e 3d 20 6b 65 79 6e 75 6d 20 6e 6b 65 79 73 29 >= keynum nkeys)
6f60: 20 0a 09 28 76 65 63 74 6f 72 2d 73 65 74 21 20 ..(vector-set!
6f70: 68 65 61 64 65 72 20 72 75 6e 6e 75 6d 20 6b 65 header runnum ke
6f80: 79 76 65 63 29 0a 09 28 73 65 74 21 20 68 64 72 yvec)..(set! hdr
6f90: 6c 73 74 20 28 63 6f 6e 73 20 28 61 70 70 6c 79 lst (cons (apply
6fa0: 20 69 75 70 3a 76 62 6f 78 20 28 72 65 76 65 72 iup:vbox (rever
6fb0: 73 65 20 72 65 73 29 29 20 68 64 72 6c 73 74 29 se res)) hdrlst)
6fc0: 29 0a 09 28 6c 6f 6f 70 20 28 2b 20 72 75 6e 6e )..(loop (+ runn
6fd0: 75 6d 20 31 29 20 30 20 28 6d 61 6b 65 2d 76 65 um 1) 0 (make-ve
6fe0: 63 74 6f 72 20 6e 6b 65 79 73 29 20 27 28 29 29 ctor nkeys) '())
6ff0: 29 0a 20 20 20 20 20 20 20 28 65 6c 73 65 0a 09 ). (else..
7000: 28 6c 65 74 20 28 28 6c 61 62 6c 20 20 28 69 75 (let ((labl (iu
7010: 70 3a 6c 61 62 65 6c 20 22 22 20 23 3a 73 69 7a p:label "" #:siz
7020: 65 20 22 36 30 78 31 35 22 20 23 3a 66 6f 6e 74 e "60x15" #:font
7030: 73 69 7a 65 20 22 31 30 22 20 23 3a 65 78 70 61 size "10" #:expa
7040: 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 29 nd "HORIZONTAL")
7050: 29 29 20 3b 3b 20 23 3a 65 78 70 61 6e 64 20 22 )) ;; #:expand "
7060: 48 4f 52 49 5a 4f 4e 54 41 4c 22 0a 09 20 20 28 HORIZONTAL".. (
7070: 76 65 63 74 6f 72 2d 73 65 74 21 20 6b 65 79 76 vector-set! keyv
7080: 65 63 20 6b 65 79 6e 75 6d 20 6c 61 62 6c 29 0a ec keynum labl).
7090: 09 20 20 28 6c 6f 6f 70 20 72 75 6e 6e 75 6d 20 . (loop runnum
70a0: 28 2b 20 6b 65 79 6e 75 6d 20 31 29 20 6b 65 79 (+ keynum 1) key
70b0: 76 65 63 20 28 63 6f 6e 73 20 6c 61 62 6c 20 72 vec (cons labl r
70c0: 65 73 29 29 29 29 29 29 0a 20 20 20 20 3b 3b 20 es)))))). ;;
70d0: 42 79 20 68 65 72 65 20 74 68 65 20 68 64 72 6c By here the hdrl
70e0: 73 74 20 63 6f 6e 74 61 69 6e 73 20 61 20 6c 69 st contains a li
70f0: 73 74 20 6f 66 20 76 62 6f 78 65 73 20 63 6f 6e st of vboxes con
7100: 74 61 69 6e 69 6e 67 20 6e 6b 65 79 73 20 6c 61 taining nkeys la
7110: 62 65 6c 73 0a 20 20 20 20 28 6c 65 74 20 6c 6f bels. (let lo
7120: 6f 70 20 28 28 72 75 6e 6e 75 6d 20 20 30 29 0a op ((runnum 0).
7130: 09 20 20 20 20 20 20 20 28 74 65 73 74 6e 75 6d . (testnum
7140: 20 30 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 0).. (tes
7150: 74 76 65 63 20 20 28 6d 61 6b 65 2d 76 65 63 74 tvec (make-vect
7160: 6f 72 20 6e 74 65 73 74 73 29 29 0a 09 20 20 20 or ntests))..
7170: 20 20 20 20 28 72 65 73 20 20 20 20 27 28 29 29 (res '())
7180: 29 0a 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 ). (cond.
7190: 20 20 20 20 20 28 28 3e 3d 20 72 75 6e 6e 75 6d ((>= runnum
71a0: 20 6e 72 75 6e 73 29 20 23 66 29 20 3b 3b 20 20 nruns) #f) ;;
71b0: 28 76 65 63 74 6f 72 20 74 61 62 6c 65 68 65 61 (vector tablehea
71c0: 64 65 72 20 72 75 6e 73 76 65 63 29 29 0a 20 20 der runsvec)).
71d0: 20 20 20 20 20 28 28 3e 3d 20 74 65 73 74 6e 75 ((>= testnu
71e0: 6d 20 6e 74 65 73 74 73 29 20 0a 09 28 76 65 63 m ntests) ..(vec
71f0: 74 6f 72 2d 73 65 74 21 20 72 75 6e 73 76 65 63 tor-set! runsvec
7200: 20 72 75 6e 6e 75 6d 20 74 65 73 74 76 65 63 29 runnum testvec)
7210: 0a 09 28 73 65 74 21 20 62 64 79 6c 73 74 20 28 ..(set! bdylst (
7220: 63 6f 6e 73 20 28 61 70 70 6c 79 20 69 75 70 3a cons (apply iup:
7230: 76 62 6f 78 20 28 72 65 76 65 72 73 65 20 72 65 vbox (reverse re
7240: 73 29 29 20 62 64 79 6c 73 74 29 29 0a 09 28 6c s)) bdylst))..(l
7250: 6f 6f 70 20 28 2b 20 72 75 6e 6e 75 6d 20 31 29 oop (+ runnum 1)
7260: 20 30 20 28 6d 61 6b 65 2d 76 65 63 74 6f 72 20 0 (make-vector
7270: 6e 74 65 73 74 73 29 20 27 28 29 29 29 0a 20 20 ntests) '())).
7280: 20 20 20 20 20 28 65 6c 73 65 0a 09 28 6c 65 74 (else..(let
7290: 2a 20 28 28 62 75 74 74 6f 6e 2d 6b 65 79 20 28 * ((button-key (
72a0: 6d 6b 73 74 72 20 72 75 6e 6e 75 6d 20 74 65 73 mkstr runnum tes
72b0: 74 6e 75 6d 29 29 0a 09 20 20 20 20 20 20 20 28 tnum)).. (
72c0: 62 75 74 6e 20 20 20 20 20 20 20 28 69 75 70 3a butn (iup:
72d0: 62 75 74 74 6f 6e 20 22 22 20 3b 3b 20 62 75 74 button "" ;; but
72e0: 74 6f 6e 2d 6b 65 79 20 0a 09 09 09 09 20 20 20 ton-key .....
72f0: 20 20 20 20 23 3a 73 69 7a 65 20 22 36 30 78 31 #:size "60x1
7300: 35 22 20 0a 09 09 09 09 20 20 20 20 20 20 20 23 5" ..... #
7310: 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e :expand "HORIZON
7320: 54 41 4c 22 0a 09 09 09 09 20 20 20 20 20 20 20 TAL".....
7330: 23 3a 66 6f 6e 74 73 69 7a 65 20 22 31 30 22 20 #:fontsize "10"
7340: 0a 09 09 09 09 20 20 20 20 20 20 20 23 3a 61 63 ..... #:ac
7350: 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 78 29 tion (lambda (x)
7360: 0a 09 09 09 09 09 09 20 20 28 6c 65 74 2a 20 28 ....... (let* (
7370: 28 74 6f 6f 6c 70 61 74 68 20 28 63 61 72 20 28 (toolpath (car (
7380: 61 72 67 76 29 29 29 0a 09 09 09 09 09 09 09 20 argv)))........
7390: 28 62 75 74 74 6e 64 61 74 20 28 68 61 73 68 2d (buttndat (hash-
73a0: 74 61 62 6c 65 2d 72 65 66 20 2a 62 75 74 74 6f table-ref *butto
73b0: 6e 64 61 74 2a 20 62 75 74 74 6f 6e 2d 6b 65 79 ndat* button-key
73c0: 29 29 0a 09 09 09 09 09 09 09 20 28 74 65 73 74 ))........ (test
73d0: 2d 69 64 20 20 28 64 62 3a 74 65 73 74 2d 67 65 -id (db:test-ge
73e0: 74 2d 69 64 20 28 76 65 63 74 6f 72 2d 72 65 66 t-id (vector-ref
73f0: 20 62 75 74 74 6e 64 61 74 20 33 29 29 29 0a 09 buttndat 3)))..
7400: 09 09 09 09 09 09 20 28 63 6d 64 20 20 28 63 6f ...... (cmd (co
7410: 6e 63 20 74 6f 6f 6c 70 61 74 68 20 22 20 2d 74 nc toolpath " -t
7420: 65 73 74 20 22 20 74 65 73 74 2d 69 64 20 22 26 est " test-id "&
7430: 22 29 29 29 0a 09 09 09 09 09 09 20 20 20 20 3b ")))....... ;
7440: 28 70 72 69 6e 74 20 22 4c 61 75 6e 63 68 69 6e (print "Launchin
7450: 67 20 22 20 63 6d 64 29 0a 09 09 09 09 09 09 20 g " cmd).......
7460: 20 20 20 28 73 79 73 74 65 6d 20 63 6d 64 29 29 (system cmd))
7470: 29 29 29 29 0a 09 20 20 28 68 61 73 68 2d 74 61 )))).. (hash-ta
7480: 62 6c 65 2d 73 65 74 21 20 2a 62 75 74 74 6f 6e ble-set! *button
7490: 64 61 74 2a 20 62 75 74 74 6f 6e 2d 6b 65 79 20 dat* button-key
74a0: 28 76 65 63 74 6f 72 20 30 20 22 31 30 30 20 31 (vector 0 "100 1
74b0: 30 30 20 31 30 30 22 20 62 75 74 74 6f 6e 2d 6b 00 100" button-k
74c0: 65 79 20 23 66 20 23 66 29 29 20 0a 09 20 20 28 ey #f #f)) .. (
74d0: 76 65 63 74 6f 72 2d 73 65 74 21 20 74 65 73 74 vector-set! test
74e0: 76 65 63 20 74 65 73 74 6e 75 6d 20 62 75 74 6e vec testnum butn
74f0: 29 0a 09 20 20 28 6c 6f 6f 70 20 72 75 6e 6e 75 ).. (loop runnu
7500: 6d 20 28 2b 20 74 65 73 74 6e 75 6d 20 31 29 20 m (+ testnum 1)
7510: 74 65 73 74 76 65 63 20 28 63 6f 6e 73 20 62 75 testvec (cons bu
7520: 74 6e 20 72 65 73 29 29 29 29 29 29 0a 20 20 20 tn res)))))).
7530: 20 3b 3b 20 6e 6f 77 20 61 73 73 65 6d 62 6c 65 ;; now assemble
7540: 20 74 68 65 20 68 64 72 6c 73 74 20 61 6e 64 20 the hdrlst and
7550: 62 64 79 6c 73 74 20 61 6e 64 20 6b 69 63 6b 20 bdylst and kick
7560: 6f 66 66 20 74 68 65 20 64 69 61 6c 6f 67 0a 20 off the dialog.
7570: 20 20 20 28 69 75 70 3a 73 68 6f 77 0a 20 20 20 (iup:show.
7580: 20 20 28 69 75 70 3a 64 69 61 6c 6f 67 20 0a 20 (iup:dialog .
7590: 20 20 20 20 20 23 3a 74 69 74 6c 65 20 22 4d 65 #:title "Me
75a0: 67 61 74 65 73 74 20 64 61 73 68 62 6f 61 72 64 gatest dashboard
75b0: 22 0a 20 20 20 20 20 20 28 6c 65 74 20 28 28 74 ". (let ((t
75c0: 61 62 73 20 28 69 75 70 3a 74 61 62 73 0a 09 09 abs (iup:tabs...
75d0: 20 20 20 28 69 75 70 3a 76 62 6f 78 0a 09 09 20 (iup:vbox...
75e0: 20 20 20 28 61 70 70 6c 79 20 69 75 70 3a 68 62 (apply iup:hb
75f0: 6f 78 20 0a 09 09 09 20 20 20 28 63 6f 6e 73 20 ox .... (cons
7600: 28 61 70 70 6c 79 20 69 75 70 3a 76 62 6f 78 20 (apply iup:vbox
7610: 6c 66 74 6c 73 74 29 0a 09 09 09 09 20 28 6c 69 lftlst)..... (li
7620: 73 74 20 0a 09 09 09 09 20 20 28 69 75 70 3a 76 st ..... (iup:v
7630: 62 6f 78 0a 09 09 09 09 20 20 20 3b 3b 20 74 68 box..... ;; th
7640: 65 20 68 65 61 64 65 72 0a 09 09 09 09 20 20 20 e header.....
7650: 28 61 70 70 6c 79 20 69 75 70 3a 68 62 6f 78 20 (apply iup:hbox
7660: 28 72 65 76 65 72 73 65 20 68 64 72 6c 73 74 29 (reverse hdrlst)
7670: 29 0a 09 09 09 09 20 20 20 28 61 70 70 6c 79 20 )..... (apply
7680: 69 75 70 3a 68 62 6f 78 20 28 72 65 76 65 72 73 iup:hbox (revers
7690: 65 20 62 64 79 6c 73 74 29 29 29 29 29 29 0a 09 e bdylst))))))..
76a0: 09 20 20 20 20 63 6f 6e 74 72 6f 6c 73 29 0a 09 . controls)..
76b0: 09 20 20 20 28 64 61 73 68 62 6f 61 72 64 3a 72 . (dashboard:r
76c0: 75 6e 2d 63 6f 6e 74 72 6f 6c 73 29 0a 09 09 20 un-controls)...
76d0: 20 20 29 29 29 0a 09 28 69 75 70 3a 61 74 74 72 )))..(iup:attr
76e0: 69 62 75 74 65 2d 73 65 74 21 20 74 61 62 73 20 ibute-set! tabs
76f0: 22 54 41 42 54 49 54 4c 45 30 22 20 22 52 75 6e "TABTITLE0" "Run
7700: 73 22 29 0a 09 28 69 75 70 3a 61 74 74 72 69 62 s")..(iup:attrib
7710: 75 74 65 2d 73 65 74 21 20 74 61 62 73 20 22 54 ute-set! tabs "T
7720: 41 42 54 49 54 4c 45 31 22 20 22 52 75 6e 20 43 ABTITLE1" "Run C
7730: 6f 6e 74 72 6f 6c 22 29 0a 09 74 61 62 73 29 29 ontrol")..tabs))
7740: 29 0a 20 20 20 20 20 28 76 65 63 74 6f 72 20 6b ). (vector k
7750: 65 79 63 6f 6c 20 6c 66 74 63 6f 6c 20 68 65 61 eycol lftcol hea
7760: 64 65 72 20 72 75 6e 73 76 65 63 29 29 29 0a 0a der runsvec)))..
7770: 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 65 (if (or (args:ge
7780: 74 2d 61 72 67 20 22 2d 72 6f 77 73 22 29 0a 09 t-arg "-rows")..
7790: 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 (get-environment
77a0: 2d 76 61 72 69 61 62 6c 65 20 22 44 41 53 48 42 -variable "DASHB
77b0: 4f 41 52 44 52 4f 57 53 22 20 29 29 0a 20 20 20 OARDROWS" )).
77c0: 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20 20 (begin.
77d0: 28 73 65 74 21 20 2a 6e 75 6d 2d 74 65 73 74 73 (set! *num-tests
77e0: 2a 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 * (string->numbe
77f0: 72 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d r (or (args:get-
7800: 61 72 67 20 22 2d 72 6f 77 73 22 29 0a 09 09 09 arg "-rows")....
7810: 09 09 20 20 20 20 20 20 28 67 65 74 2d 65 6e 76 .. (get-env
7820: 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c ironment-variabl
7830: 65 20 22 44 41 53 48 42 4f 41 52 44 52 4f 57 53 e "DASHBOARDROWS
7840: 22 29 29 29 29 0a 09 28 75 70 64 61 74 65 2d 72 "))))..(update-r
7850: 75 6e 64 61 74 20 22 25 22 20 2a 6e 75 6d 2d 72 undat "%" *num-r
7860: 75 6e 73 2a 20 22 25 2f 25 22 20 27 28 29 29 29 uns* "%/%" '()))
7870: 0a 20 20 20 20 28 73 65 74 21 20 2a 6e 75 6d 2d . (set! *num-
7880: 74 65 73 74 73 2a 20 28 6d 69 6e 20 28 6d 61 78 tests* (min (max
7890: 20 28 75 70 64 61 74 65 2d 72 75 6e 64 61 74 20 (update-rundat
78a0: 22 25 22 20 2a 6e 75 6d 2d 72 75 6e 73 2a 20 22 "%" *num-runs* "
78b0: 25 2f 25 22 20 27 28 29 29 20 38 29 20 32 30 29 %/%" '()) 8) 20)
78c0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 2a 74 69 6d ))..(define *tim
78d0: 2a 20 28 69 75 70 3a 74 69 6d 65 72 29 29 0a 28 * (iup:timer)).(
78e0: 64 65 66 69 6e 65 20 2a 6f 72 64 2a 20 23 66 29 define *ord* #f)
78f0: 0a 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d .(iup:attribute-
7900: 73 65 74 21 20 2a 74 69 6d 2a 20 22 54 49 4d 45 set! *tim* "TIME
7910: 22 20 33 30 30 29 0a 28 69 75 70 3a 61 74 74 72 " 300).(iup:attr
7920: 69 62 75 74 65 2d 73 65 74 21 20 2a 74 69 6d 2a ibute-set! *tim*
7930: 20 22 52 55 4e 22 20 22 59 45 53 22 29 0a 0a 3b "RUN" "YES")..;
7940: 3b 20 4d 6f 76 65 20 74 68 69 73 20 73 74 75 66 ; Move this stuf
7950: 66 20 74 6f 20 64 62 2e 73 63 6d 20 46 49 58 4d f to db.scm FIXM
7960: 45 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 2a 6c 61 E.;;.(define *la
7970: 73 74 2d 64 62 2d 75 70 64 61 74 65 2d 74 69 6d st-db-update-tim
7980: 65 2a 20 28 66 69 6c 65 2d 6d 6f 64 69 66 69 63 e* (file-modific
7990: 61 74 69 6f 6e 2d 74 69 6d 65 20 28 63 6f 6e 63 ation-time (conc
79a0: 20 2a 74 6f 70 70 61 74 68 2a 20 22 2f 6d 65 67 *toppath* "/meg
79b0: 61 74 65 73 74 2e 64 62 22 29 29 29 0a 28 64 65 atest.db"))).(de
79c0: 66 69 6e 65 20 28 64 62 3a 62 65 65 6e 2d 63 68 fine (db:been-ch
79d0: 61 6e 67 65 64 29 0a 20 20 28 3e 20 28 66 69 6c anged). (> (fil
79e0: 65 2d 6d 6f 64 69 66 69 63 61 74 69 6f 6e 2d 74 e-modification-t
79f0: 69 6d 65 20 28 63 6f 6e 63 20 2a 74 6f 70 70 61 ime (conc *toppa
7a00: 74 68 2a 20 22 2f 6d 65 67 61 74 65 73 74 2e 64 th* "/megatest.d
7a10: 62 22 29 29 20 2a 6c 61 73 74 2d 64 62 2d 75 70 b")) *last-db-up
7a20: 64 61 74 65 2d 74 69 6d 65 2a 29 29 0a 28 64 65 date-time*)).(de
7a30: 66 69 6e 65 20 28 64 62 3a 73 65 74 2d 64 62 2d fine (db:set-db-
7a40: 75 70 64 61 74 65 2d 74 69 6d 65 29 0a 20 20 28 update-time). (
7a50: 73 65 74 21 20 2a 6c 61 73 74 2d 64 62 2d 75 70 set! *last-db-up
7a60: 64 61 74 65 2d 74 69 6d 65 2a 20 28 66 69 6c 65 date-time* (file
7a70: 2d 6d 6f 64 69 66 69 63 61 74 69 6f 6e 2d 74 69 -modification-ti
7a80: 6d 65 20 28 63 6f 6e 63 20 2a 74 6f 70 70 61 74 me (conc *toppat
7a90: 68 2a 20 22 2f 6d 65 67 61 74 65 73 74 2e 64 62 h* "/megatest.db
7aa0: 22 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 "))))..(define (
7ab0: 72 75 6e 2d 75 70 64 61 74 65 20 78 29 0a 20 20 run-update x).
7ac0: 28 75 70 64 61 74 65 2d 62 75 74 74 6f 6e 73 20 (update-buttons
7ad0: 75 69 64 61 74 20 2a 6e 75 6d 2d 72 75 6e 73 2a uidat *num-runs*
7ae0: 20 2a 6e 75 6d 2d 74 65 73 74 73 2a 29 0a 20 20 *num-tests*).
7af0: 3b 3b 20 28 69 66 20 28 64 62 3a 62 65 65 6e 2d ;; (if (db:been-
7b00: 63 68 61 6e 67 65 64 29 0a 20 20 28 62 65 67 69 changed). (begi
7b10: 6e 0a 20 20 20 20 28 75 70 64 61 74 65 2d 72 75 n. (update-ru
7b20: 6e 64 61 74 20 28 68 61 73 68 2d 74 61 62 6c 65 ndat (hash-table
7b30: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 2a 73 65 -ref/default *se
7b40: 61 72 63 68 70 61 74 74 73 2a 20 22 72 75 6e 6e archpatts* "runn
7b50: 61 6d 65 22 20 22 25 22 29 20 2a 6e 75 6d 2d 72 ame" "%") *num-r
7b60: 75 6e 73 2a 0a 09 09 20 20 20 28 68 61 73 68 2d uns*... (hash-
7b70: 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c table-ref/defaul
7b80: 74 20 2a 73 65 61 72 63 68 70 61 74 74 73 2a 20 t *searchpatts*
7b90: 22 74 65 73 74 2d 6e 61 6d 65 22 20 22 25 2f 25 "test-name" "%/%
7ba0: 22 29 0a 09 09 20 20 20 3b 3b 20 28 68 61 73 68 ")... ;; (hash
7bb0: 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 -table-ref/defau
7bc0: 6c 74 20 2a 73 65 61 72 63 68 70 61 74 74 73 2a lt *searchpatts*
7bd0: 20 22 69 74 65 6d 2d 6e 61 6d 65 22 20 22 25 22 "item-name" "%"
7be0: 29 0a 09 09 20 20 20 28 6c 65 74 20 28 28 72 65 )... (let ((re
7bf0: 73 20 27 28 29 29 29 0a 09 09 20 20 20 20 20 28 s '()))... (
7c00: 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 for-each (lambda
7c10: 20 28 6b 65 79 29 0a 09 09 09 09 20 28 69 66 20 (key)..... (if
7c20: 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 6b 65 79 (not (equal? key
7c30: 20 22 72 75 6e 6e 61 6d 65 22 29 29 0a 09 09 09 "runname"))....
7c40: 09 20 20 20 20 20 28 6c 65 74 20 28 28 76 61 6c . (let ((val
7c50: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
7c60: 2f 64 65 66 61 75 6c 74 20 2a 73 65 61 72 63 68 /default *search
7c70: 70 61 74 74 73 2a 20 6b 65 79 20 23 66 29 29 29 patts* key #f)))
7c80: 0a 09 09 09 09 20 20 20 20 20 20 20 28 69 66 20 ..... (if
7c90: 76 61 6c 20 28 73 65 74 21 20 72 65 73 20 28 63 val (set! res (c
7ca0: 6f 6e 73 20 28 6c 69 73 74 20 6b 65 79 20 76 61 ons (list key va
7cb0: 6c 29 20 72 65 73 29 29 29 29 29 29 0a 09 09 09 l) res))))))....
7cc0: 20 20 20 20 20 20 20 2a 64 62 6b 65 79 73 2a 29 *dbkeys*)
7cd0: 0a 09 09 20 20 20 20 20 72 65 73 29 29 0a 20 20 ... res)).
7ce0: 20 20 3b 20 28 64 62 3a 73 65 74 2d 64 62 2d 75 ; (db:set-db-u
7cf0: 70 64 61 74 65 2d 74 69 6d 65 29 0a 20 20 20 20 pdate-time).
7d00: 29 29 0a 0a 28 63 6f 6e 64 20 0a 20 28 28 61 72 ))..(cond . ((ar
7d10: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e gs:get-arg "-run
7d20: 22 29 0a 20 20 28 6c 65 74 20 28 28 72 75 6e 69 "). (let ((runi
7d30: 64 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 d (string->numbe
7d40: 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 r (args:get-arg
7d50: 22 2d 72 75 6e 22 29 29 29 29 0a 20 20 20 20 28 "-run")))). (
7d60: 69 66 20 72 75 6e 69 64 0a 09 28 62 65 67 69 6e if runid..(begin
7d70: 0a 09 20 20 28 6c 61 6d 62 64 61 20 28 78 29 0a .. (lambda (x).
7d80: 09 20 20 20 20 28 6f 6e 2d 65 78 69 74 20 28 6c . (on-exit (l
7d90: 61 6d 62 64 61 20 28 29 0a 09 09 20 20 20 20 20 ambda ()...
7da0: 20 20 28 69 66 20 2a 64 62 2a 20 28 73 71 6c 69 (if *db* (sqli
7db0: 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 2a 64 te3:finalize! *d
7dc0: 62 2a 29 29 29 29 0a 09 20 20 20 20 28 63 64 62 b*)))).. (cdb
7dd0: 3a 72 65 6d 6f 74 65 2d 72 75 6e 20 65 78 61 6d :remote-run exam
7de0: 69 6e 65 2d 72 75 6e 20 2a 64 62 2a 20 72 75 6e ine-run *db* run
7df0: 69 64 29 29 29 0a 09 28 62 65 67 69 6e 0a 09 20 id)))..(begin..
7e00: 20 28 70 72 69 6e 74 20 22 45 52 52 4f 52 3a 20 (print "ERROR:
7e10: 72 75 6e 69 64 20 69 73 20 6e 6f 74 20 61 20 6e runid is not a n
7e20: 75 6d 62 65 72 20 22 20 28 61 72 67 73 3a 67 65 umber " (args:ge
7e30: 74 2d 61 72 67 20 22 2d 72 75 6e 22 29 29 0a 09 t-arg "-run"))..
7e40: 20 20 28 65 78 69 74 20 31 29 29 29 29 29 0a 20 (exit 1))))).
7e50: 28 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 ((args:get-arg "
7e60: 2d 74 65 73 74 22 29 0a 20 20 20 20 28 6c 65 74 -test"). (let
7e70: 20 28 28 74 65 73 74 69 64 20 28 73 74 72 69 6e ((testid (strin
7e80: 67 2d 3e 6e 75 6d 62 65 72 20 28 61 72 67 73 3a g->number (args:
7e90: 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 22 29 get-arg "-test")
7ea0: 29 29 29 0a 20 20 20 20 28 69 66 20 74 65 73 74 ))). (if test
7eb0: 69 64 0a 09 28 65 78 61 6d 69 6e 65 2d 74 65 73 id..(examine-tes
7ec0: 74 20 74 65 73 74 69 64 29 0a 09 28 62 65 67 69 t testid)..(begi
7ed0: 6e 0a 09 20 20 28 70 72 69 6e 74 20 22 45 52 52 n.. (print "ERR
7ee0: 4f 52 3a 20 74 65 73 74 69 64 20 69 73 20 6e 6f OR: testid is no
7ef0: 74 20 61 20 6e 75 6d 62 65 72 20 22 20 28 61 72 t a number " (ar
7f00: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 gs:get-arg "-tes
7f10: 74 22 29 29 0a 09 20 20 28 65 78 69 74 20 31 29 t")).. (exit 1)
7f20: 29 29 29 29 0a 20 28 28 61 72 67 73 3a 67 65 74 )))). ((args:get
7f30: 2d 61 72 67 20 22 2d 67 75 69 6d 6f 6e 69 74 6f -arg "-guimonito
7f40: 72 22 29 0a 20 20 28 67 75 69 2d 6d 6f 6e 69 74 r"). (gui-monit
7f50: 6f 72 20 2a 64 62 2a 29 29 0a 20 28 65 6c 73 65 or *db*)). (else
7f60: 0a 20 20 28 73 65 74 21 20 75 69 64 61 74 20 28 . (set! uidat (
7f70: 6d 61 6b 65 2d 64 61 73 68 62 6f 61 72 64 2d 62 make-dashboard-b
7f80: 75 74 74 6f 6e 73 20 2a 6e 75 6d 2d 72 75 6e 73 uttons *num-runs
7f90: 2a 20 2a 6e 75 6d 2d 74 65 73 74 73 2a 20 2a 64 * *num-tests* *d
7fa0: 62 6b 65 79 73 2a 29 29 0a 20 20 28 69 75 70 3a bkeys*)). (iup:
7fb0: 63 61 6c 6c 62 61 63 6b 2d 73 65 74 21 20 2a 74 callback-set! *t
7fc0: 69 6d 2a 0a 09 09 20 20 20 20 20 22 41 43 54 49 im*... "ACTI
7fd0: 4f 4e 5f 43 42 22 0a 09 09 20 20 20 20 20 28 6c ON_CB"... (l
7fe0: 61 6d 62 64 61 20 28 78 29 0a 09 09 20 20 20 20 ambda (x)...
7ff0: 20 20 20 28 72 75 6e 2d 75 70 64 61 74 65 20 78 (run-update x
8000: 29 29 29 29 29 0a 09 09 20 20 20 20 20 20 20 3b )))))... ;
8010: 28 70 72 69 6e 74 20 78 29 29 29 29 29 0a 0a 28 (print x)))))..(
8020: 69 75 70 3a 6d 61 69 6e 2d 6c 6f 6f 70 29 0a iup:main-loop).