Artifact
d676ee3f3f9a768bab3cc6bd5cfb98e44341d0c0:
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 0a 28 75 canvas-draw)..(u
0230: 73 65 20 73 71 6c 69 74 65 33 20 73 72 66 69 2d se sqlite3 srfi-
0240: 31 20 70 6f 73 69 78 20 72 65 67 65 78 20 72 65 1 posix regex re
0250: 67 65 78 2d 63 61 73 65 20 73 72 66 69 2d 36 39 gex-case srfi-69
0260: 29 0a 28 69 6d 70 6f 72 74 20 28 70 72 65 66 69 ).(import (prefi
0270: 78 20 73 71 6c 69 74 65 33 20 73 71 6c 69 74 65 x sqlite3 sqlite
0280: 33 3a 29 29 0a 0a 28 64 65 63 6c 61 72 65 20 28 3:))..(declare (
0290: 75 73 65 73 20 63 6f 6d 6d 6f 6e 29 29 0a 28 64 uses common)).(d
02a0: 65 63 6c 61 72 65 20 28 75 73 65 73 20 6d 61 72 eclare (uses mar
02b0: 67 73 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 gs)).(declare (u
02c0: 73 65 73 20 6b 65 79 73 29 29 0a 28 64 65 63 6c ses keys)).(decl
02d0: 61 72 65 20 28 75 73 65 73 20 69 74 65 6d 73 29 are (uses items)
02e0: 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 ).(declare (uses
02f0: 20 64 62 29 29 0a 28 64 65 63 6c 61 72 65 20 28 db)).(declare (
0300: 75 73 65 73 20 63 6f 6e 66 69 67 66 29 29 0a 28 uses configf)).(
0310: 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 70 72 declare (uses pr
0320: 6f 63 65 73 73 29 29 0a 28 64 65 63 6c 61 72 65 ocess)).(declare
0330: 20 28 75 73 65 73 20 6c 61 75 6e 63 68 29 29 0a (uses launch)).
0340: 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 72 (declare (uses r
0350: 75 6e 73 29 29 0a 28 64 65 63 6c 61 72 65 20 28 uns)).(declare (
0360: 75 73 65 73 20 64 61 73 68 62 6f 61 72 64 2d 74 uses dashboard-t
0370: 65 73 74 73 29 29 0a 28 64 65 63 6c 61 72 65 20 ests)).(declare
0380: 28 75 73 65 73 20 64 61 73 68 62 6f 61 72 64 2d (uses dashboard-
0390: 67 75 69 6d 6f 6e 69 74 6f 72 29 29 0a 3b 3b 20 guimonitor)).;;
03a0: 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 64 (declare (uses d
03b0: 61 73 68 62 6f 61 72 64 2d 6d 61 69 6e 29 29 0a ashboard-main)).
03c0: 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 6d (declare (uses m
03d0: 65 67 61 74 65 73 74 2d 76 65 72 73 69 6f 6e 29 egatest-version)
03e0: 29 0a 0a 28 69 6e 63 6c 75 64 65 20 22 63 6f 6d )..(include "com
03f0: 6d 6f 6e 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 mon_records.scm"
0400: 29 0a 28 69 6e 63 6c 75 64 65 20 22 64 62 5f 72 ).(include "db_r
0410: 65 63 6f 72 64 73 2e 73 63 6d 22 29 0a 28 69 6e ecords.scm").(in
0420: 63 6c 75 64 65 20 22 72 75 6e 5f 72 65 63 6f 72 clude "run_recor
0430: 64 73 2e 73 63 6d 22 29 0a 0a 28 64 65 66 69 6e ds.scm")..(defin
0440: 65 20 68 65 6c 70 20 28 63 6f 6e 63 20 0a 22 4d e help (conc ."M
0450: 65 67 61 74 65 73 74 20 44 61 73 68 62 6f 61 72 egatest Dashboar
0460: 64 2c 20 64 6f 63 75 6d 65 6e 74 61 74 69 6f 6e d, documentation
0470: 20 61 74 20 68 74 74 70 3a 2f 2f 77 77 77 2e 6b at http://www.k
0480: 69 61 74 6f 61 2e 63 6f 6d 2f 66 6f 73 73 69 6c iatoa.com/fossil
0490: 73 2f 6d 65 67 61 74 65 73 74 0a 20 20 76 65 72 s/megatest. ver
04a0: 73 69 6f 6e 20 22 20 6d 65 67 61 74 65 73 74 2d sion " megatest-
04b0: 76 65 72 73 69 6f 6e 20 22 0a 20 20 6c 69 63 65 version ". lice
04c0: 6e 73 65 20 47 50 4c 2c 20 43 6f 70 79 72 69 67 nse GPL, Copyrig
04d0: 68 74 20 28 43 29 20 4d 61 74 74 20 57 65 6c 6c ht (C) Matt Well
04e0: 61 6e 64 20 32 30 31 31 0a 0a 55 73 61 67 65 3a and 2011..Usage:
04f0: 20 64 61 73 68 62 6f 61 72 64 20 5b 6f 70 74 69 dashboard [opti
0500: 6f 6e 73 5d 0a 20 20 2d 68 20 20 20 20 20 20 20 ons]. -h
0510: 20 20 20 20 20 20 20 20 20 3a 20 74 68 69 73 20 : this
0520: 68 65 6c 70 0a 20 20 2d 73 65 72 76 65 72 20 68 help. -server h
0530: 6f 73 74 3a 70 6f 72 74 20 3a 20 63 6f 6e 6e 65 ost:port : conne
0540: 63 74 20 74 6f 20 68 6f 73 74 3a 70 6f 72 74 20 ct to host:port
0550: 69 6e 73 74 65 61 64 20 6f 66 20 64 62 20 61 63 instead of db ac
0560: 63 65 73 73 0a 20 20 2d 74 65 73 74 20 74 65 73 cess. -test tes
0570: 74 69 64 20 20 20 20 20 20 3a 20 63 6f 6e 74 72 tid : contr
0580: 6f 6c 20 74 65 73 74 20 69 64 65 6e 74 69 66 69 ol test identifi
0590: 65 64 20 62 79 20 74 65 73 74 69 64 0a 20 20 2d ed by testid. -
05a0: 67 75 69 6d 6f 6e 69 74 6f 72 20 20 20 20 20 20 guimonitor
05b0: 20 3a 20 63 6f 6e 74 72 6f 6c 20 70 61 6e 65 6c : control panel
05c0: 20 66 6f 72 20 72 75 6e 73 0a 0a 4d 69 73 63 0a for runs..Misc.
05d0: 20 20 2d 72 6f 77 73 20 4e 20 20 20 20 20 20 20 -rows N
05e0: 20 20 3a 20 73 65 74 20 6e 75 6d 62 65 72 20 6f : set number o
05f0: 66 20 72 6f 77 73 0a 22 29 29 0a 0a 3b 3b 20 70 f rows."))..;; p
0600: 72 6f 63 65 73 73 20 61 72 67 73 0a 28 64 65 66 rocess args.(def
0610: 69 6e 65 20 72 65 6d 61 72 67 73 20 28 61 72 67 ine remargs (arg
0620: 73 3a 67 65 74 2d 61 72 67 73 20 0a 09 09 20 28 s:get-args ... (
0630: 61 72 67 76 29 0a 09 09 20 28 6c 69 73 74 20 20 argv)... (list
0640: 22 2d 72 6f 77 73 22 0a 09 09 09 22 2d 72 75 6e "-rows"...."-run
0650: 22 0a 09 09 09 22 2d 74 65 73 74 22 0a 09 09 09 "...."-test"....
0660: 22 2d 64 65 62 75 67 22 0a 09 09 09 22 2d 68 6f "-debug"...."-ho
0670: 73 74 22 20 0a 09 09 09 29 20 0a 09 09 20 28 6c st" ....) ... (l
0680: 69 73 74 20 20 22 2d 68 22 0a 09 09 09 22 2d 67 ist "-h"...."-g
0690: 75 69 6d 6f 6e 69 74 6f 72 22 0a 09 09 09 22 2d uimonitor"...."-
06a0: 6d 61 69 6e 22 0a 09 09 09 22 2d 76 22 0a 09 09 main"...."-v"...
06b0: 09 22 2d 71 22 0a 09 09 20 20 20 20 20 20 20 29 ."-q"... )
06c0: 0a 09 09 20 61 72 67 73 3a 61 72 67 2d 68 61 73 ... args:arg-has
06d0: 68 0a 09 09 20 30 29 29 0a 0a 28 69 66 20 28 61 h... 0))..(if (a
06e0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 68 22 rgs:get-arg "-h"
06f0: 29 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 ). (begin.
0700: 20 20 20 28 70 72 69 6e 74 20 68 65 6c 70 29 0a (print help).
0710: 20 20 20 20 20 20 28 65 78 69 74 29 29 29 0a 0a (exit)))..
0720: 28 69 66 20 28 6e 6f 74 20 28 73 65 74 75 70 2d (if (not (setup-
0730: 66 6f 72 2d 72 75 6e 29 29 0a 20 20 20 20 28 62 for-run)). (b
0740: 65 67 69 6e 0a 20 20 20 20 20 20 28 70 72 69 6e egin. (prin
0750: 74 20 22 46 61 69 6c 65 64 20 74 6f 20 66 69 6e t "Failed to fin
0760: 64 20 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 d megatest.confi
0770: 67 2c 20 65 78 69 74 69 6e 67 22 29 20 0a 20 20 g, exiting") .
0780: 20 20 20 20 28 65 78 69 74 20 31 29 29 29 0a 0a (exit 1)))..
0790: 28 64 65 66 69 6e 65 20 2a 64 62 2a 20 23 66 29 (define *db* #f)
07a0: 20 3b 3b 20 28 6f 70 65 6e 2d 64 62 29 29 0a 0a ;; (open-db))..
07b0: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
07c0: 67 20 22 2d 68 6f 73 74 22 29 0a 20 20 20 20 28 g "-host"). (
07d0: 62 65 67 69 6e 0a 20 20 20 20 20 20 28 73 65 74 begin. (set
07e0: 21 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 28 73 ! *runremote* (s
07f0: 74 72 69 6e 67 2d 73 70 6c 69 74 20 28 61 72 67 tring-split (arg
0800: 73 3a 67 65 74 2d 61 72 67 20 22 2d 68 6f 73 74 s:get-arg "-host
0810: 22 20 22 3a 22 29 29 29 0a 20 20 20 20 20 20 28 " ":"))). (
0820: 63 6c 69 65 6e 74 3a 6c 61 75 6e 63 68 29 29 0a client:launch)).
0830: 20 20 20 20 28 63 6c 69 65 6e 74 3a 6c 61 75 6e (client:laun
0840: 63 68 29 29 0a 0a 3b 3b 20 48 41 43 4b 20 41 4c ch))..;; HACK AL
0850: 45 52 54 3a 20 74 68 69 73 20 69 73 20 61 20 68 ERT: this is a h
0860: 61 63 6b 2c 20 70 6c 65 61 73 65 20 66 69 78 2e ack, please fix.
0870: 0a 28 64 65 66 69 6e 65 20 2a 72 65 61 64 2d 6f .(define *read-o
0880: 6e 6c 79 2a 20 28 6e 6f 74 20 28 66 69 6c 65 2d nly* (not (file-
0890: 72 65 61 64 2d 61 63 63 65 73 73 3f 20 28 63 6f read-access? (co
08a0: 6e 63 20 2a 74 6f 70 70 61 74 68 2a 20 22 2f 6d nc *toppath* "/m
08b0: 65 67 61 74 65 73 74 2e 64 62 22 29 29 29 29 0a egatest.db")))).
08c0: 3b 3b 20 28 63 6c 69 65 6e 74 3a 73 65 74 75 70 ;; (client:setup
08d0: 20 2a 64 62 2a 29 0a 0a 28 64 65 66 69 6e 65 20 *db*)..(define
08e0: 74 6f 70 6c 65 76 65 6c 20 23 66 29 0a 28 64 65 toplevel #f).(de
08f0: 66 69 6e 65 20 64 6c 67 20 20 20 20 20 20 23 66 fine dlg #f
0900: 29 0a 28 64 65 66 69 6e 65 20 6d 61 78 2d 74 65 ).(define max-te
0910: 73 74 2d 6e 75 6d 20 30 29 0a 3b 3b 20 28 64 65 st-num 0).;; (de
0920: 66 69 6e 65 20 2a 6b 65 79 73 2a 20 20 20 28 6f fine *keys* (o
0930: 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 64 62 pen-run-close db
0940: 3a 67 65 74 2d 6b 65 79 73 20 23 66 29 29 0a 28 :get-keys #f)).(
0950: 64 65 66 69 6e 65 20 2a 6b 65 79 73 2a 20 20 20 define *keys*
0960: 28 63 64 62 3a 72 65 6d 6f 74 65 2d 72 75 6e 20 (cdb:remote-run
0970: 64 62 3a 67 65 74 2d 6b 65 79 73 20 23 66 29 29 db:get-keys #f))
0980: 0a 3b 3b 20 28 64 65 66 69 6e 65 20 2a 6b 65 79 .;; (define *key
0990: 73 2a 20 20 20 28 64 62 3a 67 65 74 2d 6b 65 79 s* (db:get-key
09a0: 73 20 20 20 2a 64 62 2a 29 29 0a 28 64 65 66 69 s *db*)).(defi
09b0: 6e 65 20 2a 64 62 6b 65 79 73 2a 20 20 28 6d 61 ne *dbkeys* (ma
09c0: 70 20 28 6c 61 6d 62 64 61 20 28 78 29 28 76 65 p (lambda (x)(ve
09d0: 63 74 6f 72 2d 72 65 66 20 78 20 30 29 29 0a 09 ctor-ref x 0))..
09e0: 09 20 20 20 20 20 20 28 61 70 70 65 6e 64 20 2a . (append *
09f0: 6b 65 79 73 2a 20 28 6c 69 73 74 20 28 76 65 63 keys* (list (vec
0a00: 74 6f 72 20 22 72 75 6e 6e 61 6d 65 22 20 22 62 tor "runname" "b
0a10: 6c 61 68 22 29 29 29 29 29 0a 28 64 65 66 69 6e lah"))))).(defin
0a20: 65 20 2a 68 65 61 64 65 72 2a 20 20 20 20 20 20 e *header*
0a30: 20 23 66 29 0a 28 64 65 66 69 6e 65 20 2a 61 6c #f).(define *al
0a40: 6c 72 75 6e 73 2a 20 20 20 20 20 27 28 29 29 0a lruns* '()).
0a50: 28 64 65 66 69 6e 65 20 2a 61 6c 6c 72 75 6e 73 (define *allruns
0a60: 2d 62 79 2d 69 64 2a 20 28 6d 61 6b 65 2d 68 61 -by-id* (make-ha
0a70: 73 68 2d 74 61 62 6c 65 29 29 20 3b 3b 20 0a 28 sh-table)) ;; .(
0a80: 64 65 66 69 6e 65 20 2a 72 75 6e 63 68 61 6e 67 define *runchang
0a90: 65 72 61 74 65 2a 20 28 6d 61 6b 65 2d 68 61 73 erate* (make-has
0aa0: 68 2d 74 61 62 6c 65 29 29 0a 0a 28 64 65 66 69 h-table))..(defi
0ab0: 6e 65 20 2a 62 75 74 74 6f 6e 64 61 74 2a 20 20 ne *buttondat*
0ac0: 20 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 (make-hash-tab
0ad0: 6c 65 29 29 20 3b 3b 20 3c 72 75 6e 2d 69 64 20 le)) ;; <run-id
0ae0: 63 6f 6c 6f 72 20 74 65 78 74 20 74 65 73 74 20 color text test
0af0: 72 75 6e 2d 6b 65 79 3e 0a 28 64 65 66 69 6e 65 run-key>.(define
0b00: 20 2a 61 6c 6c 74 65 73 74 6e 61 6d 65 6c 73 74 *alltestnamelst
0b10: 2a 20 27 28 29 29 0a 28 64 65 66 69 6e 65 20 2a * '()).(define *
0b20: 73 65 61 72 63 68 70 61 74 74 73 2a 20 20 28 6d searchpatts* (m
0b30: 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 ake-hash-table))
0b40: 0a 28 64 65 66 69 6e 65 20 2a 6e 75 6d 2d 72 75 .(define *num-ru
0b50: 6e 73 2a 20 20 20 20 20 20 38 29 0a 28 64 65 66 ns* 8).(def
0b60: 69 6e 65 20 2a 74 6f 74 2d 72 75 6e 2d 63 6f 75 ine *tot-run-cou
0b70: 6e 74 2a 20 28 63 64 62 3a 72 65 6d 6f 74 65 2d nt* (cdb:remote-
0b80: 72 75 6e 20 64 62 3a 67 65 74 2d 6e 75 6d 2d 72 run db:get-num-r
0b90: 75 6e 73 20 23 66 20 22 25 22 29 29 0a 3b 3b 20 uns #f "%")).;;
0ba0: 28 64 65 66 69 6e 65 20 2a 74 6f 74 2d 72 75 6e (define *tot-run
0bb0: 2d 63 6f 75 6e 74 2a 20 28 64 62 3a 67 65 74 2d -count* (db:get-
0bc0: 6e 75 6d 2d 72 75 6e 73 20 2a 64 62 2a 20 22 25 num-runs *db* "%
0bd0: 22 29 29 0a 28 64 65 66 69 6e 65 20 2a 6c 61 73 ")).(define *las
0be0: 74 2d 75 70 64 61 74 65 2a 20 20 20 28 63 75 72 t-update* (cur
0bf0: 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 29 0a 28 rent-seconds)).(
0c00: 64 65 66 69 6e 65 20 2a 6e 75 6d 2d 74 65 73 74 define *num-test
0c10: 73 2a 20 20 20 20 20 31 35 29 0a 28 64 65 66 69 s* 15).(defi
0c20: 6e 65 20 2a 73 74 61 72 74 2d 72 75 6e 2d 6f 66 ne *start-run-of
0c30: 66 73 65 74 2a 20 20 30 29 0a 28 64 65 66 69 6e fset* 0).(defin
0c40: 65 20 2a 73 74 61 72 74 2d 74 65 73 74 2d 6f 66 e *start-test-of
0c50: 66 73 65 74 2a 20 30 29 0a 28 64 65 66 69 6e 65 fset* 0).(define
0c60: 20 2a 65 78 61 6d 69 6e 65 2d 74 65 73 74 2d 64 *examine-test-d
0c70: 61 74 2a 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 at* (make-hash-t
0c80: 61 62 6c 65 29 29 0a 28 64 65 66 69 6e 65 20 2a able)).(define *
0c90: 65 78 69 74 2d 73 74 61 72 74 65 64 2a 20 23 66 exit-started* #f
0ca0: 29 0a 28 64 65 66 69 6e 65 20 2a 73 74 61 74 75 ).(define *statu
0cb0: 73 2d 69 67 6e 6f 72 65 2d 68 61 73 68 2a 20 28 s-ignore-hash* (
0cc0: 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 make-hash-table)
0cd0: 29 0a 28 64 65 66 69 6e 65 20 2a 73 74 61 74 65 ).(define *state
0ce0: 2d 69 67 6e 6f 72 65 2d 68 61 73 68 2a 20 20 28 -ignore-hash* (
0cf0: 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 make-hash-table)
0d00: 29 0a 0a 28 64 65 66 69 6e 65 20 2a 6c 61 73 74 )..(define *last
0d10: 2d 64 62 2d 75 70 64 61 74 65 2d 74 69 6d 65 2a -db-update-time*
0d20: 20 30 29 0a 28 64 65 66 69 6e 65 20 2a 70 6c 65 0).(define *ple
0d30: 61 73 65 2d 75 70 64 61 74 65 2d 62 75 74 74 6f ase-update-butto
0d40: 6e 73 2a 20 23 74 29 0a 28 64 65 66 69 6e 65 20 ns* #t).(define
0d50: 2a 64 65 6c 61 79 65 64 2d 75 70 64 61 74 65 2a *delayed-update*
0d60: 20 30 29 0a 0a 28 64 65 66 69 6e 65 20 2a 64 62 0)..(define *db
0d70: 2d 66 69 6c 65 2d 70 61 74 68 2a 20 28 63 6f 6e -file-path* (con
0d80: 63 20 2a 74 6f 70 70 61 74 68 2a 20 22 2f 6d 65 c *toppath* "/me
0d90: 67 61 74 65 73 74 2e 64 62 22 29 29 0a 0a 28 64 gatest.db"))..(d
0da0: 65 66 69 6e 65 20 2a 74 65 73 74 73 2d 73 6f 72 efine *tests-sor
0db0: 74 2d 72 65 76 65 72 73 65 2a 20 23 66 29 0a 28 t-reverse* #f).(
0dc0: 64 65 66 69 6e 65 20 2a 68 69 64 65 2d 65 6d 70 define *hide-emp
0dd0: 74 79 2d 72 75 6e 73 2a 20 23 66 29 0a 0a 28 64 ty-runs* #f)..(d
0de0: 65 62 75 67 3a 73 65 74 75 70 29 0a 0a 28 64 65 ebug:setup)..(de
0df0: 66 69 6e 65 20 75 69 64 61 74 20 23 66 29 0a 0a fine uidat #f)..
0e00: 28 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 (define-inline (
0e10: 64 62 6f 61 72 64 3a 75 69 64 61 74 2d 67 65 74 dboard:uidat-get
0e20: 2d 6b 65 79 63 6f 6c 20 20 76 65 63 29 28 76 65 -keycol vec)(ve
0e30: 63 74 6f 72 2d 72 65 66 20 76 65 63 20 30 29 29 ctor-ref vec 0))
0e40: 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 .(define-inline
0e50: 28 64 62 6f 61 72 64 3a 75 69 64 61 74 2d 67 65 (dboard:uidat-ge
0e60: 74 2d 6c 66 74 63 6f 6c 20 20 76 65 63 29 28 76 t-lftcol vec)(v
0e70: 65 63 74 6f 72 2d 72 65 66 20 76 65 63 20 31 29 ector-ref vec 1)
0e80: 29 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 ).(define-inline
0e90: 20 28 64 62 6f 61 72 64 3a 75 69 64 61 74 2d 67 (dboard:uidat-g
0ea0: 65 74 2d 68 65 61 64 65 72 20 20 76 65 63 29 28 et-header vec)(
0eb0: 76 65 63 74 6f 72 2d 72 65 66 20 76 65 63 20 32 vector-ref vec 2
0ec0: 29 29 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 69 6e )).(define-inlin
0ed0: 65 20 28 64 62 6f 61 72 64 3a 75 69 64 61 74 2d e (dboard:uidat-
0ee0: 67 65 74 2d 72 75 6e 73 76 65 63 20 76 65 63 29 get-runsvec vec)
0ef0: 28 76 65 63 74 6f 72 2d 72 65 66 20 76 65 63 20 (vector-ref vec
0f00: 33 29 29 0a 0a 0a 28 64 65 66 69 6e 65 20 28 6d 3))...(define (m
0f10: 65 73 73 61 67 65 2d 77 69 6e 64 6f 77 20 6d 73 essage-window ms
0f20: 67 29 0a 20 20 28 69 75 70 3a 73 68 6f 77 0a 20 g). (iup:show.
0f30: 20 20 28 69 75 70 3a 64 69 61 6c 6f 67 0a 20 20 (iup:dialog.
0f40: 20 20 28 69 75 70 3a 76 62 6f 78 20 0a 20 20 20 (iup:vbox .
0f50: 20 20 28 69 75 70 3a 6c 61 62 65 6c 20 6d 73 67 (iup:label msg
0f60: 20 23 3a 6d 61 72 67 69 6e 20 22 34 30 78 34 30 #:margin "40x40
0f70: 22 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 ")))))..(define
0f80: 28 69 75 70 6c 69 73 74 62 6f 78 2d 66 69 6c 6c (iuplistbox-fill
0f90: 2d 6c 69 73 74 20 6c 62 20 69 74 65 6d 73 20 2e -list lb items .
0fa0: 20 64 65 66 61 75 6c 74 29 0a 20 20 28 6c 65 74 default). (let
0fb0: 20 28 28 69 20 31 29 0a 09 28 73 65 6c 65 63 74 ((i 1)..(select
0fc0: 65 64 2d 69 74 65 6d 20 28 69 66 20 28 6e 75 6c ed-item (if (nul
0fd0: 6c 3f 20 64 65 66 61 75 6c 74 29 20 23 66 20 28 l? default) #f (
0fe0: 63 61 72 20 64 65 66 61 75 6c 74 29 29 29 29 0a car default)))).
0ff0: 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 (iup:attribu
1000: 74 65 2d 73 65 74 21 20 6c 62 20 22 56 41 4c 55 te-set! lb "VALU
1010: 45 22 20 28 69 66 20 73 65 6c 65 63 74 65 64 2d E" (if selected-
1020: 69 74 65 6d 20 73 65 6c 65 63 74 65 64 2d 69 74 item selected-it
1030: 65 6d 20 22 22 29 29 0a 20 20 20 20 28 66 6f 72 em "")). (for
1040: 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 69 -each (lambda (i
1050: 74 65 6d 29 0a 09 09 28 69 75 70 3a 61 74 74 72 tem)...(iup:attr
1060: 69 62 75 74 65 2d 73 65 74 21 20 6c 62 20 28 6e ibute-set! lb (n
1070: 75 6d 62 65 72 2d 3e 73 74 72 69 6e 67 20 69 29 umber->string i)
1080: 20 69 74 65 6d 29 0a 09 09 28 69 66 20 73 65 6c item)...(if sel
1090: 65 63 74 65 64 2d 69 74 65 6d 0a 09 09 20 20 20 ected-item...
10a0: 20 28 69 66 20 28 65 71 75 61 6c 3f 20 73 65 6c (if (equal? sel
10b0: 65 63 74 65 64 2d 69 74 65 6d 20 69 74 65 6d 29 ected-item item)
10c0: 0a 09 09 09 28 69 75 70 3a 61 74 74 72 69 62 75 ....(iup:attribu
10d0: 74 65 2d 73 65 74 21 20 6c 62 20 22 56 41 4c 55 te-set! lb "VALU
10e0: 45 22 20 69 74 65 6d 29 29 29 20 3b 3b 20 28 6e E" item))) ;; (n
10f0: 75 6d 62 65 72 2d 3e 73 74 72 69 6e 67 20 69 29 umber->string i)
1100: 29 29 29 0a 09 09 28 73 65 74 21 20 69 20 28 2b )))...(set! i (+
1110: 20 69 20 31 29 29 29 0a 09 20 20 20 20 20 20 69 i 1))).. i
1120: 74 65 6d 73 29 0a 20 20 20 20 69 29 29 0a 0a 28 tems). i))..(
1130: 64 65 66 69 6e 65 20 28 70 61 64 2d 6c 69 73 74 define (pad-list
1140: 20 6c 20 6e 29 28 61 70 70 65 6e 64 20 6c 20 28 l n)(append l (
1150: 6d 61 6b 65 2d 6c 69 73 74 20 28 2d 20 6e 20 28 make-list (- n (
1160: 6c 65 6e 67 74 68 20 6c 29 29 29 29 29 0a 0a 28 length l)))))..(
1170: 64 65 66 69 6e 65 20 28 63 6f 6c 6f 72 73 2d 73 define (colors-s
1180: 69 6d 69 6c 61 72 3f 20 63 6f 6c 6f 72 31 20 63 imilar? color1 c
1190: 6f 6c 6f 72 32 29 0a 20 20 28 6c 65 74 2a 20 28 olor2). (let* (
11a0: 28 63 31 20 28 6d 61 70 20 73 74 72 69 6e 67 2d (c1 (map string-
11b0: 3e 6e 75 6d 62 65 72 20 28 73 74 72 69 6e 67 2d >number (string-
11c0: 73 70 6c 69 74 20 63 6f 6c 6f 72 31 29 29 29 0a split color1))).
11d0: 09 20 28 63 32 20 28 6d 61 70 20 73 74 72 69 6e . (c2 (map strin
11e0: 67 2d 3e 6e 75 6d 62 65 72 20 28 73 74 72 69 6e g->number (strin
11f0: 67 2d 73 70 6c 69 74 20 63 6f 6c 6f 72 32 29 29 g-split color2))
1200: 29 0a 09 20 28 64 65 6c 74 61 20 28 6d 61 70 20 ).. (delta (map
1210: 28 6c 61 6d 62 64 61 20 28 61 20 62 29 28 61 62 (lambda (a b)(ab
1220: 73 20 28 2d 20 61 20 62 29 29 29 20 63 31 20 63 s (- a b))) c1 c
1230: 32 29 29 29 0a 20 20 20 20 28 6e 75 6c 6c 3f 20 2))). (null?
1240: 28 66 69 6c 74 65 72 20 28 6c 61 6d 62 64 61 20 (filter (lambda
1250: 28 78 29 28 3e 20 78 20 33 29 29 20 64 65 6c 74 (x)(> x 3)) delt
1260: 61 29 29 29 29 0a 0a 3b 3b 20 6b 65 79 70 61 74 a))))..;; keypat
1270: 74 73 3a 20 28 20 28 4b 45 59 31 20 22 61 62 63 ts: ( (KEY1 "abc
1280: 25 64 65 66 22 29 28 4b 45 59 32 20 22 25 22 29 %def")(KEY2 "%")
1290: 20 29 0a 28 64 65 66 69 6e 65 20 28 75 70 64 61 ).(define (upda
12a0: 74 65 2d 72 75 6e 64 61 74 20 72 75 6e 6e 61 6d te-rundat runnam
12b0: 65 70 61 74 74 20 6e 75 6d 72 75 6e 73 20 74 65 epatt numruns te
12c0: 73 74 6e 61 6d 65 70 61 74 74 20 6b 65 79 70 61 stnamepatt keypa
12d0: 74 74 73 29 0a 20 20 28 6c 65 74 20 28 28 6d 6f tts). (let ((mo
12e0: 64 74 69 6d 65 20 20 20 20 20 20 20 20 20 20 20 dtime
12f0: 20 20 28 66 69 6c 65 2d 6d 6f 64 69 66 69 63 61 (file-modifica
1300: 74 69 6f 6e 2d 74 69 6d 65 20 2a 64 62 2d 66 69 tion-time *db-fi
1310: 6c 65 2d 70 61 74 68 2a 29 29 0a 09 28 72 65 66 le-path*))..(ref
1320: 65 72 65 6e 63 65 64 2d 72 75 6e 2d 69 64 73 20 erenced-run-ids
1330: 27 28 29 29 29 0a 20 20 20 20 28 69 66 20 28 6f '())). (if (o
1340: 72 20 28 61 6e 64 20 28 3e 20 6d 6f 64 74 69 6d r (and (> modtim
1350: 65 20 2a 6c 61 73 74 2d 64 62 2d 75 70 64 61 74 e *last-db-updat
1360: 65 2d 74 69 6d 65 2a 29 0a 09 09 20 28 3e 20 28 e-time*)... (> (
1370: 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 current-seconds)
1380: 28 2b 20 2a 6c 61 73 74 2d 64 62 2d 75 70 64 61 (+ *last-db-upda
1390: 74 65 2d 74 69 6d 65 2a 20 35 29 29 29 0a 09 20 te-time* 5)))..
13a0: 20 20 20 28 3e 20 2a 64 65 6c 61 79 65 64 2d 75 (> *delayed-u
13b0: 70 64 61 74 65 2a 20 30 29 29 0a 09 3b 3b 0a 09 pdate* 0))..;;..
13c0: 3b 3b 20 52 75 6e 20 74 68 69 73 20 73 74 75 66 ;; Run this stuf
13d0: 66 20 6f 6e 6c 79 20 77 68 65 6e 20 74 68 65 20 f only when the
13e0: 6d 65 67 61 74 65 73 74 2e 64 62 20 66 69 6c 65 megatest.db file
13f0: 20 68 61 73 20 63 68 61 6e 67 65 64 0a 09 3b 3b has changed..;;
1400: 0a 09 28 6c 65 74 20 28 28 66 75 6c 6c 2d 72 75 ..(let ((full-ru
1410: 6e 20 28 3e 20 28 72 61 6e 64 6f 6d 20 31 30 30 n (> (random 100
1420: 29 20 37 35 29 29 29 20 3b 3b 20 32 35 25 20 6f ) 75))) ;; 25% o
1430: 66 20 74 68 65 20 74 69 6d 65 20 64 6f 20 61 20 f the time do a
1440: 66 75 6c 6c 20 72 65 66 72 65 73 68 0a 09 20 20 full refresh..
1450: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 (debug:print-inf
1460: 6f 20 34 20 22 75 70 64 61 74 65 2d 72 75 6e 64 o 4 "update-rund
1470: 61 74 20 72 75 6e 6e 61 6d 65 70 61 74 74 3a 20 at runnamepatt:
1480: 22 20 72 75 6e 6e 61 6d 65 70 61 74 74 20 22 20 " runnamepatt "
1490: 6e 75 6d 72 75 6e 73 3a 20 22 20 6e 75 6d 72 75 numruns: " numru
14a0: 6e 73 20 22 20 74 65 73 74 6e 61 6d 65 70 61 74 ns " testnamepat
14b0: 74 3a 20 22 20 74 65 73 74 6e 61 6d 65 70 61 74 t: " testnamepat
14c0: 74 20 22 20 6b 65 79 70 61 74 74 73 3a 20 22 20 t " keypatts: "
14d0: 6b 65 79 70 61 74 74 73 29 0a 09 20 20 28 73 65 keypatts).. (se
14e0: 74 21 20 2a 70 6c 65 61 73 65 2d 75 70 64 61 74 t! *please-updat
14f0: 65 2d 62 75 74 74 6f 6e 73 2a 20 23 74 29 0a 09 e-buttons* #t)..
1500: 20 20 28 73 65 74 21 20 2a 6c 61 73 74 2d 64 62 (set! *last-db
1510: 2d 75 70 64 61 74 65 2d 74 69 6d 65 2a 20 6d 6f -update-time* mo
1520: 64 74 69 6d 65 29 0a 09 20 20 28 73 65 74 21 20 dtime).. (set!
1530: 2a 64 65 6c 61 79 65 64 2d 75 70 64 61 74 65 2a *delayed-update*
1540: 20 28 2d 20 2a 64 65 6c 61 79 65 64 2d 75 70 64 (- *delayed-upd
1550: 61 74 65 2a 20 31 29 29 0a 09 20 20 28 6c 65 74 ate* 1)).. (let
1560: 2a 20 28 28 61 6c 6c 72 75 6e 73 20 20 20 20 20 * ((allruns
1570: 28 63 64 62 3a 72 65 6d 6f 74 65 2d 72 75 6e 20 (cdb:remote-run
1580: 64 62 3a 67 65 74 2d 72 75 6e 73 20 23 66 20 72 db:get-runs #f r
1590: 75 6e 6e 61 6d 65 70 61 74 74 20 6e 75 6d 72 75 unnamepatt numru
15a0: 6e 73 20 3b 3b 20 28 2b 20 6e 75 6d 72 75 6e 73 ns ;; (+ numruns
15b0: 20 31 29 20 3b 3b 20 28 2f 20 6e 75 6d 72 75 6e 1) ;; (/ numrun
15c0: 73 20 32 29 29 0a 09 09 09 09 09 20 20 20 2a 73 s 2))...... *s
15d0: 74 61 72 74 2d 72 75 6e 2d 6f 66 66 73 65 74 2a tart-run-offset*
15e0: 20 6b 65 79 70 61 74 74 73 29 29 0a 09 09 20 28 keypatts))... (
15f0: 68 65 61 64 65 72 20 20 20 20 20 20 28 64 62 3a header (db:
1600: 67 65 74 2d 68 65 61 64 65 72 20 61 6c 6c 72 75 get-header allru
1610: 6e 73 29 29 0a 09 09 20 28 72 75 6e 73 20 20 20 ns))... (runs
1620: 20 20 20 20 20 28 64 62 3a 67 65 74 2d 72 6f 77 (db:get-row
1630: 73 20 20 20 61 6c 6c 72 75 6e 73 29 29 0a 09 09 s allruns))...
1640: 20 28 72 65 73 75 6c 74 20 20 20 20 20 20 27 28 (result '(
1650: 29 29 0a 09 09 20 28 6d 61 78 74 65 73 74 73 20 ))... (maxtests
1660: 20 20 20 30 29 0a 09 09 20 28 73 74 61 74 65 73 0)... (states
1670: 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c (hash-tabl
1680: 65 2d 6b 65 79 73 20 2a 73 74 61 74 65 2d 69 67 e-keys *state-ig
1690: 6e 6f 72 65 2d 68 61 73 68 2a 29 29 0a 09 09 20 nore-hash*))...
16a0: 28 73 74 61 74 75 73 65 73 20 20 20 20 28 68 61 (statuses (ha
16b0: 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 2a 73 sh-table-keys *s
16c0: 74 61 74 75 73 2d 69 67 6e 6f 72 65 2d 68 61 73 tatus-ignore-has
16d0: 68 2a 29 29 29 0a 09 20 20 20 20 3b 3b 20 28 74 h*))).. ;; (t
16e0: 68 72 65 61 64 2d 73 6c 65 65 70 21 20 30 2e 31 hread-sleep! 0.1
16f0: 29 20 3b 3b 20 67 69 76 65 20 73 6f 6d 65 20 74 ) ;; give some t
1700: 69 6d 65 20 74 6f 20 6f 74 68 65 72 20 74 68 72 ime to other thr
1710: 65 61 64 73 0a 09 20 20 20 20 28 64 65 62 75 67 eads.. (debug
1720: 3a 70 72 69 6e 74 20 36 20 22 75 70 64 61 74 65 :print 6 "update
1730: 2d 72 75 6e 64 61 74 2c 20 67 6f 74 20 22 20 28 -rundat, got " (
1740: 6c 65 6e 67 74 68 20 72 75 6e 73 29 20 22 20 72 length runs) " r
1750: 75 6e 73 22 29 0a 09 20 20 20 20 28 69 66 20 28 uns").. (if (
1760: 3e 20 28 2b 20 2a 6c 61 73 74 2d 75 70 64 61 74 > (+ *last-updat
1770: 65 2a 20 33 30 30 29 20 28 63 75 72 72 65 6e 74 e* 300) (current
1780: 2d 73 65 63 6f 6e 64 73 29 29 20 3b 3b 20 65 76 -seconds)) ;; ev
1790: 65 72 79 20 66 69 76 65 20 6d 69 6e 75 74 65 73 ery five minutes
17a0: 0a 09 09 28 62 65 67 69 6e 0a 09 09 20 20 28 73 ...(begin... (s
17b0: 65 74 21 20 2a 6c 61 73 74 2d 75 70 64 61 74 65 et! *last-update
17c0: 2a 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e * (current-secon
17d0: 64 73 29 29 0a 09 09 20 20 28 73 65 74 21 20 2a ds))... (set! *
17e0: 74 6f 74 2d 72 75 6e 2d 63 6f 75 6e 74 2a 20 28 tot-run-count* (
17f0: 6c 65 6e 67 74 68 20 72 75 6e 73 29 29 29 29 0a length runs)))).
1800: 09 20 20 20 20 3b 3b 20 0a 09 20 20 20 20 3b 3b . ;; .. ;;
1810: 20 74 72 69 6d 20 72 75 6e 73 20 74 6f 20 6f 6e trim runs to on
1820: 6c 79 20 74 68 6f 73 65 20 74 68 61 74 20 61 72 ly those that ar
1830: 65 20 63 68 61 6e 67 69 6e 67 20 6f 66 74 65 6e e changing often
1840: 20 68 65 72 65 0a 0a 09 20 20 20 20 3b 3b 20 0a here... ;; .
1850: 09 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 . (for-each (
1860: 6c 61 6d 62 64 61 20 28 72 75 6e 29 0a 09 09 09 lambda (run)....
1870: 28 6c 65 74 2a 20 28 28 72 75 6e 2d 69 64 20 20 (let* ((run-id
1880: 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 (db:get-value-b
1890: 79 2d 68 65 61 64 65 72 20 72 75 6e 20 68 65 61 y-header run hea
18a0: 64 65 72 20 22 69 64 22 29 29 0a 09 09 09 20 20 der "id"))....
18b0: 20 20 20 20 20 28 74 65 73 74 73 20 20 20 20 28 (tests (
18c0: 6c 65 74 20 28 28 74 73 74 73 20 28 63 64 62 3a let ((tsts (cdb:
18d0: 72 65 6d 6f 74 65 2d 72 75 6e 20 64 62 3a 67 65 remote-run db:ge
18e0: 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e 20 t-tests-for-run
18f0: 23 66 20 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 #f run-id testna
1900: 6d 65 70 61 74 74 20 73 74 61 74 65 73 20 73 74 mepatt states st
1910: 61 74 75 73 65 73 29 29 29 0a 09 09 09 09 09 20 atuses)))......
1920: 20 20 28 69 66 20 2a 74 65 73 74 73 2d 73 6f 72 (if *tests-sor
1930: 74 2d 72 65 76 65 72 73 65 2a 20 28 72 65 76 65 t-reverse* (reve
1940: 72 73 65 20 74 73 74 73 29 20 74 73 74 73 29 29 rse tsts) tsts))
1950: 29 0a 09 09 09 20 20 20 20 20 20 20 28 6b 65 79 ).... (key
1960: 2d 76 61 6c 73 20 28 63 64 62 3a 72 65 6d 6f 74 -vals (cdb:remot
1970: 65 2d 72 75 6e 20 64 62 3a 67 65 74 2d 6b 65 79 e-run db:get-key
1980: 2d 76 61 6c 73 20 23 66 20 72 75 6e 2d 69 64 29 -vals #f run-id)
1990: 29 29 0a 09 09 09 20 20 3b 3b 20 4e 6f 74 20 73 )).... ;; Not s
19a0: 75 72 65 20 74 68 69 73 20 69 73 20 6e 65 65 64 ure this is need
19b0: 65 64 3f 0a 09 09 09 20 20 28 73 65 74 21 20 72 ed?.... (set! r
19c0: 65 66 65 72 65 6e 63 65 64 2d 72 75 6e 2d 69 64 eferenced-run-id
19d0: 73 20 28 63 6f 6e 73 20 72 75 6e 2d 69 64 20 72 s (cons run-id r
19e0: 65 66 65 72 65 6e 63 65 64 2d 72 75 6e 2d 69 64 eferenced-run-id
19f0: 73 29 29 0a 09 09 09 20 20 28 69 66 20 28 3e 20 s)).... (if (>
1a00: 28 6c 65 6e 67 74 68 20 74 65 73 74 73 29 20 6d (length tests) m
1a10: 61 78 74 65 73 74 73 29 0a 09 09 09 20 20 20 20 axtests)....
1a20: 20 20 28 73 65 74 21 20 6d 61 78 74 65 73 74 73 (set! maxtests
1a30: 20 28 6c 65 6e 67 74 68 20 74 65 73 74 73 29 29 (length tests))
1a40: 29 0a 09 09 09 20 20 28 69 66 20 28 6f 72 20 28 ).... (if (or (
1a50: 6e 6f 74 20 2a 68 69 64 65 2d 65 6d 70 74 79 2d not *hide-empty-
1a60: 72 75 6e 73 2a 29 20 3b 3b 20 74 68 69 73 20 72 runs*) ;; this r
1a70: 65 64 75 63 65 73 20 74 68 65 20 64 61 74 61 20 educes the data
1a80: 62 75 72 64 65 6e 20 77 68 65 6e 20 73 65 74 0a burden when set.
1a90: 09 09 09 09 20 20 28 6e 6f 74 20 28 6e 75 6c 6c .... (not (null
1aa0: 3f 20 74 65 73 74 73 29 29 29 0a 09 09 09 20 20 ? tests)))....
1ab0: 20 20 20 20 28 6c 65 74 20 28 28 64 73 74 72 75 (let ((dstru
1ac0: 63 74 20 28 76 65 63 74 6f 72 20 72 75 6e 20 74 ct (vector run t
1ad0: 65 73 74 73 20 6b 65 79 2d 76 61 6c 73 29 29 29 ests key-vals)))
1ae0: 0a 09 09 09 09 3b 3b 0a 09 09 09 09 3b 3b 20 63 .....;;.....;; c
1af0: 6f 6d 70 61 72 65 20 74 68 65 20 74 65 73 74 73 ompare the tests
1b00: 20 77 69 74 68 20 74 68 65 20 74 65 73 74 73 20 with the tests
1b10: 69 6e 20 2a 61 6c 6c 72 75 6e 73 2d 62 79 2d 69 in *allruns-by-i
1b20: 64 2a 20 73 61 6d 65 20 72 75 6e 2d 69 64 20 0a d* same run-id .
1b30: 09 09 09 09 3b 3b 20 69 66 20 64 69 66 66 65 72 ....;; if differ
1b40: 65 6e 74 20 74 68 65 6e 20 69 6e 63 72 65 6d 65 ent then increme
1b50: 6e 74 20 76 61 6c 75 65 20 69 6e 20 2a 72 75 6e nt value in *run
1b60: 63 68 61 6e 67 65 72 61 74 65 2a 0a 09 09 09 09 changerate*.....
1b70: 3b 3b 0a 09 09 09 09 28 68 61 73 68 2d 74 61 62 ;;.....(hash-tab
1b80: 6c 65 2d 73 65 74 21 20 2a 61 6c 6c 72 75 6e 73 le-set! *allruns
1b90: 2d 62 79 2d 69 64 2a 20 72 75 6e 2d 69 64 20 64 -by-id* run-id d
1ba0: 73 74 72 75 63 74 29 0a 09 09 09 09 28 73 65 74 struct).....(set
1bb0: 21 20 72 65 73 75 6c 74 20 28 63 6f 6e 73 20 64 ! result (cons d
1bc0: 73 74 72 75 63 74 20 72 65 73 75 6c 74 29 29 29 struct result)))
1bd0: 29 29 29 0a 09 09 20 20 20 20 20 20 72 75 6e 73 )))... runs
1be0: 29 0a 09 20 20 20 20 0a 09 20 20 20 20 3b 3b 0a ).. .. ;;.
1bf0: 09 20 20 20 20 3b 3b 20 69 66 20 66 75 6c 6c 2d . ;; if full-
1c00: 72 75 6e 20 75 73 65 20 72 65 66 65 72 65 6e 63 run use referenc
1c10: 65 64 2d 72 75 6e 2d 69 64 73 20 74 6f 20 64 65 ed-run-ids to de
1c20: 6c 65 74 65 20 64 61 74 61 20 69 6e 20 2a 61 6c lete data in *al
1c30: 6c 2d 72 75 6e 73 2d 62 79 2d 69 64 2a 20 61 6e l-runs-by-id* an
1c40: 64 20 2a 72 75 6e 63 68 61 6e 67 65 72 61 74 65 d *runchangerate
1c50: 2a 0a 09 20 20 20 20 3b 3b 0a 0a 09 20 20 20 20 *.. ;;...
1c60: 28 73 65 74 21 20 2a 68 65 61 64 65 72 2a 20 20 (set! *header*
1c70: 68 65 61 64 65 72 29 0a 09 20 20 20 20 28 73 65 header).. (se
1c80: 74 21 20 2a 61 6c 6c 72 75 6e 73 2a 20 72 65 73 t! *allruns* res
1c90: 75 6c 74 29 0a 09 20 20 20 20 28 64 65 62 75 67 ult).. (debug
1ca0: 3a 70 72 69 6e 74 20 36 20 22 2a 61 6c 6c 72 75 :print 6 "*allru
1cb0: 6e 73 2a 20 68 61 73 20 22 20 28 6c 65 6e 67 74 ns* has " (lengt
1cc0: 68 20 2a 61 6c 6c 72 75 6e 73 2a 29 20 22 20 72 h *allruns*) " r
1cd0: 75 6e 73 22 29 0a 09 20 20 20 20 3b 3b 20 28 73 uns").. ;; (s
1ce0: 65 74 21 20 2a 74 6f 74 2d 72 75 6e 2d 63 6f 75 et! *tot-run-cou
1cf0: 6e 74 2a 20 28 2b 20 31 20 28 6c 65 6e 67 74 68 nt* (+ 1 (length
1d00: 20 2a 61 6c 6c 72 75 6e 73 2a 29 29 29 0a 09 20 *allruns*)))..
1d10: 20 20 20 6d 61 78 74 65 73 74 73 29 29 0a 09 3b maxtests))..;
1d20: 3b 20 0a 09 3b 3b 20 52 75 6e 20 74 68 69 73 20 ; ..;; Run this
1d30: 69 66 20 74 68 65 20 6d 65 67 61 74 65 73 74 2e if the megatest.
1d40: 64 62 20 66 69 6c 65 20 64 69 64 20 6e 6f 74 20 db file did not
1d50: 67 65 74 20 74 6f 75 63 68 65 64 0a 09 3b 3b 0a get touched..;;.
1d60: 09 28 62 65 67 69 6e 0a 09 20 20 0a 09 20 20 2a .(begin.. .. *
1d70: 6e 75 6d 2d 74 65 73 74 73 2a 29 29 29 29 20 3b num-tests*)))) ;
1d80: 3b 20 46 49 58 4d 45 2c 20 6e 61 75 67 68 74 79 ; FIXME, naughty
1d90: 20 63 6f 64 69 6e 67 20 65 68 3f 0a 0a 28 64 65 coding eh?..(de
1da0: 66 69 6e 65 20 2a 63 6f 6c 6c 61 70 73 65 64 2a fine *collapsed*
1db0: 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c (make-hash-tabl
1dc0: 65 29 29 0a 3b 20 28 64 65 66 69 6e 65 20 2a 72 e)).; (define *r
1dd0: 6f 77 2d 6c 6f 6f 6b 75 70 2a 20 28 6d 61 6b 65 ow-lookup* (make
1de0: 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 20 3b 3b -hash-table)) ;;
1df0: 20 74 65 73 74 6e 61 6d 65 20 3d 3e 20 28 72 6f testname => (ro
1e00: 77 6e 75 6d 20 6c 61 62 6c 65 6f 62 6a 29 0a 0a wnum lableobj)..
1e10: 28 64 65 66 69 6e 65 20 28 74 6f 67 67 6c 65 2d (define (toggle-
1e20: 68 69 64 65 20 6c 6e 75 6d 29 20 3b 20 66 75 6c hide lnum) ; ful
1e30: 6c 74 65 73 74 6e 61 6d 65 29 0a 20 20 28 6c 65 ltestname). (le
1e40: 74 2a 20 28 28 62 74 6e 20 28 76 65 63 74 6f 72 t* ((btn (vector
1e50: 2d 72 65 66 20 28 64 62 6f 61 72 64 3a 75 69 64 -ref (dboard:uid
1e60: 61 74 2d 67 65 74 2d 6c 66 74 63 6f 6c 20 75 69 at-get-lftcol ui
1e70: 64 61 74 29 20 6c 6e 75 6d 29 29 0a 09 20 28 66 dat) lnum)).. (f
1e80: 75 6c 6c 74 65 73 74 6e 61 6d 65 20 28 69 75 70 ulltestname (iup
1e90: 3a 61 74 74 72 69 62 75 74 65 20 62 74 6e 20 22 :attribute btn "
1ea0: 54 49 54 4c 45 22 29 29 0a 09 20 28 70 61 72 74 TITLE")).. (part
1eb0: 73 20 20 20 20 20 20 20 20 28 73 74 72 69 6e 67 s (string
1ec0: 2d 73 70 6c 69 74 20 66 75 6c 6c 74 65 73 74 6e -split fulltestn
1ed0: 61 6d 65 20 22 28 22 29 29 0a 09 20 28 62 61 73 ame "(")).. (bas
1ee0: 65 74 65 73 74 6e 61 6d 65 20 28 69 66 20 28 6e etestname (if (n
1ef0: 75 6c 6c 3f 20 70 61 72 74 73 29 20 22 22 20 28 ull? parts) "" (
1f00: 63 61 72 20 70 61 72 74 73 29 29 29 29 0a 20 20 car parts)))).
1f10: 20 20 3b 28 70 72 69 6e 74 20 22 54 6f 67 67 6c ;(print "Toggl
1f20: 69 6e 67 20 22 20 62 61 73 65 74 65 73 74 6e 61 ing " basetestna
1f30: 6d 65 20 22 20 63 75 72 72 65 6e 74 6c 79 20 22 me " currently "
1f40: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
1f50: 2f 64 65 66 61 75 6c 74 20 2a 63 6f 6c 6c 61 70 /default *collap
1f60: 73 65 64 2a 20 62 61 73 65 74 65 73 74 6e 61 6d sed* basetestnam
1f70: 65 20 23 66 29 29 0a 20 20 20 20 28 69 66 20 28 e #f)). (if (
1f80: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 hash-table-ref/d
1f90: 65 66 61 75 6c 74 20 2a 63 6f 6c 6c 61 70 73 65 efault *collapse
1fa0: 64 2a 20 62 61 73 65 74 65 73 74 6e 61 6d 65 20 d* basetestname
1fb0: 23 66 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 3b #f)..(begin.. ;
1fc0: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 (iup:attribute-s
1fd0: 65 74 21 20 62 74 6e 20 22 46 47 43 4f 4c 4f 52 et! btn "FGCOLOR
1fe0: 22 20 22 30 20 30 20 30 22 29 0a 09 20 20 28 68 " "0 0 0").. (h
1ff0: 61 73 68 2d 74 61 62 6c 65 2d 64 65 6c 65 74 65 ash-table-delete
2000: 21 20 2a 63 6f 6c 6c 61 70 73 65 64 2a 20 62 61 ! *collapsed* ba
2010: 73 65 74 65 73 74 6e 61 6d 65 29 29 0a 09 28 62 setestname))..(b
2020: 65 67 69 6e 0a 09 20 20 3b 28 69 75 70 3a 61 74 egin.. ;(iup:at
2030: 74 72 69 62 75 74 65 2d 73 65 74 21 20 62 74 6e tribute-set! btn
2040: 20 22 46 47 43 4f 4c 4f 52 22 20 22 30 20 31 39 "FGCOLOR" "0 19
2050: 32 20 31 39 32 22 29 0a 09 20 20 28 68 61 73 68 2 192").. (hash
2060: 2d 74 61 62 6c 65 2d 73 65 74 21 20 2a 63 6f 6c -table-set! *col
2070: 6c 61 70 73 65 64 2a 20 62 61 73 65 74 65 73 74 lapsed* basetest
2080: 6e 61 6d 65 20 23 74 29 29 29 29 29 0a 20 20 0a name #t))))). .
2090: 28 64 65 66 69 6e 65 20 62 6c 61 6e 6b 2d 6c 69 (define blank-li
20a0: 6e 65 2d 72 78 20 28 72 65 67 65 78 70 20 22 5e ne-rx (regexp "^
20b0: 5c 5c 73 2a 24 22 29 29 0a 0a 28 64 65 66 69 6e \\s*$"))..(defin
20c0: 65 20 28 72 75 6e 2d 69 74 65 6d 2d 6e 61 6d 65 e (run-item-name
20d0: 2d 3e 76 65 63 74 6f 72 73 20 6c 73 74 29 0a 20 ->vectors lst).
20e0: 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 78 (map (lambda (x
20f0: 29 0a 09 20 28 6c 65 74 20 28 28 73 70 6c 73 74 ).. (let ((splst
2100: 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 78 (string-split x
2110: 20 22 28 22 29 29 0a 09 20 20 20 20 20 20 20 28 "(")).. (
2120: 72 65 73 20 20 20 28 76 65 63 74 6f 72 20 22 22 res (vector ""
2130: 20 22 22 29 29 29 0a 09 20 20 20 28 76 65 63 74 ""))).. (vect
2140: 6f 72 2d 73 65 74 21 20 72 65 73 20 30 20 28 63 or-set! res 0 (c
2150: 61 72 20 73 70 6c 73 74 29 29 0a 09 20 20 20 28 ar splst)).. (
2160: 69 66 20 28 3e 20 28 6c 65 6e 67 74 68 20 73 70 if (> (length sp
2170: 6c 73 74 29 20 31 29 0a 09 20 20 20 20 20 20 20 lst) 1)..
2180: 28 76 65 63 74 6f 72 2d 73 65 74 21 20 72 65 73 (vector-set! res
2190: 20 31 20 28 63 61 72 20 28 73 74 72 69 6e 67 2d 1 (car (string-
21a0: 73 70 6c 69 74 20 28 63 61 64 72 20 73 70 6c 73 split (cadr spls
21b0: 74 29 20 22 29 22 29 29 29 29 0a 09 20 20 20 72 t) ")")))).. r
21c0: 65 73 29 29 0a 20 20 20 20 20 20 20 6c 73 74 29 es)). lst)
21d0: 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 6f 6c 6c )..(define (coll
21e0: 61 70 73 65 2d 72 6f 77 73 20 69 6e 6c 73 74 29 apse-rows inlst)
21f0: 0a 20 20 28 6c 65 74 2a 20 28 28 6e 65 77 6c 73 . (let* ((newls
2200: 74 20 28 66 69 6c 74 65 72 20 28 6c 61 6d 62 64 t (filter (lambd
2210: 61 20 28 78 29 0a 09 09 09 20 20 28 6c 65 74 2a a (x).... (let*
2220: 20 28 28 74 70 61 72 74 73 20 20 20 20 28 73 74 ((tparts (st
2230: 72 69 6e 67 2d 73 70 6c 69 74 20 78 20 22 28 22 ring-split x "("
2240: 29 29 0a 09 09 09 09 20 28 62 61 73 65 74 6e 61 ))..... (basetna
2250: 6d 65 20 28 69 66 20 28 6e 75 6c 6c 3f 20 74 70 me (if (null? tp
2260: 61 72 74 73 29 20 78 20 28 63 61 72 20 74 70 61 arts) x (car tpa
2270: 72 74 73 29 29 29 29 0a 09 09 09 09 09 3b 28 70 rts))))......;(p
2280: 72 69 6e 74 20 22 78 20 22 20 78 20 22 20 74 70 rint "x " x " tp
2290: 61 72 74 73 3a 20 22 20 74 70 61 72 74 73 20 22 arts: " tparts "
22a0: 20 62 61 73 65 74 6e 61 6d 65 3a 20 22 20 62 61 basetname: " ba
22b0: 73 65 74 6e 61 6d 65 29 0a 09 09 09 20 20 20 20 setname)....
22c0: 28 63 6f 6e 64 0a 09 09 09 20 20 20 20 20 28 28 (cond.... ((
22d0: 73 74 72 69 6e 67 2d 6d 61 74 63 68 20 62 6c 61 string-match bla
22e0: 6e 6b 2d 6c 69 6e 65 2d 72 78 20 78 29 20 23 66 nk-line-rx x) #f
22f0: 29 0a 09 09 09 20 20 20 20 20 28 28 65 71 75 61 ).... ((equa
2300: 6c 3f 20 78 20 62 61 73 65 74 6e 61 6d 65 29 20 l? x basetname)
2310: 23 74 29 0a 09 09 09 20 20 20 20 20 28 28 68 61 #t).... ((ha
2320: 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 sh-table-ref/def
2330: 61 75 6c 74 20 2a 63 6f 6c 6c 61 70 73 65 64 2a ault *collapsed*
2340: 20 62 61 73 65 74 6e 61 6d 65 20 23 66 29 20 0a basetname #f) .
2350: 09 09 09 09 09 3b 28 70 72 69 6e 74 20 22 52 65 .....;(print "Re
2360: 6d 6f 76 69 6e 67 20 22 20 62 61 73 65 74 6e 61 moving " basetna
2370: 6d 65 20 22 20 66 72 6f 6d 20 69 74 65 6d 73 22 me " from items"
2380: 29 0a 09 09 09 20 20 20 20 20 20 23 66 29 0a 09 ).... #f)..
2390: 09 09 20 20 20 20 20 28 65 6c 73 65 20 23 74 29 .. (else #t)
23a0: 29 29 29 0a 09 09 09 69 6e 6c 73 74 29 29 0a 09 )))....inlst))..
23b0: 20 28 76 6c 73 74 20 20 28 72 75 6e 2d 69 74 65 (vlst (run-ite
23c0: 6d 2d 6e 61 6d 65 2d 3e 76 65 63 74 6f 72 73 20 m-name->vectors
23d0: 6e 65 77 6c 73 74 29 29 0a 09 20 3b 3b 20 73 6f newlst)).. ;; so
23e0: 72 74 20 62 79 20 73 65 63 6f 6e 64 20 66 69 65 rt by second fie
23f0: 6c 64 0a 09 20 28 76 6c 73 74 2d 73 31 20 28 73 ld.. (vlst-s1 (s
2400: 6f 72 74 20 76 6c 73 74 20 28 6c 61 6d 62 64 61 ort vlst (lambda
2410: 20 28 61 20 62 29 0a 09 09 09 20 20 20 20 20 20 (a b)....
2420: 20 28 6c 65 74 20 28 28 61 73 74 72 20 28 76 65 (let ((astr (ve
2430: 63 74 6f 72 2d 72 65 66 20 61 20 31 29 29 0a 09 ctor-ref a 1))..
2440: 09 09 09 20 20 20 20 20 28 62 73 74 72 20 28 76 ... (bstr (v
2450: 65 63 74 6f 72 2d 72 65 66 20 62 20 31 29 29 29 ector-ref b 1)))
2460: 0a 09 09 09 09 20 28 69 66 20 28 73 74 72 69 6e ..... (if (strin
2470: 67 3d 3f 20 61 73 74 72 20 22 22 29 20 23 66 20 g=? astr "") #f
2480: 23 74 29 29 29 29 29 0a 09 09 09 3b 3b 20 28 3e #t)))))....;; (>
2490: 3d 20 28 73 74 72 69 6e 67 2d 6c 65 6e 67 74 68 = (string-length
24a0: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 61 20 31 (vector-ref a 1
24b0: 29 29 28 73 74 72 69 6e 67 2d 6c 65 6e 67 74 68 ))(string-length
24c0: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 62 20 31 (vector-ref b 1
24d0: 29 29 29 29 29 29 0a 09 20 28 76 6c 73 74 2d 73 )))))).. (vlst-s
24e0: 32 20 28 73 6f 72 74 20 76 6c 73 74 2d 73 31 20 2 (sort vlst-s1
24f0: 28 6c 61 6d 62 64 61 20 28 61 20 62 29 0a 09 09 (lambda (a b)...
2500: 09 20 20 20 09 20 20 28 73 74 72 69 6e 67 3e 3d . . (string>=
2510: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 61 20 30 (vector-ref a 0
2520: 29 28 76 65 63 74 6f 72 2d 72 65 66 20 62 20 30 )(vector-ref b 0
2530: 29 29 29 29 29 29 0a 20 20 20 20 28 6d 61 70 20 )))))). (map
2540: 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 20 20 20 (lambda (x)..
2550: 28 69 66 20 28 65 71 75 61 6c 3f 20 28 76 65 63 (if (equal? (vec
2560: 74 6f 72 2d 72 65 66 20 78 20 31 29 20 22 22 29 tor-ref x 1) "")
2570: 0a 09 20 20 20 20 20 20 20 28 76 65 63 74 6f 72 .. (vector
2580: 2d 72 65 66 20 78 20 30 29 0a 09 20 20 20 20 20 -ref x 0)..
2590: 20 20 28 63 6f 6e 63 20 28 76 65 63 74 6f 72 2d (conc (vector-
25a0: 72 65 66 20 78 20 30 29 20 22 28 22 20 28 76 65 ref x 0) "(" (ve
25b0: 63 74 6f 72 2d 72 65 66 20 78 20 31 29 20 22 29 ctor-ref x 1) ")
25c0: 22 29 29 29 0a 09 20 76 6c 73 74 2d 73 32 29 29 "))).. vlst-s2))
25d0: 29 0a 20 20 20 20 0a 28 64 65 66 69 6e 65 20 28 ). .(define (
25e0: 75 70 64 61 74 65 2d 6c 61 62 65 6c 73 20 75 69 update-labels ui
25f0: 64 61 74 29 0a 20 20 28 6c 65 74 2a 20 28 28 72 dat). (let* ((r
2600: 6f 77 6e 20 20 20 20 30 29 0a 09 20 28 6b 65 79 own 0).. (key
2610: 63 6f 6c 20 20 28 64 62 6f 61 72 64 3a 75 69 64 col (dboard:uid
2620: 61 74 2d 67 65 74 2d 6b 65 79 63 6f 6c 20 75 69 at-get-keycol ui
2630: 64 61 74 29 29 0a 09 20 28 6c 66 74 63 6f 6c 20 dat)).. (lftcol
2640: 20 28 64 62 6f 61 72 64 3a 75 69 64 61 74 2d 67 (dboard:uidat-g
2650: 65 74 2d 6c 66 74 63 6f 6c 20 75 69 64 61 74 29 et-lftcol uidat)
2660: 29 0a 09 20 28 6e 75 6d 63 6f 6c 73 20 28 76 65 ).. (numcols (ve
2670: 63 74 6f 72 2d 6c 65 6e 67 74 68 20 6c 66 74 63 ctor-length lftc
2680: 6f 6c 29 29 0a 09 20 28 6d 61 78 6e 20 20 20 20 ol)).. (maxn
2690: 28 2d 20 6e 75 6d 63 6f 6c 73 20 31 29 29 0a 09 (- numcols 1))..
26a0: 20 28 61 6c 6c 76 61 6c 73 20 28 6d 61 6b 65 2d (allvals (make-
26b0: 76 65 63 74 6f 72 20 6e 75 6d 63 6f 6c 73 20 22 vector numcols "
26c0: 22 29 29 29 0a 20 20 20 20 28 66 6f 72 2d 65 61 "))). (for-ea
26d0: 63 68 20 28 6c 61 6d 62 64 61 20 28 6e 61 6d 65 ch (lambda (name
26e0: 29 0a 09 09 28 69 66 20 28 3c 3d 20 72 6f 77 6e )...(if (<= rown
26f0: 20 6d 61 78 6e 29 0a 09 09 20 20 20 20 28 76 65 maxn)... (ve
2700: 63 74 6f 72 2d 73 65 74 21 20 61 6c 6c 76 61 6c ctor-set! allval
2710: 73 20 72 6f 77 6e 20 6e 61 6d 65 29 29 20 3b 29 s rown name)) ;)
2720: 0a 09 09 28 73 65 74 21 20 72 6f 77 6e 20 28 2b ...(set! rown (+
2730: 20 31 20 72 6f 77 6e 29 29 29 0a 09 20 20 20 20 1 rown)))..
2740: 20 20 2a 61 6c 6c 74 65 73 74 6e 61 6d 65 6c 73 *alltestnamels
2750: 74 2a 29 0a 20 20 20 20 28 6c 65 74 20 6c 6f 6f t*). (let loo
2760: 70 20 28 28 69 20 30 29 29 0a 20 20 20 20 20 20 p ((i 0)).
2770: 28 6c 65 74 2a 20 28 28 6c 62 6c 20 20 20 20 28 (let* ((lbl (
2780: 76 65 63 74 6f 72 2d 72 65 66 20 6c 66 74 63 6f vector-ref lftco
2790: 6c 20 69 29 29 0a 09 20 20 20 20 20 28 6b 65 79 l i)).. (key
27a0: 76 61 6c 20 28 76 65 63 74 6f 72 2d 72 65 66 20 val (vector-ref
27b0: 6b 65 79 63 6f 6c 20 69 29 29 0a 09 20 20 20 20 keycol i))..
27c0: 20 28 6f 6c 64 76 61 6c 20 28 69 75 70 3a 61 74 (oldval (iup:at
27d0: 74 72 69 62 75 74 65 20 6c 62 6c 20 22 54 49 54 tribute lbl "TIT
27e0: 4c 45 22 29 29 0a 09 20 20 20 20 20 28 6e 65 77 LE")).. (new
27f0: 76 61 6c 20 28 76 65 63 74 6f 72 2d 72 65 66 20 val (vector-ref
2800: 61 6c 6c 76 61 6c 73 20 69 29 29 29 0a 09 28 69 allvals i)))..(i
2810: 66 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 6f f (not (equal? o
2820: 6c 64 76 61 6c 20 6e 65 77 76 61 6c 29 29 0a 09 ldval newval))..
2830: 20 20 20 20 28 6c 65 74 20 28 28 6d 75 6e 67 65 (let ((munge
2840: 64 2d 76 61 6c 20 28 6c 65 74 20 28 28 70 61 72 d-val (let ((par
2850: 74 73 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 ts (string-split
2860: 20 6e 65 77 76 61 6c 20 22 28 22 29 29 29 0a 09 newval "(")))..
2870: 09 09 09 28 69 66 20 28 3e 20 28 6c 65 6e 67 74 ...(if (> (lengt
2880: 68 20 70 61 72 74 73 29 20 31 29 28 63 6f 6e 63 h parts) 1)(conc
2890: 20 22 20 20 22 20 28 63 61 72 20 28 73 74 72 69 " " (car (stri
28a0: 6e 67 2d 73 70 6c 69 74 20 28 63 61 64 72 20 70 ng-split (cadr p
28b0: 61 72 74 73 29 20 22 29 22 29 29 29 20 6e 65 77 arts) ")"))) new
28c0: 76 61 6c 29 29 29 29 0a 09 20 20 20 20 20 20 28 val)))).. (
28d0: 76 65 63 74 6f 72 2d 73 65 74 21 20 6b 65 79 63 vector-set! keyc
28e0: 6f 6c 20 69 20 6e 65 77 76 61 6c 29 0a 09 20 20 ol i newval)..
28f0: 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 (iup:attribu
2900: 74 65 2d 73 65 74 21 20 6c 62 6c 20 22 54 49 54 te-set! lbl "TIT
2910: 4c 45 22 20 6d 75 6e 67 65 64 2d 76 61 6c 29 29 LE" munged-val))
2920: 29 0a 09 28 69 75 70 3a 61 74 74 72 69 62 75 74 )..(iup:attribut
2930: 65 2d 73 65 74 21 20 6c 62 6c 20 22 46 47 43 4f e-set! lbl "FGCO
2940: 4c 4f 52 22 20 28 69 66 20 28 68 61 73 68 2d 74 LOR" (if (hash-t
2950: 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 able-ref/default
2960: 20 2a 63 6f 6c 6c 61 70 73 65 64 2a 20 6e 65 77 *collapsed* new
2970: 76 61 6c 20 23 66 29 20 22 30 20 31 31 32 20 31 val #f) "0 112 1
2980: 31 32 22 20 22 30 20 30 20 30 22 29 29 0a 09 28 12" "0 0 0"))..(
2990: 69 66 20 28 3c 20 69 20 6d 61 78 6e 29 0a 09 20 if (< i maxn)..
29a0: 20 20 20 28 6c 6f 6f 70 20 28 2b 20 69 20 31 29 (loop (+ i 1)
29b0: 29 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 ))))))..(define
29c0: 28 67 65 74 2d 63 6f 6c 6f 72 2d 66 6f 72 2d 73 (get-color-for-s
29d0: 74 61 74 65 2d 73 74 61 74 75 73 20 73 74 61 74 tate-status stat
29e0: 65 20 73 74 61 74 75 73 29 0a 20 20 28 63 61 73 e status). (cas
29f0: 65 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f e (string->symbo
2a00: 6c 20 73 74 61 74 65 29 0a 20 20 20 20 28 28 43 l state). ((C
2a10: 4f 4d 50 4c 45 54 45 44 29 0a 20 20 20 20 20 28 OMPLETED). (
2a20: 69 66 20 28 65 71 75 61 6c 3f 20 73 74 61 74 75 if (equal? statu
2a30: 73 20 22 50 41 53 53 22 29 0a 09 20 22 37 30 20 s "PASS").. "70
2a40: 32 34 39 20 37 33 22 0a 09 20 28 69 66 20 28 6f 249 73".. (if (o
2a50: 72 20 28 65 71 75 61 6c 3f 20 73 74 61 74 75 73 r (equal? status
2a60: 20 22 57 41 52 4e 22 29 0a 09 09 20 28 65 71 75 "WARN")... (equ
2a70: 61 6c 3f 20 73 74 61 74 75 73 20 22 57 41 49 56 al? status "WAIV
2a80: 45 44 22 29 29 0a 09 20 20 20 20 20 22 32 35 35 ED")).. "255
2a90: 20 31 37 32 20 31 33 22 0a 09 20 20 20 20 20 22 172 13".. "
2aa0: 32 32 33 20 33 33 20 34 39 22 29 29 29 20 3b 3b 223 33 49"))) ;;
2ab0: 20 67 72 65 65 6e 69 73 68 20 6f 72 61 6e 67 65 greenish orange
2ac0: 69 73 68 20 72 65 64 69 73 68 0a 20 20 20 20 28 ish redish. (
2ad0: 28 4c 41 55 4e 43 48 45 44 29 20 20 20 20 20 20 (LAUNCHED)
2ae0: 20 20 20 22 31 30 31 20 31 32 33 20 31 34 32 22 "101 123 142"
2af0: 29 0a 20 20 20 20 28 28 43 48 45 43 4b 29 20 20 ). ((CHECK)
2b00: 20 20 20 20 20 20 20 20 20 20 22 32 35 35 20 31 "255 1
2b10: 30 30 20 35 30 22 29 0a 20 20 20 20 28 28 52 45 00 50"). ((RE
2b20: 4d 4f 54 45 48 4f 53 54 53 54 41 52 54 29 20 20 MOTEHOSTSTART)
2b30: 22 35 30 20 31 33 30 20 31 39 35 22 29 0a 20 20 "50 130 195").
2b40: 20 20 28 28 52 55 4e 4e 49 4e 47 29 20 20 20 20 ((RUNNING)
2b50: 20 20 20 20 20 20 22 39 20 31 33 31 20 32 33 32 "9 131 232
2b60: 22 29 0a 20 20 20 20 28 28 4b 49 4c 4c 52 45 51 "). ((KILLREQ
2b70: 29 20 20 20 20 20 20 20 20 20 20 22 33 39 20 38 ) "39 8
2b80: 32 20 32 30 36 22 29 0a 20 20 20 20 28 28 4b 49 2 206"). ((KI
2b90: 4c 4c 45 44 29 20 20 20 20 20 20 20 20 20 20 20 LLED)
2ba0: 22 32 33 34 20 31 30 31 20 31 37 22 29 0a 20 20 "234 101 17").
2bb0: 20 20 28 28 4e 4f 54 5f 53 54 41 52 54 45 44 29 ((NOT_STARTED)
2bc0: 20 20 20 20 20 20 22 32 34 30 20 32 34 30 20 32 "240 240 2
2bd0: 34 30 22 29 0a 20 20 20 20 28 65 6c 73 65 20 20 40"). (else
2be0: 20 20 20 20 20 20 20 20 20 20 20 20 20 22 31 39 "19
2bf0: 32 20 31 39 32 20 31 39 32 22 29 29 29 0a 0a 28 2 192 192")))..(
2c00: 64 65 66 69 6e 65 20 28 75 70 64 61 74 65 2d 62 define (update-b
2c10: 75 74 74 6f 6e 73 20 75 69 64 61 74 20 6e 75 6d uttons uidat num
2c20: 72 75 6e 73 20 6e 75 6d 74 65 73 74 73 29 0a 20 runs numtests).
2c30: 20 28 69 66 20 2a 70 6c 65 61 73 65 2d 75 70 64 (if *please-upd
2c40: 61 74 65 2d 62 75 74 74 6f 6e 73 2a 0a 20 20 20 ate-buttons*.
2c50: 20 20 20 28 6c 65 74 2a 20 28 28 72 75 6e 73 20 (let* ((runs
2c60: 20 20 20 20 20 20 20 28 69 66 20 28 3e 20 28 6c (if (> (l
2c70: 65 6e 67 74 68 20 2a 61 6c 6c 72 75 6e 73 2a 29 ength *allruns*)
2c80: 20 6e 75 6d 72 75 6e 73 29 0a 09 09 09 20 20 20 numruns)....
2c90: 20 20 20 28 74 61 6b 65 2d 72 69 67 68 74 20 2a (take-right *
2ca0: 61 6c 6c 72 75 6e 73 2a 20 6e 75 6d 72 75 6e 73 allruns* numruns
2cb0: 29 0a 09 09 09 20 20 20 20 20 20 28 70 61 64 2d ).... (pad-
2cc0: 6c 69 73 74 20 2a 61 6c 6c 72 75 6e 73 2a 20 6e list *allruns* n
2cd0: 75 6d 72 75 6e 73 29 29 29 0a 09 20 20 20 20 20 umruns)))..
2ce0: 28 6c 66 74 63 6f 6c 20 20 20 20 20 20 28 64 62 (lftcol (db
2cf0: 6f 61 72 64 3a 75 69 64 61 74 2d 67 65 74 2d 6c oard:uidat-get-l
2d00: 66 74 63 6f 6c 20 75 69 64 61 74 29 29 0a 09 20 ftcol uidat))..
2d10: 20 20 20 20 28 74 61 62 6c 65 68 65 61 64 65 72 (tableheader
2d20: 20 28 64 62 6f 61 72 64 3a 75 69 64 61 74 2d 67 (dboard:uidat-g
2d30: 65 74 2d 68 65 61 64 65 72 20 75 69 64 61 74 29 et-header uidat)
2d40: 29 0a 09 20 20 20 20 20 28 74 61 62 6c 65 20 20 ).. (table
2d50: 20 20 20 20 20 28 64 62 6f 61 72 64 3a 75 69 64 (dboard:uid
2d60: 61 74 2d 67 65 74 2d 72 75 6e 73 76 65 63 20 75 at-get-runsvec u
2d70: 69 64 61 74 29 29 0a 09 20 20 20 20 20 28 63 6f idat)).. (co
2d80: 6c 6e 20 20 20 20 20 20 20 20 30 29 29 0a 09 28 ln 0))..(
2d90: 73 65 74 21 20 2a 70 6c 65 61 73 65 2d 75 70 64 set! *please-upd
2da0: 61 74 65 2d 62 75 74 74 6f 6e 73 2a 20 23 66 29 ate-buttons* #f)
2db0: 0a 09 28 73 65 74 21 20 2a 61 6c 6c 74 65 73 74 ..(set! *alltest
2dc0: 6e 61 6d 65 6c 73 74 2a 20 27 28 29 29 0a 09 3b namelst* '())..;
2dd0: 3b 20 63 72 65 61 74 65 20 61 20 63 6f 6e 63 69 ; create a conci
2de0: 73 65 20 6c 69 73 74 20 6f 66 20 74 65 73 74 20 se list of test
2df0: 6e 61 6d 65 73 0a 09 28 66 6f 72 2d 65 61 63 68 names..(for-each
2e00: 0a 09 20 28 6c 61 6d 62 64 61 20 28 72 75 6e 64 .. (lambda (rund
2e10: 61 74 29 0a 09 20 20 20 28 69 66 20 28 76 65 63 at).. (if (vec
2e20: 74 6f 72 3f 20 72 75 6e 64 61 74 29 0a 09 20 20 tor? rundat)..
2e30: 20 20 20 20 20 28 6c 65 74 2a 20 28 28 74 65 73 (let* ((tes
2e40: 74 64 61 74 20 20 20 28 76 65 63 74 6f 72 2d 72 tdat (vector-r
2e50: 65 66 20 72 75 6e 64 61 74 20 31 29 29 0a 09 09 ef rundat 1))...
2e60: 20 20 20 20 20 20 28 74 65 73 74 6e 61 6d 65 73 (testnames
2e70: 20 28 6d 61 70 20 74 65 73 74 3a 74 65 73 74 2d (map test:test-
2e80: 67 65 74 2d 66 75 6c 6c 6e 61 6d 65 20 74 65 73 get-fullname tes
2e90: 74 64 61 74 29 29 29 0a 09 09 20 28 69 66 20 28 tdat)))... (if (
2ea0: 6e 6f 74 20 28 61 6e 64 20 2a 68 69 64 65 2d 65 not (and *hide-e
2eb0: 6d 70 74 79 2d 72 75 6e 73 2a 0a 09 09 09 20 20 mpty-runs*....
2ec0: 20 20 20 20 20 28 6e 75 6c 6c 3f 20 74 65 73 74 (null? test
2ed0: 6e 61 6d 65 73 29 29 29 0a 09 09 20 20 20 20 20 names)))...
2ee0: 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 (for-each (lambd
2ef0: 61 20 28 74 65 73 74 6e 61 6d 65 29 0a 09 09 09 a (testname)....
2f00: 09 20 28 69 66 20 28 6e 6f 74 20 28 6d 65 6d 62 . (if (not (memb
2f10: 65 72 20 74 65 73 74 6e 61 6d 65 20 2a 61 6c 6c er testname *all
2f20: 74 65 73 74 6e 61 6d 65 6c 73 74 2a 29 29 0a 09 testnamelst*))..
2f30: 09 09 09 20 20 20 20 20 28 62 65 67 69 6e 0a 09 ... (begin..
2f40: 09 09 09 20 20 20 20 20 20 20 28 73 65 74 21 20 ... (set!
2f50: 2a 61 6c 6c 74 65 73 74 6e 61 6d 65 6c 73 74 2a *alltestnamelst*
2f60: 20 28 61 70 70 65 6e 64 20 2a 61 6c 6c 74 65 73 (append *alltes
2f70: 74 6e 61 6d 65 6c 73 74 2a 20 28 6c 69 73 74 20 tnamelst* (list
2f80: 74 65 73 74 6e 61 6d 65 29 29 29 29 29 29 0a 09 testname))))))..
2f90: 09 09 20 20 20 20 20 20 20 74 65 73 74 6e 61 6d .. testnam
2fa0: 65 73 29 29 29 29 29 0a 09 20 72 75 6e 73 29 0a es))))).. runs).
2fb0: 0a 09 28 73 65 74 21 20 2a 61 6c 6c 74 65 73 74 ..(set! *alltest
2fc0: 6e 61 6d 65 6c 73 74 2a 20 28 63 6f 6c 6c 61 70 namelst* (collap
2fd0: 73 65 2d 72 6f 77 73 20 2a 61 6c 6c 74 65 73 74 se-rows *alltest
2fe0: 6e 61 6d 65 6c 73 74 2a 29 29 20 3b 3b 3b 20 61 namelst*)) ;;; a
2ff0: 72 67 68 2e 20 70 6c 65 61 73 65 20 63 6c 65 61 rgh. please clea
3000: 6e 20 75 70 20 74 68 69 73 20 73 69 6c 6c 79 6e n up this sillyn
3010: 65 73 73 0a 09 28 73 65 74 21 20 2a 61 6c 6c 74 ess..(set! *allt
3020: 65 73 74 6e 61 6d 65 6c 73 74 2a 20 28 6c 65 74 estnamelst* (let
3030: 20 28 28 78 6c 20 28 69 66 20 28 3e 20 28 6c 65 ((xl (if (> (le
3040: 6e 67 74 68 20 2a 61 6c 6c 74 65 73 74 6e 61 6d ngth *alltestnam
3050: 65 6c 73 74 2a 29 20 2a 73 74 61 72 74 2d 74 65 elst*) *start-te
3060: 73 74 2d 6f 66 66 73 65 74 2a 29 0a 09 09 09 09 st-offset*).....
3070: 09 20 20 20 20 20 28 64 72 6f 70 20 2a 61 6c 6c . (drop *all
3080: 74 65 73 74 6e 61 6d 65 6c 73 74 2a 20 2a 73 74 testnamelst* *st
3090: 61 72 74 2d 74 65 73 74 2d 6f 66 66 73 65 74 2a art-test-offset*
30a0: 29 0a 09 09 09 09 09 20 20 20 20 20 27 28 29 29 )...... '())
30b0: 29 29 0a 09 09 09 09 20 28 61 70 70 65 6e 64 20 ))..... (append
30c0: 78 6c 20 28 6d 61 6b 65 2d 6c 69 73 74 20 28 2d xl (make-list (-
30d0: 20 2a 6e 75 6d 2d 74 65 73 74 73 2a 20 28 6c 65 *num-tests* (le
30e0: 6e 67 74 68 20 78 6c 29 29 20 22 22 29 29 29 29 ngth xl)) ""))))
30f0: 0a 09 28 75 70 64 61 74 65 2d 6c 61 62 65 6c 73 ..(update-labels
3100: 20 75 69 64 61 74 29 0a 09 28 66 6f 72 2d 65 61 uidat)..(for-ea
3110: 63 68 0a 09 20 28 6c 61 6d 62 64 61 20 28 72 75 ch.. (lambda (ru
3120: 6e 64 61 74 29 0a 09 20 20 20 28 69 66 20 28 6e ndat).. (if (n
3130: 6f 74 20 72 75 6e 64 61 74 29 20 3b 3b 20 68 61 ot rundat) ;; ha
3140: 6e 64 6c 65 20 70 61 64 64 65 64 20 72 75 6e 73 ndle padded runs
3150: 0a 09 20 20 20 20 20 20 20 3b 3b 20 20 20 20 20 .. ;;
3160: 20 20 20 20 20 20 3b 3b 20 69 64 20 72 75 6e 2d ;; id run-
3170: 69 64 20 74 65 73 74 6e 61 6d 65 20 73 74 61 74 id testname stat
3180: 65 20 73 74 61 74 75 73 20 65 76 65 6e 74 2d 74 e status event-t
3190: 69 6d 65 20 68 6f 73 74 20 63 70 75 6c 6f 61 64 ime host cpuload
31a0: 20 64 69 73 6b 66 72 65 65 20 75 6e 61 6d 65 20 diskfree uname
31b0: 72 75 6e 64 69 72 20 69 74 65 6d 2d 70 61 74 68 rundir item-path
31c0: 20 72 75 6e 2d 64 75 72 61 74 69 6f 6e 0a 09 20 run-duration..
31d0: 20 20 20 20 20 20 28 73 65 74 21 20 72 75 6e 64 (set! rund
31e0: 61 74 20 28 76 65 63 74 6f 72 20 28 6d 61 6b 65 at (vector (make
31f0: 2d 76 65 63 74 6f 72 20 32 30 20 23 66 29 20 27 -vector 20 #f) '
3200: 28 29 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 () (map (lambda
3210: 28 78 29 20 22 22 29 20 2a 6b 65 79 73 2a 29 29 (x) "") *keys*))
3220: 29 29 3b 3b 20 33 29 29 29 0a 09 20 20 20 28 6c ));; 3))).. (l
3230: 65 74 2a 20 28 28 72 75 6e 20 20 20 20 20 20 28 et* ((run (
3240: 76 65 63 74 6f 72 2d 72 65 66 20 72 75 6e 64 61 vector-ref runda
3250: 74 20 30 29 29 0a 09 09 20 20 28 74 65 73 74 73 t 0))... (tests
3260: 64 61 74 20 28 76 65 63 74 6f 72 2d 72 65 66 20 dat (vector-ref
3270: 72 75 6e 64 61 74 20 31 29 29 0a 09 09 20 20 28 rundat 1))... (
3280: 6b 65 79 2d 76 61 6c 2d 64 61 74 20 28 76 65 63 key-val-dat (vec
3290: 74 6f 72 2d 72 65 66 20 72 75 6e 64 61 74 20 32 tor-ref rundat 2
32a0: 29 29 0a 09 09 20 20 28 72 75 6e 2d 69 64 20 20 ))... (run-id
32b0: 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 (db:get-value-b
32c0: 79 2d 68 65 61 64 65 72 20 72 75 6e 20 2a 68 65 y-header run *he
32d0: 61 64 65 72 2a 20 22 69 64 22 29 29 0a 09 09 20 ader* "id"))...
32e0: 20 28 6b 65 79 2d 76 61 6c 73 20 28 61 70 70 65 (key-vals (appe
32f0: 6e 64 20 6b 65 79 2d 76 61 6c 2d 64 61 74 0a 09 nd key-val-dat..
3300: 09 09 09 20 20 20 20 28 6c 69 73 74 20 28 6c 65 ... (list (le
3310: 74 20 28 28 78 20 28 64 62 3a 67 65 74 2d 76 61 t ((x (db:get-va
3320: 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 lue-by-header ru
3330: 6e 20 2a 68 65 61 64 65 72 2a 20 22 72 75 6e 6e n *header* "runn
3340: 61 6d 65 22 29 29 29 0a 09 09 09 09 09 20 20 20 ame")))......
3350: 20 28 69 66 20 78 20 78 20 22 22 29 29 29 29 29 (if x x "")))))
3360: 0a 09 09 20 20 28 72 75 6e 2d 6b 65 79 20 20 28 ... (run-key (
3370: 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 string-intersper
3380: 73 65 20 6b 65 79 2d 76 61 6c 73 20 22 5c 6e 22 se key-vals "\n"
3390: 29 29 29 0a 0a 09 20 20 20 20 20 3b 3b 20 66 69 )))... ;; fi
33a0: 6c 6c 20 69 6e 20 74 68 65 20 72 75 6e 20 68 65 ll in the run he
33b0: 61 64 65 72 20 6b 65 79 20 76 61 6c 75 65 73 0a ader key values.
33c0: 09 20 20 20 20 20 28 6c 65 74 20 28 28 72 6f 77 . (let ((row
33d0: 6e 20 20 20 20 20 20 30 29 0a 09 09 20 20 20 28 n 0)... (
33e0: 68 65 61 64 65 72 63 6f 6c 20 28 76 65 63 74 6f headercol (vecto
33f0: 72 2d 72 65 66 20 74 61 62 6c 65 68 65 61 64 65 r-ref tableheade
3400: 72 20 63 6f 6c 6e 29 29 29 0a 09 20 20 20 20 20 r coln)))..
3410: 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d (for-each (lam
3420: 62 64 61 20 28 6b 76 61 6c 29 0a 09 09 09 20 20 bda (kval)....
3430: 20 28 6c 65 74 2a 20 28 28 6c 61 62 6c 20 20 20 (let* ((labl
3440: 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 68 (vector-ref h
3450: 65 61 64 65 72 63 6f 6c 20 72 6f 77 6e 29 29 29 eadercol rown)))
3460: 0a 09 09 09 20 20 20 20 20 28 69 66 20 28 6e 6f .... (if (no
3470: 74 20 28 65 71 75 61 6c 3f 20 6b 76 61 6c 20 28 t (equal? kval (
3480: 69 75 70 3a 61 74 74 72 69 62 75 74 65 20 6c 61 iup:attribute la
3490: 62 6c 20 22 54 49 54 4c 45 22 29 29 29 0a 09 09 bl "TITLE")))...
34a0: 09 09 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 .. (iup:attribut
34b0: 65 2d 73 65 74 21 20 28 76 65 63 74 6f 72 2d 72 e-set! (vector-r
34c0: 65 66 20 68 65 61 64 65 72 63 6f 6c 20 72 6f 77 ef headercol row
34d0: 6e 29 20 22 54 49 54 4c 45 22 20 6b 76 61 6c 29 n) "TITLE" kval)
34e0: 29 0a 09 09 09 20 20 20 20 20 28 73 65 74 21 20 ).... (set!
34f0: 72 6f 77 6e 20 28 2b 20 72 6f 77 6e 20 31 29 29 rown (+ rown 1))
3500: 29 29 0a 09 09 09 20 6b 65 79 2d 76 61 6c 73 29 )).... key-vals)
3510: 29 0a 0a 09 20 20 20 20 20 3b 3b 20 46 6f 72 20 )... ;; For
3520: 74 68 69 73 20 72 75 6e 20 6e 6f 77 20 66 69 6c this run now fil
3530: 6c 20 69 6e 20 74 68 65 20 62 75 74 74 6f 6e 73 l in the buttons
3540: 20 66 6f 72 20 65 61 63 68 20 74 65 73 74 0a 09 for each test..
3550: 20 20 20 20 20 28 6c 65 74 20 28 28 72 6f 77 6e (let ((rown
3560: 20 30 29 0a 09 09 20 20 20 28 63 6f 6c 75 6d 6e 0)... (column
3570: 64 61 74 20 20 28 76 65 63 74 6f 72 2d 72 65 66 dat (vector-ref
3580: 20 74 61 62 6c 65 20 63 6f 6c 6e 29 29 29 0a 09 table coln)))..
3590: 20 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 (for-each
35a0: 0a 09 09 28 6c 61 6d 62 64 61 20 28 74 65 73 74 ...(lambda (test
35b0: 6e 61 6d 65 29 0a 09 09 20 20 28 6c 65 74 20 28 name)... (let (
35c0: 28 62 75 74 74 6f 6e 64 61 74 20 20 28 68 61 73 (buttondat (has
35d0: 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 h-table-ref/defa
35e0: 75 6c 74 20 2a 62 75 74 74 6f 6e 64 61 74 2a 20 ult *buttondat*
35f0: 28 6d 6b 73 74 72 20 63 6f 6c 6e 20 72 6f 77 6e (mkstr coln rown
3600: 29 20 23 66 29 29 29 0a 09 09 20 20 20 20 28 69 ) #f)))... (i
3610: 66 20 62 75 74 74 6f 6e 64 61 74 0a 09 09 09 28 f buttondat....(
3620: 6c 65 74 2a 20 28 28 74 65 73 74 20 20 20 20 20 let* ((test
3630: 20 20 28 6c 65 74 20 28 28 6d 61 74 63 68 69 6e (let ((matchin
3640: 67 20 28 66 69 6c 74 65 72 20 0a 09 09 09 09 09 g (filter ......
3650: 09 09 20 20 20 20 28 6c 61 6d 62 64 61 20 28 78 .. (lambda (x
3660: 29 28 65 71 75 61 6c 3f 20 28 74 65 73 74 3a 74 )(equal? (test:t
3670: 65 73 74 2d 67 65 74 2d 66 75 6c 6c 6e 61 6d 65 est-get-fullname
3680: 20 78 29 20 74 65 73 74 6e 61 6d 65 29 29 0a 09 x) testname))..
3690: 09 09 09 09 09 09 20 20 20 20 74 65 73 74 73 64 ...... testsd
36a0: 61 74 29 29 29 0a 09 09 09 09 09 20 20 20 20 20 at)))......
36b0: 28 69 66 20 28 6e 75 6c 6c 3f 20 6d 61 74 63 68 (if (null? match
36c0: 69 6e 67 29 0a 09 09 09 09 09 09 20 28 76 65 63 ing)....... (vec
36d0: 74 6f 72 20 2d 31 20 2d 31 20 22 22 20 22 22 20 tor -1 -1 "" ""
36e0: 22 22 20 30 20 22 22 20 22 22 20 30 20 22 22 20 "" 0 "" "" 0 ""
36f0: 22 22 20 22 22 20 30 20 22 22 20 22 22 29 0a 09 "" "" 0 "" "")..
3700: 09 09 09 09 09 20 28 63 61 72 20 6d 61 74 63 68 ..... (car match
3710: 69 6e 67 29 29 29 29 0a 09 09 09 20 20 20 20 20 ing))))....
3720: 20 20 28 74 65 73 74 6e 61 6d 65 20 20 20 28 64 (testname (d
3730: 62 3a 74 65 73 74 2d 67 65 74 2d 74 65 73 74 6e b:test-get-testn
3740: 61 6d 65 20 20 74 65 73 74 29 29 0a 09 09 09 20 ame test))....
3750: 20 20 20 20 20 20 28 69 74 65 6d 70 61 74 68 20 (itempath
3760: 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 (db:test-get-i
3770: 74 65 6d 2d 70 61 74 68 20 74 65 73 74 29 29 0a tem-path test)).
3780: 09 09 09 20 20 20 20 20 20 20 28 74 65 73 74 66 ... (testf
3790: 75 6c 6c 6e 61 6d 65 20 28 74 65 73 74 3a 74 65 ullname (test:te
37a0: 73 74 2d 67 65 74 2d 66 75 6c 6c 6e 61 6d 65 20 st-get-fullname
37b0: 74 65 73 74 29 29 0a 09 09 09 20 20 20 20 20 20 test))....
37c0: 20 28 74 65 73 74 73 74 61 74 75 73 20 28 64 62 (teststatus (db
37d0: 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 75 73 :test-get-status
37e0: 20 20 20 74 65 73 74 29 29 0a 09 09 09 20 20 20 test))....
37f0: 20 20 20 20 28 74 65 73 74 73 74 61 74 65 20 20 (teststate
3800: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 (db:test-get-sta
3810: 74 65 20 20 20 20 74 65 73 74 29 29 0a 09 09 09 te test))....
3820: 20 20 20 20 20 20 20 28 74 65 73 74 73 74 61 72 (teststar
3830: 74 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d t (db:test-get-
3840: 65 76 65 6e 74 5f 74 69 6d 65 20 74 65 73 74 29 event_time test)
3850: 29 0a 09 09 09 20 20 20 20 20 20 20 28 72 75 6e ).... (run
3860: 74 69 6d 65 20 20 20 20 28 64 62 3a 74 65 73 74 time (db:test
3870: 2d 67 65 74 2d 72 75 6e 5f 64 75 72 61 74 69 6f -get-run_duratio
3880: 6e 20 74 65 73 74 29 29 0a 09 09 09 20 20 20 20 n test))....
3890: 20 20 20 28 62 75 74 74 6f 6e 74 78 74 20 20 28 (buttontxt (
38a0: 69 66 20 28 65 71 75 61 6c 3f 20 74 65 73 74 73 if (equal? tests
38b0: 74 61 74 65 20 22 43 4f 4d 50 4c 45 54 45 44 22 tate "COMPLETED"
38c0: 29 20 74 65 73 74 73 74 61 74 75 73 20 74 65 73 ) teststatus tes
38d0: 74 73 74 61 74 65 29 29 0a 09 09 09 20 20 20 20 tstate))....
38e0: 20 20 20 28 62 75 74 74 6f 6e 20 20 20 20 20 28 (button (
38f0: 76 65 63 74 6f 72 2d 72 65 66 20 63 6f 6c 75 6d vector-ref colum
3900: 6e 64 61 74 20 72 6f 77 6e 29 29 0a 09 09 09 20 ndat rown))....
3910: 20 20 20 20 20 20 28 63 6f 6c 6f 72 20 20 20 20 (color
3920: 20 20 28 67 65 74 2d 63 6f 6c 6f 72 2d 66 6f 72 (get-color-for
3930: 2d 73 74 61 74 65 2d 73 74 61 74 75 73 20 74 65 -state-status te
3940: 73 74 73 74 61 74 65 20 74 65 73 74 73 74 61 74 ststate teststat
3950: 75 73 29 29 0a 09 09 09 20 20 20 20 20 20 20 28 us)).... (
3960: 63 75 72 72 2d 63 6f 6c 6f 72 20 28 76 65 63 74 curr-color (vect
3970: 6f 72 2d 72 65 66 20 62 75 74 74 6f 6e 64 61 74 or-ref buttondat
3980: 20 31 29 29 20 3b 3b 20 28 69 75 70 3a 61 74 74 1)) ;; (iup:att
3990: 72 69 62 75 74 65 20 62 75 74 74 6f 6e 20 22 42 ribute button "B
39a0: 47 43 4f 4c 4f 52 22 29 29 0a 09 09 09 20 20 20 GCOLOR"))....
39b0: 20 20 20 20 28 63 75 72 72 2d 74 69 74 6c 65 20 (curr-title
39c0: 28 76 65 63 74 6f 72 2d 72 65 66 20 62 75 74 74 (vector-ref butt
39d0: 6f 6e 64 61 74 20 32 29 29 29 20 3b 3b 20 28 69 ondat 2))) ;; (i
39e0: 75 70 3a 61 74 74 72 69 62 75 74 65 20 62 75 74 up:attribute but
39f0: 74 6f 6e 20 22 54 49 54 4c 45 22 29 29 29 0a 09 ton "TITLE")))..
3a00: 09 09 20 20 28 69 66 20 28 6e 6f 74 20 28 65 71 .. (if (not (eq
3a10: 75 61 6c 3f 20 63 75 72 72 2d 63 6f 6c 6f 72 20 ual? curr-color
3a20: 63 6f 6c 6f 72 29 29 0a 09 09 09 20 20 20 20 20 color))....
3a30: 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d (iup:attribute-
3a40: 73 65 74 21 20 62 75 74 74 6f 6e 20 22 42 47 43 set! button "BGC
3a50: 4f 4c 4f 52 22 20 63 6f 6c 6f 72 29 29 0a 09 09 OLOR" color))...
3a60: 09 20 20 28 69 66 20 28 6e 6f 74 20 28 65 71 75 . (if (not (equ
3a70: 61 6c 3f 20 63 75 72 72 2d 74 69 74 6c 65 20 62 al? curr-title b
3a80: 75 74 74 6f 6e 74 78 74 29 29 0a 09 09 09 20 20 uttontxt))....
3a90: 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 (iup:attribu
3aa0: 74 65 2d 73 65 74 21 20 62 75 74 74 6f 6e 20 22 te-set! button "
3ab0: 54 49 54 4c 45 22 20 20 20 62 75 74 74 6f 6e 74 TITLE" buttont
3ac0: 78 74 29 29 0a 09 09 09 20 20 28 76 65 63 74 6f xt)).... (vecto
3ad0: 72 2d 73 65 74 21 20 62 75 74 74 6f 6e 64 61 74 r-set! buttondat
3ae0: 20 30 20 72 75 6e 2d 69 64 29 0a 09 09 09 20 20 0 run-id)....
3af0: 28 76 65 63 74 6f 72 2d 73 65 74 21 20 62 75 74 (vector-set! but
3b00: 74 6f 6e 64 61 74 20 31 20 63 6f 6c 6f 72 29 0a tondat 1 color).
3b10: 09 09 09 20 20 28 76 65 63 74 6f 72 2d 73 65 74 ... (vector-set
3b20: 21 20 62 75 74 74 6f 6e 64 61 74 20 32 20 62 75 ! buttondat 2 bu
3b30: 74 74 6f 6e 74 78 74 29 0a 09 09 09 20 20 28 76 ttontxt).... (v
3b40: 65 63 74 6f 72 2d 73 65 74 21 20 62 75 74 74 6f ector-set! butto
3b50: 6e 64 61 74 20 33 20 74 65 73 74 29 0a 09 09 09 ndat 3 test)....
3b60: 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 62 (vector-set! b
3b70: 75 74 74 6f 6e 64 61 74 20 34 20 72 75 6e 2d 6b uttondat 4 run-k
3b80: 65 79 29 29 29 0a 09 09 20 20 20 20 28 73 65 74 ey)))... (set
3b90: 21 20 72 6f 77 6e 20 28 2b 20 72 6f 77 6e 20 31 ! rown (+ rown 1
3ba0: 29 29 29 29 0a 09 09 2a 61 6c 6c 74 65 73 74 6e ))))...*alltestn
3bb0: 61 6d 65 6c 73 74 2a 29 29 0a 09 20 20 20 20 20 amelst*))..
3bc0: 28 73 65 74 21 20 63 6f 6c 6e 20 28 2b 20 63 6f (set! coln (+ co
3bd0: 6c 6e 20 31 29 29 29 29 0a 09 20 72 75 6e 73 29 ln 1)))).. runs)
3be0: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 6d 6b )))..(define (mk
3bf0: 73 74 72 20 2e 20 78 29 0a 20 20 28 73 74 72 69 str . x). (stri
3c00: 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 ng-intersperse (
3c10: 6d 61 70 20 63 6f 6e 63 20 78 29 20 22 2c 22 29 map conc x) ",")
3c20: 29 0a 0a 28 64 65 66 69 6e 65 20 28 75 70 64 61 )..(define (upda
3c30: 74 65 2d 73 65 61 72 63 68 20 78 20 76 61 6c 29 te-search x val)
3c40: 0a 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 53 65 . ;; (print "Se
3c50: 74 74 69 6e 67 20 73 65 61 72 63 68 20 66 6f 72 tting search for
3c60: 20 22 20 78 20 22 20 74 6f 20 22 20 76 61 6c 29 " x " to " val)
3c70: 0a 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 . (hash-table-s
3c80: 65 74 21 20 2a 73 65 61 72 63 68 70 61 74 74 73 et! *searchpatts
3c90: 2a 20 78 20 76 61 6c 29 29 0a 0a 28 64 65 66 69 * x val))..(defi
3ca0: 6e 65 20 28 6d 61 72 6b 2d 66 6f 72 2d 75 70 64 ne (mark-for-upd
3cb0: 61 74 65 29 0a 20 20 28 73 65 74 21 20 2a 6c 61 ate). (set! *la
3cc0: 73 74 2d 64 62 2d 75 70 64 61 74 65 2d 74 69 6d st-db-update-tim
3cd0: 65 2a 20 30 29 0a 20 20 28 73 65 74 21 20 2a 64 e* 0). (set! *d
3ce0: 65 6c 61 79 65 64 2d 75 70 64 61 74 65 2a 20 31 elayed-update* 1
3cf0: 29 0a 20 20 29 0a 0a 28 64 65 66 69 6e 65 20 28 ). )..(define (
3d00: 6d 61 6b 65 2d 64 61 73 68 62 6f 61 72 64 2d 62 make-dashboard-b
3d10: 75 74 74 6f 6e 73 20 6e 72 75 6e 73 20 6e 74 65 uttons nruns nte
3d20: 73 74 73 20 6b 65 79 6e 61 6d 65 73 29 0a 20 20 sts keynames).
3d30: 28 6c 65 74 2a 20 28 28 6e 6b 65 79 73 20 20 20 (let* ((nkeys
3d40: 28 6c 65 6e 67 74 68 20 6b 65 79 6e 61 6d 65 73 (length keynames
3d50: 29 29 0a 09 20 28 72 75 6e 73 76 65 63 20 28 6d )).. (runsvec (m
3d60: 61 6b 65 2d 76 65 63 74 6f 72 20 6e 72 75 6e 73 ake-vector nruns
3d70: 29 29 0a 09 20 28 68 65 61 64 65 72 20 20 28 6d )).. (header (m
3d80: 61 6b 65 2d 76 65 63 74 6f 72 20 6e 72 75 6e 73 ake-vector nruns
3d90: 29 29 0a 09 20 28 6c 66 74 63 6f 6c 20 20 28 6d )).. (lftcol (m
3da0: 61 6b 65 2d 76 65 63 74 6f 72 20 6e 74 65 73 74 ake-vector ntest
3db0: 73 29 29 0a 09 20 28 6b 65 79 63 6f 6c 20 20 28 s)).. (keycol (
3dc0: 6d 61 6b 65 2d 76 65 63 74 6f 72 20 6e 74 65 73 make-vector ntes
3dd0: 74 73 29 29 0a 09 20 28 63 6f 6e 74 72 6f 6c 73 ts)).. (controls
3de0: 20 27 28 29 29 0a 09 20 28 6c 66 74 6c 73 74 20 '()).. (lftlst
3df0: 20 27 28 29 29 0a 09 20 28 68 64 72 6c 73 74 20 '()).. (hdrlst
3e00: 20 27 28 29 29 0a 09 20 28 62 64 79 6c 73 74 20 '()).. (bdylst
3e10: 20 27 28 29 29 0a 09 20 28 72 65 73 75 6c 74 20 '()).. (result
3e20: 20 27 28 29 29 0a 09 20 28 69 20 20 20 20 20 20 '()).. (i
3e30: 20 30 29 29 0a 20 20 20 20 3b 3b 20 63 6f 6e 74 0)). ;; cont
3e40: 72 6f 6c 73 20 28 61 6c 6f 6e 67 20 62 6f 74 74 rols (along bott
3e50: 6f 6d 29 0a 20 20 20 20 28 73 65 74 21 20 63 6f om). (set! co
3e60: 6e 74 72 6f 6c 73 0a 09 20 20 28 69 75 70 3a 68 ntrols.. (iup:h
3e70: 62 6f 78 0a 09 20 20 20 28 69 75 70 3a 76 62 6f box.. (iup:vbo
3e80: 78 0a 09 20 20 20 20 28 69 75 70 3a 66 72 61 6d x.. (iup:fram
3e90: 65 20 0a 09 20 20 20 20 20 23 3a 74 69 74 6c 65 e .. #:title
3ea0: 20 22 66 69 6c 74 65 72 20 74 65 73 74 20 61 6e "filter test an
3eb0: 64 20 69 74 65 6d 73 22 0a 09 20 20 20 20 20 28 d items".. (
3ec0: 69 75 70 3a 68 62 6f 78 0a 09 20 20 20 20 20 20 iup:hbox..
3ed0: 28 69 75 70 3a 74 65 78 74 62 6f 78 20 23 3a 73 (iup:textbox #:s
3ee0: 69 7a 65 20 22 31 32 30 78 31 35 22 20 23 3a 66 ize "120x15" #:f
3ef0: 6f 6e 74 73 69 7a 65 20 22 31 30 22 20 23 3a 76 ontsize "10" #:v
3f00: 61 6c 75 65 20 22 25 22 0a 09 09 09 20 20 20 23 alue "%".... #
3f10: 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 :action (lambda
3f20: 28 6f 62 6a 20 75 6e 6b 20 76 61 6c 29 0a 09 09 (obj unk val)...
3f30: 09 09 20 20 20 20 20 20 28 6d 61 72 6b 2d 66 6f .. (mark-fo
3f40: 72 2d 75 70 64 61 74 65 29 0a 09 09 09 09 20 20 r-update).....
3f50: 20 20 20 20 28 75 70 64 61 74 65 2d 73 65 61 72 (update-sear
3f60: 63 68 20 22 74 65 73 74 2d 6e 61 6d 65 22 20 76 ch "test-name" v
3f70: 61 6c 29 29 29 0a 09 20 20 20 20 20 20 3b 3b 28 al))).. ;;(
3f80: 69 75 70 3a 74 65 78 74 62 6f 78 20 23 3a 73 69 iup:textbox #:si
3f90: 7a 65 20 22 36 30 78 31 35 22 20 23 3a 66 6f 6e ze "60x15" #:fon
3fa0: 74 73 69 7a 65 20 22 31 30 22 20 23 3a 76 61 6c tsize "10" #:val
3fb0: 75 65 20 22 25 22 0a 09 20 20 20 20 20 20 3b 3b ue "%".. ;;
3fc0: 20 20 09 20 20 20 23 3a 61 63 74 69 6f 6e 20 28 . #:action (
3fd0: 6c 61 6d 62 64 61 20 28 6f 62 6a 20 75 6e 6b 20 lambda (obj unk
3fe0: 76 61 6c 29 0a 09 20 20 20 20 20 20 3b 3b 20 20 val).. ;;
3ff0: 09 09 20 20 20 20 20 20 28 6d 61 72 6b 2d 66 6f .. (mark-fo
4000: 72 2d 75 70 64 61 74 65 29 0a 09 20 20 20 20 20 r-update)..
4010: 20 3b 3b 20 20 09 09 20 20 20 20 20 20 28 75 70 ;; .. (up
4020: 64 61 74 65 2d 73 65 61 72 63 68 20 22 69 74 65 date-search "ite
4030: 6d 2d 6e 61 6d 65 22 20 76 61 6c 29 29 0a 09 20 m-name" val))..
4040: 20 20 20 20 20 29 29 0a 09 20 20 20 20 28 69 75 )).. (iu
4050: 70 3a 76 62 6f 78 0a 09 20 20 20 20 20 28 69 75 p:vbox.. (iu
4060: 70 3a 68 62 6f 78 0a 09 20 20 20 20 20 20 28 69 p:hbox.. (i
4070: 75 70 3a 62 75 74 74 6f 6e 20 22 53 6f 72 74 22 up:button "Sort"
4080: 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 #:action (lambd
4090: 61 20 28 6f 62 6a 29 0a 09 09 09 09 09 20 20 20 a (obj)......
40a0: 20 28 73 65 74 21 20 2a 74 65 73 74 73 2d 73 6f (set! *tests-so
40b0: 72 74 2d 72 65 76 65 72 73 65 2a 20 28 6e 6f 74 rt-reverse* (not
40c0: 20 2a 74 65 73 74 73 2d 73 6f 72 74 2d 72 65 76 *tests-sort-rev
40d0: 65 72 73 65 2a 29 29 0a 09 09 09 09 09 20 20 20 erse*))......
40e0: 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d (iup:attribute-
40f0: 73 65 74 21 20 6f 62 6a 20 22 54 49 54 4c 45 22 set! obj "TITLE"
4100: 20 28 69 66 20 2a 74 65 73 74 73 2d 73 6f 72 74 (if *tests-sort
4110: 2d 72 65 76 65 72 73 65 2a 20 22 2b 53 6f 72 74 -reverse* "+Sort
4120: 22 20 22 2d 53 6f 72 74 22 29 29 0a 09 09 09 09 " "-Sort")).....
4130: 09 20 20 20 20 28 6d 61 72 6b 2d 66 6f 72 2d 75 . (mark-for-u
4140: 70 64 61 74 65 29 29 29 0a 09 20 20 20 20 20 20 pdate)))..
4150: 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 48 69 64 (iup:button "Hid
4160: 65 45 6d 70 74 79 22 20 23 3a 61 63 74 69 6f 6e eEmpty" #:action
4170: 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 29 0a 09 (lambda (obj)..
4180: 09 09 09 09 09 20 28 73 65 74 21 20 2a 68 69 64 ..... (set! *hid
4190: 65 2d 65 6d 70 74 79 2d 72 75 6e 73 2a 20 28 6e e-empty-runs* (n
41a0: 6f 74 20 2a 68 69 64 65 2d 65 6d 70 74 79 2d 72 ot *hide-empty-r
41b0: 75 6e 73 2a 29 29 0a 09 09 09 09 09 09 20 28 69 uns*))....... (i
41c0: 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 up:attribute-set
41d0: 21 20 6f 62 6a 20 22 54 49 54 4c 45 22 20 28 69 ! obj "TITLE" (i
41e0: 66 20 2a 68 69 64 65 2d 65 6d 70 74 79 2d 72 75 f *hide-empty-ru
41f0: 6e 73 2a 20 22 2b 48 69 64 65 22 20 22 2d 48 69 ns* "+Hide" "-Hi
4200: 64 65 22 29 29 0a 09 09 09 09 09 09 20 28 6d 61 de"))....... (ma
4210: 72 6b 2d 66 6f 72 2d 75 70 64 61 74 65 29 29 29 rk-for-update)))
4220: 0a 09 20 20 20 20 20 20 28 69 75 70 3a 62 75 74 .. (iup:but
4230: 74 6f 6e 20 22 52 65 66 72 65 73 68 22 20 20 20 ton "Refresh"
4240: 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 #:action (lambda
4250: 20 28 6f 62 6a 29 0a 09 09 09 09 09 09 20 28 6d (obj)....... (m
4260: 61 72 6b 2d 66 6f 72 2d 75 70 64 61 74 65 29 29 ark-for-update))
4270: 29 29 0a 09 20 20 20 20 20 28 69 75 70 3a 68 62 )).. (iup:hb
4280: 6f 78 0a 09 20 20 20 20 20 20 28 69 75 70 3a 62 ox.. (iup:b
4290: 75 74 74 6f 6e 20 22 51 75 69 74 22 20 23 3a 61 utton "Quit" #:a
42a0: 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f ction (lambda (o
42b0: 62 6a 29 28 69 66 20 2a 64 62 2a 20 28 73 71 6c bj)(if *db* (sql
42c0: 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 2a ite3:finalize! *
42d0: 64 62 2a 29 29 28 65 78 69 74 29 29 29 0a 09 20 db*))(exit)))..
42e0: 20 20 20 20 20 28 69 75 70 3a 62 75 74 74 6f 6e (iup:button
42f0: 20 22 4d 6f 6e 69 74 6f 72 22 20 23 3a 61 63 74 "Monitor" #:act
4300: 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a ion (lambda (obj
4310: 29 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 20 28 )(system (conc (
4320: 63 61 72 20 28 61 72 67 76 29 29 22 20 2d 67 75 car (argv))" -gu
4330: 69 6d 6f 6e 69 74 6f 72 20 26 22 29 29 29 29 29 imonitor &")))))
4340: 0a 09 20 20 20 20 20 29 29 0a 09 20 20 20 3b 3b .. )).. ;;
4350: 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 3c 2d (iup:button "<-
4360: 20 20 4c 65 66 74 22 20 23 3a 61 63 74 69 6f 6e Left" #:action
4370: 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 29 28 73 (lambda (obj)(s
4380: 65 74 21 20 2a 73 74 61 72 74 2d 72 75 6e 2d 6f et! *start-run-o
4390: 66 66 73 65 74 2a 20 20 28 2b 20 2a 73 74 61 72 ffset* (+ *star
43a0: 74 2d 72 75 6e 2d 6f 66 66 73 65 74 2a 20 31 29 t-run-offset* 1)
43b0: 29 29 29 0a 09 20 20 20 3b 3b 20 28 69 75 70 3a ))).. ;; (iup:
43c0: 62 75 74 74 6f 6e 20 22 55 70 20 20 20 20 20 5e button "Up ^
43d0: 22 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 " #:action (lamb
43e0: 64 61 20 28 6f 62 6a 29 28 73 65 74 21 20 2a 73 da (obj)(set! *s
43f0: 74 61 72 74 2d 74 65 73 74 2d 6f 66 66 73 65 74 tart-test-offset
4400: 2a 20 28 69 66 20 28 3e 20 2a 73 74 61 72 74 2d * (if (> *start-
4410: 74 65 73 74 2d 6f 66 66 73 65 74 2a 20 30 29 28 test-offset* 0)(
4420: 2d 20 2a 73 74 61 72 74 2d 74 65 73 74 2d 6f 66 - *start-test-of
4430: 66 73 65 74 2a 20 31 29 20 30 29 29 29 29 0a 09 fset* 1) 0))))..
4440: 20 20 20 3b 3b 20 28 69 75 70 3a 62 75 74 74 6f ;; (iup:butto
4450: 6e 20 22 44 6f 77 6e 20 20 20 76 22 20 23 3a 61 n "Down v" #:a
4460: 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f ction (lambda (o
4470: 62 6a 29 28 73 65 74 21 20 2a 73 74 61 72 74 2d bj)(set! *start-
4480: 74 65 73 74 2d 6f 66 66 73 65 74 2a 20 28 69 66 test-offset* (if
4490: 20 28 3e 3d 20 2a 73 74 61 72 74 2d 74 65 73 74 (>= *start-test
44a0: 2d 6f 66 66 73 65 74 2a 20 28 6c 65 6e 67 74 68 -offset* (length
44b0: 20 2a 61 6c 6c 74 65 73 74 6e 61 6d 65 6c 73 74 *alltestnamelst
44c0: 2a 29 29 28 6c 65 6e 67 74 68 20 2a 61 6c 6c 74 *))(length *allt
44d0: 65 73 74 6e 61 6d 65 6c 73 74 2a 29 28 2b 20 2a estnamelst*)(+ *
44e0: 73 74 61 72 74 2d 74 65 73 74 2d 6f 66 66 73 65 start-test-offse
44f0: 74 2a 20 31 29 29 29 29 29 0a 09 20 20 20 3b 3b t* 1))))).. ;;
4500: 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 52 69 (iup:button "Ri
4510: 67 68 74 20 2d 3e 22 20 23 3a 61 63 74 69 6f 6e ght ->" #:action
4520: 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 29 28 73 (lambda (obj)(s
4530: 65 74 21 20 2a 73 74 61 72 74 2d 72 75 6e 2d 6f et! *start-run-o
4540: 66 66 73 65 74 2a 20 20 28 69 66 20 28 3e 20 2a ffset* (if (> *
4550: 73 74 61 72 74 2d 72 75 6e 2d 6f 66 66 73 65 74 start-run-offset
4560: 2a 20 30 29 28 2d 20 2a 73 74 61 72 74 2d 72 75 * 0)(- *start-ru
4570: 6e 2d 6f 66 66 73 65 74 2a 20 31 29 20 30 29 29 n-offset* 1) 0))
4580: 29 29 0a 09 20 20 20 28 69 75 70 3a 66 72 61 6d )).. (iup:fram
4590: 65 20 0a 09 20 20 20 20 23 3a 74 69 74 6c 65 20 e .. #:title
45a0: 22 68 69 64 65 22 0a 09 20 20 20 20 28 69 75 70 "hide".. (iup
45b0: 3a 76 62 6f 78 0a 09 20 20 20 20 20 28 61 70 70 :vbox.. (app
45c0: 6c 79 20 0a 09 20 20 20 20 20 20 69 75 70 3a 68 ly .. iup:h
45d0: 62 6f 78 0a 09 20 20 20 20 20 20 28 6d 61 70 20 box.. (map
45e0: 28 6c 61 6d 62 64 61 20 28 73 74 61 74 75 73 29 (lambda (status)
45f0: 0a 09 09 20 20 20 20 20 28 69 75 70 3a 74 6f 67 ... (iup:tog
4600: 67 6c 65 20 73 74 61 74 75 73 20 20 23 3a 61 63 gle status #:ac
4610: 74 69 6f 6e 20 20 20 28 6c 61 6d 62 64 61 20 28 tion (lambda (
4620: 6f 62 6a 20 76 61 6c 29 0a 09 09 09 09 09 09 20 obj val).......
4630: 20 20 20 20 20 28 6d 61 72 6b 2d 66 6f 72 2d 75 (mark-for-u
4640: 70 64 61 74 65 29 0a 09 09 09 09 09 09 20 20 20 pdate).......
4650: 20 20 20 28 69 66 20 28 65 71 3f 20 76 61 6c 20 (if (eq? val
4660: 31 29 0a 09 09 09 09 09 09 09 20 20 28 68 61 73 1)........ (has
4670: 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 2a 73 74 h-table-set! *st
4680: 61 74 75 73 2d 69 67 6e 6f 72 65 2d 68 61 73 68 atus-ignore-hash
4690: 2a 20 73 74 61 74 75 73 20 23 74 29 0a 09 09 09 * status #t)....
46a0: 09 09 09 09 20 20 28 68 61 73 68 2d 74 61 62 6c .... (hash-tabl
46b0: 65 2d 64 65 6c 65 74 65 21 20 2a 73 74 61 74 75 e-delete! *statu
46c0: 73 2d 69 67 6e 6f 72 65 2d 68 61 73 68 2a 20 73 s-ignore-hash* s
46d0: 74 61 74 75 73 29 29 29 29 29 0a 09 20 20 20 20 tatus)))))..
46e0: 20 20 27 28 22 50 41 53 53 22 20 22 46 41 49 4c '("PASS" "FAIL
46f0: 22 20 22 57 41 52 4e 22 20 22 43 48 45 43 4b 22 " "WARN" "CHECK"
4700: 20 22 57 41 49 56 45 44 22 20 22 53 54 55 43 4b "WAIVED" "STUCK
4710: 2f 44 45 41 44 22 20 22 6e 2f 61 22 29 29 29 0a /DEAD" "n/a"))).
4720: 09 20 20 20 20 20 28 61 70 70 6c 79 20 0a 09 20 . (apply ..
4730: 20 20 20 20 20 69 75 70 3a 68 62 6f 78 0a 09 20 iup:hbox..
4740: 20 20 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 (map (lambd
4750: 61 20 28 73 74 61 74 65 29 0a 09 09 20 20 20 20 a (state)...
4760: 20 28 69 75 70 3a 74 6f 67 67 6c 65 20 73 74 61 (iup:toggle sta
4770: 74 65 20 20 20 23 3a 61 63 74 69 6f 6e 20 20 20 te #:action
4780: 28 6c 61 6d 62 64 61 20 28 6f 62 6a 20 76 61 6c (lambda (obj val
4790: 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 28 6d )....... (m
47a0: 61 72 6b 2d 66 6f 72 2d 75 70 64 61 74 65 29 0a ark-for-update).
47b0: 09 09 09 09 09 09 20 20 20 20 20 20 28 69 66 20 ...... (if
47c0: 28 65 71 3f 20 76 61 6c 20 31 29 0a 09 09 09 09 (eq? val 1).....
47d0: 09 09 09 20 20 28 68 61 73 68 2d 74 61 62 6c 65 ... (hash-table
47e0: 2d 73 65 74 21 20 2a 73 74 61 74 65 2d 69 67 6e -set! *state-ign
47f0: 6f 72 65 2d 68 61 73 68 2a 20 73 74 61 74 65 20 ore-hash* state
4800: 23 74 29 0a 09 09 09 09 09 09 09 20 20 28 68 61 #t)........ (ha
4810: 73 68 2d 74 61 62 6c 65 2d 64 65 6c 65 74 65 21 sh-table-delete!
4820: 20 2a 73 74 61 74 65 2d 69 67 6e 6f 72 65 2d 68 *state-ignore-h
4830: 61 73 68 2a 20 73 74 61 74 65 29 29 29 29 29 0a ash* state))))).
4840: 09 09 20 20 20 27 28 22 52 55 4e 4e 49 4e 47 22 .. '("RUNNING"
4850: 20 22 43 4f 4d 50 4c 45 54 45 44 22 20 22 49 4e "COMPLETED" "IN
4860: 43 4f 4d 50 4c 45 54 45 22 20 22 4c 41 55 4e 43 COMPLETE" "LAUNC
4870: 48 45 44 22 20 22 4e 4f 54 5f 53 54 41 52 54 45 HED" "NOT_STARTE
4880: 44 22 20 22 4b 49 4c 4c 45 44 22 20 22 44 45 4c D" "KILLED" "DEL
4890: 45 54 45 44 22 29 29 29 0a 09 20 20 20 20 20 28 ETED"))).. (
48a0: 69 75 70 3a 76 61 6c 75 61 74 6f 72 20 23 3a 76 iup:valuator #:v
48b0: 61 6c 75 65 63 68 61 6e 67 65 64 5f 63 62 20 28 aluechanged_cb (
48c0: 6c 61 6d 62 64 61 20 28 6f 62 6a 29 0a 09 09 09 lambda (obj)....
48d0: 09 09 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 .. (let ((
48e0: 76 61 6c 20 28 69 6e 65 78 61 63 74 2d 3e 65 78 val (inexact->ex
48f0: 61 63 74 20 28 72 6f 75 6e 64 20 28 2f 20 28 73 act (round (/ (s
4900: 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 69 tring->number (i
4910: 75 70 3a 61 74 74 72 69 62 75 74 65 20 6f 62 6a up:attribute obj
4920: 20 22 56 41 4c 55 45 22 29 29 20 31 30 29 29 29 "VALUE")) 10)))
4930: 29 0a 09 09 09 09 09 09 20 20 20 20 20 28 6f 6c )....... (ol
4940: 64 6d 61 78 20 20 20 28 73 74 72 69 6e 67 2d 3e dmax (string->
4950: 6e 75 6d 62 65 72 20 28 69 75 70 3a 61 74 74 72 number (iup:attr
4960: 69 62 75 74 65 20 6f 62 6a 20 22 4d 41 58 22 29 ibute obj "MAX")
4970: 29 29 0a 09 09 09 09 09 09 20 20 20 20 20 28 6d ))....... (m
4980: 61 78 72 75 6e 73 20 20 2a 74 6f 74 2d 72 75 6e axruns *tot-run
4990: 2d 63 6f 75 6e 74 2a 29 29 0a 09 09 09 09 09 09 -count*)).......
49a0: 20 28 73 65 74 21 20 2a 73 74 61 72 74 2d 72 75 (set! *start-ru
49b0: 6e 2d 6f 66 66 73 65 74 2a 20 76 61 6c 29 0a 09 n-offset* val)..
49c0: 09 09 09 09 09 20 28 6d 61 72 6b 2d 66 6f 72 2d ..... (mark-for-
49d0: 75 70 64 61 74 65 29 0a 09 09 09 09 09 09 20 28 update)....... (
49e0: 64 65 62 75 67 3a 70 72 69 6e 74 20 36 20 22 2a debug:print 6 "*
49f0: 73 74 61 72 74 2d 72 75 6e 2d 6f 66 66 73 65 74 start-run-offset
4a00: 2a 20 22 20 2a 73 74 61 72 74 2d 72 75 6e 2d 6f * " *start-run-o
4a10: 66 66 73 65 74 2a 20 22 20 6d 61 78 72 75 6e 73 ffset* " maxruns
4a20: 3a 20 22 20 6d 61 78 72 75 6e 73 20 22 2c 20 76 : " maxruns ", v
4a30: 61 6c 3a 20 22 20 76 61 6c 20 22 20 6f 6c 64 6d al: " val " oldm
4a40: 61 78 3a 20 22 20 6f 6c 64 6d 61 78 29 0a 09 09 ax: " oldmax)...
4a50: 09 09 09 09 20 28 69 75 70 3a 61 74 74 72 69 62 .... (iup:attrib
4a60: 75 74 65 2d 73 65 74 21 20 6f 62 6a 20 22 4d 41 ute-set! obj "MA
4a70: 58 22 20 28 2a 20 6d 61 78 72 75 6e 73 20 31 30 X" (* maxruns 10
4a80: 29 29 29 29 0a 09 09 09 20 20 20 23 3a 65 78 70 )))).... #:exp
4a90: 61 6e 64 20 22 59 45 53 22 0a 09 09 09 20 20 20 and "YES"....
4aa0: 23 3a 6d 61 78 20 28 2a 20 31 30 20 28 6c 65 6e #:max (* 10 (len
4ab0: 67 74 68 20 2a 61 6c 6c 72 75 6e 73 2a 29 29 29 gth *allruns*)))
4ac0: 29 29 0a 09 20 20 20 3b 28 69 75 70 3a 62 75 74 )).. ;(iup:but
4ad0: 74 6f 6e 20 22 69 6e 63 20 72 6f 77 73 22 20 23 ton "inc rows" #
4ae0: 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 :action (lambda
4af0: 28 6f 62 6a 29 28 73 65 74 21 20 2a 6e 75 6d 2d (obj)(set! *num-
4b00: 74 65 73 74 73 2a 20 28 2b 20 2a 6e 75 6d 2d 74 tests* (+ *num-t
4b10: 65 73 74 73 2a 20 31 29 29 29 29 0a 09 20 20 20 ests* 1))))..
4b20: 3b 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 64 65 ;(iup:button "de
4b30: 63 20 72 6f 77 73 22 20 23 3a 61 63 74 69 6f 6e c rows" #:action
4b40: 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 29 28 73 (lambda (obj)(s
4b50: 65 74 21 20 2a 6e 75 6d 2d 74 65 73 74 73 2a 20 et! *num-tests*
4b60: 28 69 66 20 28 3e 20 2a 6e 75 6d 2d 74 65 73 74 (if (> *num-test
4b70: 73 2a 20 30 29 28 2d 20 2a 6e 75 6d 2d 74 65 73 s* 0)(- *num-tes
4b80: 74 73 2a 20 31 29 20 30 29 29 29 29 0a 09 20 20 ts* 1) 0))))..
4b90: 20 29 0a 09 20 20 29 0a 20 20 20 20 0a 20 20 20 ).. ). .
4ba0: 20 3b 3b 20 63 72 65 61 74 65 20 74 68 65 20 6c ;; create the l
4bb0: 65 66 74 20 6d 6f 73 74 20 63 6f 6c 75 6d 6e 20 eft most column
4bc0: 66 6f 72 20 74 68 65 20 72 75 6e 20 6b 65 79 20 for the run key
4bd0: 6e 61 6d 65 73 20 61 6e 64 20 74 68 65 20 74 65 names and the te
4be0: 73 74 20 6e 61 6d 65 73 20 0a 20 20 20 20 28 73 st names . (s
4bf0: 65 74 21 20 6c 66 74 6c 73 74 20 28 6c 69 73 74 et! lftlst (list
4c00: 20 28 69 75 70 3a 68 62 6f 78 0a 09 09 09 28 69 (iup:hbox....(i
4c10: 75 70 3a 6c 61 62 65 6c 29 20 3b 3b 20 28 69 75 up:label) ;; (iu
4c20: 70 3a 76 61 6c 75 61 74 6f 72 29 0a 09 09 09 28 p:valuator)....(
4c30: 61 70 70 6c 79 20 69 75 70 3a 76 62 6f 78 20 0a apply iup:vbox .
4c40: 09 09 09 20 20 20 20 20 20 20 28 6d 61 70 20 28 ... (map (
4c50: 6c 61 6d 62 64 61 20 28 78 29 09 09 0a 09 09 09 lambda (x)......
4c60: 09 20 20 20 20 20 20 28 6c 65 74 20 28 28 72 65 . (let ((re
4c70: 73 20 28 69 75 70 3a 68 62 6f 78 20 23 3a 65 78 s (iup:hbox #:ex
4c80: 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c pand "HORIZONTAL
4c90: 22 0a 09 09 09 09 09 09 20 20 28 69 75 70 3a 6c "....... (iup:l
4ca0: 61 62 65 6c 20 78 20 23 3a 73 69 7a 65 20 22 78 abel x #:size "x
4cb0: 31 35 22 20 23 3a 66 6f 6e 74 73 69 7a 65 20 22 15" #:fontsize "
4cc0: 31 30 22 20 23 3a 65 78 70 61 6e 64 20 22 48 4f 10" #:expand "HO
4cd0: 52 49 5a 4f 4e 54 41 4c 22 29 0a 09 09 09 09 09 RIZONTAL")......
4ce0: 09 20 20 28 69 75 70 3a 74 65 78 74 62 6f 78 20 . (iup:textbox
4cf0: 23 3a 73 69 7a 65 20 22 78 31 35 22 20 23 3a 66 #:size "x15" #:f
4d00: 6f 6e 74 73 69 7a 65 20 22 31 30 22 20 23 3a 76 ontsize "10" #:v
4d10: 61 6c 75 65 20 22 25 22 20 23 3a 65 78 70 61 6e alue "%" #:expan
4d20: 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 0a 09 d "HORIZONTAL"..
4d30: 09 09 09 09 09 09 20 20 20 20 20 20 20 23 3a 61 ...... #:a
4d40: 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f ction (lambda (o
4d50: 62 6a 20 75 6e 6b 20 76 61 6c 29 0a 09 09 09 09 bj unk val).....
4d60: 09 09 09 09 09 20 20 28 6d 61 72 6b 2d 66 6f 72 ..... (mark-for
4d70: 2d 75 70 64 61 74 65 29 0a 09 09 09 09 09 09 09 -update)........
4d80: 09 09 20 20 28 75 70 64 61 74 65 2d 73 65 61 72 .. (update-sear
4d90: 63 68 20 78 20 76 61 6c 29 29 29 29 29 29 0a 09 ch x val))))))..
4da0: 09 09 09 09 28 73 65 74 21 20 69 20 28 2b 20 69 ....(set! i (+ i
4db0: 20 31 29 29 0a 09 09 09 09 09 72 65 73 29 29 0a 1))......res)).
4dc0: 09 09 09 09 20 20 20 20 6b 65 79 6e 61 6d 65 73 .... keynames
4dd0: 29 29 29 29 29 0a 20 20 20 20 28 6c 65 74 20 6c ))))). (let l
4de0: 6f 6f 70 20 28 28 74 65 73 74 6e 75 6d 20 20 30 oop ((testnum 0
4df0: 29 0a 09 20 20 20 20 20 20 20 28 72 65 73 20 20 ).. (res
4e00: 20 20 20 20 27 28 29 29 29 0a 20 20 20 20 20 20 '())).
4e10: 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 28 28 3e (cond. ((>
4e20: 3d 20 74 65 73 74 6e 75 6d 20 6e 74 65 73 74 73 = testnum ntests
4e30: 29 0a 09 3b 3b 20 6e 6f 77 20 6c 66 74 6c 73 74 )..;; now lftlst
4e40: 20 77 69 6c 6c 20 62 65 20 61 6e 20 68 62 6f 78 will be an hbox
4e50: 20 77 69 74 68 20 74 68 65 20 74 65 73 74 20 6b with the test k
4e60: 65 79 73 20 61 6e 64 20 74 68 65 20 74 65 73 74 eys and the test
4e70: 20 6e 61 6d 65 20 6c 61 62 65 6c 73 0a 09 28 73 name labels..(s
4e80: 65 74 21 20 6c 66 74 6c 73 74 20 28 61 70 70 65 et! lftlst (appe
4e90: 6e 64 20 6c 66 74 6c 73 74 20 28 6c 69 73 74 20 nd lftlst (list
4ea0: 28 69 75 70 3a 68 62 6f 78 20 20 23 3a 65 78 70 (iup:hbox #:exp
4eb0: 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 and "HORIZONTAL"
4ec0: 0a 09 09 09 09 09 20 20 20 28 69 75 70 3a 76 61 ...... (iup:va
4ed0: 6c 75 61 74 6f 72 20 23 3a 76 61 6c 75 65 63 68 luator #:valuech
4ee0: 61 6e 67 65 64 5f 63 62 20 28 6c 61 6d 62 64 61 anged_cb (lambda
4ef0: 20 28 6f 62 6a 29 0a 09 09 09 09 09 09 09 09 09 (obj)..........
4f00: 20 20 20 20 20 28 6c 65 74 20 28 28 76 61 6c 20 (let ((val
4f10: 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 (string->number
4f20: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 20 6f (iup:attribute o
4f30: 62 6a 20 22 56 41 4c 55 45 22 29 29 29 0a 09 09 bj "VALUE")))...
4f40: 09 09 09 09 09 09 09 09 20 20 20 28 6f 6c 64 6d ........ (oldm
4f50: 61 78 20 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d ax (string->num
4f60: 62 65 72 20 28 69 75 70 3a 61 74 74 72 69 62 75 ber (iup:attribu
4f70: 74 65 20 6f 62 6a 20 22 4d 41 58 22 29 29 29 0a te obj "MAX"))).
4f80: 09 09 09 09 09 09 09 09 09 09 20 20 20 28 6e 65 .......... (ne
4f90: 77 6d 61 78 20 20 28 2a 20 31 30 20 28 6c 65 6e wmax (* 10 (len
4fa0: 67 74 68 20 2a 61 6c 6c 74 65 73 74 6e 61 6d 65 gth *alltestname
4fb0: 6c 73 74 2a 29 29 29 29 0a 09 09 09 09 09 09 09 lst*))))........
4fc0: 09 09 20 20 20 20 20 20 20 28 73 65 74 21 20 2a .. (set! *
4fd0: 70 6c 65 61 73 65 2d 75 70 64 61 74 65 2d 62 75 please-update-bu
4fe0: 74 74 6f 6e 73 2a 20 23 74 29 0a 09 09 09 09 09 ttons* #t)......
4ff0: 09 09 09 09 20 20 20 20 20 20 20 28 73 65 74 21 .... (set!
5000: 20 2a 73 74 61 72 74 2d 74 65 73 74 2d 6f 66 66 *start-test-off
5010: 73 65 74 2a 20 28 69 6e 65 78 61 63 74 2d 3e 65 set* (inexact->e
5020: 78 61 63 74 20 28 72 6f 75 6e 64 20 28 2f 20 76 xact (round (/ v
5030: 61 6c 20 31 30 29 29 29 29 0a 09 09 09 09 09 09 al 10)))).......
5040: 09 09 09 20 20 20 20 20 20 20 28 64 65 62 75 67 ... (debug
5050: 3a 70 72 69 6e 74 20 36 20 22 2a 73 74 61 72 74 :print 6 "*start
5060: 2d 74 65 73 74 2d 6f 66 66 73 65 74 2a 20 22 20 -test-offset* "
5070: 2a 73 74 61 72 74 2d 74 65 73 74 2d 6f 66 66 73 *start-test-offs
5080: 65 74 2a 20 22 20 76 61 6c 3a 20 22 20 76 61 6c et* " val: " val
5090: 20 22 20 6e 65 77 6d 61 78 3a 20 22 20 6e 65 77 " newmax: " new
50a0: 6d 61 78 20 22 20 6f 6c 64 6d 61 78 3a 20 22 20 max " oldmax: "
50b0: 6f 6c 64 6d 61 78 29 0a 09 09 09 09 09 09 09 09 oldmax).........
50c0: 09 20 20 20 20 20 20 20 28 69 66 20 28 3c 20 76 . (if (< v
50d0: 61 6c 20 31 30 29 0a 09 09 09 09 09 09 09 09 09 al 10)..........
50e0: 09 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 . (iup:attribu
50f0: 74 65 2d 73 65 74 21 20 6f 62 6a 20 22 4d 41 58 te-set! obj "MAX
5100: 22 20 6e 65 77 6d 61 78 29 29 0a 09 09 09 09 09 " newmax))......
5110: 09 09 09 09 20 20 20 20 20 20 20 29 29 0a 09 09 .... ))...
5120: 09 09 09 09 09 20 23 3a 65 78 70 61 6e 64 20 22 ..... #:expand "
5130: 56 45 52 54 49 43 41 4c 22 20 0a 09 09 09 09 09 VERTICAL" ......
5140: 09 09 20 23 3a 6f 72 69 65 6e 74 61 74 69 6f 6e .. #:orientation
5150: 20 22 56 45 52 54 49 43 41 4c 22 29 0a 09 09 09 "VERTICAL")....
5160: 09 09 20 20 20 28 61 70 70 6c 79 20 69 75 70 3a .. (apply iup:
5170: 76 62 6f 78 20 28 72 65 76 65 72 73 65 20 72 65 vbox (reverse re
5180: 73 29 29 29 29 29 29 29 0a 20 20 20 20 20 20 20 s))))))).
5190: 28 65 6c 73 65 0a 09 28 6c 65 74 20 28 28 6c 61 (else..(let ((la
51a0: 62 6c 20 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 bl (iup:button
51b0: 22 22 20 0a 09 09 09 09 20 23 3a 66 6c 61 74 20 "" ..... #:flat
51c0: 22 59 45 53 22 20 0a 09 09 09 09 20 23 3a 61 6c "YES" ..... #:al
51d0: 69 67 6e 6d 65 6e 74 20 22 41 4c 45 46 54 22 0a ignment "ALEFT".
51e0: 09 09 09 09 20 3b 20 23 3a 69 6d 61 67 65 20 69 .... ; #:image i
51f0: 6d 67 31 0a 09 09 09 09 20 3b 20 23 3a 69 6d 70 mg1..... ; #:imp
5200: 72 65 73 73 20 69 6d 67 32 0a 09 09 09 09 20 23 ress img2..... #
5210: 3a 73 69 7a 65 20 22 78 31 35 22 0a 09 09 09 09 :size "x15".....
5220: 20 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a #:expand "HORIZ
5230: 4f 4e 54 41 4c 22 0a 09 09 09 09 20 23 3a 66 6f ONTAL"..... #:fo
5240: 6e 74 73 69 7a 65 20 22 31 30 22 0a 09 09 09 09 ntsize "10".....
5250: 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 #:action (lambd
5260: 61 20 28 6f 62 6a 29 0a 09 09 09 09 09 20 20 20 a (obj)......
5270: 20 28 6d 61 72 6b 2d 66 6f 72 2d 75 70 64 61 74 (mark-for-updat
5280: 65 29 0a 09 09 09 09 09 20 20 20 20 28 74 6f 67 e)...... (tog
5290: 67 6c 65 2d 68 69 64 65 20 74 65 73 74 6e 75 6d gle-hide testnum
52a0: 29 29 29 29 29 20 3b 3b 20 28 69 75 70 3a 61 74 ))))) ;; (iup:at
52b0: 74 72 69 62 75 74 65 20 6f 62 6a 20 22 54 49 54 tribute obj "TIT
52c0: 4c 45 22 29 29 29 29 0a 09 20 20 28 76 65 63 74 LE")))).. (vect
52d0: 6f 72 2d 73 65 74 21 20 6c 66 74 63 6f 6c 20 74 or-set! lftcol t
52e0: 65 73 74 6e 75 6d 20 6c 61 62 6c 29 0a 09 20 20 estnum labl)..
52f0: 28 6c 6f 6f 70 20 28 2b 20 74 65 73 74 6e 75 6d (loop (+ testnum
5300: 20 31 29 28 63 6f 6e 73 20 6c 61 62 6c 20 72 65 1)(cons labl re
5310: 73 29 29 29 29 29 29 0a 20 20 20 20 3b 3b 20 0a s)))))). ;; .
5320: 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 (let loop ((
5330: 72 75 6e 6e 75 6d 20 20 30 29 0a 09 20 20 20 20 runnum 0)..
5340: 20 20 20 28 6b 65 79 6e 75 6d 20 20 30 29 0a 09 (keynum 0)..
5350: 20 20 20 20 20 20 20 28 6b 65 79 76 65 63 20 20 (keyvec
5360: 28 6d 61 6b 65 2d 76 65 63 74 6f 72 20 6e 6b 65 (make-vector nke
5370: 79 73 29 29 0a 09 20 20 20 20 20 20 20 28 72 65 ys)).. (re
5380: 73 20 20 20 20 27 28 29 29 29 0a 20 20 20 20 20 s '())).
5390: 20 28 63 6f 6e 64 20 3b 3b 20 6e 62 2f 2f 20 6e (cond ;; nb// n
53a0: 6f 20 65 6c 73 65 20 66 6f 72 20 74 68 69 73 20 o else for this
53b0: 61 70 70 72 6f 61 63 68 2e 0a 20 20 20 20 20 20 approach..
53c0: 20 28 28 3e 3d 20 72 75 6e 6e 75 6d 20 6e 72 75 ((>= runnum nru
53d0: 6e 73 29 20 23 66 29 0a 20 20 20 20 20 20 20 28 ns) #f). (
53e0: 28 3e 3d 20 6b 65 79 6e 75 6d 20 6e 6b 65 79 73 (>= keynum nkeys
53f0: 29 20 0a 09 28 76 65 63 74 6f 72 2d 73 65 74 21 ) ..(vector-set!
5400: 20 68 65 61 64 65 72 20 72 75 6e 6e 75 6d 20 6b header runnum k
5410: 65 79 76 65 63 29 0a 09 28 73 65 74 21 20 68 64 eyvec)..(set! hd
5420: 72 6c 73 74 20 28 63 6f 6e 73 20 28 61 70 70 6c rlst (cons (appl
5430: 79 20 69 75 70 3a 76 62 6f 78 20 28 72 65 76 65 y iup:vbox (reve
5440: 72 73 65 20 72 65 73 29 29 20 68 64 72 6c 73 74 rse res)) hdrlst
5450: 29 29 0a 09 28 6c 6f 6f 70 20 28 2b 20 72 75 6e ))..(loop (+ run
5460: 6e 75 6d 20 31 29 20 30 20 28 6d 61 6b 65 2d 76 num 1) 0 (make-v
5470: 65 63 74 6f 72 20 6e 6b 65 79 73 29 20 27 28 29 ector nkeys) '()
5480: 29 29 0a 20 20 20 20 20 20 20 28 65 6c 73 65 0a )). (else.
5490: 09 28 6c 65 74 20 28 28 6c 61 62 6c 20 20 28 69 .(let ((labl (i
54a0: 75 70 3a 6c 61 62 65 6c 20 22 22 20 23 3a 73 69 up:label "" #:si
54b0: 7a 65 20 22 36 30 78 31 35 22 20 23 3a 66 6f 6e ze "60x15" #:fon
54c0: 74 73 69 7a 65 20 22 31 30 22 20 23 3a 65 78 70 tsize "10" #:exp
54d0: 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 and "HORIZONTAL"
54e0: 29 29 29 20 3b 3b 20 23 3a 65 78 70 61 6e 64 20 ))) ;; #:expand
54f0: 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 0a 09 20 20 "HORIZONTAL"..
5500: 28 76 65 63 74 6f 72 2d 73 65 74 21 20 6b 65 79 (vector-set! key
5510: 76 65 63 20 6b 65 79 6e 75 6d 20 6c 61 62 6c 29 vec keynum labl)
5520: 0a 09 20 20 28 6c 6f 6f 70 20 72 75 6e 6e 75 6d .. (loop runnum
5530: 20 28 2b 20 6b 65 79 6e 75 6d 20 31 29 20 6b 65 (+ keynum 1) ke
5540: 79 76 65 63 20 28 63 6f 6e 73 20 6c 61 62 6c 20 yvec (cons labl
5550: 72 65 73 29 29 29 29 29 29 0a 20 20 20 20 3b 3b res)))))). ;;
5560: 20 42 79 20 68 65 72 65 20 74 68 65 20 68 64 72 By here the hdr
5570: 6c 73 74 20 63 6f 6e 74 61 69 6e 73 20 61 20 6c lst contains a l
5580: 69 73 74 20 6f 66 20 76 62 6f 78 65 73 20 63 6f ist of vboxes co
5590: 6e 74 61 69 6e 69 6e 67 20 6e 6b 65 79 73 20 6c ntaining nkeys l
55a0: 61 62 65 6c 73 0a 20 20 20 20 28 6c 65 74 20 6c abels. (let l
55b0: 6f 6f 70 20 28 28 72 75 6e 6e 75 6d 20 20 30 29 oop ((runnum 0)
55c0: 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 6e 75 .. (testnu
55d0: 6d 20 30 29 0a 09 20 20 20 20 20 20 20 28 74 65 m 0).. (te
55e0: 73 74 76 65 63 20 20 28 6d 61 6b 65 2d 76 65 63 stvec (make-vec
55f0: 74 6f 72 20 6e 74 65 73 74 73 29 29 0a 09 20 20 tor ntests))..
5600: 20 20 20 20 20 28 72 65 73 20 20 20 20 27 28 29 (res '()
5610: 29 29 0a 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 )). (cond.
5620: 20 20 20 20 20 20 28 28 3e 3d 20 72 75 6e 6e 75 ((>= runnu
5630: 6d 20 6e 72 75 6e 73 29 20 23 66 29 20 3b 3b 20 m nruns) #f) ;;
5640: 20 28 76 65 63 74 6f 72 20 74 61 62 6c 65 68 65 (vector tablehe
5650: 61 64 65 72 20 72 75 6e 73 76 65 63 29 29 0a 20 ader runsvec)).
5660: 20 20 20 20 20 20 28 28 3e 3d 20 74 65 73 74 6e ((>= testn
5670: 75 6d 20 6e 74 65 73 74 73 29 20 0a 09 28 76 65 um ntests) ..(ve
5680: 63 74 6f 72 2d 73 65 74 21 20 72 75 6e 73 76 65 ctor-set! runsve
5690: 63 20 72 75 6e 6e 75 6d 20 74 65 73 74 76 65 63 c runnum testvec
56a0: 29 0a 09 28 73 65 74 21 20 62 64 79 6c 73 74 20 )..(set! bdylst
56b0: 28 63 6f 6e 73 20 28 61 70 70 6c 79 20 69 75 70 (cons (apply iup
56c0: 3a 76 62 6f 78 20 28 72 65 76 65 72 73 65 20 72 :vbox (reverse r
56d0: 65 73 29 29 20 62 64 79 6c 73 74 29 29 0a 09 28 es)) bdylst))..(
56e0: 6c 6f 6f 70 20 28 2b 20 72 75 6e 6e 75 6d 20 31 loop (+ runnum 1
56f0: 29 20 30 20 28 6d 61 6b 65 2d 76 65 63 74 6f 72 ) 0 (make-vector
5700: 20 6e 74 65 73 74 73 29 20 27 28 29 29 29 0a 20 ntests) '())).
5710: 20 20 20 20 20 20 28 65 6c 73 65 0a 09 28 6c 65 (else..(le
5720: 74 2a 20 28 28 62 75 74 74 6f 6e 2d 6b 65 79 20 t* ((button-key
5730: 28 6d 6b 73 74 72 20 72 75 6e 6e 75 6d 20 74 65 (mkstr runnum te
5740: 73 74 6e 75 6d 29 29 0a 09 20 20 20 20 20 20 20 stnum))..
5750: 28 62 75 74 6e 20 20 20 20 20 20 20 28 69 75 70 (butn (iup
5760: 3a 62 75 74 74 6f 6e 20 22 22 20 3b 3b 20 62 75 :button "" ;; bu
5770: 74 74 6f 6e 2d 6b 65 79 20 0a 09 09 09 09 20 20 tton-key .....
5780: 20 20 20 20 20 23 3a 73 69 7a 65 20 22 36 30 78 #:size "60x
5790: 31 35 22 20 0a 09 09 09 09 20 20 20 20 20 20 20 15" .....
57a0: 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f #:expand "HORIZO
57b0: 4e 54 41 4c 22 0a 09 09 09 09 20 20 20 20 20 20 NTAL".....
57c0: 20 23 3a 66 6f 6e 74 73 69 7a 65 20 22 31 30 22 #:fontsize "10"
57d0: 20 0a 09 09 09 09 20 20 20 20 20 20 20 23 3a 61 ..... #:a
57e0: 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 78 ction (lambda (x
57f0: 29 0a 09 09 09 09 09 09 20 20 28 6c 65 74 2a 20 )....... (let*
5800: 28 28 74 6f 6f 6c 70 61 74 68 20 28 63 61 72 20 ((toolpath (car
5810: 28 61 72 67 76 29 29 29 0a 09 09 09 09 09 09 09 (argv)))........
5820: 20 28 62 75 74 74 6e 64 61 74 20 28 68 61 73 68 (buttndat (hash
5830: 2d 74 61 62 6c 65 2d 72 65 66 20 2a 62 75 74 74 -table-ref *butt
5840: 6f 6e 64 61 74 2a 20 62 75 74 74 6f 6e 2d 6b 65 ondat* button-ke
5850: 79 29 29 0a 09 09 09 09 09 09 09 20 28 74 65 73 y))........ (tes
5860: 74 2d 69 64 20 20 28 64 62 3a 74 65 73 74 2d 67 t-id (db:test-g
5870: 65 74 2d 69 64 20 28 76 65 63 74 6f 72 2d 72 65 et-id (vector-re
5880: 66 20 62 75 74 74 6e 64 61 74 20 33 29 29 29 0a f buttndat 3))).
5890: 09 09 09 09 09 09 09 20 28 63 6d 64 20 20 28 63 ....... (cmd (c
58a0: 6f 6e 63 20 74 6f 6f 6c 70 61 74 68 20 22 20 2d onc toolpath " -
58b0: 74 65 73 74 20 22 20 74 65 73 74 2d 69 64 20 22 test " test-id "
58c0: 26 22 29 29 29 0a 09 09 09 09 09 09 20 20 20 20 &"))).......
58d0: 3b 28 70 72 69 6e 74 20 22 4c 61 75 6e 63 68 69 ;(print "Launchi
58e0: 6e 67 20 22 20 63 6d 64 29 0a 09 09 09 09 09 09 ng " cmd).......
58f0: 20 20 20 20 28 73 79 73 74 65 6d 20 63 6d 64 29 (system cmd)
5900: 29 29 29 29 29 0a 09 20 20 28 68 61 73 68 2d 74 ))))).. (hash-t
5910: 61 62 6c 65 2d 73 65 74 21 20 2a 62 75 74 74 6f able-set! *butto
5920: 6e 64 61 74 2a 20 62 75 74 74 6f 6e 2d 6b 65 79 ndat* button-key
5930: 20 28 76 65 63 74 6f 72 20 30 20 22 31 30 30 20 (vector 0 "100
5940: 31 30 30 20 31 30 30 22 20 62 75 74 74 6f 6e 2d 100 100" button-
5950: 6b 65 79 20 23 66 20 23 66 29 29 20 0a 09 20 20 key #f #f)) ..
5960: 28 76 65 63 74 6f 72 2d 73 65 74 21 20 74 65 73 (vector-set! tes
5970: 74 76 65 63 20 74 65 73 74 6e 75 6d 20 62 75 74 tvec testnum but
5980: 6e 29 0a 09 20 20 28 6c 6f 6f 70 20 72 75 6e 6e n).. (loop runn
5990: 75 6d 20 28 2b 20 74 65 73 74 6e 75 6d 20 31 29 um (+ testnum 1)
59a0: 20 74 65 73 74 76 65 63 20 28 63 6f 6e 73 20 62 testvec (cons b
59b0: 75 74 6e 20 72 65 73 29 29 29 29 29 29 0a 20 20 utn res)))))).
59c0: 20 20 3b 3b 20 6e 6f 77 20 61 73 73 65 6d 62 6c ;; now assembl
59d0: 65 20 74 68 65 20 68 64 72 6c 73 74 20 61 6e 64 e the hdrlst and
59e0: 20 62 64 79 6c 73 74 20 61 6e 64 20 6b 69 63 6b bdylst and kick
59f0: 20 6f 66 66 20 74 68 65 20 64 69 61 6c 6f 67 0a off the dialog.
5a00: 20 20 20 20 28 69 75 70 3a 73 68 6f 77 0a 20 20 (iup:show.
5a10: 20 20 20 28 69 75 70 3a 64 69 61 6c 6f 67 20 0a (iup:dialog .
5a20: 20 20 20 20 20 20 23 3a 74 69 74 6c 65 20 22 4d #:title "M
5a30: 65 67 61 74 65 73 74 20 64 61 73 68 62 6f 61 72 egatest dashboar
5a40: 64 22 0a 20 20 20 20 20 20 28 69 75 70 3a 76 62 d". (iup:vb
5a50: 6f 78 0a 09 28 61 70 70 6c 79 20 69 75 70 3a 68 ox..(apply iup:h
5a60: 62 6f 78 20 0a 09 20 20 20 20 20 20 20 28 63 6f box .. (co
5a70: 6e 73 20 28 61 70 70 6c 79 20 69 75 70 3a 76 62 ns (apply iup:vb
5a80: 6f 78 20 6c 66 74 6c 73 74 29 0a 09 09 20 20 20 ox lftlst)...
5a90: 20 20 28 6c 69 73 74 20 0a 09 09 20 20 20 20 20 (list ...
5aa0: 20 28 69 75 70 3a 76 62 6f 78 0a 09 09 20 20 20 (iup:vbox...
5ab0: 20 20 20 20 3b 3b 20 74 68 65 20 68 65 61 64 65 ;; the heade
5ac0: 72 0a 09 09 20 20 20 20 20 20 20 28 61 70 70 6c r... (appl
5ad0: 79 20 69 75 70 3a 68 62 6f 78 20 28 72 65 76 65 y iup:hbox (reve
5ae0: 72 73 65 20 68 64 72 6c 73 74 29 29 0a 09 09 20 rse hdrlst))...
5af0: 20 20 20 20 20 20 28 61 70 70 6c 79 20 69 75 70 (apply iup
5b00: 3a 68 62 6f 78 20 28 72 65 76 65 72 73 65 20 62 :hbox (reverse b
5b10: 64 79 6c 73 74 29 29 29 29 29 29 0a 20 20 20 20 dylst)))))).
5b20: 20 20 20 63 6f 6e 74 72 6f 6c 73 29 29 29 0a 20 controls))).
5b30: 20 20 20 28 76 65 63 74 6f 72 20 6b 65 79 63 6f (vector keyco
5b40: 6c 20 6c 66 74 63 6f 6c 20 68 65 61 64 65 72 20 l lftcol header
5b50: 72 75 6e 73 76 65 63 29 29 29 0a 0a 28 69 66 20 runsvec)))..(if
5b60: 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (or (args:get-ar
5b70: 67 20 22 2d 72 6f 77 73 22 29 0a 09 28 67 65 74 g "-rows")..(get
5b80: 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 -environment-var
5b90: 69 61 62 6c 65 20 22 44 41 53 48 42 4f 41 52 44 iable "DASHBOARD
5ba0: 52 4f 57 53 22 20 29 29 0a 20 20 20 20 28 62 65 ROWS" )). (be
5bb0: 67 69 6e 0a 20 20 20 20 20 20 20 20 28 73 65 74 gin. (set
5bc0: 21 20 2a 6e 75 6d 2d 74 65 73 74 73 2a 20 28 73 ! *num-tests* (s
5bd0: 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 6f tring->number (o
5be0: 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 r (args:get-arg
5bf0: 22 2d 72 6f 77 73 22 29 0a 09 09 09 09 09 20 20 "-rows")......
5c00: 20 20 20 20 28 67 65 74 2d 65 6e 76 69 72 6f 6e (get-environ
5c10: 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 22 44 ment-variable "D
5c20: 41 53 48 42 4f 41 52 44 52 4f 57 53 22 29 29 29 ASHBOARDROWS")))
5c30: 29 0a 09 28 75 70 64 61 74 65 2d 72 75 6e 64 61 )..(update-runda
5c40: 74 20 22 25 22 20 2a 6e 75 6d 2d 72 75 6e 73 2a t "%" *num-runs*
5c50: 20 22 25 2f 25 22 20 27 28 29 29 29 0a 20 20 20 "%/%" '())).
5c60: 20 28 73 65 74 21 20 2a 6e 75 6d 2d 74 65 73 74 (set! *num-test
5c70: 73 2a 20 28 6d 69 6e 20 28 6d 61 78 20 28 75 70 s* (min (max (up
5c80: 64 61 74 65 2d 72 75 6e 64 61 74 20 22 25 22 20 date-rundat "%"
5c90: 2a 6e 75 6d 2d 72 75 6e 73 2a 20 22 25 2f 25 22 *num-runs* "%/%"
5ca0: 20 27 28 29 29 20 38 29 20 32 30 29 29 29 0a 0a '()) 8) 20)))..
5cb0: 28 64 65 66 69 6e 65 20 2a 74 69 6d 2a 20 28 69 (define *tim* (i
5cc0: 75 70 3a 74 69 6d 65 72 29 29 0a 28 64 65 66 69 up:timer)).(defi
5cd0: 6e 65 20 2a 6f 72 64 2a 20 23 66 29 0a 28 69 75 ne *ord* #f).(iu
5ce0: 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 p:attribute-set!
5cf0: 20 2a 74 69 6d 2a 20 22 54 49 4d 45 22 20 33 30 *tim* "TIME" 30
5d00: 30 29 0a 28 69 75 70 3a 61 74 74 72 69 62 75 74 0).(iup:attribut
5d10: 65 2d 73 65 74 21 20 2a 74 69 6d 2a 20 22 52 55 e-set! *tim* "RU
5d20: 4e 22 20 22 59 45 53 22 29 0a 0a 3b 3b 20 4d 6f N" "YES")..;; Mo
5d30: 76 65 20 74 68 69 73 20 73 74 75 66 66 20 74 6f ve this stuff to
5d40: 20 64 62 2e 73 63 6d 20 46 49 58 4d 45 0a 3b 3b db.scm FIXME.;;
5d50: 0a 28 64 65 66 69 6e 65 20 2a 6c 61 73 74 2d 64 .(define *last-d
5d60: 62 2d 75 70 64 61 74 65 2d 74 69 6d 65 2a 20 28 b-update-time* (
5d70: 66 69 6c 65 2d 6d 6f 64 69 66 69 63 61 74 69 6f file-modificatio
5d80: 6e 2d 74 69 6d 65 20 28 63 6f 6e 63 20 2a 74 6f n-time (conc *to
5d90: 70 70 61 74 68 2a 20 22 2f 6d 65 67 61 74 65 73 ppath* "/megates
5da0: 74 2e 64 62 22 29 29 29 0a 28 64 65 66 69 6e 65 t.db"))).(define
5db0: 20 28 64 62 3a 62 65 65 6e 2d 63 68 61 6e 67 65 (db:been-change
5dc0: 64 29 0a 20 20 28 3e 20 28 66 69 6c 65 2d 6d 6f d). (> (file-mo
5dd0: 64 69 66 69 63 61 74 69 6f 6e 2d 74 69 6d 65 20 dification-time
5de0: 28 63 6f 6e 63 20 2a 74 6f 70 70 61 74 68 2a 20 (conc *toppath*
5df0: 22 2f 6d 65 67 61 74 65 73 74 2e 64 62 22 29 29 "/megatest.db"))
5e00: 20 2a 6c 61 73 74 2d 64 62 2d 75 70 64 61 74 65 *last-db-update
5e10: 2d 74 69 6d 65 2a 29 29 0a 28 64 65 66 69 6e 65 -time*)).(define
5e20: 20 28 64 62 3a 73 65 74 2d 64 62 2d 75 70 64 61 (db:set-db-upda
5e30: 74 65 2d 74 69 6d 65 29 0a 20 20 28 73 65 74 21 te-time). (set!
5e40: 20 2a 6c 61 73 74 2d 64 62 2d 75 70 64 61 74 65 *last-db-update
5e50: 2d 74 69 6d 65 2a 20 28 66 69 6c 65 2d 6d 6f 64 -time* (file-mod
5e60: 69 66 69 63 61 74 69 6f 6e 2d 74 69 6d 65 20 28 ification-time (
5e70: 63 6f 6e 63 20 2a 74 6f 70 70 61 74 68 2a 20 22 conc *toppath* "
5e80: 2f 6d 65 67 61 74 65 73 74 2e 64 62 22 29 29 29 /megatest.db")))
5e90: 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 75 6e 2d )..(define (run-
5ea0: 75 70 64 61 74 65 20 78 29 0a 20 20 28 75 70 64 update x). (upd
5eb0: 61 74 65 2d 62 75 74 74 6f 6e 73 20 75 69 64 61 ate-buttons uida
5ec0: 74 20 2a 6e 75 6d 2d 72 75 6e 73 2a 20 2a 6e 75 t *num-runs* *nu
5ed0: 6d 2d 74 65 73 74 73 2a 29 0a 20 20 3b 3b 20 28 m-tests*). ;; (
5ee0: 69 66 20 28 64 62 3a 62 65 65 6e 2d 63 68 61 6e if (db:been-chan
5ef0: 67 65 64 29 0a 20 20 28 62 65 67 69 6e 0a 20 20 ged). (begin.
5f00: 20 20 28 75 70 64 61 74 65 2d 72 75 6e 64 61 74 (update-rundat
5f10: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
5f20: 2f 64 65 66 61 75 6c 74 20 2a 73 65 61 72 63 68 /default *search
5f30: 70 61 74 74 73 2a 20 22 72 75 6e 6e 61 6d 65 22 patts* "runname"
5f40: 20 22 25 22 29 20 2a 6e 75 6d 2d 72 75 6e 73 2a "%") *num-runs*
5f50: 0a 09 09 20 20 20 28 68 61 73 68 2d 74 61 62 6c ... (hash-tabl
5f60: 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 2a 73 e-ref/default *s
5f70: 65 61 72 63 68 70 61 74 74 73 2a 20 22 74 65 73 earchpatts* "tes
5f80: 74 2d 6e 61 6d 65 22 20 22 25 2f 25 22 29 0a 09 t-name" "%/%")..
5f90: 09 20 20 20 3b 3b 20 28 68 61 73 68 2d 74 61 62 . ;; (hash-tab
5fa0: 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 2a le-ref/default *
5fb0: 73 65 61 72 63 68 70 61 74 74 73 2a 20 22 69 74 searchpatts* "it
5fc0: 65 6d 2d 6e 61 6d 65 22 20 22 25 22 29 0a 09 09 em-name" "%")...
5fd0: 20 20 20 28 6c 65 74 20 28 28 72 65 73 20 27 28 (let ((res '(
5fe0: 29 29 29 0a 09 09 20 20 20 20 20 28 66 6f 72 2d )))... (for-
5ff0: 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 6b 65 each (lambda (ke
6000: 79 29 0a 09 09 09 09 20 28 69 66 20 28 6e 6f 74 y)..... (if (not
6010: 20 28 65 71 75 61 6c 3f 20 6b 65 79 20 22 72 75 (equal? key "ru
6020: 6e 6e 61 6d 65 22 29 29 0a 09 09 09 09 20 20 20 nname")).....
6030: 20 20 28 6c 65 74 20 28 28 76 61 6c 20 28 68 61 (let ((val (ha
6040: 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 sh-table-ref/def
6050: 61 75 6c 74 20 2a 73 65 61 72 63 68 70 61 74 74 ault *searchpatt
6060: 73 2a 20 6b 65 79 20 23 66 29 29 29 0a 09 09 09 s* key #f)))....
6070: 09 20 20 20 20 20 20 20 28 69 66 20 76 61 6c 20 . (if val
6080: 28 73 65 74 21 20 72 65 73 20 28 63 6f 6e 73 20 (set! res (cons
6090: 28 6c 69 73 74 20 6b 65 79 20 76 61 6c 29 20 72 (list key val) r
60a0: 65 73 29 29 29 29 29 29 0a 09 09 09 20 20 20 20 es))))))....
60b0: 20 20 20 2a 64 62 6b 65 79 73 2a 29 0a 09 09 20 *dbkeys*)...
60c0: 20 20 20 20 72 65 73 29 29 0a 20 20 20 20 3b 20 res)). ;
60d0: 28 64 62 3a 73 65 74 2d 64 62 2d 75 70 64 61 74 (db:set-db-updat
60e0: 65 2d 74 69 6d 65 29 0a 20 20 20 20 29 29 0a 0a e-time). ))..
60f0: 28 63 6f 6e 64 20 0a 20 28 28 61 72 67 73 3a 67 (cond . ((args:g
6100: 65 74 2d 61 72 67 20 22 2d 72 75 6e 22 29 0a 20 et-arg "-run").
6110: 20 28 6c 65 74 20 28 28 72 75 6e 69 64 20 28 73 (let ((runid (s
6120: 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 61 tring->number (a
6130: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 rgs:get-arg "-ru
6140: 6e 22 29 29 29 29 0a 20 20 20 20 28 69 66 20 72 n")))). (if r
6150: 75 6e 69 64 0a 09 28 62 65 67 69 6e 0a 09 20 20 unid..(begin..
6160: 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 20 20 20 (lambda (x)..
6170: 20 28 6f 6e 2d 65 78 69 74 20 28 6c 61 6d 62 64 (on-exit (lambd
6180: 61 20 28 29 0a 09 09 20 20 20 20 20 20 20 28 69 a ()... (i
6190: 66 20 2a 64 62 2a 20 28 73 71 6c 69 74 65 33 3a f *db* (sqlite3:
61a0: 66 69 6e 61 6c 69 7a 65 21 20 2a 64 62 2a 29 29 finalize! *db*))
61b0: 29 29 0a 09 20 20 20 20 28 63 64 62 3a 72 65 6d )).. (cdb:rem
61c0: 6f 74 65 2d 72 75 6e 20 65 78 61 6d 69 6e 65 2d ote-run examine-
61d0: 72 75 6e 20 2a 64 62 2a 20 72 75 6e 69 64 29 29 run *db* runid))
61e0: 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 70 72 )..(begin.. (pr
61f0: 69 6e 74 20 22 45 52 52 4f 52 3a 20 72 75 6e 69 int "ERROR: runi
6200: 64 20 69 73 20 6e 6f 74 20 61 20 6e 75 6d 62 65 d is not a numbe
6210: 72 20 22 20 28 61 72 67 73 3a 67 65 74 2d 61 72 r " (args:get-ar
6220: 67 20 22 2d 72 75 6e 22 29 29 0a 09 20 20 28 65 g "-run")).. (e
6230: 78 69 74 20 31 29 29 29 29 29 0a 20 28 28 61 72 xit 1))))). ((ar
6240: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 gs:get-arg "-tes
6250: 74 22 29 0a 20 20 20 20 28 6c 65 74 20 28 28 74 t"). (let ((t
6260: 65 73 74 69 64 20 28 73 74 72 69 6e 67 2d 3e 6e estid (string->n
6270: 75 6d 62 65 72 20 28 61 72 67 73 3a 67 65 74 2d umber (args:get-
6280: 61 72 67 20 22 2d 74 65 73 74 22 29 29 29 29 0a arg "-test")))).
6290: 20 20 20 20 28 69 66 20 74 65 73 74 69 64 0a 09 (if testid..
62a0: 28 65 78 61 6d 69 6e 65 2d 74 65 73 74 20 74 65 (examine-test te
62b0: 73 74 69 64 29 0a 09 28 62 65 67 69 6e 0a 09 20 stid)..(begin..
62c0: 20 28 70 72 69 6e 74 20 22 45 52 52 4f 52 3a 20 (print "ERROR:
62d0: 74 65 73 74 69 64 20 69 73 20 6e 6f 74 20 61 20 testid is not a
62e0: 6e 75 6d 62 65 72 20 22 20 28 61 72 67 73 3a 67 number " (args:g
62f0: 65 74 2d 61 72 67 20 22 2d 74 65 73 74 22 29 29 et-arg "-test"))
6300: 0a 09 20 20 28 65 78 69 74 20 31 29 29 29 29 29 .. (exit 1)))))
6310: 0a 20 28 28 61 72 67 73 3a 67 65 74 2d 61 72 67 . ((args:get-arg
6320: 20 22 2d 67 75 69 6d 6f 6e 69 74 6f 72 22 29 0a "-guimonitor").
6330: 20 20 28 67 75 69 2d 6d 6f 6e 69 74 6f 72 20 2a (gui-monitor *
6340: 64 62 2a 29 29 0a 20 28 65 6c 73 65 0a 20 20 28 db*)). (else. (
6350: 73 65 74 21 20 75 69 64 61 74 20 28 6d 61 6b 65 set! uidat (make
6360: 2d 64 61 73 68 62 6f 61 72 64 2d 62 75 74 74 6f -dashboard-butto
6370: 6e 73 20 2a 6e 75 6d 2d 72 75 6e 73 2a 20 2a 6e ns *num-runs* *n
6380: 75 6d 2d 74 65 73 74 73 2a 20 2a 64 62 6b 65 79 um-tests* *dbkey
6390: 73 2a 29 29 0a 20 20 28 69 75 70 3a 63 61 6c 6c s*)). (iup:call
63a0: 62 61 63 6b 2d 73 65 74 21 20 2a 74 69 6d 2a 0a back-set! *tim*.
63b0: 09 09 20 20 20 20 20 22 41 43 54 49 4f 4e 5f 43 .. "ACTION_C
63c0: 42 22 0a 09 09 20 20 20 20 20 28 6c 61 6d 62 64 B"... (lambd
63d0: 61 20 28 78 29 0a 09 09 20 20 20 20 20 20 20 28 a (x)... (
63e0: 72 75 6e 2d 75 70 64 61 74 65 20 78 29 29 29 29 run-update x))))
63f0: 29 0a 09 09 20 20 20 20 20 20 20 3b 28 70 72 69 )... ;(pri
6400: 6e 74 20 78 29 29 29 29 29 0a 0a 28 69 75 70 3a nt x)))))..(iup:
6410: 6d 61 69 6e 2d 6c 6f 6f 70 29 0a main-loop).