Artifact
dfc3e5bd3faebb57141b0a59ed8626666dbbf8d8:
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 36 2c right 2006-2016,
0060: 20 4d 61 74 74 68 65 77 20 57 65 6c 6c 61 6e 64 Matthew Welland
0070: 2e 0a 3b 3b 20 0a 3b 3b 20 20 54 68 69 73 20 70 ..;; .;; This p
0080: 72 6f 67 72 61 6d 20 69 73 20 6d 61 64 65 20 61 rogram is made a
0090: 76 61 69 6c 61 62 6c 65 20 75 6e 64 65 72 20 74 vailable under t
00a0: 68 65 20 47 4e 55 20 47 50 4c 20 76 65 72 73 69 he GNU GPL versi
00b0: 6f 6e 20 32 2e 30 20 6f 72 0a 3b 3b 20 20 67 72 on 2.0 or.;; gr
00c0: 65 61 74 65 72 2e 20 53 65 65 20 74 68 65 20 61 eater. See the a
00d0: 63 63 6f 6d 70 61 6e 79 69 6e 67 20 66 69 6c 65 ccompanying file
00e0: 20 43 4f 50 59 49 4e 47 20 66 6f 72 20 64 65 74 COPYING for det
00f0: 61 69 6c 73 2e 0a 3b 3b 20 0a 3b 3b 20 20 54 68 ails..;; .;; Th
0100: 69 73 20 70 72 6f 67 72 61 6d 20 69 73 20 64 69 is program is di
0110: 73 74 72 69 62 75 74 65 64 20 57 49 54 48 4f 55 stributed WITHOU
0120: 54 20 41 4e 59 20 57 41 52 52 41 4e 54 59 3b 20 T ANY WARRANTY;
0130: 77 69 74 68 6f 75 74 20 65 76 65 6e 20 74 68 65 without even the
0140: 0a 3b 3b 20 20 69 6d 70 6c 69 65 64 20 77 61 72 .;; implied war
0150: 72 61 6e 74 79 20 6f 66 20 4d 45 52 43 48 41 4e ranty of MERCHAN
0160: 54 41 42 49 4c 49 54 59 20 6f 72 20 46 49 54 4e TABILITY or FITN
0170: 45 53 53 20 46 4f 52 20 41 20 50 41 52 54 49 43 ESS FOR A PARTIC
0180: 55 4c 41 52 0a 3b 3b 20 20 50 55 52 50 4f 53 45 ULAR.;; PURPOSE
0190: 2e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
01a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 75 73 65 ==========..(use
01e0: 20 66 6f 72 6d 61 74 29 0a 28 72 65 71 75 69 72 format).(requir
01f0: 65 2d 6c 69 62 72 61 72 79 20 69 75 70 29 0a 28 e-library iup).(
0200: 69 6d 70 6f 72 74 20 28 70 72 65 66 69 78 20 69 import (prefix i
0210: 75 70 20 69 75 70 3a 29 29 0a 0a 28 75 73 65 20 up iup:))..(use
0220: 63 61 6e 76 61 73 2d 64 72 61 77 29 0a 28 69 6d canvas-draw).(im
0230: 70 6f 72 74 20 63 61 6e 76 61 73 2d 64 72 61 77 port canvas-draw
0240: 2d 69 75 70 29 0a 0a 28 75 73 65 20 73 71 6c 69 -iup)..(use sqli
0250: 74 65 33 20 73 72 66 69 2d 31 20 70 6f 73 69 78 te3 srfi-1 posix
0260: 20 72 65 67 65 78 20 72 65 67 65 78 2d 63 61 73 regex regex-cas
0270: 65 20 73 72 66 69 2d 36 39 20 64 65 66 73 74 72 e srfi-69 defstr
0280: 75 63 74 20 73 70 61 72 73 65 2d 76 65 63 74 6f uct sparse-vecto
0290: 72 73 29 0a 28 69 6d 70 6f 72 74 20 28 70 72 65 rs).(import (pre
02a0: 66 69 78 20 73 71 6c 69 74 65 33 20 73 71 6c 69 fix sqlite3 sqli
02b0: 74 65 33 3a 29 29 0a 0a 28 64 65 63 6c 61 72 65 te3:))..(declare
02c0: 20 28 75 73 65 73 20 63 6f 6d 6d 6f 6e 29 29 0a (uses common)).
02d0: 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 6d (declare (uses m
02e0: 61 72 67 73 29 29 0a 28 64 65 63 6c 61 72 65 20 args)).(declare
02f0: 28 75 73 65 73 20 6b 65 79 73 29 29 0a 28 64 65 (uses keys)).(de
0300: 63 6c 61 72 65 20 28 75 73 65 73 20 69 74 65 6d clare (uses item
0310: 73 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 s)).(declare (us
0320: 65 73 20 64 62 29 29 0a 28 64 65 63 6c 61 72 65 es db)).(declare
0330: 20 28 75 73 65 73 20 63 6f 6e 66 69 67 66 29 29 (uses configf))
0340: 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 .(declare (uses
0350: 70 72 6f 63 65 73 73 29 29 0a 28 64 65 63 6c 61 process)).(decla
0360: 72 65 20 28 75 73 65 73 20 6c 61 75 6e 63 68 29 re (uses launch)
0370: 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 ).(declare (uses
0380: 20 72 75 6e 73 29 29 0a 28 64 65 63 6c 61 72 65 runs)).(declare
0390: 20 28 75 73 65 73 20 64 61 73 68 62 6f 61 72 64 (uses dashboard
03a0: 2d 74 65 73 74 73 29 29 0a 28 64 65 63 6c 61 72 -tests)).(declar
03b0: 65 20 28 75 73 65 73 20 64 61 73 68 62 6f 61 72 e (uses dashboar
03c0: 64 2d 67 75 69 6d 6f 6e 69 74 6f 72 29 29 0a 28 d-guimonitor)).(
03d0: 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 74 72 declare (uses tr
03e0: 65 65 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 ee)).(declare (u
03f0: 73 65 73 20 64 63 6f 6d 6d 6f 6e 29 29 0a 0a 3b ses dcommon))..;
0400: 3b 20 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 ; (declare (uses
0410: 20 64 61 73 68 62 6f 61 72 64 2d 6d 61 69 6e 29 dashboard-main)
0420: 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 ).(declare (uses
0430: 20 6d 65 67 61 74 65 73 74 2d 76 65 72 73 69 6f megatest-versio
0440: 6e 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 n)).(declare (us
0450: 65 73 20 6d 74 29 29 0a 0a 28 69 6e 63 6c 75 64 es mt))..(includ
0460: 65 20 22 63 6f 6d 6d 6f 6e 5f 72 65 63 6f 72 64 e "common_record
0470: 73 2e 73 63 6d 22 29 0a 28 69 6e 63 6c 75 64 65 s.scm").(include
0480: 20 22 64 62 5f 72 65 63 6f 72 64 73 2e 73 63 6d "db_records.scm
0490: 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 72 75 6e ").(include "run
04a0: 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 29 0a 28 _records.scm").(
04b0: 69 6e 63 6c 75 64 65 20 22 6d 65 67 61 74 65 73 include "megates
04c0: 74 2d 66 6f 73 73 69 6c 2d 68 61 73 68 2e 73 63 t-fossil-hash.sc
04d0: 6d 22 29 0a 0a 28 64 65 66 69 6e 65 20 68 65 6c m")..(define hel
04e0: 70 20 28 63 6f 6e 63 20 0a 09 20 20 20 20 20 20 p (conc ..
04f0: 22 4d 65 67 61 74 65 73 74 20 44 61 73 68 62 6f "Megatest Dashbo
0500: 61 72 64 2c 20 64 6f 63 75 6d 65 6e 74 61 74 69 ard, documentati
0510: 6f 6e 20 61 74 20 68 74 74 70 3a 2f 2f 77 77 77 on at http://www
0520: 2e 6b 69 61 74 6f 61 2e 63 6f 6d 2f 66 6f 73 73 .kiatoa.com/foss
0530: 69 6c 73 2f 6d 65 67 61 74 65 73 74 0a 20 20 76 ils/megatest. v
0540: 65 72 73 69 6f 6e 20 22 20 6d 65 67 61 74 65 73 ersion " megates
0550: 74 2d 76 65 72 73 69 6f 6e 20 22 0a 20 20 6c 69 t-version ". li
0560: 63 65 6e 73 65 20 47 50 4c 2c 20 43 6f 70 79 72 cense GPL, Copyr
0570: 69 67 68 74 20 28 43 29 20 4d 61 74 74 20 57 65 ight (C) Matt We
0580: 6c 6c 61 6e 64 20 32 30 31 32 2d 32 30 31 36 0a lland 2012-2016.
0590: 0a 55 73 61 67 65 3a 20 64 61 73 68 62 6f 61 72 .Usage: dashboar
05a0: 64 20 5b 6f 70 74 69 6f 6e 73 5d 0a 20 20 2d 68 d [options]. -h
05b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
05c0: 20 20 20 3a 20 74 68 69 73 20 68 65 6c 70 0a 20 : this help.
05d0: 20 2d 73 65 72 76 65 72 20 68 6f 73 74 3a 70 6f -server host:po
05e0: 72 74 20 20 20 20 3a 20 63 6f 6e 6e 65 63 74 20 rt : connect
05f0: 74 6f 20 68 6f 73 74 3a 70 6f 72 74 20 69 6e 73 to host:port ins
0600: 74 65 61 64 20 6f 66 20 64 62 20 61 63 63 65 73 tead of db acces
0610: 73 0a 20 20 2d 74 65 73 74 20 72 75 6e 2d 69 64 s. -test run-id
0620: 2c 74 65 73 74 2d 69 64 20 3a 20 63 6f 6e 74 72 ,test-id : contr
0630: 6f 6c 20 74 65 73 74 20 69 64 65 6e 74 69 66 69 ol test identifi
0640: 65 64 20 62 79 20 74 65 73 74 69 64 0a 20 20 2d ed by testid. -
0650: 67 75 69 6d 6f 6e 69 74 6f 72 20 20 20 20 20 20 guimonitor
0660: 20 20 20 20 3a 20 63 6f 6e 74 72 6f 6c 20 70 61 : control pa
0670: 6e 65 6c 20 66 6f 72 20 72 75 6e 73 0a 0a 4d 69 nel for runs..Mi
0680: 73 63 0a 20 20 2d 72 6f 77 73 20 4e 20 20 20 20 sc. -rows N
0690: 20 20 20 20 20 3a 20 73 65 74 20 6e 75 6d 62 65 : set numbe
06a0: 72 20 6f 66 20 72 6f 77 73 0a 22 29 29 0a 0a 3b r of rows."))..;
06b0: 3b 20 70 72 6f 63 65 73 73 20 61 72 67 73 0a 28 ; process args.(
06c0: 64 65 66 69 6e 65 20 72 65 6d 61 72 67 73 20 28 define remargs (
06d0: 61 72 67 73 3a 67 65 74 2d 61 72 67 73 20 0a 09 args:get-args ..
06e0: 09 20 28 61 72 67 76 29 0a 09 09 20 28 6c 69 73 . (argv)... (lis
06f0: 74 20 20 22 2d 72 6f 77 73 22 0a 09 09 09 22 2d t "-rows"...."-
0700: 72 75 6e 22 0a 09 09 09 22 2d 74 65 73 74 22 0a run"...."-test".
0710: 09 09 09 22 2d 64 65 62 75 67 22 0a 09 09 09 22 ..."-debug"...."
0720: 2d 68 6f 73 74 22 20 0a 09 09 09 22 2d 74 72 61 -host" ...."-tra
0730: 6e 73 70 6f 72 74 22 0a 09 09 09 29 20 0a 09 09 nsport"....) ...
0740: 20 28 6c 69 73 74 20 20 22 2d 68 22 0a 09 09 09 (list "-h"....
0750: 22 2d 75 73 65 2d 73 65 72 76 65 72 22 0a 09 09 "-use-server"...
0760: 09 22 2d 67 75 69 6d 6f 6e 69 74 6f 72 22 0a 09 ."-guimonitor"..
0770: 09 09 22 2d 6d 61 69 6e 22 0a 09 09 09 22 2d 76 .."-main"...."-v
0780: 22 0a 09 09 09 22 2d 71 22 0a 09 09 09 22 2d 75 "...."-q"...."-u
0790: 73 65 2d 6c 6f 63 61 6c 22 0a 09 09 09 29 0a 09 se-local"....)..
07a0: 09 20 61 72 67 73 3a 61 72 67 2d 68 61 73 68 0a . args:arg-hash.
07b0: 09 09 20 30 29 29 0a 0a 28 69 66 20 28 61 72 67 .. 0))..(if (arg
07c0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 68 22 29 0a s:get-arg "-h").
07d0: 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 (begin.
07e0: 20 28 70 72 69 6e 74 20 68 65 6c 70 29 0a 20 20 (print help).
07f0: 20 20 20 20 28 65 78 69 74 29 29 29 0a 0a 28 69 (exit)))..(i
0800: 66 20 28 6e 6f 74 20 28 6c 61 75 6e 63 68 3a 73 f (not (launch:s
0810: 65 74 75 70 29 29 0a 20 20 20 20 28 62 65 67 69 etup)). (begi
0820: 6e 0a 20 20 20 20 20 20 28 70 72 69 6e 74 20 22 n. (print "
0830: 46 61 69 6c 65 64 20 74 6f 20 66 69 6e 64 20 6d Failed to find m
0840: 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 2c 20 egatest.config,
0850: 65 78 69 74 69 6e 67 22 29 20 0a 20 20 20 20 20 exiting") .
0860: 20 28 65 78 69 74 20 31 29 29 29 0a 0a 3b 3b 20 (exit 1)))..;;
0870: 63 72 65 61 74 65 20 61 20 73 74 75 63 74 20 66 create a stuct f
0880: 6f 72 20 61 6c 6c 20 74 68 65 20 6d 69 73 63 65 or all the misce
0890: 6c 6c 61 6e 65 6f 75 73 20 73 74 61 74 65 0a 3b llaneous state.;
08a0: 3b 0a 28 64 65 66 73 74 72 75 63 74 20 64 3a 61 ;.(defstruct d:a
08b0: 6c 6c 64 61 74 20 0a 20 20 61 6c 6c 72 75 6e 73 lldat . allruns
08c0: 20 0a 20 20 61 6c 6c 72 75 6e 73 2d 62 79 2d 69 . allruns-by-i
08d0: 64 0a 20 20 62 75 74 74 6f 6e 64 61 74 20 0a 20 d. buttondat .
08e0: 20 63 75 72 72 2d 74 61 62 2d 6e 75 6d 0a 20 20 curr-tab-num.
08f0: 64 62 64 69 72 0a 20 20 64 62 66 70 61 74 68 0a dbdir. dbfpath.
0900: 20 20 64 62 6b 65 79 73 20 0a 20 20 64 62 6c 6f dbkeys . dblo
0910: 63 61 6c 0a 20 20 66 69 6c 74 65 72 73 2d 63 68 cal. filters-ch
0920: 61 6e 67 65 64 0a 20 20 68 65 61 64 65 72 20 20 anged. header
0930: 20 20 20 20 0a 20 20 68 69 64 65 2d 65 6d 70 74 . hide-empt
0940: 79 2d 72 75 6e 73 0a 20 20 68 69 64 65 2d 6e 6f y-runs. hide-no
0950: 74 2d 68 69 64 65 20 20 3b 3b 20 74 6f 67 67 6c t-hide ;; toggl
0960: 65 20 66 6f 72 20 68 69 64 65 2f 6e 6f 74 20 68 e for hide/not h
0970: 69 64 65 0a 20 20 68 69 64 65 2d 6e 6f 74 2d 68 ide. hide-not-h
0980: 69 64 65 2d 62 75 74 74 6f 6e 0a 20 20 68 69 64 ide-button. hid
0990: 65 2d 6e 6f 74 2d 68 69 64 65 2d 74 61 62 73 0a e-not-hide-tabs.
09a0: 20 20 69 74 65 6d 2d 74 65 73 74 2d 6e 61 6d 65 item-test-name
09b0: 73 0a 20 20 6b 65 79 73 0a 20 20 6c 61 73 74 2d s. keys. last-
09c0: 64 62 2d 75 70 64 61 74 65 20 0a 20 20 6e 75 6d db-update . num
09d0: 2d 74 65 73 74 73 0a 20 20 6e 75 6d 72 75 6e 73 -tests. numruns
09e0: 0a 20 20 70 6c 65 61 73 65 2d 75 70 64 61 74 65 . please-update
09f0: 20 20 0a 20 20 72 6f 0a 20 20 73 65 61 72 63 68 . ro. search
0a00: 70 61 74 74 73 0a 20 20 73 74 61 72 74 2d 72 75 patts. start-ru
0a10: 6e 2d 6f 66 66 73 65 74 0a 20 20 73 74 61 72 74 n-offset. start
0a20: 2d 74 65 73 74 2d 6f 66 66 73 65 74 0a 20 20 73 -test-offset. s
0a30: 74 61 74 65 2d 69 67 6e 6f 72 65 2d 68 61 73 68 tate-ignore-hash
0a40: 0a 20 20 73 74 61 74 75 73 2d 69 67 6e 6f 72 65 . status-ignore
0a50: 2d 68 61 73 68 0a 20 20 74 6f 74 2d 72 75 6e 73 -hash. tot-runs
0a60: 20 20 20 0a 20 20 75 70 64 61 74 65 2d 6d 75 74 . update-mut
0a70: 65 78 0a 20 20 75 70 64 61 74 65 72 73 0a 20 20 ex. updaters.
0a80: 75 70 64 61 74 69 6e 67 0a 20 20 75 73 65 73 65 updating. usese
0a90: 72 76 65 72 20 20 0a 20 20 29 0a 0a 28 64 65 66 rver . )..(def
0aa0: 69 6e 65 20 2a 61 6c 6c 64 61 74 2a 20 28 6d 61 ine *alldat* (ma
0ab0: 6b 65 2d 64 3a 61 6c 6c 64 61 74 0a 09 09 20 20 ke-d:alldat...
0ac0: 68 65 61 64 65 72 3a 20 23 66 20 0a 09 09 20 20 header: #f ...
0ad0: 61 6c 6c 72 75 6e 73 3a 20 27 28 29 0a 09 09 20 allruns: '()...
0ae0: 20 61 6c 6c 72 75 6e 73 2d 62 79 2d 69 64 3a 20 allruns-by-id:
0af0: 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 (make-hash-table
0b00: 29 0a 09 09 20 20 62 75 74 74 6f 6e 64 61 74 3a )... buttondat:
0b10: 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c (make-hash-tabl
0b20: 65 29 0a 09 09 20 20 73 65 61 72 63 68 70 61 74 e)... searchpat
0b30: 74 73 3a 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 ts: (make-hash-t
0b40: 61 62 6c 65 29 0a 09 09 20 20 6e 75 6d 72 75 6e able)... numrun
0b50: 73 3a 20 31 36 0a 09 09 20 20 6c 61 73 74 2d 64 s: 16... last-d
0b60: 62 2d 75 70 64 61 74 65 3a 20 30 0a 09 09 20 20 b-update: 0...
0b70: 70 6c 65 61 73 65 2d 75 70 64 61 74 65 3a 20 23 please-update: #
0b80: 74 0a 09 09 20 20 75 70 64 61 74 69 6e 67 3a 20 t... updating:
0b90: 23 66 0a 09 09 20 20 75 70 64 61 74 65 2d 6d 75 #f... update-mu
0ba0: 74 65 78 3a 20 28 6d 61 6b 65 2d 6d 75 74 65 78 tex: (make-mutex
0bb0: 29 0a 09 09 20 20 69 74 65 6d 2d 74 65 73 74 2d )... item-test-
0bc0: 6e 61 6d 65 73 3a 20 27 28 29 0a 09 09 20 20 6e names: '()... n
0bd0: 75 6d 2d 74 65 73 74 73 3a 20 31 35 0a 09 09 20 um-tests: 15...
0be0: 20 73 74 61 72 74 2d 72 75 6e 2d 6f 66 66 73 65 start-run-offse
0bf0: 74 3a 20 30 0a 09 09 20 20 73 74 61 72 74 2d 74 t: 0... start-t
0c00: 65 73 74 2d 6f 66 66 73 65 74 3a 20 30 0a 09 09 est-offset: 0...
0c10: 20 20 73 74 61 74 75 73 2d 69 67 6e 6f 72 65 2d status-ignore-
0c20: 68 61 73 68 3a 20 28 6d 61 6b 65 2d 68 61 73 68 hash: (make-hash
0c30: 2d 74 61 62 6c 65 29 0a 09 09 20 20 73 74 61 74 -table)... stat
0c40: 65 2d 69 67 6e 6f 72 65 2d 68 61 73 68 3a 20 28 e-ignore-hash: (
0c50: 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 make-hash-table)
0c60: 0a 09 09 20 20 68 69 64 65 2d 65 6d 70 74 79 2d ... hide-empty-
0c70: 72 75 6e 73 3a 20 23 66 0a 09 09 20 20 68 69 64 runs: #f... hid
0c80: 65 2d 6e 6f 74 2d 68 69 64 65 3a 20 23 74 0a 09 e-not-hide: #t..
0c90: 09 20 20 68 69 64 65 2d 6e 6f 74 2d 68 69 64 65 . hide-not-hide
0ca0: 2d 62 75 74 74 6f 6e 3a 20 23 66 0a 09 09 20 20 -button: #f...
0cb0: 68 69 64 65 2d 6e 6f 74 2d 68 69 64 65 2d 74 61 hide-not-hide-ta
0cc0: 62 73 3a 20 23 66 0a 09 09 20 20 63 75 72 72 2d bs: #f... curr-
0cd0: 74 61 62 2d 6e 75 6d 3a 20 30 0a 09 09 20 20 75 tab-num: 0... u
0ce0: 70 64 61 74 65 72 73 3a 20 28 6d 61 6b 65 2d 68 pdaters: (make-h
0cf0: 61 73 68 2d 74 61 62 6c 65 29 0a 09 09 20 20 66 ash-table)... f
0d00: 69 6c 74 65 72 73 2d 63 68 61 6e 67 65 64 3a 20 ilters-changed:
0d10: 23 66 0a 09 09 20 20 29 29 0a 0a 3b 3b 20 64 61 #f... ))..;; da
0d20: 74 61 20 66 6f 72 20 72 75 6e 73 2c 20 74 65 73 ta for runs, tes
0d30: 74 73 20 65 74 63 0a 3b 3b 0a 28 64 65 66 73 74 ts etc.;;.(defst
0d40: 72 75 63 74 20 64 3a 72 75 6e 64 61 74 0a 20 20 ruct d:rundat.
0d50: 3b 3b 20 6e 65 77 20 73 79 73 74 65 6d 0a 20 20 ;; new system.
0d60: 72 75 6e 73 2d 69 6e 64 65 78 20 20 20 20 3b 3b runs-index ;;
0d70: 20 74 61 72 67 65 74 2f 72 75 6e 6e 61 6d 65 20 target/runname
0d80: 3d 3e 20 63 6f 6c 6e 75 6d 0a 20 20 74 65 73 74 => colnum. test
0d90: 73 2d 69 6e 64 65 78 20 20 20 3b 3b 20 74 65 73 s-index ;; tes
0da0: 74 6e 61 6d 65 2f 69 74 65 6d 70 61 74 68 20 3d tname/itempath =
0db0: 3e 20 72 6f 77 6e 75 6d 0a 20 20 6d 61 74 72 69 > rownum. matri
0dc0: 78 2d 64 61 74 20 20 20 20 3b 3b 20 76 65 63 74 x-dat ;; vect
0dd0: 6f 72 20 6f 66 20 76 65 63 74 6f 72 73 20 72 6f or of vectors ro
0de0: 77 73 2f 63 6f 6c 73 0a 20 20 29 0a 0a 28 64 65 ws/cols. )..(de
0df0: 66 69 6e 65 20 28 64 3a 72 75 6e 64 61 74 2d 6d fine (d:rundat-m
0e00: 61 6b 65 2d 69 6e 69 74 29 0a 20 20 28 6d 61 6b ake-init). (mak
0e10: 65 2d 64 3a 72 75 6e 64 61 74 0a 20 20 20 72 75 e-d:rundat. ru
0e20: 6e 73 2d 69 6e 64 65 78 3a 20 28 6d 61 6b 65 2d ns-index: (make-
0e30: 68 61 73 68 2d 74 61 62 6c 65 29 0a 20 20 20 74 hash-table). t
0e40: 65 73 74 73 2d 69 6e 64 65 78 3a 20 28 6d 61 6b ests-index: (mak
0e50: 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 0a 20 20 e-hash-table).
0e60: 20 6d 61 74 72 69 78 2d 64 61 74 3a 20 28 6d 61 matrix-dat: (ma
0e70: 6b 65 2d 73 70 61 72 73 65 2d 61 72 72 61 79 29 ke-sparse-array)
0e80: 29 29 0a 0a 28 64 65 66 73 74 72 75 63 74 20 64 ))..(defstruct d
0e90: 3a 74 65 73 74 64 61 74 0a 20 20 69 64 20 20 20 :testdat. id
0ea0: 20 20 20 20 3b 3b 20 74 65 73 74 69 64 0a 20 20 ;; testid.
0eb0: 73 74 61 74 65 20 20 20 20 3b 3b 20 74 65 73 74 state ;; test
0ec0: 20 73 74 61 74 65 0a 20 20 73 74 61 74 75 73 20 state. status
0ed0: 20 20 3b 3b 20 74 65 73 74 20 73 74 61 74 75 73 ;; test status
0ee0: 0a 20 20 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 . )..(define (d
0ef0: 3a 72 75 6e 64 61 74 2d 67 65 74 2d 63 6f 6c 2d :rundat-get-col-
0f00: 6e 75 6d 20 64 61 74 20 74 61 72 67 65 74 20 72 num dat target r
0f10: 75 6e 6e 61 6d 65 20 66 6f 72 63 65 2d 73 65 74 unname force-set
0f20: 29 0a 20 20 28 6c 65 74 2a 20 28 28 72 75 6e 73 ). (let* ((runs
0f30: 2d 69 6e 64 65 78 20 28 64 3a 72 75 6e 64 61 74 -index (d:rundat
0f40: 2d 72 75 6e 73 2d 69 6e 64 65 78 20 64 61 74 29 -runs-index dat)
0f50: 29 0a 09 20 28 63 6f 6c 2d 6e 61 6d 65 20 20 20 ).. (col-name
0f60: 28 63 6f 6e 63 20 74 61 72 67 65 74 20 22 2f 22 (conc target "/"
0f70: 20 72 75 6e 6e 61 6d 65 29 29 0a 09 20 28 72 65 runname)).. (re
0f80: 73 20 20 20 20 20 20 20 20 28 68 61 73 68 2d 74 s (hash-t
0f90: 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 able-ref/default
0fa0: 20 72 75 6e 73 2d 69 6e 64 65 78 20 63 6f 6c 2d runs-index col-
0fb0: 6e 61 6d 65 20 23 66 29 29 29 0a 20 20 20 20 28 name #f))). (
0fc0: 69 66 20 72 65 73 0a 09 72 65 73 0a 09 28 69 66 if res..res..(if
0fd0: 20 66 6f 72 63 65 2d 73 65 74 0a 09 20 20 20 20 force-set..
0fe0: 28 6c 65 74 20 28 28 6d 61 78 2d 63 6f 6c 2d 6e (let ((max-col-n
0ff0: 75 6d 20 28 2b 20 31 20 28 61 70 70 6c 79 20 6d um (+ 1 (apply m
1000: 61 78 20 2d 31 20 28 68 61 73 68 2d 74 61 62 6c ax -1 (hash-tabl
1010: 65 2d 76 61 6c 75 65 73 20 72 75 6e 73 2d 69 6e e-values runs-in
1020: 64 65 78 29 29 29 29 29 0a 09 20 20 20 20 20 20 dex)))))..
1030: 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 (hash-table-set!
1040: 20 72 75 6e 73 2d 69 6e 64 65 78 20 63 6f 6c 2d runs-index col-
1050: 6e 61 6d 65 20 6d 61 78 2d 63 6f 6c 2d 6e 75 6d name max-col-num
1060: 29 0a 09 20 20 20 20 20 20 6d 61 78 2d 63 6f 6c ).. max-col
1070: 2d 6e 75 6d 29 29 29 29 29 0a 0a 28 64 65 66 69 -num)))))..(defi
1080: 6e 65 20 28 64 3a 72 75 6e 64 61 74 2d 67 65 74 ne (d:rundat-get
1090: 2d 72 6f 77 2d 6e 75 6d 20 64 61 74 20 74 65 73 -row-num dat tes
10a0: 74 6e 61 6d 65 20 69 74 65 6d 70 61 74 68 20 66 tname itempath f
10b0: 6f 72 63 65 2d 73 65 74 29 0a 20 20 28 6c 65 74 orce-set). (let
10c0: 2a 20 28 28 74 65 73 74 73 2d 69 6e 64 65 78 20 * ((tests-index
10d0: 28 64 3a 72 75 6e 64 61 74 2d 72 75 6e 73 2d 69 (d:rundat-runs-i
10e0: 6e 64 65 78 20 64 61 74 29 29 0a 09 20 28 72 6f ndex dat)).. (ro
10f0: 77 2d 6e 61 6d 65 20 20 20 20 28 63 6f 6e 63 20 w-name (conc
1100: 74 65 73 74 6e 61 6d 65 20 22 2f 22 20 69 74 65 testname "/" ite
1110: 6d 70 61 74 68 29 29 0a 09 20 28 72 65 73 20 20 mpath)).. (res
1120: 20 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 (hash-tab
1130: 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 72 le-ref/default r
1140: 75 6e 73 2d 69 6e 64 65 78 20 72 6f 77 2d 6e 61 uns-index row-na
1150: 6d 65 20 23 66 29 29 29 0a 20 20 20 20 28 69 66 me #f))). (if
1160: 20 72 65 73 0a 09 72 65 73 0a 09 28 69 66 20 66 res..res..(if f
1170: 6f 72 63 65 2d 73 65 74 0a 09 20 20 20 20 28 6c orce-set.. (l
1180: 65 74 20 28 28 6d 61 78 2d 72 6f 77 2d 6e 75 6d et ((max-row-num
1190: 20 28 2b 20 31 20 28 61 70 70 6c 79 20 6d 61 78 (+ 1 (apply max
11a0: 20 2d 31 20 28 68 61 73 68 2d 74 61 62 6c 65 2d -1 (hash-table-
11b0: 76 61 6c 75 65 73 20 74 65 73 74 73 2d 69 6e 64 values tests-ind
11c0: 65 78 29 29 29 29 29 0a 09 20 20 20 20 20 20 28 ex))))).. (
11d0: 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 hash-table-set!
11e0: 72 75 6e 73 2d 69 6e 64 65 78 20 72 6f 77 2d 6e runs-index row-n
11f0: 61 6d 65 20 6d 61 78 2d 72 6f 77 2d 6e 75 6d 29 ame max-row-num)
1200: 0a 09 20 20 20 20 20 20 6d 61 78 2d 72 6f 77 2d .. max-row-
1210: 6e 75 6d 29 29 29 29 29 0a 0a 3b 3b 20 64 65 66 num)))))..;; def
1220: 61 75 6c 74 20 69 73 20 74 6f 20 4e 4f 54 20 73 ault is to NOT s
1230: 65 74 20 74 68 65 20 63 65 6c 6c 20 69 66 20 74 et the cell if t
1240: 68 65 20 63 6f 6c 75 6d 6e 20 61 6e 64 20 72 6f he column and ro
1250: 77 20 6e 61 6d 65 73 20 61 72 65 20 6e 6f 74 20 w names are not
1260: 70 72 65 2d 65 78 69 73 74 69 6e 67 0a 3b 3b 0a pre-existing.;;.
1270: 28 64 65 66 69 6e 65 20 28 64 3a 72 75 6e 64 61 (define (d:runda
1280: 74 2d 73 65 74 2d 74 65 73 74 2d 63 65 6c 6c 20 t-set-test-cell
1290: 64 61 74 20 74 61 72 67 65 74 20 72 75 6e 6e 61 dat target runna
12a0: 6d 65 20 74 65 73 74 6e 61 6d 65 20 69 74 65 6d me testname item
12b0: 70 61 74 68 20 74 65 73 74 2d 69 64 20 73 74 61 path test-id sta
12c0: 74 65 20 73 74 61 74 75 73 20 23 21 6b 65 79 20 te status #!key
12d0: 28 66 6f 72 63 65 2d 73 65 74 20 23 66 29 29 0a (force-set #f)).
12e0: 20 20 28 6c 65 74 2a 20 28 28 63 6f 6c 2d 6e 75 (let* ((col-nu
12f0: 6d 20 20 28 64 3a 72 75 6e 64 61 74 2d 67 65 74 m (d:rundat-get
1300: 2d 63 6f 6c 2d 6e 75 6d 20 64 61 74 20 74 61 72 -col-num dat tar
1310: 67 65 74 20 72 75 6e 6e 61 6d 65 20 66 6f 72 63 get runname forc
1320: 65 2d 73 65 74 29 29 0a 09 20 28 72 6f 77 2d 6e e-set)).. (row-n
1330: 75 6d 20 20 28 64 3a 72 75 6e 64 61 74 2d 67 65 um (d:rundat-ge
1340: 74 2d 72 6f 77 2d 6e 75 6d 20 64 61 74 20 74 65 t-row-num dat te
1350: 73 74 6e 61 6d 65 20 69 74 65 6d 70 61 74 68 20 stname itempath
1360: 66 6f 72 63 65 2d 73 65 74 29 29 29 0a 20 20 20 force-set))).
1370: 20 28 69 66 20 28 61 6e 64 20 72 6f 77 2d 6e 75 (if (and row-nu
1380: 6d 20 63 6f 6c 2d 6e 75 6d 29 0a 09 28 6c 65 74 m col-num)..(let
1390: 20 28 28 74 64 61 74 20 28 64 3a 74 65 73 74 64 ((tdat (d:testd
13a0: 61 74 20 0a 09 09 20 20 20 20 20 69 64 3a 20 74 at ... id: t
13b0: 65 73 74 2d 69 64 0a 09 09 20 20 20 20 20 73 74 est-id... st
13c0: 61 74 65 3a 20 73 74 61 74 65 0a 09 09 20 20 20 ate: state...
13d0: 20 20 73 74 61 74 75 73 3a 20 73 74 61 74 75 73 status: status
13e0: 29 29 29 0a 09 20 20 28 73 70 61 72 73 65 2d 61 ))).. (sparse-a
13f0: 72 72 61 79 2d 73 65 74 21 20 28 64 3a 72 75 6e rray-set! (d:run
1400: 64 61 74 2d 6d 61 74 72 69 78 2d 64 61 74 20 64 dat-matrix-dat d
1410: 61 74 29 20 63 6f 6c 2d 6e 75 6d 20 72 6f 77 2d at) col-num row-
1420: 6e 75 6d 20 74 64 61 74 29 0a 09 20 20 74 64 61 num tdat).. tda
1430: 74 29 0a 09 23 66 29 29 29 0a 0a 0a 0a 0a 0a 28 t)..#f)))......(
1440: 64 3a 61 6c 6c 64 61 74 2d 75 73 65 73 65 72 76 d:alldat-useserv
1450: 65 72 2d 73 65 74 21 20 2a 61 6c 6c 64 61 74 2a er-set! *alldat*
1460: 20 28 63 6f 6e 64 0a 09 09 09 09 20 20 20 28 28 (cond..... ((
1470: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 75 args:get-arg "-u
1480: 73 65 2d 6c 6f 63 61 6c 22 29 20 23 66 29 0a 09 se-local") #f)..
1490: 09 09 09 20 20 20 28 28 63 6f 6e 66 69 67 66 3a ... ((configf:
14a0: 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 lookup *configda
14b0: 74 2a 20 22 64 61 73 68 62 6f 61 72 64 22 20 22 t* "dashboard" "
14c0: 75 73 65 2d 73 65 72 76 65 72 22 29 0a 09 09 09 use-server")....
14d0: 09 20 20 20 20 28 6c 65 74 20 28 28 61 6e 73 20 . (let ((ans
14e0: 28 63 6f 6e 66 69 67 3a 6c 6f 6f 6b 75 70 20 2a (config:lookup *
14f0: 63 6f 6e 66 69 67 64 61 74 2a 20 22 64 61 73 68 configdat* "dash
1500: 62 6f 61 72 64 22 20 22 75 73 65 2d 73 65 72 76 board" "use-serv
1510: 65 72 22 29 29 29 0a 09 09 09 09 20 20 20 20 20 er"))).....
1520: 20 28 69 66 20 28 65 71 75 61 6c 3f 20 61 6e 73 (if (equal? ans
1530: 20 22 79 65 73 22 29 20 23 74 20 23 66 29 29 29 "yes") #t #f)))
1540: 0a 09 09 09 09 20 20 20 28 65 6c 73 65 20 23 74 ..... (else #t
1550: 29 29 29 0a 28 64 65 66 69 6e 65 20 2a 64 61 73 ))).(define *das
1560: 68 62 6f 61 72 64 2d 6d 6f 64 65 2a 20 28 73 74 hboard-mode* (st
1570: 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 28 6f 72 ring->symbol (or
1580: 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 (configf:lookup
1590: 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 64 61 *configdat* "da
15a0: 73 68 62 6f 61 72 64 22 20 22 6d 6f 64 65 22 29 shboard" "mode")
15b0: 20 22 64 61 73 68 62 6f 61 72 64 22 29 29 29 0a "dashboard"))).
15c0: 0a 28 64 3a 61 6c 6c 64 61 74 2d 64 62 64 69 72 .(d:alldat-dbdir
15d0: 2d 73 65 74 21 20 2a 61 6c 6c 64 61 74 2a 20 28 -set! *alldat* (
15e0: 64 62 3a 64 62 66 69 6c 65 2d 70 61 74 68 20 23 db:dbfile-path #
15f0: 66 29 29 20 3b 3b 20 28 63 6f 6e 63 20 28 63 6f f)) ;; (conc (co
1600: 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 2a 63 6f nfigf:lookup *co
1610: 6e 66 69 67 64 61 74 2a 20 22 73 65 74 75 70 22 nfigdat* "setup"
1620: 20 22 6c 69 6e 6b 74 72 65 65 22 29 20 22 2f 2e "linktree") "/.
1630: 64 62 22 29 29 0a 28 64 3a 61 6c 6c 64 61 74 2d db")).(d:alldat-
1640: 64 62 6c 6f 63 61 6c 2d 73 65 74 21 20 2a 61 6c dblocal-set! *al
1650: 6c 64 61 74 2a 20 28 6d 61 6b 65 2d 64 62 72 3a ldat* (make-dbr:
1660: 64 62 73 74 72 75 63 74 20 70 61 74 68 3a 20 20 dbstruct path:
1670: 28 64 3a 61 6c 6c 64 61 74 2d 64 62 64 69 72 20 (d:alldat-dbdir
1680: 2a 61 6c 6c 64 61 74 2a 29 0a 09 09 09 09 09 09 *alldat*).......
1690: 20 20 20 6c 6f 63 61 6c 3a 20 23 74 29 29 0a 28 local: #t)).(
16a0: 64 3a 61 6c 6c 64 61 74 2d 64 62 66 70 61 74 68 d:alldat-dbfpath
16b0: 2d 73 65 74 21 20 2a 61 6c 6c 64 61 74 2a 20 28 -set! *alldat* (
16c0: 64 62 3a 64 62 66 69 6c 65 2d 70 61 74 68 20 30 db:dbfile-path 0
16d0: 29 29 0a 0a 3b 3b 20 48 41 43 4b 20 41 4c 45 52 ))..;; HACK ALER
16e0: 54 3a 20 74 68 69 73 20 69 73 20 61 20 68 61 63 T: this is a hac
16f0: 6b 2c 20 70 6c 65 61 73 65 20 66 69 78 2e 0a 28 k, please fix..(
1700: 64 3a 61 6c 6c 64 61 74 2d 72 6f 2d 73 65 74 21 d:alldat-ro-set!
1710: 20 2a 61 6c 6c 64 61 74 2a 20 28 6e 6f 74 20 28 *alldat* (not (
1720: 66 69 6c 65 2d 72 65 61 64 2d 61 63 63 65 73 73 file-read-access
1730: 3f 20 28 64 3a 61 6c 6c 64 61 74 2d 64 62 66 70 ? (d:alldat-dbfp
1740: 61 74 68 20 2a 61 6c 6c 64 61 74 2a 29 29 29 29 ath *alldat*))))
1750: 0a 0a 28 64 3a 61 6c 6c 64 61 74 2d 6b 65 79 73 ..(d:alldat-keys
1760: 2d 73 65 74 21 20 2a 61 6c 6c 64 61 74 2a 20 28 -set! *alldat* (
1770: 69 66 20 28 64 3a 61 6c 6c 64 61 74 2d 75 73 65 if (d:alldat-use
1780: 73 65 72 76 65 72 20 2a 61 6c 6c 64 61 74 2a 29 server *alldat*)
1790: 0a 09 09 09 09 20 28 72 6d 74 3a 67 65 74 2d 6b ..... (rmt:get-k
17a0: 65 79 73 29 0a 09 09 09 09 20 28 64 62 3a 67 65 eys)..... (db:ge
17b0: 74 2d 6b 65 79 73 20 28 64 3a 61 6c 6c 64 61 74 t-keys (d:alldat
17c0: 2d 64 62 6c 6f 63 61 6c 20 2a 61 6c 6c 64 61 74 -dblocal *alldat
17d0: 2a 29 29 29 29 0a 28 64 3a 61 6c 6c 64 61 74 2d *)))).(d:alldat-
17e0: 64 62 6b 65 79 73 2d 73 65 74 21 20 2a 61 6c 6c dbkeys-set! *all
17f0: 64 61 74 2a 20 28 61 70 70 65 6e 64 20 28 64 3a dat* (append (d:
1800: 61 6c 6c 64 61 74 2d 6b 65 79 73 20 2a 61 6c 6c alldat-keys *all
1810: 64 61 74 2a 29 20 28 6c 69 73 74 20 22 72 75 6e dat*) (list "run
1820: 6e 61 6d 65 22 29 29 29 0a 28 64 3a 61 6c 6c 64 name"))).(d:alld
1830: 61 74 2d 74 6f 74 2d 72 75 6e 73 2d 73 65 74 21 at-tot-runs-set!
1840: 20 2a 61 6c 6c 64 61 74 2a 20 28 69 66 20 28 64 *alldat* (if (d
1850: 3a 61 6c 6c 64 61 74 2d 75 73 65 73 65 72 76 65 :alldat-useserve
1860: 72 20 2a 61 6c 6c 64 61 74 2a 29 0a 09 09 09 09 r *alldat*).....
1870: 20 20 20 20 20 28 72 6d 74 3a 67 65 74 2d 6e 75 (rmt:get-nu
1880: 6d 2d 72 75 6e 73 20 22 25 22 29 0a 09 09 09 09 m-runs "%").....
1890: 20 20 20 20 20 28 64 62 3a 67 65 74 2d 6e 75 6d (db:get-num
18a0: 2d 72 75 6e 73 20 28 64 3a 61 6c 6c 64 61 74 2d -runs (d:alldat-
18b0: 64 62 6c 6f 63 61 6c 20 2a 61 6c 6c 64 61 74 2a dblocal *alldat*
18c0: 29 20 22 25 22 29 29 29 0a 3b 3b 0a 28 64 65 66 ) "%"))).;;.(def
18d0: 69 6e 65 20 2a 65 78 69 74 2d 73 74 61 72 74 65 ine *exit-starte
18e0: 64 2a 20 23 66 29 0a 3b 3b 20 2a 75 70 64 61 74 d* #f).;; *updat
18f0: 65 72 73 2a 20 28 6d 61 6b 65 2d 68 61 73 68 2d ers* (make-hash-
1900: 74 61 62 6c 65 29 29 0a 0a 3b 3b 20 73 6f 72 74 table))..;; sort
1910: 69 6e 67 20 67 6c 6f 62 61 6c 20 64 61 74 61 20 ing global data
1920: 28 77 6f 75 6c 64 20 61 70 70 6c 79 20 74 6f 20 (would apply to
1930: 6d 61 6e 79 20 74 65 73 74 73 75 69 74 65 73 20 many testsuites
1940: 73 6f 20 6c 65 61 76 65 20 69 74 20 67 6c 6f 62 so leave it glob
1950: 61 6c 20 66 6f 72 20 6e 6f 77 29 0a 3b 3b 0a 28 al for now).;;.(
1960: 64 65 66 69 6e 65 20 2a 74 65 73 74 73 2d 73 6f define *tests-so
1970: 72 74 2d 6f 70 74 69 6f 6e 73 2a 20 28 76 65 63 rt-options* (vec
1980: 74 6f 72 20 28 76 65 63 74 6f 72 20 22 53 6f 72 tor (vector "Sor
1990: 74 20 2b 61 22 20 27 74 65 73 74 6e 61 6d 65 20 t +a" 'testname
19a0: 20 20 22 41 53 43 22 29 0a 09 09 09 09 20 20 20 "ASC").....
19b0: 20 20 28 76 65 63 74 6f 72 20 22 53 6f 72 74 20 (vector "Sort
19c0: 2d 61 22 20 27 74 65 73 74 6e 61 6d 65 20 20 20 -a" 'testname
19d0: 22 44 45 53 43 22 29 0a 09 09 09 09 20 20 20 20 "DESC").....
19e0: 20 28 76 65 63 74 6f 72 20 22 53 6f 72 74 20 2b (vector "Sort +
19f0: 74 22 20 27 65 76 65 6e 74 5f 74 69 6d 65 20 22 t" 'event_time "
1a00: 41 53 43 22 29 0a 09 09 09 09 20 20 20 20 20 28 ASC")..... (
1a10: 76 65 63 74 6f 72 20 22 53 6f 72 74 20 2d 74 22 vector "Sort -t"
1a20: 20 27 65 76 65 6e 74 5f 74 69 6d 65 20 22 44 45 'event_time "DE
1a30: 53 43 22 29 0a 09 09 09 09 20 20 20 20 20 28 76 SC")..... (v
1a40: 65 63 74 6f 72 20 22 53 6f 72 74 20 2b 73 22 20 ector "Sort +s"
1a50: 27 73 74 61 74 65 73 74 61 74 75 73 20 22 41 53 'statestatus "AS
1a60: 43 22 29 0a 09 09 09 09 20 20 20 20 20 28 76 65 C")..... (ve
1a70: 63 74 6f 72 20 22 53 6f 72 74 20 2d 73 22 20 27 ctor "Sort -s" '
1a80: 73 74 61 74 65 73 74 61 74 75 73 20 22 44 45 53 statestatus "DES
1a90: 43 22 29 0a 09 09 09 09 20 20 20 20 20 28 76 65 C")..... (ve
1aa0: 63 74 6f 72 20 22 53 6f 72 74 20 2b 61 22 20 27 ctor "Sort +a" '
1ab0: 74 65 73 74 6e 61 6d 65 20 20 20 22 41 53 43 22 testname "ASC"
1ac0: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 2a 74 65 )))..(define *te
1ad0: 73 74 73 2d 73 6f 72 74 2d 74 79 70 65 2d 69 6e sts-sort-type-in
1ae0: 64 65 78 2a 20 27 28 28 22 2b 74 65 73 74 6e 61 dex* '(("+testna
1af0: 6d 65 22 20 30 29 0a 09 09 09 09 20 20 28 22 2d me" 0)..... ("-
1b00: 74 65 73 74 6e 61 6d 65 22 20 31 29 0a 09 09 09 testname" 1)....
1b10: 09 20 20 28 22 2b 65 76 65 6e 74 5f 74 69 6d 65 . ("+event_time
1b20: 22 20 32 29 0a 09 09 09 09 20 20 28 22 2d 65 76 " 2)..... ("-ev
1b30: 65 6e 74 5f 74 69 6d 65 22 20 33 29 0a 09 09 09 ent_time" 3)....
1b40: 09 20 20 28 22 2b 73 74 61 74 65 73 74 61 74 75 . ("+statestatu
1b50: 73 22 20 34 29 0a 09 09 09 09 20 20 28 22 2d 73 s" 4)..... ("-s
1b60: 74 61 74 65 73 74 61 74 75 73 22 20 35 29 29 29 tatestatus" 5)))
1b70: 0a 0a 3b 3b 20 44 6f 6e 27 74 20 66 6f 72 67 65 ..;; Don't forge
1b80: 74 20 74 6f 20 61 64 6a 75 73 74 20 74 68 65 20 t to adjust the
1b90: 3e 3d 20 62 65 6c 6f 77 20 69 66 20 79 6f 75 20 >= below if you
1ba0: 61 64 64 20 74 6f 20 74 68 65 20 73 6f 72 74 2d add to the sort-
1bb0: 6f 70 74 69 6f 6e 73 20 61 62 6f 76 65 0a 28 64 options above.(d
1bc0: 65 66 69 6e 65 20 28 6e 65 78 74 2d 73 6f 72 74 efine (next-sort
1bd0: 2d 6f 70 74 69 6f 6e 29 0a 20 20 28 69 66 20 28 -option). (if (
1be0: 3e 3d 20 2a 74 65 73 74 73 2d 73 6f 72 74 2d 72 >= *tests-sort-r
1bf0: 65 76 65 72 73 65 2a 20 35 29 0a 20 20 20 20 20 everse* 5).
1c00: 20 28 73 65 74 21 20 2a 74 65 73 74 73 2d 73 6f (set! *tests-so
1c10: 72 74 2d 72 65 76 65 72 73 65 2a 20 30 29 0a 20 rt-reverse* 0).
1c20: 20 20 20 20 20 28 73 65 74 21 20 2a 74 65 73 74 (set! *test
1c30: 73 2d 73 6f 72 74 2d 72 65 76 65 72 73 65 2a 20 s-sort-reverse*
1c40: 28 2b 20 2a 74 65 73 74 73 2d 73 6f 72 74 2d 72 (+ *tests-sort-r
1c50: 65 76 65 72 73 65 2a 20 31 29 29 29 0a 20 20 2a everse* 1))). *
1c60: 74 65 73 74 73 2d 73 6f 72 74 2d 72 65 76 65 72 tests-sort-rever
1c70: 73 65 2a 29 0a 0a 28 64 65 66 69 6e 65 20 2a 74 se*)..(define *t
1c80: 65 73 74 73 2d 73 6f 72 74 2d 72 65 76 65 72 73 ests-sort-revers
1c90: 65 2a 20 0a 20 20 28 6c 65 74 20 28 28 74 2d 73 e* . (let ((t-s
1ca0: 6f 72 74 20 28 61 73 73 6f 63 20 28 63 6f 6e 66 ort (assoc (conf
1cb0: 69 67 66 3a 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 igf:lookup *conf
1cc0: 69 67 64 61 74 2a 20 22 64 61 73 68 62 6f 61 72 igdat* "dashboar
1cd0: 64 22 20 22 74 65 73 74 73 6f 72 74 22 29 20 2a d" "testsort") *
1ce0: 74 65 73 74 73 2d 73 6f 72 74 2d 74 79 70 65 2d tests-sort-type-
1cf0: 69 6e 64 65 78 2a 29 29 29 0a 20 20 20 20 28 69 index*))). (i
1d00: 66 20 74 2d 73 6f 72 74 0a 09 28 63 61 64 72 20 f t-sort..(cadr
1d10: 74 2d 73 6f 72 74 29 0a 09 33 29 29 29 0a 0a 28 t-sort)..3)))..(
1d20: 64 65 66 69 6e 65 20 28 67 65 74 2d 63 75 72 72 define (get-curr
1d30: 2d 73 6f 72 74 29 0a 20 20 28 76 65 63 74 6f 72 -sort). (vector
1d40: 2d 72 65 66 20 2a 74 65 73 74 73 2d 73 6f 72 74 -ref *tests-sort
1d50: 2d 6f 70 74 69 6f 6e 73 2a 20 2a 74 65 73 74 73 -options* *tests
1d60: 2d 73 6f 72 74 2d 72 65 76 65 72 73 65 2a 29 29 -sort-reverse*))
1d70: 0a 0a 28 64 65 62 75 67 3a 73 65 74 75 70 29 0a ..(debug:setup).
1d80: 0a 28 64 65 66 69 6e 65 20 75 69 64 61 74 20 23 .(define uidat #
1d90: 66 29 0a 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 69 f)..(define-inli
1da0: 6e 65 20 28 64 62 6f 61 72 64 3a 75 69 64 61 74 ne (dboard:uidat
1db0: 2d 67 65 74 2d 6b 65 79 63 6f 6c 20 20 76 65 63 -get-keycol vec
1dc0: 29 28 76 65 63 74 6f 72 2d 72 65 66 20 76 65 63 )(vector-ref vec
1dd0: 20 30 29 29 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 0)).(define-inl
1de0: 69 6e 65 20 28 64 62 6f 61 72 64 3a 75 69 64 61 ine (dboard:uida
1df0: 74 2d 67 65 74 2d 6c 66 74 63 6f 6c 20 20 76 65 t-get-lftcol ve
1e00: 63 29 28 76 65 63 74 6f 72 2d 72 65 66 20 76 65 c)(vector-ref ve
1e10: 63 20 31 29 29 0a 28 64 65 66 69 6e 65 2d 69 6e c 1)).(define-in
1e20: 6c 69 6e 65 20 28 64 62 6f 61 72 64 3a 75 69 64 line (dboard:uid
1e30: 61 74 2d 67 65 74 2d 68 65 61 64 65 72 20 20 76 at-get-header v
1e40: 65 63 29 28 76 65 63 74 6f 72 2d 72 65 66 20 76 ec)(vector-ref v
1e50: 65 63 20 32 29 29 0a 28 64 65 66 69 6e 65 2d 69 ec 2)).(define-i
1e60: 6e 6c 69 6e 65 20 28 64 62 6f 61 72 64 3a 75 69 nline (dboard:ui
1e70: 64 61 74 2d 67 65 74 2d 72 75 6e 73 76 65 63 20 dat-get-runsvec
1e80: 76 65 63 29 28 76 65 63 74 6f 72 2d 72 65 66 20 vec)(vector-ref
1e90: 76 65 63 20 33 29 29 0a 0a 28 69 66 20 28 67 65 vec 3))..(if (ge
1ea0: 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 t-environment-va
1eb0: 72 69 61 62 6c 65 20 22 4d 54 5f 52 55 4e 5f 41 riable "MT_RUN_A
1ec0: 52 45 41 5f 48 4f 4d 45 22 29 28 63 68 61 6e 67 REA_HOME")(chang
1ed0: 65 2d 64 69 72 65 63 74 6f 72 79 20 28 67 65 74 e-directory (get
1ee0: 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 -environment-var
1ef0: 69 61 62 6c 65 20 22 4d 54 5f 52 55 4e 5f 41 52 iable "MT_RUN_AR
1f00: 45 41 5f 48 4f 4d 45 22 29 29 29 0a 0a 28 64 65 EA_HOME")))..(de
1f10: 66 69 6e 65 20 28 6d 65 73 73 61 67 65 2d 77 69 fine (message-wi
1f20: 6e 64 6f 77 20 6d 73 67 29 0a 20 20 28 69 75 70 ndow msg). (iup
1f30: 3a 73 68 6f 77 0a 20 20 20 28 69 75 70 3a 64 69 :show. (iup:di
1f40: 61 6c 6f 67 0a 20 20 20 20 28 69 75 70 3a 76 62 alog. (iup:vb
1f50: 6f 78 20 0a 20 20 20 20 20 28 69 75 70 3a 6c 61 ox . (iup:la
1f60: 62 65 6c 20 6d 73 67 20 23 3a 6d 61 72 67 69 6e bel msg #:margin
1f70: 20 22 34 30 78 34 30 22 29 29 29 29 29 0a 0a 28 "40x40")))))..(
1f80: 64 65 66 69 6e 65 20 28 69 75 70 6c 69 73 74 62 define (iuplistb
1f90: 6f 78 2d 66 69 6c 6c 2d 6c 69 73 74 20 6c 62 20 ox-fill-list lb
1fa0: 69 74 65 6d 73 20 23 21 6b 65 79 20 28 73 65 6c items #!key (sel
1fb0: 65 63 74 65 64 2d 69 74 65 6d 20 23 66 29 29 0a ected-item #f)).
1fc0: 20 20 28 6c 65 74 20 28 28 69 20 31 29 29 0a 20 (let ((i 1)).
1fd0: 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 (for-each (la
1fe0: 6d 62 64 61 20 28 69 74 65 6d 29 0a 09 09 28 69 mbda (item)...(i
1ff0: 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 up:attribute-set
2000: 21 20 6c 62 20 28 6e 75 6d 62 65 72 2d 3e 73 74 ! lb (number->st
2010: 72 69 6e 67 20 69 29 20 69 74 65 6d 29 0a 09 09 ring i) item)...
2020: 28 69 66 20 73 65 6c 65 63 74 65 64 2d 69 74 65 (if selected-ite
2030: 6d 0a 09 09 20 20 20 20 28 69 66 20 28 65 71 75 m... (if (equ
2040: 61 6c 3f 20 73 65 6c 65 63 74 65 64 2d 69 74 65 al? selected-ite
2050: 6d 20 69 74 65 6d 29 0a 09 09 09 28 69 75 70 3a m item)....(iup:
2060: 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 6c attribute-set! l
2070: 62 20 22 56 41 4c 55 45 22 20 69 29 29 29 20 3b b "VALUE" i))) ;
2080: 3b 20 28 6e 75 6d 62 65 72 2d 3e 73 74 72 69 6e ; (number->strin
2090: 67 20 69 29 29 29 29 0a 09 09 28 73 65 74 21 20 g i))))...(set!
20a0: 69 20 28 2b 20 69 20 31 29 29 29 0a 09 20 20 20 i (+ i 1)))..
20b0: 20 20 20 69 74 65 6d 73 29 0a 20 20 20 20 3b 3b items). ;;
20c0: 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d (iup:attribute-
20d0: 73 65 74 21 20 6c 62 20 22 56 41 4c 55 45 22 20 set! lb "VALUE"
20e0: 28 69 66 20 73 65 6c 65 63 74 65 64 2d 69 74 65 (if selected-ite
20f0: 6d 20 73 65 6c 65 63 74 65 64 2d 69 74 65 6d 20 m selected-item
2100: 22 22 29 29 0a 20 20 20 20 69 29 29 0a 0a 28 64 "")). i))..(d
2110: 65 66 69 6e 65 20 28 70 61 64 2d 6c 69 73 74 20 efine (pad-list
2120: 6c 20 6e 29 28 61 70 70 65 6e 64 20 6c 20 28 6d l n)(append l (m
2130: 61 6b 65 2d 6c 69 73 74 20 28 2d 20 6e 20 28 6c ake-list (- n (l
2140: 65 6e 67 74 68 20 6c 29 29 29 29 29 0a 0a 28 64 ength l)))))..(d
2150: 65 66 69 6e 65 20 28 63 6f 6c 6f 72 73 2d 73 69 efine (colors-si
2160: 6d 69 6c 61 72 3f 20 63 6f 6c 6f 72 31 20 63 6f milar? color1 co
2170: 6c 6f 72 32 29 0a 20 20 28 6c 65 74 2a 20 28 28 lor2). (let* ((
2180: 63 31 20 20 20 20 28 6d 61 70 20 73 74 72 69 6e c1 (map strin
2190: 67 2d 3e 6e 75 6d 62 65 72 20 28 73 74 72 69 6e g->number (strin
21a0: 67 2d 73 70 6c 69 74 20 63 6f 6c 6f 72 31 29 29 g-split color1))
21b0: 29 0a 09 20 28 63 32 20 20 20 20 28 6d 61 70 20 ).. (c2 (map
21c0: 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 string->number (
21d0: 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 63 6f 6c string-split col
21e0: 6f 72 32 29 29 29 0a 09 20 28 64 65 6c 74 61 20 or2))).. (delta
21f0: 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 61 20 (map (lambda (a
2200: 62 29 28 61 62 73 20 28 2d 20 61 20 62 29 29 29 b)(abs (- a b)))
2210: 20 63 31 20 63 32 29 29 29 0a 20 20 20 20 28 6e c1 c2))). (n
2220: 75 6c 6c 3f 20 28 66 69 6c 74 65 72 20 28 6c 61 ull? (filter (la
2230: 6d 62 64 61 20 28 78 29 28 3e 20 78 20 33 29 29 mbda (x)(> x 3))
2240: 20 64 65 6c 74 61 29 29 29 29 0a 0a 28 64 65 66 delta))))..(def
2250: 69 6e 65 20 28 64 62 6f 61 72 64 3a 63 6f 6d 70 ine (dboard:comp
2260: 61 72 65 2d 74 65 73 74 73 20 74 65 73 74 31 20 are-tests test1
2270: 74 65 73 74 32 29 0a 20 20 28 6c 65 74 2a 20 28 test2). (let* (
2280: 28 74 65 73 74 2d 6e 61 6d 65 31 20 20 28 64 62 (test-name1 (db
2290: 3a 74 65 73 74 2d 67 65 74 2d 74 65 73 74 6e 61 :test-get-testna
22a0: 6d 65 20 20 74 65 73 74 31 29 29 0a 09 20 28 69 me test1)).. (i
22b0: 74 65 6d 2d 70 61 74 68 31 20 20 28 64 62 3a 74 tem-path1 (db:t
22c0: 65 73 74 2d 67 65 74 2d 69 74 65 6d 2d 70 61 74 est-get-item-pat
22d0: 68 20 74 65 73 74 31 29 29 0a 09 20 28 65 76 65 h test1)).. (eve
22e0: 6e 74 74 69 6d 65 31 20 20 28 64 62 3a 74 65 73 nttime1 (db:tes
22f0: 74 2d 67 65 74 2d 65 76 65 6e 74 5f 74 69 6d 65 t-get-event_time
2300: 20 74 65 73 74 31 29 29 0a 09 20 28 74 65 73 74 test1)).. (test
2310: 2d 6e 61 6d 65 32 20 20 28 64 62 3a 74 65 73 74 -name2 (db:test
2320: 2d 67 65 74 2d 74 65 73 74 6e 61 6d 65 20 20 74 -get-testname t
2330: 65 73 74 32 29 29 0a 09 20 28 69 74 65 6d 2d 70 est2)).. (item-p
2340: 61 74 68 32 20 20 28 64 62 3a 74 65 73 74 2d 67 ath2 (db:test-g
2350: 65 74 2d 69 74 65 6d 2d 70 61 74 68 20 74 65 73 et-item-path tes
2360: 74 32 29 29 0a 09 20 28 65 76 65 6e 74 74 69 6d t2)).. (eventtim
2370: 65 32 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 e2 (db:test-get
2380: 2d 65 76 65 6e 74 5f 74 69 6d 65 20 74 65 73 74 -event_time test
2390: 32 29 29 0a 09 20 28 73 61 6d 65 2d 6e 61 6d 65 2)).. (same-name
23a0: 20 20 20 28 65 71 75 61 6c 3f 20 74 65 73 74 2d (equal? test-
23b0: 6e 61 6d 65 31 20 74 65 73 74 2d 6e 61 6d 65 32 name1 test-name2
23c0: 29 29 0a 09 20 28 74 65 73 74 31 2d 74 6f 70 20 )).. (test1-top
23d0: 20 20 28 65 71 75 61 6c 3f 20 69 74 65 6d 2d 70 (equal? item-p
23e0: 61 74 68 31 20 22 22 29 29 0a 09 20 28 74 65 73 ath1 "")).. (tes
23f0: 74 32 2d 74 6f 70 20 20 20 28 65 71 75 61 6c 3f t2-top (equal?
2400: 20 69 74 65 6d 2d 70 61 74 68 32 20 22 22 29 29 item-path2 ""))
2410: 0a 09 20 28 74 65 73 74 31 2d 6f 6c 64 65 72 20 .. (test1-older
2420: 28 3e 20 65 76 65 6e 74 74 69 6d 65 31 20 65 76 (> eventtime1 ev
2430: 65 6e 74 74 69 6d 65 32 29 29 0a 09 20 28 73 61 enttime2)).. (sa
2440: 6d 65 2d 74 69 6d 65 20 20 20 28 65 71 75 61 6c me-time (equal
2450: 3f 20 65 76 65 6e 74 74 69 6d 65 31 20 65 76 65 ? eventtime1 eve
2460: 6e 74 74 69 6d 65 32 29 29 29 09 09 09 20 0a 20 nttime2)))... .
2470: 20 20 20 28 69 66 20 73 61 6d 65 2d 6e 61 6d 65 (if same-name
2480: 0a 09 28 69 66 20 73 61 6d 65 2d 74 69 6d 65 0a ..(if same-time.
2490: 09 20 20 20 20 28 73 74 72 69 6e 67 3e 3f 20 69 . (string>? i
24a0: 74 65 6d 2d 70 61 74 68 31 20 69 74 65 6d 2d 70 tem-path1 item-p
24b0: 61 74 68 32 29 0a 09 20 20 20 20 74 65 73 74 31 ath2).. test1
24c0: 2d 6f 6c 64 65 72 29 0a 09 28 69 66 20 73 61 6d -older)..(if sam
24d0: 65 2d 74 69 6d 65 0a 09 20 20 20 20 28 73 74 72 e-time.. (str
24e0: 69 6e 67 3e 3f 20 74 65 73 74 2d 6e 61 6d 65 31 ing>? test-name1
24f0: 20 74 65 73 74 2d 6e 61 6d 65 32 29 0a 09 20 20 test-name2)..
2500: 20 20 74 65 73 74 31 2d 6f 6c 64 65 72 29 29 29 test1-older)))
2510: 29 0a 0a 3b 3b 20 54 68 69 73 20 69 73 20 72 6f )..;; This is ro
2520: 75 67 68 6c 79 20 74 68 65 20 73 61 6d 65 20 61 ughly the same a
2530: 73 20 64 62 6f 61 72 64 3a 67 65 74 2d 74 65 73 s dboard:get-tes
2540: 74 73 2d 64 61 74 2c 20 73 68 6f 75 6c 64 20 6d ts-dat, should m
2550: 65 72 67 65 20 74 68 65 6d 20 69 66 20 70 6f 73 erge them if pos
2560: 73 69 62 6c 65 0a 3b 3b 0a 28 64 65 66 69 6e 65 sible.;;.(define
2570: 20 28 64 62 6f 61 72 64 3a 67 65 74 2d 74 65 73 (dboard:get-tes
2580: 74 73 2d 66 6f 72 2d 72 75 6e 2d 64 75 70 6c 69 ts-for-run-dupli
2590: 63 61 74 65 20 64 61 74 61 20 72 75 6e 2d 69 64 cate data run-id
25a0: 20 72 75 6e 20 74 65 73 74 6e 61 6d 65 70 61 74 run testnamepat
25b0: 74 20 6b 65 79 2d 76 61 6c 73 29 0a 20 20 28 6c t key-vals). (l
25c0: 65 74 2a 20 28 28 73 74 61 74 65 73 20 20 20 20 et* ((states
25d0: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 (hash-table-ke
25e0: 79 73 20 28 64 3a 61 6c 6c 64 61 74 2d 73 74 61 ys (d:alldat-sta
25f0: 74 65 2d 69 67 6e 6f 72 65 2d 68 61 73 68 20 64 te-ignore-hash d
2600: 61 74 61 29 29 29 0a 09 20 28 73 74 61 74 75 73 ata))).. (status
2610: 65 73 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c es (hash-tabl
2620: 65 2d 6b 65 79 73 20 28 64 3a 61 6c 6c 64 61 74 e-keys (d:alldat
2630: 2d 73 74 61 74 75 73 2d 69 67 6e 6f 72 65 2d 68 -status-ignore-h
2640: 61 73 68 20 64 61 74 61 29 29 29 0a 09 20 28 73 ash data))).. (s
2650: 6f 72 74 2d 69 6e 66 6f 20 20 20 28 67 65 74 2d ort-info (get-
2660: 63 75 72 72 2d 73 6f 72 74 29 29 0a 09 20 28 73 curr-sort)).. (s
2670: 6f 72 74 2d 62 79 20 20 20 20 20 28 76 65 63 74 ort-by (vect
2680: 6f 72 2d 72 65 66 20 73 6f 72 74 2d 69 6e 66 6f or-ref sort-info
2690: 20 31 29 29 0a 09 20 28 73 6f 72 74 2d 6f 72 64 1)).. (sort-ord
26a0: 65 72 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 er (vector-ref
26b0: 73 6f 72 74 2d 69 6e 66 6f 20 32 29 29 0a 09 20 sort-info 2))..
26c0: 28 62 75 62 62 6c 65 2d 74 79 70 65 20 28 69 66 (bubble-type (if
26d0: 20 28 6d 65 6d 62 65 72 20 73 6f 72 74 2d 6f 72 (member sort-or
26e0: 64 65 72 20 27 28 74 65 73 74 6e 61 6d 65 29 29 der '(testname))
26f0: 0a 09 09 09 20 20 27 74 65 73 74 6e 61 6d 65 0a .... 'testname.
2700: 09 09 09 20 20 27 69 74 65 6d 70 61 74 68 29 29 ... 'itempath))
2710: 0a 09 20 28 70 72 65 76 2d 64 61 74 20 20 20 20 .. (prev-dat
2720: 28 6c 65 74 20 28 28 72 65 63 20 28 68 61 73 68 (let ((rec (hash
2730: 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 -table-ref/defau
2740: 6c 74 20 28 64 3a 61 6c 6c 64 61 74 2d 61 6c 6c lt (d:alldat-all
2750: 72 75 6e 73 2d 62 79 2d 69 64 20 64 61 74 61 29 runs-by-id data)
2760: 20 72 75 6e 2d 69 64 20 23 66 29 29 29 0a 09 09 run-id #f)))...
2770: 09 28 69 66 20 72 65 63 20 72 65 63 20 28 76 65 .(if rec rec (ve
2780: 63 74 6f 72 20 72 75 6e 20 27 28 29 20 6b 65 79 ctor run '() key
2790: 2d 76 61 6c 73 20 2d 31 30 30 29 29 29 29 20 3b -vals -100)))) ;
27a0: 3b 20 2d 31 30 30 20 69 73 20 62 65 66 6f 72 65 ; -100 is before
27b0: 20 74 69 6d 65 20 62 65 67 61 6e 0a 09 20 28 70 time began.. (p
27c0: 72 65 76 2d 74 65 73 74 73 20 20 28 76 65 63 74 rev-tests (vect
27d0: 6f 72 2d 72 65 66 20 70 72 65 76 2d 64 61 74 20 or-ref prev-dat
27e0: 31 29 29 0a 09 20 28 6c 61 73 74 2d 75 70 64 61 1)).. (last-upda
27f0: 74 65 20 28 76 65 63 74 6f 72 2d 72 65 66 20 70 te (vector-ref p
2800: 72 65 76 2d 64 61 74 20 33 29 29 0a 09 20 28 74 rev-dat 3)).. (t
2810: 6d 70 74 65 73 74 73 20 20 20 20 28 69 66 20 28 mptests (if (
2820: 64 3a 61 6c 6c 64 61 74 2d 75 73 65 73 65 72 76 d:alldat-useserv
2830: 65 72 20 64 61 74 61 29 0a 09 09 09 20 20 28 72 er data).... (r
2840: 6d 74 3a 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 mt:get-tests-for
2850: 2d 72 75 6e 20 72 75 6e 2d 69 64 20 74 65 73 74 -run run-id test
2860: 6e 61 6d 65 70 61 74 74 20 73 74 61 74 65 73 20 namepatt states
2870: 73 74 61 74 75 73 65 73 0a 09 09 09 09 09 09 20 statuses.......
2880: 23 66 20 23 66 0a 09 09 09 09 09 09 20 28 64 3a #f #f....... (d:
2890: 61 6c 6c 64 61 74 2d 68 69 64 65 2d 6e 6f 74 2d alldat-hide-not-
28a0: 68 69 64 65 20 64 61 74 61 29 0a 09 09 09 09 09 hide data)......
28b0: 09 20 73 6f 72 74 2d 62 79 0a 09 09 09 09 09 09 . sort-by.......
28c0: 20 73 6f 72 74 2d 6f 72 64 65 72 0a 09 09 09 09 sort-order.....
28d0: 09 09 20 27 73 68 6f 72 74 6c 69 73 74 0a 09 09 .. 'shortlist...
28e0: 09 09 09 09 20 28 69 66 20 28 64 3a 61 6c 6c 64 .... (if (d:alld
28f0: 61 74 2d 66 69 6c 74 65 72 73 2d 63 68 61 6e 67 at-filters-chang
2900: 65 64 20 64 61 74 61 29 0a 09 09 09 09 09 09 20 ed data).......
2910: 20 20 20 20 30 0a 09 09 09 09 09 09 20 20 20 20 0.......
2920: 20 6c 61 73 74 2d 75 70 64 61 74 65 29 0a 09 09 last-update)...
2930: 09 09 09 09 20 2a 64 61 73 68 62 6f 61 72 64 2d .... *dashboard-
2940: 6d 6f 64 65 2a 29 20 3b 3b 20 75 73 65 20 64 61 mode*) ;; use da
2950: 73 68 62 6f 61 72 64 20 6d 6f 64 65 0a 09 09 09 shboard mode....
2960: 20 20 28 64 62 3a 67 65 74 2d 74 65 73 74 73 2d (db:get-tests-
2970: 66 6f 72 2d 72 75 6e 20 28 64 3a 61 6c 6c 64 61 for-run (d:allda
2980: 74 2d 64 62 6c 6f 63 61 6c 20 64 61 74 61 29 20 t-dblocal data)
2990: 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 70 run-id testnamep
29a0: 61 74 74 20 73 74 61 74 65 73 20 73 74 61 74 75 att states statu
29b0: 73 65 73 0a 09 09 09 09 09 09 23 66 20 23 66 0a ses.......#f #f.
29c0: 09 09 09 09 09 09 28 64 3a 61 6c 6c 64 61 74 2d ......(d:alldat-
29d0: 68 69 64 65 2d 6e 6f 74 2d 68 69 64 65 20 64 61 hide-not-hide da
29e0: 74 61 29 0a 09 09 09 09 09 09 73 6f 72 74 2d 62 ta).......sort-b
29f0: 79 0a 09 09 09 09 09 09 73 6f 72 74 2d 6f 72 64 y.......sort-ord
2a00: 65 72 0a 09 09 09 09 09 09 27 73 68 6f 72 74 6c er.......'shortl
2a10: 69 73 74 0a 09 09 09 09 09 09 28 69 66 20 28 64 ist.......(if (d
2a20: 3a 61 6c 6c 64 61 74 2d 66 69 6c 74 65 72 73 2d :alldat-filters-
2a30: 63 68 61 6e 67 65 64 20 64 61 74 61 29 0a 09 09 changed data)...
2a40: 09 09 09 09 20 20 20 20 30 0a 09 09 09 09 09 09 .... 0.......
2a50: 20 20 20 20 6c 61 73 74 2d 75 70 64 61 74 65 29 last-update)
2a60: 0a 09 09 09 09 09 09 2a 64 61 73 68 62 6f 61 72 .......*dashboar
2a70: 64 2d 6d 6f 64 65 2a 29 29 29 0a 09 20 28 74 65 d-mode*))).. (te
2a80: 73 74 73 20 20 20 20 20 20 20 28 6c 65 74 20 28 sts (let (
2a90: 28 6e 65 77 64 61 74 20 28 66 69 6c 74 65 72 0a (newdat (filter.
2aa0: 09 09 09 09 20 20 20 20 20 28 6c 61 6d 62 64 61 .... (lambda
2ab0: 20 28 78 29 0a 09 09 09 09 20 20 20 20 20 20 20 (x).....
2ac0: 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 28 64 62 (not (equal? (db
2ad0: 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 65 20 :test-get-state
2ae0: 78 29 20 22 44 45 4c 45 54 45 44 22 29 29 29 20 x) "DELETED")))
2af0: 3b 3b 20 72 65 6d 6f 76 65 20 64 65 6c 65 74 65 ;; remove delete
2b00: 64 20 74 65 73 74 73 20 62 75 74 20 64 6f 20 69 d tests but do i
2b10: 74 20 61 66 74 65 72 20 6d 65 72 67 69 6e 67 0a t after merging.
2b20: 09 09 09 09 20 20 20 20 20 28 64 65 6c 65 74 65 .... (delete
2b30: 2d 64 75 70 6c 69 63 61 74 65 73 20 28 69 66 20 -duplicates (if
2b40: 28 64 3a 61 6c 6c 64 61 74 2d 66 69 6c 74 65 72 (d:alldat-filter
2b50: 73 2d 63 68 61 6e 67 65 64 20 64 61 74 61 29 0a s-changed data).
2b60: 09 09 09 09 09 09 09 20 20 20 20 74 6d 70 74 65 ....... tmpte
2b70: 73 74 73 0a 09 09 09 09 09 09 09 20 20 20 20 28 sts........ (
2b80: 61 70 70 65 6e 64 20 74 6d 70 74 65 73 74 73 20 append tmptests
2b90: 70 72 65 76 2d 74 65 73 74 73 29 29 0a 09 09 09 prev-tests))....
2ba0: 09 09 09 09 28 6c 61 6d 62 64 61 20 28 61 20 62 ....(lambda (a b
2bb0: 29 0a 09 09 09 09 09 09 09 20 20 28 65 71 3f 20 )........ (eq?
2bc0: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 64 20 (db:test-get-id
2bd0: 61 29 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 a)(db:test-get-i
2be0: 64 20 62 29 29 29 29 29 29 29 0a 09 09 09 28 69 d b)))))))....(i
2bf0: 66 20 28 65 71 3f 20 2a 74 65 73 74 73 2d 73 6f f (eq? *tests-so
2c00: 72 74 2d 72 65 76 65 72 73 65 2a 20 33 29 20 3b rt-reverse* 3) ;
2c10: 3b 20 2b 65 76 65 6e 74 5f 74 69 6d 65 0a 09 09 ; +event_time...
2c20: 09 20 20 20 20 28 73 6f 72 74 20 6e 65 77 64 61 . (sort newda
2c30: 74 20 64 62 6f 61 72 64 3a 63 6f 6d 70 61 72 65 t dboard:compare
2c40: 2d 74 65 73 74 73 29 0a 09 09 09 20 20 20 20 6e -tests).... n
2c50: 65 77 64 61 74 29 29 29 29 0a 20 20 20 20 28 76 ewdat)))). (v
2c60: 65 63 74 6f 72 2d 73 65 74 21 20 70 72 65 76 2d ector-set! prev-
2c70: 64 61 74 20 33 20 28 2d 20 28 63 75 72 72 65 6e dat 3 (- (curren
2c80: 74 2d 73 65 63 6f 6e 64 73 29 20 32 29 29 20 3b t-seconds) 2)) ;
2c90: 3b 20 67 6f 20 62 61 63 6b 20 74 77 6f 20 73 65 ; go back two se
2ca0: 63 6f 6e 64 73 20 69 6e 20 74 69 6d 65 20 74 6f conds in time to
2cb0: 20 65 6e 73 75 72 65 20 61 6c 6c 20 63 68 61 6e ensure all chan
2cc0: 67 65 73 20 61 72 65 20 63 61 70 74 75 72 65 64 ges are captured
2cd0: 2e 0a 20 20 20 20 3b 3b 20 28 64 65 62 75 67 3a .. ;; (debug:
2ce0: 70 72 69 6e 74 20 30 20 22 28 64 62 6f 61 72 64 print 0 "(dboard
2cf0: 3a 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 :get-tests-for-r
2d00: 75 6e 2d 64 75 70 6c 69 63 61 74 65 3a 20 66 69 un-duplicate: fi
2d10: 6c 74 65 72 73 2d 63 68 61 6e 67 65 64 3d 22 20 lters-changed="
2d20: 28 64 3a 61 6c 6c 64 61 74 2d 66 69 6c 74 65 72 (d:alldat-filter
2d30: 73 2d 63 68 61 6e 67 65 64 20 64 61 74 61 29 20 s-changed data)
2d40: 22 20 6c 61 73 74 2d 75 70 64 61 74 65 3d 22 20 " last-update="
2d50: 6c 61 73 74 2d 75 70 64 61 74 65 20 22 20 67 6f last-update " go
2d60: 74 20 22 20 28 6c 65 6e 67 74 68 20 74 6d 70 74 t " (length tmpt
2d70: 65 73 74 73 29 20 22 20 74 65 73 74 20 72 65 63 ests) " test rec
2d80: 6f 72 64 73 20 66 6f 72 20 72 75 6e 20 22 20 72 ords for run " r
2d90: 75 6e 2d 69 64 29 0a 20 20 20 20 74 65 73 74 73 un-id). tests
2da0: 29 29 0a 0a 3b 3b 20 63 72 65 61 74 65 20 61 20 ))..;; create a
2db0: 76 69 72 74 75 61 6c 20 74 61 62 6c 65 20 6f 66 virtual table of
2dc0: 20 61 6c 6c 20 74 68 65 20 74 65 73 74 73 0a 3b all the tests.;
2dd0: 3b 20 6b 65 79 70 61 74 74 73 3a 20 28 20 28 4b ; keypatts: ( (K
2de0: 45 59 31 20 22 61 62 63 25 64 65 66 22 29 28 4b EY1 "abc%def")(K
2df0: 45 59 32 20 22 25 22 29 20 29 0a 28 64 65 66 69 EY2 "%") ).(defi
2e00: 6e 65 20 28 75 70 64 61 74 65 2d 72 75 6e 64 61 ne (update-runda
2e10: 74 20 64 61 74 61 20 72 75 6e 6e 61 6d 65 70 61 t data runnamepa
2e20: 74 74 20 6e 75 6d 72 75 6e 73 20 74 65 73 74 6e tt numruns testn
2e30: 61 6d 65 70 61 74 74 20 6b 65 79 70 61 74 74 73 amepatt keypatts
2e40: 29 0a 20 20 28 6c 65 74 2a 20 28 28 72 65 66 65 ). (let* ((refe
2e50: 72 65 6e 63 65 64 2d 72 75 6e 2d 69 64 73 20 27 renced-run-ids '
2e60: 28 29 29 0a 09 20 28 61 6c 6c 72 75 6e 73 20 20 ()).. (allruns
2e70: 20 20 20 28 69 66 20 28 64 3a 61 6c 6c 64 61 74 (if (d:alldat
2e80: 2d 75 73 65 73 65 72 76 65 72 20 64 61 74 61 29 -useserver data)
2e90: 0a 09 09 09 20 20 28 72 6d 74 3a 67 65 74 2d 72 .... (rmt:get-r
2ea0: 75 6e 73 20 72 75 6e 6e 61 6d 65 70 61 74 74 20 uns runnamepatt
2eb0: 6e 75 6d 72 75 6e 73 20 28 64 3a 61 6c 6c 64 61 numruns (d:allda
2ec0: 74 2d 73 74 61 72 74 2d 72 75 6e 2d 6f 66 66 73 t-start-run-offs
2ed0: 65 74 20 64 61 74 61 29 20 6b 65 79 70 61 74 74 et data) keypatt
2ee0: 73 29 0a 09 09 09 20 20 28 64 62 3a 67 65 74 2d s).... (db:get-
2ef0: 72 75 6e 73 20 28 64 3a 61 6c 6c 64 61 74 2d 64 runs (d:alldat-d
2f00: 62 6c 6f 63 61 6c 20 64 61 74 61 29 20 72 75 6e blocal data) run
2f10: 6e 61 6d 65 70 61 74 74 20 6e 75 6d 72 75 6e 73 namepatt numruns
2f20: 20 3b 3b 20 28 2b 20 6e 75 6d 72 75 6e 73 20 31 ;; (+ numruns 1
2f30: 29 20 3b 3b 20 28 2f 20 6e 75 6d 72 75 6e 73 20 ) ;; (/ numruns
2f40: 32 29 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 2))..... (
2f50: 64 3a 61 6c 6c 64 61 74 2d 73 74 61 72 74 2d 72 d:alldat-start-r
2f60: 75 6e 2d 6f 66 66 73 65 74 20 64 61 74 61 29 20 un-offset data)
2f70: 6b 65 79 70 61 74 74 73 29 29 29 0a 09 20 28 68 keypatts))).. (h
2f80: 65 61 64 65 72 20 20 20 20 20 20 28 64 62 3a 67 eader (db:g
2f90: 65 74 2d 68 65 61 64 65 72 20 61 6c 6c 72 75 6e et-header allrun
2fa0: 73 29 29 0a 09 20 28 72 75 6e 73 20 20 20 20 20 s)).. (runs
2fb0: 20 20 20 28 64 62 3a 67 65 74 2d 72 6f 77 73 20 (db:get-rows
2fc0: 20 20 61 6c 6c 72 75 6e 73 29 29 0a 09 20 28 72 allruns)).. (r
2fd0: 65 73 75 6c 74 20 20 20 20 20 20 27 28 29 29 0a esult '()).
2fe0: 09 20 28 6d 61 78 74 65 73 74 73 20 20 20 20 30 . (maxtests 0
2ff0: 29 0a 29 0a 20 20 20 20 3b 3b 20 0a 20 20 20 20 ).). ;; .
3000: 3b 3b 20 74 72 69 6d 20 72 75 6e 73 20 74 6f 20 ;; trim runs to
3010: 6f 6e 6c 79 20 74 68 6f 73 65 20 74 68 61 74 20 only those that
3020: 61 72 65 20 63 68 61 6e 67 69 6e 67 20 6f 66 74 are changing oft
3030: 65 6e 20 68 65 72 65 0a 20 20 20 20 3b 3b 20 0a en here. ;; .
3040: 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c (for-each (l
3050: 61 6d 62 64 61 20 28 72 75 6e 29 0a 09 09 28 6c ambda (run)...(l
3060: 65 74 2a 20 28 28 72 75 6e 2d 69 64 20 20 20 20 et* ((run-id
3070: 20 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d (db:get-value-
3080: 62 79 2d 68 65 61 64 65 72 20 72 75 6e 20 68 65 by-header run he
3090: 61 64 65 72 20 22 69 64 22 29 29 0a 09 09 20 20 ader "id"))...
30a0: 20 20 20 20 20 28 6b 65 79 2d 76 61 6c 73 20 20 (key-vals
30b0: 20 20 28 69 66 20 28 64 3a 61 6c 6c 64 61 74 2d (if (d:alldat-
30c0: 75 73 65 73 65 72 76 65 72 20 64 61 74 61 29 20 useserver data)
30d0: 0a 09 09 09 09 09 28 72 6d 74 3a 67 65 74 2d 6b ......(rmt:get-k
30e0: 65 79 2d 76 61 6c 73 20 72 75 6e 2d 69 64 29 0a ey-vals run-id).
30f0: 09 09 09 09 09 28 64 62 3a 67 65 74 2d 6b 65 79 .....(db:get-key
3100: 2d 76 61 6c 73 20 28 64 3a 61 6c 6c 64 61 74 2d -vals (d:alldat-
3110: 64 62 6c 6f 63 61 6c 20 64 61 74 61 29 20 72 75 dblocal data) ru
3120: 6e 2d 69 64 29 29 29 0a 09 09 20 20 20 20 20 20 n-id)))...
3130: 20 28 74 65 73 74 73 20 20 20 20 20 20 20 28 64 (tests (d
3140: 62 6f 61 72 64 3a 67 65 74 2d 74 65 73 74 73 2d board:get-tests-
3150: 66 6f 72 2d 72 75 6e 2d 64 75 70 6c 69 63 61 74 for-run-duplicat
3160: 65 20 64 61 74 61 20 72 75 6e 2d 69 64 20 72 75 e data run-id ru
3170: 6e 20 74 65 73 74 6e 61 6d 65 70 61 74 74 20 6b n testnamepatt k
3180: 65 79 2d 76 61 6c 73 29 29 29 0a 09 09 20 20 3b ey-vals)))... ;
3190: 3b 20 4e 4f 54 45 3a 20 62 75 62 62 6c 65 2d 75 ; NOTE: bubble-u
31a0: 70 20 61 6c 73 6f 20 73 65 74 73 20 74 68 65 20 p also sets the
31b0: 67 6c 6f 62 61 6c 20 28 64 3a 61 6c 6c 64 61 74 global (d:alldat
31c0: 2d 69 74 65 6d 2d 74 65 73 74 2d 6e 61 6d 65 73 -item-test-names
31d0: 20 64 61 74 61 29 0a 09 09 20 20 3b 3b 20 28 74 data)... ;; (t
31e0: 65 73 74 73 20 20 20 20 20 20 20 28 62 75 62 62 ests (bubb
31f0: 6c 65 2d 75 70 20 74 6d 70 74 65 73 74 73 20 70 le-up tmptests p
3200: 72 69 6f 72 69 74 79 3a 20 62 75 62 62 6c 65 2d riority: bubble-
3210: 74 79 70 65 29 29 0a 09 09 20 20 3b 3b 20 4e 4f type))... ;; NO
3220: 54 45 3a 20 31 31 2f 30 31 2f 32 30 31 33 20 54 TE: 11/01/2013 T
3230: 68 69 73 20 72 6f 75 74 69 6e 65 20 69 73 20 2a his routine is *
3240: 4e 4f 54 2a 20 67 65 74 74 69 6e 67 20 63 61 6c NOT* getting cal
3250: 6c 65 64 20 65 78 63 65 73 73 69 76 65 6c 79 2e led excessively.
3260: 0a 09 09 20 20 3b 3b 20 28 64 65 62 75 67 3a 70 ... ;; (debug:p
3270: 72 69 6e 74 20 30 20 22 47 65 74 74 69 6e 67 20 rint 0 "Getting
3280: 64 61 74 61 20 66 6f 72 20 72 75 6e 20 22 20 72 data for run " r
3290: 75 6e 2d 69 64 20 22 20 77 69 74 68 20 6b 65 79 un-id " with key
32a0: 2d 76 61 6c 73 3d 22 20 6b 65 79 2d 76 61 6c 73 -vals=" key-vals
32b0: 29 0a 09 09 20 20 3b 3b 20 4e 6f 74 20 73 75 72 )... ;; Not sur
32c0: 65 20 74 68 69 73 20 69 73 20 6e 65 65 64 65 64 e this is needed
32d0: 3f 0a 09 09 20 20 28 69 66 20 28 6e 6f 74 20 28 ?... (if (not (
32e0: 6e 75 6c 6c 3f 20 74 65 73 74 73 29 29 0a 09 09 null? tests))...
32f0: 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 09 (begin....
3300: 28 73 65 74 21 20 72 65 66 65 72 65 6e 63 65 64 (set! referenced
3310: 2d 72 75 6e 2d 69 64 73 20 28 63 6f 6e 73 20 72 -run-ids (cons r
3320: 75 6e 2d 69 64 20 72 65 66 65 72 65 6e 63 65 64 un-id referenced
3330: 2d 72 75 6e 2d 69 64 73 29 29 0a 09 09 09 28 69 -run-ids))....(i
3340: 66 20 28 3e 20 28 6c 65 6e 67 74 68 20 74 65 73 f (> (length tes
3350: 74 73 29 20 6d 61 78 74 65 73 74 73 29 0a 09 09 ts) maxtests)...
3360: 09 20 20 20 20 28 73 65 74 21 20 6d 61 78 74 65 . (set! maxte
3370: 73 74 73 20 28 6c 65 6e 67 74 68 20 74 65 73 74 sts (length test
3380: 73 29 29 29 0a 09 09 09 28 69 66 20 28 6f 72 20 s)))....(if (or
3390: 28 6e 6f 74 20 28 64 3a 61 6c 6c 64 61 74 2d 68 (not (d:alldat-h
33a0: 69 64 65 2d 65 6d 70 74 79 2d 72 75 6e 73 20 64 ide-empty-runs d
33b0: 61 74 61 29 29 20 3b 3b 20 74 68 69 73 20 72 65 ata)) ;; this re
33c0: 64 75 63 65 73 20 74 68 65 20 64 61 74 61 20 62 duces the data b
33d0: 75 72 64 65 6e 20 77 68 65 6e 20 73 65 74 0a 09 urden when set..
33e0: 09 09 09 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 74 ...(not (null? t
33f0: 65 73 74 73 29 29 29 0a 09 09 09 20 20 20 20 28 ests))).... (
3400: 6c 65 74 20 28 28 64 73 74 72 75 63 74 20 28 76 let ((dstruct (v
3410: 65 63 74 6f 72 20 72 75 6e 20 74 65 73 74 73 20 ector run tests
3420: 6b 65 79 2d 76 61 6c 73 20 28 2d 20 28 63 75 72 key-vals (- (cur
3430: 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 20 31 30 rent-seconds) 10
3440: 29 29 29 29 0a 09 09 09 20 20 20 20 20 20 28 68 )))).... (h
3450: 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 28 ash-table-set! (
3460: 64 3a 61 6c 6c 64 61 74 2d 61 6c 6c 72 75 6e 73 d:alldat-allruns
3470: 2d 62 79 2d 69 64 20 64 61 74 61 29 20 72 75 6e -by-id data) run
3480: 2d 69 64 20 64 73 74 72 75 63 74 29 0a 09 09 09 -id dstruct)....
3490: 20 20 20 20 20 20 28 73 65 74 21 20 72 65 73 75 (set! resu
34a0: 6c 74 20 28 63 6f 6e 73 20 64 73 74 72 75 63 74 lt (cons dstruct
34b0: 20 72 65 73 75 6c 74 29 29 29 29 29 29 29 29 0a result)))))))).
34c0: 09 20 20 20 20 20 20 72 75 6e 73 29 0a 0a 20 20 . runs)..
34d0: 20 20 28 64 3a 61 6c 6c 64 61 74 2d 68 65 61 64 (d:alldat-head
34e0: 65 72 2d 73 65 74 21 20 64 61 74 61 20 68 65 61 er-set! data hea
34f0: 64 65 72 29 0a 20 20 20 20 28 64 3a 61 6c 6c 64 der). (d:alld
3500: 61 74 2d 61 6c 6c 72 75 6e 73 2d 73 65 74 21 20 at-allruns-set!
3510: 64 61 74 61 20 72 65 73 75 6c 74 29 0a 20 20 20 data result).
3520: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e (debug:print-in
3530: 66 6f 20 36 20 22 28 64 3a 61 6c 6c 64 61 74 2d fo 6 "(d:alldat-
3540: 61 6c 6c 72 75 6e 73 20 64 61 74 61 29 20 68 61 allruns data) ha
3550: 73 20 22 20 28 6c 65 6e 67 74 68 20 28 64 3a 61 s " (length (d:a
3560: 6c 6c 64 61 74 2d 61 6c 6c 72 75 6e 73 20 64 61 lldat-allruns da
3570: 74 61 29 29 20 22 20 72 75 6e 73 22 29 0a 20 20 ta)) " runs").
3580: 20 20 6d 61 78 74 65 73 74 73 29 29 0a 0a 28 64 maxtests))..(d
3590: 65 66 69 6e 65 20 2a 63 6f 6c 6c 61 70 73 65 64 efine *collapsed
35a0: 2a 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 * (make-hash-tab
35b0: 6c 65 29 29 0a 09 09 09 09 09 3b 20 28 64 65 66 le))......; (def
35c0: 69 6e 65 20 2a 72 6f 77 2d 6c 6f 6f 6b 75 70 2a ine *row-lookup*
35d0: 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c (make-hash-tabl
35e0: 65 29 29 20 3b 3b 20 74 65 73 74 6e 61 6d 65 20 e)) ;; testname
35f0: 3d 3e 20 28 72 6f 77 6e 75 6d 20 6c 61 62 6c 65 => (rownum lable
3600: 6f 62 6a 29 0a 0a 28 64 65 66 69 6e 65 20 28 74 obj)..(define (t
3610: 6f 67 67 6c 65 2d 68 69 64 65 20 6c 6e 75 6d 29 oggle-hide lnum)
3620: 20 3b 20 66 75 6c 6c 74 65 73 74 6e 61 6d 65 29 ; fulltestname)
3630: 0a 20 20 28 6c 65 74 2a 20 28 28 62 74 6e 20 28 . (let* ((btn (
3640: 76 65 63 74 6f 72 2d 72 65 66 20 28 64 62 6f 61 vector-ref (dboa
3650: 72 64 3a 75 69 64 61 74 2d 67 65 74 2d 6c 66 74 rd:uidat-get-lft
3660: 63 6f 6c 20 75 69 64 61 74 29 20 6c 6e 75 6d 29 col uidat) lnum)
3670: 29 0a 09 20 28 66 75 6c 6c 74 65 73 74 6e 61 6d ).. (fulltestnam
3680: 65 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 e (iup:attribute
3690: 20 62 74 6e 20 22 54 49 54 4c 45 22 29 29 0a 09 btn "TITLE"))..
36a0: 20 28 70 61 72 74 73 20 20 20 20 20 20 20 20 28 (parts (
36b0: 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 66 75 6c string-split ful
36c0: 6c 74 65 73 74 6e 61 6d 65 20 22 28 22 29 29 0a ltestname "(")).
36d0: 09 20 28 62 61 73 65 74 65 73 74 6e 61 6d 65 20 . (basetestname
36e0: 28 69 66 20 28 6e 75 6c 6c 3f 20 70 61 72 74 73 (if (null? parts
36f0: 29 20 22 22 20 28 63 61 72 20 70 61 72 74 73 29 ) "" (car parts)
3700: 29 29 29 0a 09 09 09 09 09 3b 28 70 72 69 6e 74 )))......;(print
3710: 20 22 54 6f 67 67 6c 69 6e 67 20 22 20 62 61 73 "Toggling " bas
3720: 65 74 65 73 74 6e 61 6d 65 20 22 20 63 75 72 72 etestname " curr
3730: 65 6e 74 6c 79 20 22 20 28 68 61 73 68 2d 74 61 ently " (hash-ta
3740: 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 ble-ref/default
3750: 2a 63 6f 6c 6c 61 70 73 65 64 2a 20 62 61 73 65 *collapsed* base
3760: 74 65 73 74 6e 61 6d 65 20 23 66 29 29 0a 20 20 testname #f)).
3770: 20 20 28 69 66 20 28 68 61 73 68 2d 74 61 62 6c (if (hash-tabl
3780: 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 2a 63 e-ref/default *c
3790: 6f 6c 6c 61 70 73 65 64 2a 20 62 61 73 65 74 65 ollapsed* basete
37a0: 73 74 6e 61 6d 65 20 23 66 29 0a 09 28 62 65 67 stname #f)..(beg
37b0: 69 6e 0a 09 09 09 09 09 3b 28 69 75 70 3a 61 74 in......;(iup:at
37c0: 74 72 69 62 75 74 65 2d 73 65 74 21 20 62 74 6e tribute-set! btn
37d0: 20 22 46 47 43 4f 4c 4f 52 22 20 22 30 20 30 20 "FGCOLOR" "0 0
37e0: 30 22 29 0a 09 20 20 28 68 61 73 68 2d 74 61 62 0").. (hash-tab
37f0: 6c 65 2d 64 65 6c 65 74 65 21 20 2a 63 6f 6c 6c le-delete! *coll
3800: 61 70 73 65 64 2a 20 62 61 73 65 74 65 73 74 6e apsed* basetestn
3810: 61 6d 65 29 29 0a 09 28 62 65 67 69 6e 0a 09 09 ame))..(begin...
3820: 09 09 09 3b 28 69 75 70 3a 61 74 74 72 69 62 75 ...;(iup:attribu
3830: 74 65 2d 73 65 74 21 20 62 74 6e 20 22 46 47 43 te-set! btn "FGC
3840: 4f 4c 4f 52 22 20 22 30 20 31 39 32 20 31 39 32 OLOR" "0 192 192
3850: 22 29 0a 09 20 20 28 68 61 73 68 2d 74 61 62 6c ").. (hash-tabl
3860: 65 2d 73 65 74 21 20 2a 63 6f 6c 6c 61 70 73 65 e-set! *collapse
3870: 64 2a 20 62 61 73 65 74 65 73 74 6e 61 6d 65 20 d* basetestname
3880: 23 74 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 #t)))))..(define
3890: 20 62 6c 61 6e 6b 2d 6c 69 6e 65 2d 72 78 20 28 blank-line-rx (
38a0: 72 65 67 65 78 70 20 22 5e 5c 5c 73 2a 24 22 29 regexp "^\\s*$")
38b0: 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 75 6e 2d )..(define (run-
38c0: 69 74 65 6d 2d 6e 61 6d 65 2d 3e 76 65 63 74 6f item-name->vecto
38d0: 72 73 20 6c 73 74 29 0a 20 20 28 6d 61 70 20 28 rs lst). (map (
38e0: 6c 61 6d 62 64 61 20 28 78 29 0a 09 20 28 6c 65 lambda (x).. (le
38f0: 74 20 28 28 73 70 6c 73 74 20 28 73 74 72 69 6e t ((splst (strin
3900: 67 2d 73 70 6c 69 74 20 78 20 22 28 22 29 29 0a g-split x "(")).
3910: 09 20 20 20 20 20 20 20 28 72 65 73 20 20 20 28 . (res (
3920: 76 65 63 74 6f 72 20 22 22 20 22 22 29 29 29 0a vector "" ""))).
3930: 09 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 . (vector-set!
3940: 20 72 65 73 20 30 20 28 63 61 72 20 73 70 6c 73 res 0 (car spls
3950: 74 29 29 0a 09 20 20 20 28 69 66 20 28 3e 20 28 t)).. (if (> (
3960: 6c 65 6e 67 74 68 20 73 70 6c 73 74 29 20 31 29 length splst) 1)
3970: 0a 09 20 20 20 20 20 20 20 28 76 65 63 74 6f 72 .. (vector
3980: 2d 73 65 74 21 20 72 65 73 20 31 20 28 63 61 72 -set! res 1 (car
3990: 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 28 (string-split (
39a0: 63 61 64 72 20 73 70 6c 73 74 29 20 22 29 22 29 cadr splst) ")")
39b0: 29 29 29 0a 09 20 20 20 72 65 73 29 29 0a 20 20 ))).. res)).
39c0: 20 20 20 20 20 6c 73 74 29 29 0a 0a 28 64 65 66 lst))..(def
39d0: 69 6e 65 20 28 63 6f 6c 6c 61 70 73 65 2d 72 6f ine (collapse-ro
39e0: 77 73 20 69 6e 6c 73 74 29 0a 20 20 28 6c 65 74 ws inlst). (let
39f0: 2a 20 28 28 73 6f 72 74 2d 69 6e 66 6f 20 20 20 * ((sort-info
3a00: 28 67 65 74 2d 63 75 72 72 2d 73 6f 72 74 29 29 (get-curr-sort))
3a10: 0a 09 20 28 73 6f 72 74 2d 62 79 20 20 20 20 20 .. (sort-by
3a20: 28 76 65 63 74 6f 72 2d 72 65 66 20 73 6f 72 74 (vector-ref sort
3a30: 2d 69 6e 66 6f 20 31 29 29 0a 09 20 28 73 6f 72 -info 1)).. (sor
3a40: 74 2d 6f 72 64 65 72 20 20 28 76 65 63 74 6f 72 t-order (vector
3a50: 2d 72 65 66 20 73 6f 72 74 2d 69 6e 66 6f 20 32 -ref sort-info 2
3a60: 29 29 0a 09 20 28 62 75 62 62 6c 65 2d 74 79 70 )).. (bubble-typ
3a70: 65 20 28 69 66 20 28 6d 65 6d 62 65 72 20 73 6f e (if (member so
3a80: 72 74 2d 6f 72 64 65 72 20 27 28 74 65 73 74 6e rt-order '(testn
3a90: 61 6d 65 29 29 0a 09 09 09 20 20 27 74 65 73 74 ame)).... 'test
3aa0: 6e 61 6d 65 0a 09 09 09 20 20 27 69 74 65 6d 70 name.... 'itemp
3ab0: 61 74 68 29 29 0a 09 20 28 6e 65 77 6c 73 74 20 ath)).. (newlst
3ac0: 20 20 20 20 20 28 66 69 6c 74 65 72 20 28 6c 61 (filter (la
3ad0: 6d 62 64 61 20 28 78 29 0a 09 09 09 09 28 6c 65 mbda (x).....(le
3ae0: 74 2a 20 28 28 74 70 61 72 74 73 20 20 20 20 28 t* ((tparts (
3af0: 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 78 20 22 string-split x "
3b00: 28 22 29 29 0a 09 09 09 09 20 20 20 20 20 20 20 (")).....
3b10: 28 62 61 73 65 74 6e 61 6d 65 20 28 69 66 20 28 (basetname (if (
3b20: 6e 75 6c 6c 3f 20 74 70 61 72 74 73 29 20 78 20 null? tparts) x
3b30: 28 63 61 72 20 74 70 61 72 74 73 29 29 29 29 0a (car tparts)))).
3b40: 09 09 09 09 09 3b 28 70 72 69 6e 74 20 22 78 20 .....;(print "x
3b50: 22 20 78 20 22 20 74 70 61 72 74 73 3a 20 22 20 " x " tparts: "
3b60: 74 70 61 72 74 73 20 22 20 62 61 73 65 74 6e 61 tparts " basetna
3b70: 6d 65 3a 20 22 20 62 61 73 65 74 6e 61 6d 65 29 me: " basetname)
3b80: 0a 09 09 09 09 20 20 28 63 6f 6e 64 0a 09 09 09 ..... (cond....
3b90: 09 20 20 20 28 28 73 74 72 69 6e 67 2d 6d 61 74 . ((string-mat
3ba0: 63 68 20 62 6c 61 6e 6b 2d 6c 69 6e 65 2d 72 78 ch blank-line-rx
3bb0: 20 78 29 20 23 66 29 0a 09 09 09 09 20 20 20 28 x) #f)..... (
3bc0: 28 65 71 75 61 6c 3f 20 78 20 62 61 73 65 74 6e (equal? x basetn
3bd0: 61 6d 65 29 20 23 74 29 0a 09 09 09 09 20 20 20 ame) #t).....
3be0: 28 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 ((hash-table-ref
3bf0: 2f 64 65 66 61 75 6c 74 20 2a 63 6f 6c 6c 61 70 /default *collap
3c00: 73 65 64 2a 20 62 61 73 65 74 6e 61 6d 65 20 23 sed* basetname #
3c10: 66 29 20 0a 09 09 09 09 09 3b 28 70 72 69 6e 74 f) ......;(print
3c20: 20 22 52 65 6d 6f 76 69 6e 67 20 22 20 62 61 73 "Removing " bas
3c30: 65 74 6e 61 6d 65 20 22 20 66 72 6f 6d 20 69 74 etname " from it
3c40: 65 6d 73 22 29 0a 09 09 09 09 20 20 20 20 23 66 ems")..... #f
3c50: 29 0a 09 09 09 09 20 20 20 28 65 6c 73 65 20 23 )..... (else #
3c60: 74 29 29 29 29 0a 09 09 09 20 20 20 20 20 20 69 t)))).... i
3c70: 6e 6c 73 74 29 29 0a 09 20 28 76 6c 73 74 20 20 nlst)).. (vlst
3c80: 20 20 20 20 20 20 20 28 72 75 6e 2d 69 74 65 6d (run-item
3c90: 2d 6e 61 6d 65 2d 3e 76 65 63 74 6f 72 73 20 6e -name->vectors n
3ca0: 65 77 6c 73 74 29 29 0a 09 20 28 76 6c 73 74 32 ewlst)).. (vlst2
3cb0: 20 20 20 20 20 20 20 20 28 62 75 62 62 6c 65 2d (bubble-
3cc0: 75 70 20 76 6c 73 74 20 70 72 69 6f 72 69 74 79 up vlst priority
3cd0: 3a 20 62 75 62 62 6c 65 2d 74 79 70 65 29 29 29 : bubble-type)))
3ce0: 0a 20 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 . (map (lambd
3cf0: 61 20 28 78 29 0a 09 20 20 20 28 69 66 20 28 65 a (x).. (if (e
3d00: 71 75 61 6c 3f 20 28 76 65 63 74 6f 72 2d 72 65 qual? (vector-re
3d10: 66 20 78 20 31 29 20 22 22 29 0a 09 20 20 20 20 f x 1) "")..
3d20: 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 78 (vector-ref x
3d30: 20 30 29 0a 09 20 20 20 20 20 20 20 28 63 6f 6e 0).. (con
3d40: 63 20 28 76 65 63 74 6f 72 2d 72 65 66 20 78 20 c (vector-ref x
3d50: 30 29 20 22 28 22 20 28 76 65 63 74 6f 72 2d 72 0) "(" (vector-r
3d60: 65 66 20 78 20 31 29 20 22 29 22 29 29 29 0a 09 ef x 1) ")")))..
3d70: 20 76 6c 73 74 32 29 29 29 0a 0a 28 64 65 66 69 vlst2)))..(defi
3d80: 6e 65 20 28 75 70 64 61 74 65 2d 6c 61 62 65 6c ne (update-label
3d90: 73 20 75 69 64 61 74 29 0a 20 20 28 6c 65 74 2a s uidat). (let*
3da0: 20 28 28 72 6f 77 6e 20 20 20 20 30 29 0a 09 20 ((rown 0)..
3db0: 28 6b 65 79 63 6f 6c 20 20 28 64 62 6f 61 72 64 (keycol (dboard
3dc0: 3a 75 69 64 61 74 2d 67 65 74 2d 6b 65 79 63 6f :uidat-get-keyco
3dd0: 6c 20 75 69 64 61 74 29 29 0a 09 20 28 6c 66 74 l uidat)).. (lft
3de0: 63 6f 6c 20 20 28 64 62 6f 61 72 64 3a 75 69 64 col (dboard:uid
3df0: 61 74 2d 67 65 74 2d 6c 66 74 63 6f 6c 20 75 69 at-get-lftcol ui
3e00: 64 61 74 29 29 0a 09 20 28 6e 75 6d 63 6f 6c 73 dat)).. (numcols
3e10: 20 28 76 65 63 74 6f 72 2d 6c 65 6e 67 74 68 20 (vector-length
3e20: 6c 66 74 63 6f 6c 29 29 0a 09 20 28 6d 61 78 6e lftcol)).. (maxn
3e30: 20 20 20 20 28 2d 20 6e 75 6d 63 6f 6c 73 20 31 (- numcols 1
3e40: 29 29 0a 09 20 28 61 6c 6c 76 61 6c 73 20 28 6d )).. (allvals (m
3e50: 61 6b 65 2d 76 65 63 74 6f 72 20 6e 75 6d 63 6f ake-vector numco
3e60: 6c 73 20 22 22 29 29 29 0a 20 20 20 20 28 66 6f ls ""))). (fo
3e70: 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 r-each (lambda (
3e80: 6e 61 6d 65 29 0a 09 09 28 69 66 20 28 3c 3d 20 name)...(if (<=
3e90: 72 6f 77 6e 20 6d 61 78 6e 29 0a 09 09 20 20 20 rown maxn)...
3ea0: 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 61 6c (vector-set! al
3eb0: 6c 76 61 6c 73 20 72 6f 77 6e 20 6e 61 6d 65 29 lvals rown name)
3ec0: 29 20 3b 29 0a 09 09 28 73 65 74 21 20 72 6f 77 ) ;)...(set! row
3ed0: 6e 20 28 2b 20 31 20 72 6f 77 6e 29 29 29 0a 09 n (+ 1 rown)))..
3ee0: 20 20 20 20 20 20 2a 61 6c 6c 74 65 73 74 6e 61 *alltestna
3ef0: 6d 65 6c 73 74 2a 29 0a 20 20 20 20 28 6c 65 74 melst*). (let
3f00: 20 6c 6f 6f 70 20 28 28 69 20 30 29 29 0a 20 20 loop ((i 0)).
3f10: 20 20 20 20 28 6c 65 74 2a 20 28 28 6c 62 6c 20 (let* ((lbl
3f20: 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 6c (vector-ref l
3f30: 66 74 63 6f 6c 20 69 29 29 0a 09 20 20 20 20 20 ftcol i))..
3f40: 28 6b 65 79 76 61 6c 20 28 76 65 63 74 6f 72 2d (keyval (vector-
3f50: 72 65 66 20 6b 65 79 63 6f 6c 20 69 29 29 0a 09 ref keycol i))..
3f60: 20 20 20 20 20 28 6f 6c 64 76 61 6c 20 28 69 75 (oldval (iu
3f70: 70 3a 61 74 74 72 69 62 75 74 65 20 6c 62 6c 20 p:attribute lbl
3f80: 22 54 49 54 4c 45 22 29 29 0a 09 20 20 20 20 20 "TITLE"))..
3f90: 28 6e 65 77 76 61 6c 20 28 76 65 63 74 6f 72 2d (newval (vector-
3fa0: 72 65 66 20 61 6c 6c 76 61 6c 73 20 69 29 29 29 ref allvals i)))
3fb0: 0a 09 28 69 66 20 28 6e 6f 74 20 28 65 71 75 61 ..(if (not (equa
3fc0: 6c 3f 20 6f 6c 64 76 61 6c 20 6e 65 77 76 61 6c l? oldval newval
3fd0: 29 29 0a 09 20 20 20 20 28 6c 65 74 20 28 28 6d )).. (let ((m
3fe0: 75 6e 67 65 64 2d 76 61 6c 20 28 6c 65 74 20 28 unged-val (let (
3ff0: 28 70 61 72 74 73 20 28 73 74 72 69 6e 67 2d 73 (parts (string-s
4000: 70 6c 69 74 20 6e 65 77 76 61 6c 20 22 28 22 29 plit newval "(")
4010: 29 29 0a 09 09 09 09 28 69 66 20 28 3e 20 28 6c )).....(if (> (l
4020: 65 6e 67 74 68 20 70 61 72 74 73 29 20 31 29 28 ength parts) 1)(
4030: 63 6f 6e 63 20 22 20 20 22 20 28 63 61 72 20 28 conc " " (car (
4040: 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 28 63 61 string-split (ca
4050: 64 72 20 70 61 72 74 73 29 20 22 29 22 29 29 29 dr parts) ")")))
4060: 20 6e 65 77 76 61 6c 29 29 29 29 0a 09 20 20 20 newval))))..
4070: 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 (vector-set!
4080: 6b 65 79 63 6f 6c 20 69 20 6e 65 77 76 61 6c 29 keycol i newval)
4090: 0a 09 20 20 20 20 20 20 28 69 75 70 3a 61 74 74 .. (iup:att
40a0: 72 69 62 75 74 65 2d 73 65 74 21 20 6c 62 6c 20 ribute-set! lbl
40b0: 22 54 49 54 4c 45 22 20 6d 75 6e 67 65 64 2d 76 "TITLE" munged-v
40c0: 61 6c 29 29 29 0a 09 28 69 75 70 3a 61 74 74 72 al)))..(iup:attr
40d0: 69 62 75 74 65 2d 73 65 74 21 20 6c 62 6c 20 22 ibute-set! lbl "
40e0: 46 47 43 4f 4c 4f 52 22 20 28 69 66 20 28 68 61 FGCOLOR" (if (ha
40f0: 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 sh-table-ref/def
4100: 61 75 6c 74 20 2a 63 6f 6c 6c 61 70 73 65 64 2a ault *collapsed*
4110: 20 6e 65 77 76 61 6c 20 23 66 29 20 22 30 20 31 newval #f) "0 1
4120: 31 32 20 31 31 32 22 20 22 30 20 30 20 30 22 29 12 112" "0 0 0")
4130: 29 0a 09 28 69 66 20 28 3c 20 69 20 6d 61 78 6e )..(if (< i maxn
4140: 29 0a 09 20 20 20 20 28 6c 6f 6f 70 20 28 2b 20 ).. (loop (+
4150: 69 20 31 29 29 29 29 29 29 29 0a 0a 3b 3b 20 0a i 1)))))))..;; .
4160: 28 64 65 66 69 6e 65 20 28 67 65 74 2d 69 74 65 (define (get-ite
4170: 6d 69 7a 65 64 2d 74 65 73 74 73 20 74 65 73 74 mized-tests test
4180: 2d 64 61 74 73 29 0a 20 20 28 6c 65 74 20 28 28 -dats). (let ((
4190: 74 6e 61 6d 65 73 20 27 28 29 29 29 0a 20 20 20 tnames '())).
41a0: 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 (for-each (lamb
41b0: 64 61 20 28 74 64 61 74 29 0a 09 09 28 6c 65 74 da (tdat)...(let
41c0: 20 28 28 74 6e 61 6d 65 20 28 76 65 63 74 6f 72 ((tname (vector
41d0: 2d 72 65 66 20 74 64 61 74 20 30 29 29 20 20 3b -ref tdat 0)) ;
41e0: 3b 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 74 ; (db:test-get-t
41f0: 65 73 74 6e 61 6d 65 20 74 64 61 74 29 29 0a 09 estname tdat))..
4200: 09 20 20 20 20 20 20 28 69 70 61 74 68 20 28 76 . (ipath (v
4210: 65 63 74 6f 72 2d 72 65 66 20 74 64 61 74 20 31 ector-ref tdat 1
4220: 29 29 29 20 3b 3b 20 28 64 62 3a 74 65 73 74 2d ))) ;; (db:test-
4230: 67 65 74 2d 69 74 65 6d 2d 70 61 74 68 20 74 64 get-item-path td
4240: 61 74 29 29 29 0a 09 09 20 20 28 69 66 20 28 6e at)))... (if (n
4250: 6f 74 20 28 65 71 75 61 6c 3f 20 69 70 61 74 68 ot (equal? ipath
4260: 20 22 22 29 29 0a 09 09 20 20 20 20 20 20 28 69 ""))... (i
4270: 66 20 28 61 6e 64 20 28 6c 69 73 74 3f 20 74 6e f (and (list? tn
4280: 61 6d 65 73 29 0a 09 09 09 20 20 20 20 20 20 20 ames)....
4290: 28 73 74 72 69 6e 67 3f 20 74 6e 61 6d 65 29 0a (string? tname).
42a0: 09 09 09 20 20 20 20 20 20 20 28 6e 6f 74 20 28 ... (not (
42b0: 6d 65 6d 62 65 72 20 74 6e 61 6d 65 20 74 6e 61 member tname tna
42c0: 6d 65 73 29 29 29 0a 09 09 09 20 20 28 73 65 74 mes))).... (set
42d0: 21 20 74 6e 61 6d 65 73 20 28 61 70 70 65 6e 64 ! tnames (append
42e0: 20 74 6e 61 6d 65 73 20 28 6c 69 73 74 20 74 6e tnames (list tn
42f0: 61 6d 65 29 29 29 29 29 29 29 0a 09 20 20 20 20 ame)))))))..
4300: 20 20 74 65 73 74 2d 64 61 74 73 29 0a 20 20 20 test-dats).
4310: 20 74 6e 61 6d 65 73 29 29 0a 0a 3b 3b 20 42 75 tnames))..;; Bu
4320: 62 62 6c 65 20 75 70 20 74 68 65 20 74 6f 70 20 bble up the top
4330: 74 65 73 74 73 20 74 6f 20 61 62 6f 76 65 20 74 tests to above t
4340: 68 65 20 69 74 65 6d 73 2c 20 63 6f 6c 6c 65 63 he items, collec
4350: 74 20 74 68 65 20 69 74 65 6d 73 20 75 6e 64 65 t the items unde
4360: 72 6e 65 61 74 68 0a 3b 3b 20 61 6c 6c 20 77 68 rneath.;; all wh
4370: 69 6c 65 20 70 72 65 73 65 72 76 69 6e 67 20 74 ile preserving t
4380: 68 65 20 73 6f 72 74 20 6f 72 64 65 72 20 66 72 he sort order fr
4390: 6f 6d 20 74 68 65 20 53 51 4c 20 71 75 65 72 79 om the SQL query
43a0: 20 61 73 20 62 65 73 74 20 61 73 20 70 6f 73 73 as best as poss
43b0: 69 62 6c 65 2e 0a 3b 3b 0a 28 64 65 66 69 6e 65 ible..;;.(define
43c0: 20 28 62 75 62 62 6c 65 2d 75 70 20 74 65 73 74 (bubble-up test
43d0: 2d 64 61 74 73 20 23 21 6b 65 79 20 28 70 72 69 -dats #!key (pri
43e0: 6f 72 69 74 79 20 27 69 74 65 6d 70 61 74 68 29 ority 'itempath)
43f0: 29 0a 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 74 ). (if (null? t
4400: 65 73 74 2d 64 61 74 73 29 0a 20 20 20 20 20 20 est-dats).
4410: 74 65 73 74 2d 64 61 74 73 0a 20 20 20 20 20 20 test-dats.
4420: 28 62 65 67 69 6e 0a 09 28 6c 65 74 2a 20 28 28 (begin..(let* ((
4430: 74 6e 61 6d 65 73 20 20 20 27 28 29 29 20 20 20 tnames '())
4440: 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 ;;
4450: 6c 69 73 74 20 6f 66 20 6e 61 6d 65 73 20 75 73 list of names us
4460: 65 64 20 74 6f 20 72 65 73 65 72 76 65 20 6f 72 ed to reserve or
4470: 64 65 72 0a 09 20 20 20 20 20 20 20 28 74 65 73 der.. (tes
4480: 74 73 20 20 20 20 28 6d 61 6b 65 2d 68 61 73 68 ts (make-hash
4490: 2d 74 61 62 6c 65 29 29 20 20 3b 3b 20 68 61 73 -table)) ;; has
44a0: 68 20 6f 66 20 6c 69 73 74 73 2c 20 75 73 65 64 h of lists, used
44b0: 20 74 6f 20 62 75 69 6c 64 20 61 73 20 77 65 20 to build as we
44c0: 67 6f 0a 09 20 20 20 20 20 20 20 28 69 74 65 6d go.. (item
44d0: 69 7a 65 64 20 28 67 65 74 2d 69 74 65 6d 69 7a ized (get-itemiz
44e0: 65 64 2d 74 65 73 74 73 20 74 65 73 74 2d 64 61 ed-tests test-da
44f0: 74 73 29 29 29 0a 09 20 20 28 66 6f 72 2d 65 61 ts))).. (for-ea
4500: 63 68 20 0a 09 20 20 20 28 6c 61 6d 62 64 61 20 ch .. (lambda
4510: 28 74 65 73 74 64 61 74 29 0a 09 20 20 20 20 20 (testdat)..
4520: 28 6c 65 74 2a 20 28 28 74 6e 61 6d 65 20 28 76 (let* ((tname (v
4530: 65 63 74 6f 72 2d 72 65 66 20 74 65 73 74 64 61 ector-ref testda
4540: 74 20 30 29 29 20 20 3b 3b 20 64 62 3a 74 65 73 t 0)) ;; db:tes
4550: 74 2d 67 65 74 2d 74 65 73 74 6e 61 6d 65 20 74 t-get-testname t
4560: 65 73 74 64 61 74 29 29 0a 09 09 20 20 20 20 28 estdat))... (
4570: 69 70 61 74 68 20 28 76 65 63 74 6f 72 2d 72 65 ipath (vector-re
4580: 66 20 74 65 73 74 64 61 74 20 31 29 29 29 20 3b f testdat 1))) ;
4590: 3b 20 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 74 ; db:test-get-it
45a0: 65 6d 2d 70 61 74 68 20 74 65 73 74 64 61 74 29 em-path testdat)
45b0: 29 29 0a 09 20 20 20 20 20 20 20 3b 3b 20 20 20 )).. ;;
45c0: 28 73 65 65 6e 20 20 28 68 61 73 68 2d 74 61 62 (seen (hash-tab
45d0: 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 74 le-ref/default t
45e0: 65 73 74 73 20 74 6e 61 6d 65 20 23 66 29 29 29 ests tname #f)))
45f0: 0a 09 20 20 20 20 20 20 20 28 69 66 20 28 6e 6f .. (if (no
4600: 74 20 28 6d 65 6d 62 65 72 20 74 6e 61 6d 65 20 t (member tname
4610: 74 6e 61 6d 65 73 29 29 0a 09 09 20 20 20 28 69 tnames))... (i
4620: 66 20 28 6f 72 20 28 61 6e 64 20 28 65 71 3f 20 f (or (and (eq?
4630: 70 72 69 6f 72 69 74 79 20 27 69 74 65 6d 70 61 priority 'itempa
4640: 74 68 29 0a 09 09 09 09 28 6e 6f 74 20 28 65 71 th).....(not (eq
4650: 75 61 6c 3f 20 69 70 61 74 68 20 22 22 29 29 29 ual? ipath "")))
4660: 0a 09 09 09 20 20 20 28 61 6e 64 20 28 65 71 3f .... (and (eq?
4670: 20 70 72 69 6f 72 69 74 79 20 27 74 65 73 74 6e priority 'testn
4680: 61 6d 65 29 0a 09 09 09 09 28 65 71 75 61 6c 3f ame).....(equal?
4690: 20 69 70 61 74 68 20 22 22 29 29 0a 09 09 09 20 ipath ""))....
46a0: 20 20 28 6e 6f 74 20 28 6d 65 6d 62 65 72 20 74 (not (member t
46b0: 6e 61 6d 65 20 69 74 65 6d 69 7a 65 64 29 29 29 name itemized)))
46c0: 0a 09 09 20 20 20 20 20 20 20 28 73 65 74 21 20 ... (set!
46d0: 74 6e 61 6d 65 73 20 28 61 70 70 65 6e 64 20 74 tnames (append t
46e0: 6e 61 6d 65 73 20 28 6c 69 73 74 20 74 6e 61 6d names (list tnam
46f0: 65 29 29 29 29 29 0a 09 20 20 20 20 20 20 20 28 e))))).. (
4700: 69 66 20 28 65 71 75 61 6c 3f 20 69 70 61 74 68 if (equal? ipath
4710: 20 22 22 29 0a 09 09 20 20 20 3b 3b 20 54 68 69 "")... ;; Thi
4720: 73 20 61 20 74 6f 70 20 6c 65 76 65 6c 2c 20 70 s a top level, p
4730: 72 65 70 65 6e 64 20 69 74 0a 09 09 20 20 20 28 repend it... (
4740: 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 hash-table-set!
4750: 74 65 73 74 73 20 74 6e 61 6d 65 20 28 63 6f 6e tests tname (con
4760: 73 20 74 65 73 74 64 61 74 20 28 68 61 73 68 2d s testdat (hash-
4770: 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c table-ref/defaul
4780: 74 20 74 65 73 74 73 20 74 6e 61 6d 65 20 27 28 t tests tname '(
4790: 29 29 29 29 0a 09 09 20 20 20 3b 3b 20 54 68 69 ))))... ;; Thi
47a0: 73 20 69 73 20 69 74 65 6d 2c 20 61 70 70 65 6e s is item, appen
47b0: 64 20 69 74 0a 09 09 20 20 20 28 68 61 73 68 2d d it... (hash-
47c0: 74 61 62 6c 65 2d 73 65 74 21 20 74 65 73 74 73 table-set! tests
47d0: 20 74 6e 61 6d 65 20 28 61 70 70 65 6e 64 20 28 tname (append (
47e0: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 hash-table-ref/d
47f0: 65 66 61 75 6c 74 20 74 65 73 74 73 20 74 6e 61 efault tests tna
4800: 6d 65 20 27 28 29 29 28 6c 69 73 74 20 74 65 73 me '())(list tes
4810: 74 64 61 74 29 29 29 29 29 29 0a 09 20 20 20 74 tdat)))))).. t
4820: 65 73 74 2d 64 61 74 73 29 0a 09 20 20 3b 3b 20 est-dats).. ;;
4830: 53 65 74 20 61 6c 6c 20 74 65 73 74 73 20 77 69 Set all tests wi
4840: 74 68 20 69 74 65 6d 73 20 0a 09 20 20 28 64 3a th items .. (d:
4850: 61 6c 6c 64 61 74 2d 69 74 65 6d 2d 74 65 73 74 alldat-item-test
4860: 2d 6e 61 6d 65 73 2d 73 65 74 21 20 2a 61 6c 6c -names-set! *all
4870: 64 61 74 2a 20 28 61 70 70 65 6e 64 20 28 69 66 dat* (append (if
4880: 20 28 6e 75 6c 6c 3f 20 74 6e 61 6d 65 73 29 0a (null? tnames).
4890: 09 09 09 09 09 09 09 20 20 20 20 20 20 27 28 29 ....... '()
48a0: 0a 09 09 09 09 09 09 09 20 20 20 20 20 20 28 66 ........ (f
48b0: 69 6c 74 65 72 20 28 6c 61 6d 62 64 61 20 28 74 ilter (lambda (t
48c0: 6e 61 6d 65 29 0a 09 09 09 09 09 09 09 09 09 28 name)..........(
48d0: 6c 65 74 20 28 28 74 6c 73 74 20 28 68 61 73 68 let ((tlst (hash
48e0: 2d 74 61 62 6c 65 2d 72 65 66 20 74 65 73 74 73 -table-ref tests
48f0: 20 74 6e 61 6d 65 29 29 29 0a 09 09 09 09 09 09 tname))).......
4900: 09 09 09 20 20 28 61 6e 64 20 28 6c 69 73 74 20 ... (and (list
4910: 74 6c 73 74 29 0a 09 09 09 09 09 09 09 09 09 20 tlst)..........
4920: 20 20 20 20 20 20 28 3e 20 28 6c 65 6e 67 74 68 (> (length
4930: 20 74 6c 73 74 29 20 31 29 29 29 29 0a 09 09 09 tlst) 1))))....
4940: 09 09 09 09 09 20 20 20 20 20 20 74 6e 61 6d 65 ..... tname
4950: 73 29 29 0a 09 09 09 09 09 09 09 20 20 28 64 3a s))........ (d:
4960: 61 6c 6c 64 61 74 2d 69 74 65 6d 2d 74 65 73 74 alldat-item-test
4970: 2d 6e 61 6d 65 73 20 2a 61 6c 6c 64 61 74 2a 29 -names *alldat*)
4980: 29 29 0a 09 20 20 28 6c 65 74 20 6c 6f 6f 70 20 )).. (let loop
4990: 28 28 68 65 64 20 28 63 61 72 20 74 6e 61 6d 65 ((hed (car tname
49a0: 73 29 29 0a 09 09 20 20 20 20 20 28 74 61 6c 20 s))... (tal
49b0: 28 63 64 72 20 74 6e 61 6d 65 73 29 29 0a 09 09 (cdr tnames))...
49c0: 20 20 20 20 20 28 72 65 73 20 27 28 29 29 29 0a (res '())).
49d0: 09 20 20 20 20 28 6c 65 74 20 28 28 6e 65 77 72 . (let ((newr
49e0: 65 73 20 28 61 70 70 65 6e 64 20 72 65 73 20 28 es (append res (
49f0: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 74 hash-table-ref t
4a00: 65 73 74 73 20 68 65 64 29 29 29 29 0a 09 20 20 ests hed))))..
4a10: 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 74 (if (null? t
4a20: 61 6c 29 0a 09 09 20 20 6e 65 77 72 65 73 0a 09 al)... newres..
4a30: 09 20 20 28 6c 6f 6f 70 20 28 63 61 72 20 74 61 . (loop (car ta
4a40: 6c 29 28 63 64 72 20 74 61 6c 29 20 6e 65 77 72 l)(cdr tal) newr
4a50: 65 73 29 29 29 29 29 29 29 29 0a 0a 28 64 65 66 es))))))))..(def
4a60: 69 6e 65 20 28 75 70 64 61 74 65 2d 62 75 74 74 ine (update-butt
4a70: 6f 6e 73 20 75 69 64 61 74 20 6e 75 6d 72 75 6e ons uidat numrun
4a80: 73 20 6e 75 6d 74 65 73 74 73 29 0a 20 20 28 6c s numtests). (l
4a90: 65 74 2a 20 28 28 72 75 6e 73 20 20 20 20 20 20 et* ((runs
4aa0: 20 20 28 69 66 20 28 3e 20 28 6c 65 6e 67 74 68 (if (> (length
4ab0: 20 28 64 3a 61 6c 6c 64 61 74 2d 61 6c 6c 72 75 (d:alldat-allru
4ac0: 6e 73 20 2a 61 6c 6c 64 61 74 2a 29 29 20 6e 75 ns *alldat*)) nu
4ad0: 6d 72 75 6e 73 29 0a 09 09 09 20 20 28 74 61 6b mruns).... (tak
4ae0: 65 2d 72 69 67 68 74 20 28 64 3a 61 6c 6c 64 61 e-right (d:allda
4af0: 74 2d 61 6c 6c 72 75 6e 73 20 2a 61 6c 6c 64 61 t-allruns *allda
4b00: 74 2a 29 20 6e 75 6d 72 75 6e 73 29 0a 09 09 09 t*) numruns)....
4b10: 20 20 28 70 61 64 2d 6c 69 73 74 20 28 64 3a 61 (pad-list (d:a
4b20: 6c 6c 64 61 74 2d 61 6c 6c 72 75 6e 73 20 2a 61 lldat-allruns *a
4b30: 6c 6c 64 61 74 2a 29 20 6e 75 6d 72 75 6e 73 29 lldat*) numruns)
4b40: 29 29 0a 09 20 28 6c 66 74 63 6f 6c 20 20 20 20 )).. (lftcol
4b50: 20 20 28 64 62 6f 61 72 64 3a 75 69 64 61 74 2d (dboard:uidat-
4b60: 67 65 74 2d 6c 66 74 63 6f 6c 20 75 69 64 61 74 get-lftcol uidat
4b70: 29 29 0a 09 20 28 74 61 62 6c 65 68 65 61 64 65 )).. (tableheade
4b80: 72 20 28 64 62 6f 61 72 64 3a 75 69 64 61 74 2d r (dboard:uidat-
4b90: 67 65 74 2d 68 65 61 64 65 72 20 75 69 64 61 74 get-header uidat
4ba0: 29 29 0a 09 20 28 74 61 62 6c 65 20 20 20 20 20 )).. (table
4bb0: 20 20 28 64 62 6f 61 72 64 3a 75 69 64 61 74 2d (dboard:uidat-
4bc0: 67 65 74 2d 72 75 6e 73 76 65 63 20 75 69 64 61 get-runsvec uida
4bd0: 74 29 29 0a 09 20 28 63 6f 6c 6e 20 20 20 20 20 t)).. (coln
4be0: 20 20 20 30 29 29 0a 20 20 20 20 28 73 65 74 21 0)). (set!
4bf0: 20 2a 61 6c 6c 74 65 73 74 6e 61 6d 65 6c 73 74 *alltestnamelst
4c00: 2a 20 27 28 29 29 0a 20 20 20 20 3b 3b 20 63 72 * '()). ;; cr
4c10: 65 61 74 65 20 61 20 63 6f 6e 63 69 73 65 20 6c eate a concise l
4c20: 69 73 74 20 6f 66 20 74 65 73 74 20 6e 61 6d 65 ist of test name
4c30: 73 0a 20 20 20 20 28 66 6f 72 2d 65 61 63 68 0a s. (for-each.
4c40: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 72 75 (lambda (ru
4c50: 6e 64 61 74 29 0a 20 20 20 20 20 20 20 28 69 66 ndat). (if
4c60: 20 28 76 65 63 74 6f 72 3f 20 72 75 6e 64 61 74 (vector? rundat
4c70: 29 0a 09 20 20 20 28 6c 65 74 2a 20 28 28 74 65 ).. (let* ((te
4c80: 73 74 64 61 74 20 20 20 28 76 65 63 74 6f 72 2d stdat (vector-
4c90: 72 65 66 20 72 75 6e 64 61 74 20 31 29 29 0a 09 ref rundat 1))..
4ca0: 09 20 20 28 74 65 73 74 6e 61 6d 65 73 20 28 6d . (testnames (m
4cb0: 61 70 20 74 65 73 74 3a 74 65 73 74 2d 67 65 74 ap test:test-get
4cc0: 2d 66 75 6c 6c 6e 61 6d 65 20 74 65 73 74 64 61 -fullname testda
4cd0: 74 29 29 29 0a 09 20 20 20 20 20 28 69 66 20 28 t))).. (if (
4ce0: 6e 6f 74 20 28 61 6e 64 20 28 64 3a 61 6c 6c 64 not (and (d:alld
4cf0: 61 74 2d 68 69 64 65 2d 65 6d 70 74 79 2d 72 75 at-hide-empty-ru
4d00: 6e 73 20 2a 61 6c 6c 64 61 74 2a 29 0a 09 09 09 ns *alldat*)....
4d10: 20 20 20 28 6e 75 6c 6c 3f 20 74 65 73 74 6e 61 (null? testna
4d20: 6d 65 73 29 29 29 0a 09 09 20 28 66 6f 72 2d 65 mes)))... (for-e
4d30: 61 63 68 20 28 6c 61 6d 62 64 61 20 28 74 65 73 ach (lambda (tes
4d40: 74 6e 61 6d 65 29 0a 09 09 09 20 20 20 20 20 28 tname).... (
4d50: 69 66 20 28 6e 6f 74 20 28 6d 65 6d 62 65 72 20 if (not (member
4d60: 74 65 73 74 6e 61 6d 65 20 2a 61 6c 6c 74 65 73 testname *alltes
4d70: 74 6e 61 6d 65 6c 73 74 2a 29 29 0a 09 09 09 09 tnamelst*)).....
4d80: 20 28 62 65 67 69 6e 0a 09 09 09 09 20 20 20 28 (begin..... (
4d90: 73 65 74 21 20 2a 61 6c 6c 74 65 73 74 6e 61 6d set! *alltestnam
4da0: 65 6c 73 74 2a 20 28 61 70 70 65 6e 64 20 2a 61 elst* (append *a
4db0: 6c 6c 74 65 73 74 6e 61 6d 65 6c 73 74 2a 20 28 lltestnamelst* (
4dc0: 6c 69 73 74 20 74 65 73 74 6e 61 6d 65 29 29 29 list testname)))
4dd0: 29 29 29 0a 09 09 09 20 20 20 74 65 73 74 6e 61 ))).... testna
4de0: 6d 65 73 29 29 29 29 29 0a 20 20 20 20 20 72 75 mes))))). ru
4df0: 6e 73 29 0a 0a 20 20 20 20 28 73 65 74 21 20 2a ns).. (set! *
4e00: 61 6c 6c 74 65 73 74 6e 61 6d 65 6c 73 74 2a 20 alltestnamelst*
4e10: 28 63 6f 6c 6c 61 70 73 65 2d 72 6f 77 73 20 2a (collapse-rows *
4e20: 61 6c 6c 74 65 73 74 6e 61 6d 65 6c 73 74 2a 29 alltestnamelst*)
4e30: 29 20 3b 3b 3b 20 61 72 67 68 2e 20 70 6c 65 61 ) ;;; argh. plea
4e40: 73 65 20 63 6c 65 61 6e 20 75 70 20 74 68 69 73 se clean up this
4e50: 20 73 69 6c 6c 79 6e 65 73 73 0a 20 20 20 20 28 sillyness. (
4e60: 73 65 74 21 20 2a 61 6c 6c 74 65 73 74 6e 61 6d set! *alltestnam
4e70: 65 6c 73 74 2a 20 28 6c 65 74 20 28 28 78 6c 20 elst* (let ((xl
4e80: 28 69 66 20 28 3e 20 28 6c 65 6e 67 74 68 20 2a (if (> (length *
4e90: 61 6c 6c 74 65 73 74 6e 61 6d 65 6c 73 74 2a 29 alltestnamelst*)
4ea0: 20 28 64 3a 61 6c 6c 64 61 74 2d 73 74 61 72 74 (d:alldat-start
4eb0: 2d 74 65 73 74 2d 6f 66 66 73 65 74 20 2a 61 6c -test-offset *al
4ec0: 6c 64 61 74 2a 29 29 0a 09 09 09 09 09 20 28 64 ldat*))...... (d
4ed0: 72 6f 70 20 2a 61 6c 6c 74 65 73 74 6e 61 6d 65 rop *alltestname
4ee0: 6c 73 74 2a 20 28 64 3a 61 6c 6c 64 61 74 2d 73 lst* (d:alldat-s
4ef0: 74 61 72 74 2d 74 65 73 74 2d 6f 66 66 73 65 74 tart-test-offset
4f00: 20 2a 61 6c 6c 64 61 74 2a 29 29 0a 09 09 09 09 *alldat*)).....
4f10: 09 20 27 28 29 29 29 29 0a 09 09 09 20 20 20 20 . '())))....
4f20: 20 28 61 70 70 65 6e 64 20 78 6c 20 28 6d 61 6b (append xl (mak
4f30: 65 2d 6c 69 73 74 20 28 2d 20 28 64 3a 61 6c 6c e-list (- (d:all
4f40: 64 61 74 2d 6e 75 6d 2d 74 65 73 74 73 20 2a 61 dat-num-tests *a
4f50: 6c 6c 64 61 74 2a 29 20 28 6c 65 6e 67 74 68 20 lldat*) (length
4f60: 78 6c 29 29 20 22 22 29 29 29 29 0a 20 20 20 20 xl)) "")))).
4f70: 28 75 70 64 61 74 65 2d 6c 61 62 65 6c 73 20 75 (update-labels u
4f80: 69 64 61 74 29 0a 20 20 20 20 28 66 6f 72 2d 65 idat). (for-e
4f90: 61 63 68 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 ach. (lambda
4fa0: 20 28 72 75 6e 64 61 74 29 0a 20 20 20 20 20 20 (rundat).
4fb0: 20 28 69 66 20 28 6e 6f 74 20 72 75 6e 64 61 74 (if (not rundat
4fc0: 29 20 3b 3b 20 68 61 6e 64 6c 65 20 70 61 64 64 ) ;; handle padd
4fd0: 65 64 20 72 75 6e 73 0a 09 20 20 20 3b 3b 20 20 ed runs.. ;;
4fe0: 20 20 20 20 20 20 20 20 20 3b 3b 20 69 64 20 72 ;; id r
4ff0: 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 20 73 un-id testname s
5000: 74 61 74 65 20 73 74 61 74 75 73 20 65 76 65 6e tate status even
5010: 74 2d 74 69 6d 65 20 68 6f 73 74 20 63 70 75 6c t-time host cpul
5020: 6f 61 64 20 64 69 73 6b 66 72 65 65 20 75 6e 61 oad diskfree una
5030: 6d 65 20 72 75 6e 64 69 72 20 69 74 65 6d 2d 70 me rundir item-p
5040: 61 74 68 20 72 75 6e 2d 64 75 72 61 74 69 6f 6e ath run-duration
5050: 0a 09 20 20 20 28 73 65 74 21 20 72 75 6e 64 61 .. (set! runda
5060: 74 20 28 76 65 63 74 6f 72 20 28 6d 61 6b 65 2d t (vector (make-
5070: 76 65 63 74 6f 72 20 32 30 20 23 66 29 20 27 28 vector 20 #f) '(
5080: 29 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 ) (map (lambda (
5090: 78 29 20 22 22 29 20 28 64 3a 61 6c 6c 64 61 74 x) "") (d:alldat
50a0: 2d 6b 65 79 73 20 2a 61 6c 6c 64 61 74 2a 29 29 -keys *alldat*))
50b0: 29 29 29 3b 3b 20 33 29 29 29 0a 20 20 20 20 20 )));; 3))).
50c0: 20 20 28 6c 65 74 2a 20 28 28 72 75 6e 20 20 20 (let* ((run
50d0: 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 72 (vector-ref r
50e0: 75 6e 64 61 74 20 30 29 29 0a 09 20 20 20 20 20 undat 0))..
50f0: 20 28 74 65 73 74 73 64 61 74 20 28 76 65 63 74 (testsdat (vect
5100: 6f 72 2d 72 65 66 20 72 75 6e 64 61 74 20 31 29 or-ref rundat 1)
5110: 29 0a 09 20 20 20 20 20 20 28 6b 65 79 2d 76 61 ).. (key-va
5120: 6c 2d 64 61 74 20 28 76 65 63 74 6f 72 2d 72 65 l-dat (vector-re
5130: 66 20 72 75 6e 64 61 74 20 32 29 29 0a 09 20 20 f rundat 2))..
5140: 20 20 20 20 28 72 75 6e 2d 69 64 20 20 20 28 64 (run-id (d
5150: 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 b:get-value-by-h
5160: 65 61 64 65 72 20 72 75 6e 20 28 64 3a 61 6c 6c eader run (d:all
5170: 64 61 74 2d 68 65 61 64 65 72 20 2a 61 6c 6c 64 dat-header *alld
5180: 61 74 2a 29 20 22 69 64 22 29 29 0a 09 20 20 20 at*) "id"))..
5190: 20 20 20 28 6b 65 79 2d 76 61 6c 73 20 28 61 70 (key-vals (ap
51a0: 70 65 6e 64 20 6b 65 79 2d 76 61 6c 2d 64 61 74 pend key-val-dat
51b0: 0a 09 09 09 09 28 6c 69 73 74 20 28 6c 65 74 20 .....(list (let
51c0: 28 28 78 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 ((x (db:get-valu
51d0: 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 6e 20 e-by-header run
51e0: 28 64 3a 61 6c 6c 64 61 74 2d 68 65 61 64 65 72 (d:alldat-header
51f0: 20 2a 61 6c 6c 64 61 74 2a 29 20 22 72 75 6e 6e *alldat*) "runn
5200: 61 6d 65 22 29 29 29 0a 09 09 09 09 09 28 69 66 ame")))......(if
5210: 20 78 20 78 20 22 22 29 29 29 29 29 0a 09 20 20 x x "")))))..
5220: 20 20 20 20 28 72 75 6e 2d 6b 65 79 20 20 28 73 (run-key (s
5230: 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 tring-interspers
5240: 65 20 6b 65 79 2d 76 61 6c 73 20 22 5c 6e 22 29 e key-vals "\n")
5250: 29 29 0a 09 20 0a 09 20 3b 3b 20 66 69 6c 6c 20 )).. .. ;; fill
5260: 69 6e 20 74 68 65 20 72 75 6e 20 68 65 61 64 65 in the run heade
5270: 72 20 6b 65 79 20 76 61 6c 75 65 73 0a 09 20 28 r key values.. (
5280: 6c 65 74 20 28 28 72 6f 77 6e 20 20 20 20 20 20 let ((rown
5290: 30 29 0a 09 20 20 20 20 20 20 20 28 68 65 61 64 0).. (head
52a0: 65 72 63 6f 6c 20 28 76 65 63 74 6f 72 2d 72 65 ercol (vector-re
52b0: 66 20 74 61 62 6c 65 68 65 61 64 65 72 20 63 6f f tableheader co
52c0: 6c 6e 29 29 29 0a 09 20 20 20 28 66 6f 72 2d 65 ln))).. (for-e
52d0: 61 63 68 20 28 6c 61 6d 62 64 61 20 28 6b 76 61 ach (lambda (kva
52e0: 6c 29 0a 09 09 20 20 20 20 20 20 20 28 6c 65 74 l)... (let
52f0: 2a 20 28 28 6c 61 62 6c 20 20 20 20 20 20 28 76 * ((labl (v
5300: 65 63 74 6f 72 2d 72 65 66 20 68 65 61 64 65 72 ector-ref header
5310: 63 6f 6c 20 72 6f 77 6e 29 29 29 0a 09 09 09 20 col rown)))....
5320: 28 69 66 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f (if (not (equal?
5330: 20 6b 76 61 6c 20 28 69 75 70 3a 61 74 74 72 69 kval (iup:attri
5340: 62 75 74 65 20 6c 61 62 6c 20 22 54 49 54 4c 45 bute labl "TITLE
5350: 22 29 29 29 0a 09 09 09 20 20 20 20 20 28 69 75 "))).... (iu
5360: 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 p:attribute-set!
5370: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 68 65 61 (vector-ref hea
5380: 64 65 72 63 6f 6c 20 72 6f 77 6e 29 20 22 54 49 dercol rown) "TI
5390: 54 4c 45 22 20 6b 76 61 6c 29 29 0a 09 09 09 20 TLE" kval))....
53a0: 28 73 65 74 21 20 72 6f 77 6e 20 28 2b 20 72 6f (set! rown (+ ro
53b0: 77 6e 20 31 29 29 29 29 0a 09 09 20 20 20 20 20 wn 1))))...
53c0: 6b 65 79 2d 76 61 6c 73 29 29 0a 09 20 0a 09 20 key-vals)).. ..
53d0: 3b 3b 20 46 6f 72 20 74 68 69 73 20 72 75 6e 20 ;; For this run
53e0: 6e 6f 77 20 66 69 6c 6c 20 69 6e 20 74 68 65 20 now fill in the
53f0: 62 75 74 74 6f 6e 73 20 66 6f 72 20 65 61 63 68 buttons for each
5400: 20 74 65 73 74 0a 09 20 28 6c 65 74 20 28 28 72 test.. (let ((r
5410: 6f 77 6e 20 30 29 0a 09 20 20 20 20 20 20 20 28 own 0).. (
5420: 63 6f 6c 75 6d 6e 64 61 74 20 20 28 76 65 63 74 columndat (vect
5430: 6f 72 2d 72 65 66 20 74 61 62 6c 65 20 63 6f 6c or-ref table col
5440: 6e 29 29 29 0a 09 20 20 20 28 66 6f 72 2d 65 61 n))).. (for-ea
5450: 63 68 0a 09 20 20 20 20 28 6c 61 6d 62 64 61 20 ch.. (lambda
5460: 28 74 65 73 74 6e 61 6d 65 29 0a 09 20 20 20 20 (testname)..
5470: 20 20 28 6c 65 74 20 28 28 62 75 74 74 6f 6e 64 (let ((buttond
5480: 61 74 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d at (hash-table-
5490: 72 65 66 2f 64 65 66 61 75 6c 74 20 28 64 3a 61 ref/default (d:a
54a0: 6c 6c 64 61 74 2d 62 75 74 74 6f 6e 64 61 74 20 lldat-buttondat
54b0: 2a 61 6c 6c 64 61 74 2a 29 20 28 6d 6b 73 74 72 *alldat*) (mkstr
54c0: 20 63 6f 6c 6e 20 72 6f 77 6e 29 20 23 66 29 29 coln rown) #f))
54d0: 29 0a 09 09 28 69 66 20 62 75 74 74 6f 6e 64 61 )...(if buttonda
54e0: 74 0a 09 09 20 20 20 20 28 6c 65 74 2a 20 28 28 t... (let* ((
54f0: 74 65 73 74 20 20 20 20 20 20 20 28 6c 65 74 20 test (let
5500: 28 28 6d 61 74 63 68 69 6e 67 20 28 66 69 6c 74 ((matching (filt
5510: 65 72 20 0a 09 09 09 09 09 09 09 28 6c 61 6d 62 er ........(lamb
5520: 64 61 20 28 78 29 28 65 71 75 61 6c 3f 20 28 74 da (x)(equal? (t
5530: 65 73 74 3a 74 65 73 74 2d 67 65 74 2d 66 75 6c est:test-get-ful
5540: 6c 6e 61 6d 65 20 78 29 20 74 65 73 74 6e 61 6d lname x) testnam
5550: 65 29 29 0a 09 09 09 09 09 09 09 74 65 73 74 73 e))........tests
5560: 64 61 74 29 29 29 0a 09 09 09 09 09 20 28 69 66 dat)))...... (if
5570: 20 28 6e 75 6c 6c 3f 20 6d 61 74 63 68 69 6e 67 (null? matching
5580: 29 0a 09 09 09 09 09 20 20 20 20 20 28 76 65 63 )...... (vec
5590: 74 6f 72 20 2d 31 20 2d 31 20 22 22 20 22 22 20 tor -1 -1 "" ""
55a0: 22 22 20 30 20 22 22 20 22 22 20 30 20 22 22 20 "" 0 "" "" 0 ""
55b0: 22 22 20 22 22 20 30 20 22 22 20 22 22 29 0a 09 "" "" 0 "" "")..
55c0: 09 09 09 09 20 20 20 20 20 28 63 61 72 20 6d 61 .... (car ma
55d0: 74 63 68 69 6e 67 29 29 29 29 0a 09 09 09 20 20 tching))))....
55e0: 20 28 74 65 73 74 6e 61 6d 65 20 20 20 28 64 62 (testname (db
55f0: 3a 74 65 73 74 2d 67 65 74 2d 74 65 73 74 6e 61 :test-get-testna
5600: 6d 65 20 20 74 65 73 74 29 29 0a 09 09 09 20 20 me test))....
5610: 20 28 69 74 65 6d 70 61 74 68 20 20 20 28 64 62 (itempath (db
5620: 3a 74 65 73 74 2d 67 65 74 2d 69 74 65 6d 2d 70 :test-get-item-p
5630: 61 74 68 20 74 65 73 74 29 29 0a 09 09 09 20 20 ath test))....
5640: 20 28 74 65 73 74 66 75 6c 6c 6e 61 6d 65 20 28 (testfullname (
5650: 74 65 73 74 3a 74 65 73 74 2d 67 65 74 2d 66 75 test:test-get-fu
5660: 6c 6c 6e 61 6d 65 20 74 65 73 74 29 29 0a 09 09 llname test))...
5670: 09 20 20 20 28 74 65 73 74 73 74 61 74 75 73 20 . (teststatus
5680: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 (db:test-get-sta
5690: 74 75 73 20 20 20 74 65 73 74 29 29 0a 09 09 09 tus test))....
56a0: 20 20 20 28 74 65 73 74 73 74 61 74 65 20 20 28 (teststate (
56b0: 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 db:test-get-stat
56c0: 65 20 20 20 20 74 65 73 74 29 29 0a 09 09 09 20 e test))....
56d0: 20 20 3b 3b 28 74 65 73 74 73 74 61 72 74 20 20 ;;(teststart
56e0: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 65 76 65 (db:test-get-eve
56f0: 6e 74 5f 74 69 6d 65 20 74 65 73 74 29 29 0a 09 nt_time test))..
5700: 09 09 20 20 20 3b 3b 28 72 75 6e 74 69 6d 65 20 .. ;;(runtime
5710: 20 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d (db:test-get-
5720: 72 75 6e 5f 64 75 72 61 74 69 6f 6e 20 74 65 73 run_duration tes
5730: 74 29 29 0a 09 09 09 20 20 20 28 62 75 74 74 6f t)).... (butto
5740: 6e 74 78 74 20 20 28 63 6f 6e 64 0a 09 09 09 09 ntxt (cond.....
5750: 09 28 28 6d 65 6d 62 65 72 20 74 65 73 74 73 74 .((member testst
5760: 61 74 65 20 27 28 22 43 4f 4d 50 4c 45 54 45 44 ate '("COMPLETED
5770: 22 20 22 41 52 43 48 49 56 45 44 22 29 29 20 74 " "ARCHIVED")) t
5780: 65 73 74 73 74 61 74 75 73 29 0a 09 09 09 09 09 eststatus)......
5790: 28 28 61 6e 64 20 28 65 71 75 61 6c 3f 20 74 65 ((and (equal? te
57a0: 73 74 73 74 61 74 65 20 22 4e 4f 54 5f 53 54 41 ststate "NOT_STA
57b0: 52 54 45 44 22 29 0a 09 09 09 09 09 20 20 20 20 RTED")......
57c0: 20 20 28 6d 65 6d 62 65 72 20 74 65 73 74 73 74 (member testst
57d0: 61 74 75 73 20 27 28 22 5a 45 52 4f 5f 49 54 45 atus '("ZERO_ITE
57e0: 4d 53 22 20 22 42 4c 4f 43 4b 45 44 22 20 22 50 MS" "BLOCKED" "P
57f0: 52 45 51 5f 46 41 49 4c 22 20 22 50 52 45 51 5f REQ_FAIL" "PREQ_
5800: 44 49 53 43 41 52 44 45 44 22 20 22 54 49 4d 45 DISCARDED" "TIME
5810: 44 5f 4f 55 54 22 20 22 4b 45 45 50 5f 54 52 59 D_OUT" "KEEP_TRY
5820: 49 4e 47 22 20 22 54 45 4e 5f 53 54 52 49 4b 45 ING" "TEN_STRIKE
5830: 53 22 29 29 29 0a 09 09 09 09 09 20 74 65 73 74 S")))...... test
5840: 73 74 61 74 75 73 29 0a 09 09 09 09 09 28 65 6c status)......(el
5850: 73 65 0a 09 09 09 09 09 20 74 65 73 74 73 74 61 se...... teststa
5860: 74 65 29 29 29 0a 09 09 09 20 20 20 28 62 75 74 te))).... (but
5870: 74 6f 6e 20 20 20 20 20 28 76 65 63 74 6f 72 2d ton (vector-
5880: 72 65 66 20 63 6f 6c 75 6d 6e 64 61 74 20 72 6f ref columndat ro
5890: 77 6e 29 29 0a 09 09 09 20 20 20 28 63 6f 6c 6f wn)).... (colo
58a0: 72 20 20 20 20 20 20 28 63 61 72 20 28 67 75 74 r (car (gut
58b0: 69 6c 73 3a 67 65 74 2d 63 6f 6c 6f 72 2d 66 6f ils:get-color-fo
58c0: 72 2d 73 74 61 74 65 2d 73 74 61 74 75 73 20 74 r-state-status t
58d0: 65 73 74 73 74 61 74 65 20 74 65 73 74 73 74 61 eststate teststa
58e0: 74 75 73 29 29 29 0a 09 09 09 20 20 20 28 63 75 tus))).... (cu
58f0: 72 72 2d 63 6f 6c 6f 72 20 28 76 65 63 74 6f 72 rr-color (vector
5900: 2d 72 65 66 20 62 75 74 74 6f 6e 64 61 74 20 31 -ref buttondat 1
5910: 29 29 20 3b 3b 20 28 69 75 70 3a 61 74 74 72 69 )) ;; (iup:attri
5920: 62 75 74 65 20 62 75 74 74 6f 6e 20 22 42 47 43 bute button "BGC
5930: 4f 4c 4f 52 22 29 29 0a 09 09 09 20 20 20 28 63 OLOR")).... (c
5940: 75 72 72 2d 74 69 74 6c 65 20 28 76 65 63 74 6f urr-title (vecto
5950: 72 2d 72 65 66 20 62 75 74 74 6f 6e 64 61 74 20 r-ref buttondat
5960: 32 29 29 29 20 3b 3b 20 28 69 75 70 3a 61 74 74 2))) ;; (iup:att
5970: 72 69 62 75 74 65 20 62 75 74 74 6f 6e 20 22 54 ribute button "T
5980: 49 54 4c 45 22 29 29 29 0a 09 09 20 20 20 20 20 ITLE")))...
5990: 20 28 69 66 20 28 6e 6f 74 20 28 65 71 75 61 6c (if (not (equal
59a0: 3f 20 63 75 72 72 2d 63 6f 6c 6f 72 20 63 6f 6c ? curr-color col
59b0: 6f 72 29 29 0a 09 09 09 20 20 28 69 75 70 3a 61 or)).... (iup:a
59c0: 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 62 75 ttribute-set! bu
59d0: 74 74 6f 6e 20 22 42 47 43 4f 4c 4f 52 22 20 63 tton "BGCOLOR" c
59e0: 6f 6c 6f 72 29 29 0a 09 09 20 20 20 20 20 20 28 olor))... (
59f0: 69 66 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 if (not (equal?
5a00: 63 75 72 72 2d 74 69 74 6c 65 20 62 75 74 74 6f curr-title butto
5a10: 6e 74 78 74 29 29 0a 09 09 09 20 20 28 69 75 70 ntxt)).... (iup
5a20: 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 :attribute-set!
5a30: 62 75 74 74 6f 6e 20 22 54 49 54 4c 45 22 20 20 button "TITLE"
5a40: 20 62 75 74 74 6f 6e 74 78 74 29 29 0a 09 09 20 buttontxt))...
5a50: 20 20 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 (vector-set
5a60: 21 20 62 75 74 74 6f 6e 64 61 74 20 30 20 72 75 ! buttondat 0 ru
5a70: 6e 2d 69 64 29 0a 09 09 20 20 20 20 20 20 28 76 n-id)... (v
5a80: 65 63 74 6f 72 2d 73 65 74 21 20 62 75 74 74 6f ector-set! butto
5a90: 6e 64 61 74 20 31 20 63 6f 6c 6f 72 29 0a 09 09 ndat 1 color)...
5aa0: 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d 73 65 (vector-se
5ab0: 74 21 20 62 75 74 74 6f 6e 64 61 74 20 32 20 62 t! buttondat 2 b
5ac0: 75 74 74 6f 6e 74 78 74 29 0a 09 09 20 20 20 20 uttontxt)...
5ad0: 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 62 (vector-set! b
5ae0: 75 74 74 6f 6e 64 61 74 20 33 20 74 65 73 74 29 uttondat 3 test)
5af0: 0a 09 09 20 20 20 20 20 20 28 76 65 63 74 6f 72 ... (vector
5b00: 2d 73 65 74 21 20 62 75 74 74 6f 6e 64 61 74 20 -set! buttondat
5b10: 34 20 72 75 6e 2d 6b 65 79 29 29 29 0a 09 09 28 4 run-key)))...(
5b20: 73 65 74 21 20 72 6f 77 6e 20 28 2b 20 72 6f 77 set! rown (+ row
5b30: 6e 20 31 29 29 29 29 0a 09 20 20 20 20 2a 61 6c n 1)))).. *al
5b40: 6c 74 65 73 74 6e 61 6d 65 6c 73 74 2a 29 29 0a ltestnamelst*)).
5b50: 09 20 28 73 65 74 21 20 63 6f 6c 6e 20 28 2b 20 . (set! coln (+
5b60: 63 6f 6c 6e 20 31 29 29 29 29 0a 20 20 20 20 20 coln 1)))).
5b70: 72 75 6e 73 29 29 29 0a 0a 28 64 65 66 69 6e 65 runs)))..(define
5b80: 20 28 6d 6b 73 74 72 20 2e 20 78 29 0a 20 20 28 (mkstr . x). (
5b90: 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 string-intersper
5ba0: 73 65 20 28 6d 61 70 20 63 6f 6e 63 20 78 29 20 se (map conc x)
5bb0: 22 2c 22 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 ","))..(define (
5bc0: 73 65 74 2d 62 67 2d 6f 6e 2d 66 69 6c 74 65 72 set-bg-on-filter
5bd0: 29 0a 20 20 28 6c 65 74 20 28 28 73 65 61 72 63 ). (let ((searc
5be0: 68 2d 63 68 61 6e 67 65 64 20 28 6e 6f 74 20 28 h-changed (not (
5bf0: 6e 75 6c 6c 3f 20 28 66 69 6c 74 65 72 20 28 6c null? (filter (l
5c00: 61 6d 62 64 61 20 28 6b 65 79 29 0a 09 09 09 09 ambda (key).....
5c10: 09 20 20 20 20 20 20 28 6e 6f 74 20 28 65 71 75 . (not (equ
5c20: 61 6c 3f 20 28 68 61 73 68 2d 74 61 62 6c 65 2d al? (hash-table-
5c30: 72 65 66 20 28 64 3a 61 6c 6c 64 61 74 2d 73 65 ref (d:alldat-se
5c40: 61 72 63 68 70 61 74 74 73 20 2a 61 6c 6c 64 61 archpatts *allda
5c50: 74 2a 29 20 6b 65 79 29 20 22 25 22 29 29 29 0a t*) key) "%"))).
5c60: 09 09 09 09 09 20 20 20 20 28 68 61 73 68 2d 74 ..... (hash-t
5c70: 61 62 6c 65 2d 6b 65 79 73 20 28 64 3a 61 6c 6c able-keys (d:all
5c80: 64 61 74 2d 73 65 61 72 63 68 70 61 74 74 73 20 dat-searchpatts
5c90: 2a 61 6c 6c 64 61 74 2a 29 29 29 29 29 29 0a 09 *alldat*))))))..
5ca0: 28 73 74 61 74 65 2d 63 68 61 6e 67 65 64 20 20 (state-changed
5cb0: 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 28 68 61 73 (not (null? (has
5cc0: 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 28 64 3a h-table-keys (d:
5cd0: 61 6c 6c 64 61 74 2d 73 74 61 74 65 2d 69 67 6e alldat-state-ign
5ce0: 6f 72 65 2d 68 61 73 68 20 2a 61 6c 6c 64 61 74 ore-hash *alldat
5cf0: 2a 29 29 29 29 29 0a 09 28 73 74 61 74 75 73 2d *)))))..(status-
5d00: 63 68 61 6e 67 65 64 20 28 6e 6f 74 20 28 6e 75 changed (not (nu
5d10: 6c 6c 3f 20 28 68 61 73 68 2d 74 61 62 6c 65 2d ll? (hash-table-
5d20: 6b 65 79 73 20 28 64 3a 61 6c 6c 64 61 74 2d 73 keys (d:alldat-s
5d30: 74 61 74 75 73 2d 69 67 6e 6f 72 65 2d 68 61 73 tatus-ignore-has
5d40: 68 20 2a 61 6c 6c 64 61 74 2a 29 29 29 29 29 29 h *alldat*))))))
5d50: 0a 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 . (iup:attrib
5d60: 75 74 65 2d 73 65 74 21 20 28 64 3a 61 6c 6c 64 ute-set! (d:alld
5d70: 61 74 2d 68 69 64 65 2d 6e 6f 74 2d 68 69 64 65 at-hide-not-hide
5d80: 2d 74 61 62 73 20 2a 61 6c 6c 64 61 74 2a 29 20 -tabs *alldat*)
5d90: 22 42 47 43 4f 4c 4f 52 22 0a 09 09 09 28 69 66 "BGCOLOR"....(if
5da0: 20 28 6f 72 20 73 65 61 72 63 68 2d 63 68 61 6e (or search-chan
5db0: 67 65 64 0a 09 09 09 09 73 74 61 74 65 2d 63 68 ged.....state-ch
5dc0: 61 6e 67 65 64 0a 09 09 09 09 73 74 61 74 75 73 anged.....status
5dd0: 2d 63 68 61 6e 67 65 64 29 0a 09 09 09 20 20 20 -changed)....
5de0: 20 22 31 39 30 20 31 38 30 20 31 39 30 22 0a 09 "190 180 190"..
5df0: 09 09 20 20 20 20 22 31 39 30 20 31 39 30 20 31 .. "190 190 1
5e00: 39 30 22 0a 09 09 09 20 20 20 20 29 29 0a 20 20 90".... )).
5e10: 20 20 28 64 3a 61 6c 6c 64 61 74 2d 66 69 6c 74 (d:alldat-filt
5e20: 65 72 73 2d 63 68 61 6e 67 65 64 2d 73 65 74 21 ers-changed-set!
5e30: 20 2a 61 6c 6c 64 61 74 2a 20 23 74 29 29 29 0a *alldat* #t))).
5e40: 0a 28 64 65 66 69 6e 65 20 28 75 70 64 61 74 65 .(define (update
5e50: 2d 73 65 61 72 63 68 20 78 20 76 61 6c 29 0a 20 -search x val).
5e60: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 (hash-table-set
5e70: 21 20 28 64 3a 61 6c 6c 64 61 74 2d 73 65 61 72 ! (d:alldat-sear
5e80: 63 68 70 61 74 74 73 20 2a 61 6c 6c 64 61 74 2a chpatts *alldat*
5e90: 29 20 78 20 76 61 6c 29 0a 20 20 28 64 3a 61 6c ) x val). (d:al
5ea0: 6c 64 61 74 2d 66 69 6c 74 65 72 73 2d 63 68 61 ldat-filters-cha
5eb0: 6e 67 65 64 2d 73 65 74 21 20 2a 61 6c 6c 64 61 nged-set! *allda
5ec0: 74 2a 20 23 74 29 0a 20 20 28 73 65 74 2d 62 67 t* #t). (set-bg
5ed0: 2d 6f 6e 2d 66 69 6c 74 65 72 29 29 0a 0a 28 64 -on-filter))..(d
5ee0: 65 66 69 6e 65 20 28 6d 61 72 6b 2d 66 6f 72 2d efine (mark-for-
5ef0: 75 70 64 61 74 65 29 0a 20 20 28 64 3a 61 6c 6c update). (d:all
5f00: 64 61 74 2d 66 69 6c 74 65 72 73 2d 63 68 61 6e dat-filters-chan
5f10: 67 65 64 2d 73 65 74 21 20 2a 61 6c 6c 64 61 74 ged-set! *alldat
5f20: 2a 20 23 74 29 0a 20 20 28 64 3a 61 6c 6c 64 61 * #t). (d:allda
5f30: 74 2d 6c 61 73 74 2d 64 62 2d 75 70 64 61 74 65 t-last-db-update
5f40: 2d 73 65 74 21 20 2a 61 6c 6c 64 61 74 2a 20 30 -set! *alldat* 0
5f50: 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;==========
5f60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5f70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5f80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5f90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
5fa0: 52 20 55 20 4e 20 43 20 4f 20 4e 20 54 20 52 20 R U N C O N T R
5fb0: 4f 20 4c 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d O L.;;==========
5fc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5fd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5fe0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5ff0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b ============..;;
6000: 20 74 61 72 67 65 74 20 70 6f 70 75 6c 61 74 69 target populati
6010: 6e 67 20 6c 6f 67 69 63 0a 3b 3b 20 20 0a 3b 3b ng logic.;; .;;
6020: 20 6c 62 20 20 20 20 20 20 20 20 20 20 20 20 3d lb =
6030: 20 3c 76 65 63 74 6f 72 20 63 75 72 72 2d 6c 61 <vector curr-la
6040: 62 65 6c 2d 6f 62 6a 65 63 74 20 6e 65 78 74 2d bel-object next-
6050: 6c 61 62 65 6c 2d 6f 62 6a 65 63 74 3e 0a 3b 3b label-object>.;;
6060: 20 66 69 65 6c 64 20 20 20 20 20 20 20 20 20 3d field =
6070: 20 74 61 72 67 65 74 20 66 69 65 6c 64 20 6e 61 target field na
6080: 6d 65 20 66 6f 72 20 74 68 69 73 20 64 72 6f 70 me for this drop
6090: 64 6f 77 6e 0a 3b 3b 20 72 65 66 65 72 65 6e 74 down.;; referent
60a0: 2d 76 61 6c 73 20 3d 20 73 65 6c 65 63 74 65 64 -vals = selected
60b0: 20 76 61 6c 75 65 20 69 6e 20 74 68 65 20 6c 65 value in the le
60c0: 66 74 20 64 72 6f 70 64 6f 77 6e 0a 3b 3b 20 74 ft dropdown.;; t
60d0: 61 72 67 65 74 73 20 20 20 20 20 20 20 3d 20 6c argets = l
60e0: 69 73 74 20 6f 66 20 74 61 72 67 65 74 73 20 74 ist of targets t
60f0: 6f 20 75 73 65 20 74 6f 20 62 75 69 6c 64 20 74 o use to build t
6100: 68 65 20 64 72 6f 70 64 6f 77 6e 0a 3b 3b 20 0a he dropdown.;; .
6110: 3b 3b 20 65 61 63 68 20 6e 6f 64 65 20 69 73 20 ;; each node is
6120: 63 68 61 69 6e 65 64 3a 20 6b 65 79 31 20 2d 3e chained: key1 ->
6130: 20 6b 65 79 32 20 2d 3e 20 6b 65 79 33 0a 3b 3b key2 -> key3.;;
6140: 0a 3b 3b 20 6d 75 73 74 20 73 65 6c 65 63 74 20 .;; must select
6150: 76 61 6c 75 65 73 20 66 72 6f 6d 20 6f 6e 6c 79 values from only
6160: 20 61 70 72 6f 70 72 69 61 74 65 20 74 61 72 67 apropriate targ
6170: 65 74 73 0a 3b 3b 20 20 20 61 20 62 20 63 0a 3b ets.;; a b c.;
6180: 3b 20 20 20 61 20 64 20 65 0a 3b 3b 20 20 20 61 ; a d e.;; a
6190: 20 62 20 66 0a 3b 3b 20 20 20 20 20 20 20 20 61 b f.;; a
61a0: 2f 62 20 3d 3e 20 63 20 66 0a 3b 3b 0a 28 64 65 /b => c f.;;.(de
61b0: 66 69 6e 65 20 28 64 61 73 68 62 6f 61 72 64 3a fine (dashboard:
61c0: 70 6f 70 75 6c 61 74 65 2d 74 61 72 67 65 74 2d populate-target-
61d0: 64 72 6f 70 64 6f 77 6e 20 6c 62 20 72 65 66 65 dropdown lb refe
61e0: 72 65 6e 74 2d 76 61 6c 73 20 74 61 72 67 65 74 rent-vals target
61f0: 73 29 20 3b 3b 20 20 72 75 6e 63 6f 6e 66 2d 74 s) ;; runconf-t
6200: 61 72 67 73 29 0a 20 20 3b 3b 20 69 73 20 74 68 args). ;; is th
6210: 65 20 63 75 72 72 65 6e 74 20 76 61 6c 75 65 20 e current value
6220: 69 6e 20 74 68 65 20 6e 65 77 20 6c 69 73 74 3f in the new list?
6230: 20 63 68 6f 6f 73 65 20 6e 65 77 20 64 65 66 61 choose new defa
6240: 75 6c 74 20 69 66 20 6e 6f 74 0a 20 20 28 6c 65 ult if not. (le
6250: 74 2a 20 28 28 72 65 6d 76 61 6c 75 65 73 20 20 t* ((remvalues
6260: 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 72 6f (map (lambda (ro
6270: 77 29 0a 09 09 09 20 20 20 20 28 63 6f 6d 6d 6f w).... (commo
6280: 6e 3a 6c 69 73 74 2d 69 73 2d 73 75 62 6c 69 73 n:list-is-sublis
6290: 74 20 72 65 66 65 72 65 6e 74 2d 76 61 6c 73 20 t referent-vals
62a0: 28 76 65 63 74 6f 72 2d 3e 6c 69 73 74 20 72 6f (vector->list ro
62b0: 77 29 29 29 0a 09 09 09 20 20 74 61 72 67 65 74 w))).... target
62c0: 73 29 29 0a 09 20 28 76 61 6c 75 65 73 20 20 20 s)).. (values
62d0: 20 20 28 64 65 6c 65 74 65 2d 64 75 70 6c 69 63 (delete-duplic
62e0: 61 74 65 73 20 28 6d 61 70 20 63 61 72 20 28 66 ates (map car (f
62f0: 69 6c 74 65 72 20 6c 69 73 74 3f 20 72 65 6d 76 ilter list? remv
6300: 61 6c 75 65 73 29 29 29 29 0a 09 20 28 73 65 6c alues)))).. (sel
6310: 2d 76 61 6c 6e 75 6d 20 28 69 75 70 3a 61 74 74 -valnum (iup:att
6320: 72 69 62 75 74 65 20 6c 62 20 22 56 41 4c 55 45 ribute lb "VALUE
6330: 22 29 29 0a 09 20 28 73 65 6c 2d 76 61 6c 20 20 ")).. (sel-val
6340: 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 (iup:attribute
6350: 20 6c 62 20 73 65 6c 2d 76 61 6c 6e 75 6d 29 29 lb sel-valnum))
6360: 0a 09 20 28 76 61 6c 2d 6e 75 6d 20 20 20 20 31 .. (val-num 1
6370: 29 29 0a 20 20 20 20 3b 3b 20 66 69 72 73 74 20 )). ;; first
6380: 63 68 65 63 6b 20 69 66 20 74 68 65 20 63 75 72 check if the cur
6390: 72 65 6e 74 20 76 61 6c 75 65 20 69 73 20 69 6e rent value is in
63a0: 20 74 68 65 20 6e 65 77 20 6c 69 73 74 2c 20 6f the new list, o
63b0: 74 68 65 72 77 69 73 65 20 72 65 70 6c 61 63 65 therwise replace
63c0: 20 77 69 74 68 20 0a 20 20 20 20 3b 3b 20 66 69 with . ;; fi
63d0: 72 73 74 20 76 61 6c 75 65 20 66 72 6f 6d 20 76 rst value from v
63e0: 61 6c 75 65 73 0a 20 20 20 20 28 69 75 70 3a 61 alues. (iup:a
63f0: 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 6c 62 ttribute-set! lb
6400: 20 22 52 45 4d 4f 56 45 49 54 45 4d 22 20 22 41 "REMOVEITEM" "A
6410: 4c 4c 22 29 0a 20 20 20 20 28 66 6f 72 2d 65 61 LL"). (for-ea
6420: 63 68 20 28 6c 61 6d 62 64 61 20 28 76 61 6c 29 ch (lambda (val)
6430: 0a 09 09 3b 3b 20 28 69 75 70 3a 61 74 74 72 69 ...;; (iup:attri
6440: 62 75 74 65 2d 73 65 74 21 20 6c 62 20 22 41 50 bute-set! lb "AP
6450: 50 45 4e 44 49 54 45 4d 22 20 76 61 6c 29 0a 09 PENDITEM" val)..
6460: 09 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d .(iup:attribute-
6470: 73 65 74 21 20 6c 62 20 28 63 6f 6e 63 20 76 61 set! lb (conc va
6480: 6c 2d 6e 75 6d 29 20 76 61 6c 29 0a 09 09 28 69 l-num) val)...(i
6490: 66 20 28 65 71 75 61 6c 3f 20 73 65 6c 2d 76 61 f (equal? sel-va
64a0: 6c 20 76 61 6c 29 0a 09 09 20 20 20 20 28 69 75 l val)... (iu
64b0: 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 p:attribute-set!
64c0: 20 6c 62 20 22 56 41 4c 55 45 22 20 76 61 6c 2d lb "VALUE" val-
64d0: 6e 75 6d 29 29 0a 09 09 28 73 65 74 21 20 76 61 num))...(set! va
64e0: 6c 2d 6e 75 6d 20 28 2b 20 76 61 6c 2d 6e 75 6d l-num (+ val-num
64f0: 20 31 29 29 29 0a 09 20 20 20 20 20 20 76 61 6c 1))).. val
6500: 75 65 73 29 0a 20 20 20 20 28 6c 65 74 20 28 28 ues). (let ((
6510: 76 61 6c 20 28 69 75 70 3a 61 74 74 72 69 62 75 val (iup:attribu
6520: 74 65 20 6c 62 20 22 56 41 4c 55 45 22 29 29 29 te lb "VALUE")))
6530: 0a 20 20 20 20 20 20 28 69 66 20 76 61 6c 0a 09 . (if val..
6540: 20 20 76 61 6c 0a 09 20 20 28 69 66 20 28 6e 6f val.. (if (no
6550: 74 20 28 6e 75 6c 6c 3f 20 76 61 6c 75 65 73 29 t (null? values)
6560: 29 0a 09 20 20 20 20 20 20 28 6c 65 74 20 28 28 ).. (let ((
6570: 6e 65 77 76 61 6c 20 28 63 61 72 20 76 61 6c 75 newval (car valu
6580: 65 73 29 29 29 0a 09 09 28 69 75 70 3a 61 74 74 es)))...(iup:att
6590: 72 69 62 75 74 65 2d 73 65 74 21 20 6c 62 20 22 ribute-set! lb "
65a0: 56 41 4c 55 45 22 20 6e 65 77 76 61 6c 29 0a 09 VALUE" newval)..
65b0: 09 6e 65 77 76 61 6c 29 29 29 29 29 29 0a 0a 28 .newval))))))..(
65c0: 64 65 66 69 6e 65 20 28 64 61 73 68 62 6f 61 72 define (dashboar
65d0: 64 3a 75 70 64 61 74 65 2d 74 61 72 67 65 74 2d d:update-target-
65e0: 73 65 6c 65 63 74 6f 72 20 6b 65 79 2d 6c 62 73 selector key-lbs
65f0: 20 23 21 6b 65 79 20 28 61 63 74 69 6f 6e 2d 70 #!key (action-p
6600: 72 6f 63 20 23 66 29 29 0a 20 20 28 6c 65 74 2a roc #f)). (let*
6610: 20 28 28 72 75 6e 63 6f 6e 66 2d 74 61 72 67 73 ((runconf-targs
6620: 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 72 75 6e (common:get-run
6630: 63 6f 6e 66 69 67 2d 74 61 72 67 65 74 73 29 29 config-targets))
6640: 0a 09 20 28 64 62 2d 74 61 72 67 65 74 2d 64 61 .. (db-target-da
6650: 74 20 28 69 66 20 28 64 3a 61 6c 6c 64 61 74 2d t (if (d:alldat-
6660: 75 73 65 73 65 72 76 65 72 20 2a 61 6c 6c 64 61 useserver *allda
6670: 74 2a 29 20 0a 09 09 09 20 20 20 20 28 72 6d 74 t*) .... (rmt
6680: 3a 67 65 74 2d 74 61 72 67 65 74 73 29 0a 09 09 :get-targets)...
6690: 09 20 20 20 20 28 64 62 3a 67 65 74 2d 74 61 72 . (db:get-tar
66a0: 67 65 74 73 20 28 64 3a 61 6c 6c 64 61 74 2d 64 gets (d:alldat-d
66b0: 62 6c 6f 63 61 6c 20 2a 61 6c 6c 64 61 74 2a 29 blocal *alldat*)
66c0: 29 29 29 0a 09 20 28 68 65 61 64 65 72 20 20 20 ))).. (header
66d0: 20 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 (vector-ref
66e0: 20 64 62 2d 74 61 72 67 65 74 2d 64 61 74 20 30 db-target-dat 0
66f0: 29 29 0a 09 20 28 64 62 2d 74 61 72 67 65 74 73 )).. (db-targets
6700: 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 (vector-ref
6710: 64 62 2d 74 61 72 67 65 74 2d 64 61 74 20 31 29 db-target-dat 1)
6720: 29 0a 09 20 28 61 6c 6c 2d 74 61 72 67 65 74 73 ).. (all-targets
6730: 20 20 20 28 61 70 70 65 6e 64 20 64 62 2d 74 61 (append db-ta
6740: 72 67 65 74 73 0a 09 09 09 09 28 6d 61 70 20 28 rgets.....(map (
6750: 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 09 09 20 lambda (x).....
6760: 20 20 20 20 20 20 28 6c 69 73 74 2d 3e 76 65 63 (list->vec
6770: 74 6f 72 0a 09 09 09 09 09 28 74 61 6b 65 20 28 tor......(take (
6780: 61 70 70 65 6e 64 20 28 73 74 72 69 6e 67 2d 73 append (string-s
6790: 70 6c 69 74 20 78 20 22 2f 22 29 0a 09 09 09 09 plit x "/").....
67a0: 09 09 20 20 20 20 20 20 28 6d 61 6b 65 2d 6c 69 .. (make-li
67b0: 73 74 20 28 6c 65 6e 67 74 68 20 68 65 61 64 65 st (length heade
67c0: 72 29 20 22 6e 61 22 29 29 0a 09 09 09 09 09 20 r) "na"))......
67d0: 20 20 20 20 20 28 6c 65 6e 67 74 68 20 68 65 61 (length hea
67e0: 64 65 72 29 29 29 29 0a 09 09 09 09 20 20 20 20 der)))).....
67f0: 20 72 75 6e 63 6f 6e 66 2d 74 61 72 67 73 29 29 runconf-targs))
6800: 29 0a 09 20 28 6b 65 79 2d 6c 69 73 74 62 6f 78 ).. (key-listbox
6810: 65 73 20 28 69 66 20 6b 65 79 2d 6c 62 73 20 6b es (if key-lbs k
6820: 65 79 2d 6c 62 73 20 28 6d 61 6b 65 2d 6c 69 73 ey-lbs (make-lis
6830: 74 20 28 6c 65 6e 67 74 68 20 68 65 61 64 65 72 t (length header
6840: 29 20 23 66 29 29 29 29 0a 20 20 20 20 28 6c 65 ) #f)))). (le
6850: 74 20 6c 6f 6f 70 20 28 28 6b 65 79 20 20 20 20 t loop ((key
6860: 20 28 63 61 72 20 68 65 61 64 65 72 29 29 0a 09 (car header))..
6870: 20 20 20 20 20 20 20 28 72 65 6d 6b 65 79 73 20 (remkeys
6880: 28 63 64 72 20 68 65 61 64 65 72 29 29 0a 09 20 (cdr header))..
6890: 20 20 20 20 20 20 28 72 65 66 76 61 6c 73 20 27 (refvals '
68a0: 28 29 29 0a 09 20 20 20 20 20 20 20 28 69 6e 64 ()).. (ind
68b0: 78 20 20 20 20 30 29 0a 09 20 20 20 20 20 20 20 x 0)..
68c0: 28 6c 62 73 20 20 20 20 20 27 28 29 29 29 0a 20 (lbs '())).
68d0: 20 20 20 20 20 28 6c 65 74 2a 20 28 28 6c 62 20 (let* ((lb
68e0: 28 6c 65 74 20 28 28 6c 62 20 28 6c 69 73 74 2d (let ((lb (list-
68f0: 72 65 66 20 6b 65 79 2d 6c 69 73 74 62 6f 78 65 ref key-listboxe
6900: 73 20 69 6e 64 78 29 29 29 0a 09 09 20 20 20 28 s indx)))... (
6910: 69 66 20 6c 62 0a 09 09 20 20 20 20 20 20 20 6c if lb... l
6920: 62 0a 09 09 20 20 20 20 20 20 20 28 69 75 70 3a b... (iup:
6930: 6c 69 73 74 62 6f 78 20 0a 09 09 09 23 3a 73 69 listbox ....#:si
6940: 7a 65 20 22 34 35 78 35 30 22 20 0a 09 09 09 23 ze "45x50" ....#
6950: 3a 66 6f 6e 74 73 69 7a 65 20 22 31 30 22 0a 09 :fontsize "10"..
6960: 09 09 23 3a 65 78 70 61 6e 64 20 22 59 45 53 22 ..#:expand "YES"
6970: 20 3b 3b 20 22 56 45 52 54 49 43 41 4c 22 0a 09 ;; "VERTICAL"..
6980: 09 09 3b 3b 20 23 3a 64 72 6f 70 64 6f 77 6e 20 ..;; #:dropdown
6990: 22 59 45 53 22 0a 09 09 09 23 3a 65 64 69 74 62 "YES"....#:editb
69a0: 6f 78 20 22 59 45 53 22 0a 09 09 09 23 3a 61 63 ox "YES"....#:ac
69b0: 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 tion (lambda (ob
69c0: 6a 20 61 20 62 20 63 29 0a 09 09 09 09 20 20 20 j a b c).....
69d0: 28 61 63 74 69 6f 6e 2d 70 72 6f 63 29 29 0a 09 (action-proc))..
69e0: 09 09 23 3a 63 61 72 65 74 5f 63 62 20 28 6c 61 ..#:caret_cb (la
69f0: 6d 62 64 61 20 28 6f 62 6a 20 61 20 62 20 63 29 mbda (obj a b c)
6a00: 28 61 63 74 69 6f 6e 2d 70 72 6f 63 29 29 0a 09 (action-proc))..
6a10: 09 09 29 29 29 29 0a 09 20 20 20 20 20 3b 3b 20 ..)))).. ;;
6a20: 6c 6f 6f 70 20 74 68 6f 75 67 68 20 61 6c 6c 20 loop though all
6a30: 74 68 65 20 74 61 72 67 65 74 73 20 61 6e 64 20 the targets and
6a40: 62 75 69 6c 64 20 74 68 65 20 6c 69 73 74 20 66 build the list f
6a50: 6f 72 20 74 68 69 73 20 64 72 6f 70 64 6f 77 6e or this dropdown
6a60: 0a 09 20 20 20 20 20 28 73 65 6c 65 63 74 65 64 .. (selected
6a70: 2d 76 61 6c 75 65 20 28 64 61 73 68 62 6f 61 72 -value (dashboar
6a80: 64 3a 70 6f 70 75 6c 61 74 65 2d 74 61 72 67 65 d:populate-targe
6a90: 74 2d 64 72 6f 70 64 6f 77 6e 20 6c 62 20 72 65 t-dropdown lb re
6aa0: 66 76 61 6c 73 20 61 6c 6c 2d 74 61 72 67 65 74 fvals all-target
6ab0: 73 29 29 29 0a 09 28 69 66 20 28 6e 75 6c 6c 3f s)))..(if (null?
6ac0: 20 72 65 6d 6b 65 79 73 29 0a 09 20 20 20 20 3b remkeys).. ;
6ad0: 3b 20 72 65 74 75 72 6e 20 61 20 6c 69 73 74 20 ; return a list
6ae0: 6f 66 20 74 68 65 20 6c 69 73 74 62 6f 78 20 69 of the listbox i
6af0: 74 65 6d 73 20 61 6e 64 20 61 6e 20 69 75 70 3a tems and an iup:
6b00: 68 62 6f 78 20 77 69 74 68 20 74 68 65 20 6c 61 hbox with the la
6b10: 62 65 6c 73 20 61 6e 64 20 6c 69 73 74 62 6f 78 bels and listbox
6b20: 65 73 0a 09 20 20 20 20 28 6c 65 74 20 28 28 6c es.. (let ((l
6b30: 69 73 74 62 6f 78 65 73 20 28 61 70 70 65 6e 64 istboxes (append
6b40: 20 6c 62 73 20 28 6c 69 73 74 20 6c 62 29 29 29 lbs (list lb)))
6b50: 29 0a 09 20 20 20 20 20 20 28 6c 69 73 74 20 6c ).. (list l
6b60: 69 73 74 62 6f 78 65 73 0a 09 09 20 20 20 20 28 istboxes... (
6b70: 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 68 74 78 map (lambda (htx
6b80: 74 20 6c 62 29 0a 09 09 09 20 20 20 28 69 75 70 t lb).... (iup
6b90: 3a 76 62 6f 78 0a 09 09 09 20 20 20 20 28 69 75 :vbox.... (iu
6ba0: 70 3a 6c 61 62 65 6c 20 68 74 78 74 29 20 0a 09 p:label htxt) ..
6bb0: 09 09 20 20 20 20 6c 62 29 29 0a 09 09 09 20 68 .. lb)).... h
6bc0: 65 61 64 65 72 0a 09 09 09 20 6c 69 73 74 62 6f eader.... listbo
6bd0: 78 65 73 29 29 29 0a 09 20 20 20 20 28 6c 6f 6f xes))).. (loo
6be0: 70 20 28 63 61 72 20 72 65 6d 6b 65 79 73 29 0a p (car remkeys).
6bf0: 09 09 20 20 28 63 64 72 20 72 65 6d 6b 65 79 73 .. (cdr remkeys
6c00: 29 0a 09 09 20 20 28 61 70 70 65 6e 64 20 72 65 )... (append re
6c10: 66 76 61 6c 73 20 28 6c 69 73 74 20 73 65 6c 65 fvals (list sele
6c20: 63 74 65 64 2d 76 61 6c 75 65 29 29 0a 09 09 20 cted-value))...
6c30: 20 28 2b 20 69 6e 64 78 20 31 29 0a 09 09 20 20 (+ indx 1)...
6c40: 28 61 70 70 65 6e 64 20 6c 62 73 20 28 6c 69 73 (append lbs (lis
6c50: 74 20 6c 62 29 29 29 29 29 29 29 29 0a 0a 3b 3b t lb))))))))..;;
6c60: 20 4d 61 6b 65 20 61 20 76 65 72 74 69 63 61 6c Make a vertical
6c70: 20 6c 69 73 74 20 6f 66 20 74 6f 67 67 6c 65 73 list of toggles
6c80: 20 75 73 69 6e 67 20 69 74 65 6d 73 2c 20 77 68 using items, wh
6c90: 65 6e 20 74 6f 67 67 6c 65 64 20 63 61 6c 6c 20 en toggled call
6ca0: 70 72 6f 63 20 77 69 74 68 20 74 68 65 20 63 6f proc with the co
6cb0: 6e 63 27 64 20 73 74 72 69 6e 67 20 0a 3b 3b 20 nc'd string .;;
6cc0: 69 6e 74 65 72 73 70 65 72 73 65 64 20 77 69 74 interspersed wit
6cd0: 68 20 63 6f 6d 6d 61 73 0a 3b 3b 0a 28 64 65 66 h commas.;;.(def
6ce0: 69 6e 65 20 28 64 61 73 68 62 6f 61 72 64 3a 74 ine (dashboard:t
6cf0: 65 78 74 2d 6c 69 73 74 2d 74 6f 67 67 6c 65 2d ext-list-toggle-
6d00: 62 6f 78 20 69 74 65 6d 73 20 70 72 6f 63 29 0a box items proc).
6d10: 20 20 28 6c 65 74 20 28 28 61 6c 6c 74 67 6c 73 (let ((alltgls
6d20: 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c (make-hash-tabl
6d30: 65 29 29 29 0a 20 20 20 20 28 61 70 70 6c 79 20 e))). (apply
6d40: 69 75 70 3a 76 62 6f 78 0a 09 20 20 20 28 6d 61 iup:vbox.. (ma
6d50: 70 20 28 6c 61 6d 62 64 61 20 28 69 74 65 6d 29 p (lambda (item)
6d60: 0a 09 09 20 20 28 69 75 70 3a 74 6f 67 67 6c 65 ... (iup:toggle
6d70: 20 0a 09 09 20 20 20 69 74 65 6d 0a 09 09 20 20 ... item...
6d80: 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53 22 0a #:expand "YES".
6d90: 09 09 20 20 20 23 3a 61 63 74 69 6f 6e 20 28 6c .. #:action (l
6da0: 61 6d 62 64 61 20 28 6f 62 6a 20 74 73 74 61 74 ambda (obj tstat
6db0: 65 29 0a 09 09 09 20 20 20 20 20 20 28 69 66 20 e).... (if
6dc0: 28 65 71 3f 20 74 73 74 61 74 65 20 30 29 0a 09 (eq? tstate 0)..
6dd0: 09 09 09 20 20 28 68 61 73 68 2d 74 61 62 6c 65 ... (hash-table
6de0: 2d 64 65 6c 65 74 65 21 20 61 6c 6c 74 67 6c 73 -delete! alltgls
6df0: 20 69 74 65 6d 29 0a 09 09 09 09 20 20 28 68 61 item)..... (ha
6e00: 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 61 6c sh-table-set! al
6e10: 6c 74 67 6c 73 20 69 74 65 6d 20 23 74 29 29 0a ltgls item #t)).
6e20: 09 09 09 20 20 20 20 20 20 28 6c 65 74 20 28 28 ... (let ((
6e30: 61 6c 6c 20 28 68 61 73 68 2d 74 61 62 6c 65 2d all (hash-table-
6e40: 6b 65 79 73 20 61 6c 6c 74 67 6c 73 29 29 29 0a keys alltgls))).
6e50: 09 09 09 09 28 70 72 6f 63 20 61 6c 6c 29 29 29 ....(proc all)))
6e60: 29 29 0a 09 09 69 74 65 6d 73 29 29 29 29 0a 0a ))...items))))..
6e70: 3b 3b 20 45 78 74 72 61 63 74 20 74 68 65 20 76 ;; Extract the v
6e80: 61 72 69 6f 75 73 20 62 69 74 73 20 6f 66 20 64 arious bits of d
6e90: 61 74 61 20 66 72 6f 6d 20 2a 64 61 74 61 2a 20 ata from *data*
6ea0: 61 6e 64 20 63 72 65 61 74 65 20 74 68 65 20 63 and create the c
6eb0: 6f 6d 6d 61 6e 64 20 6c 69 6e 65 20 65 71 75 69 ommand line equi
6ec0: 76 61 6c 65 6e 74 20 74 68 61 74 20 77 69 6c 6c valent that will
6ed0: 20 62 65 20 64 69 73 70 6c 61 79 65 64 0a 3b 3b be displayed.;;
6ee0: 0a 28 64 65 66 69 6e 65 20 28 64 61 73 68 62 6f .(define (dashbo
6ef0: 61 72 64 3a 75 70 64 61 74 65 2d 72 75 6e 2d 63 ard:update-run-c
6f00: 6f 6d 6d 61 6e 64 29 0a 20 20 28 6c 65 74 2a 20 ommand). (let*
6f10: 28 28 63 6d 64 2d 74 62 20 20 20 20 20 20 20 28 ((cmd-tb (
6f20: 64 62 6f 61 72 64 3a 64 61 74 61 2d 67 65 74 2d dboard:data-get-
6f30: 63 6f 6d 6d 61 6e 64 2d 74 62 20 2a 64 61 74 61 command-tb *data
6f40: 2a 29 29 0a 09 20 28 63 6d 64 20 20 20 20 20 20 *)).. (cmd
6f50: 20 20 20 20 28 64 62 6f 61 72 64 3a 64 61 74 61 (dboard:data
6f60: 2d 67 65 74 2d 63 6f 6d 6d 61 6e 64 20 20 20 20 -get-command
6f70: 2a 64 61 74 61 2a 29 29 0a 09 20 28 74 65 73 74 *data*)).. (test
6f80: 2d 70 61 74 74 20 20 20 20 28 6c 65 74 20 28 28 -patt (let ((
6f90: 74 70 20 28 64 62 6f 61 72 64 3a 64 61 74 61 2d tp (dboard:data-
6fa0: 67 65 74 2d 74 65 73 74 2d 70 61 74 74 73 20 2a get-test-patts *
6fb0: 64 61 74 61 2a 29 29 29 0a 09 09 09 20 28 69 66 data*))).... (if
6fc0: 20 28 65 71 75 61 6c 3f 20 74 70 20 22 22 29 20 (equal? tp "")
6fd0: 22 25 22 20 74 70 29 29 29 0a 09 20 28 73 74 61 "%" tp))).. (sta
6fe0: 74 65 73 20 20 20 20 20 20 20 28 64 62 6f 61 72 tes (dboar
6ff0: 64 3a 64 61 74 61 2d 67 65 74 2d 73 74 61 74 65 d:data-get-state
7000: 73 20 20 20 20 20 2a 64 61 74 61 2a 29 29 0a 09 s *data*))..
7010: 20 28 73 74 61 74 75 73 65 73 20 20 20 20 20 28 (statuses (
7020: 64 62 6f 61 72 64 3a 64 61 74 61 2d 67 65 74 2d dboard:data-get-
7030: 73 74 61 74 75 73 65 73 20 20 20 2a 64 61 74 61 statuses *data
7040: 2a 29 29 0a 09 20 28 74 61 72 67 65 74 20 20 20 *)).. (target
7050: 20 20 20 20 28 6c 65 74 20 28 28 74 61 72 67 2d (let ((targ-
7060: 6c 69 73 74 20 28 64 62 6f 61 72 64 3a 64 61 74 list (dboard:dat
7070: 61 2d 67 65 74 2d 74 61 72 67 65 74 20 20 20 20 a-get-target
7080: 20 2a 64 61 74 61 2a 29 29 29 0a 09 09 09 20 28 *data*))).... (
7090: 69 66 20 74 61 72 67 2d 6c 69 73 74 20 28 73 74 if targ-list (st
70a0: 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 ring-intersperse
70b0: 20 74 61 72 67 2d 6c 69 73 74 20 22 2f 22 29 20 targ-list "/")
70c0: 22 6e 6f 2d 74 61 72 67 65 74 2d 73 65 6c 65 63 "no-target-selec
70d0: 74 65 64 22 29 29 29 0a 09 20 28 72 75 6e 2d 6e ted"))).. (run-n
70e0: 61 6d 65 20 20 20 20 20 28 64 62 6f 61 72 64 3a ame (dboard:
70f0: 64 61 74 61 2d 67 65 74 2d 72 75 6e 2d 6e 61 6d data-get-run-nam
7100: 65 20 20 20 2a 64 61 74 61 2a 29 29 0a 09 20 28 e *data*)).. (
7110: 73 74 61 74 65 73 2d 73 74 72 20 20 20 28 69 66 states-str (if
7120: 20 28 6f 72 20 28 6e 6f 74 20 73 74 61 74 65 73 (or (not states
7130: 29 0a 09 09 09 20 20 20 20 20 20 20 28 6e 75 6c ).... (nul
7140: 6c 3f 20 73 74 61 74 65 73 29 29 0a 09 09 09 20 l? states))....
7150: 20 20 22 22 0a 09 09 09 20 20 20 28 63 6f 6e 63 "".... (conc
7160: 20 22 20 2d 73 74 61 74 65 20 22 20 20 28 73 74 " -state " (st
7170: 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 ring-intersperse
7180: 20 73 74 61 74 65 73 20 22 2c 22 29 29 29 29 0a states ",")))).
7190: 09 20 28 73 74 61 74 75 73 65 73 2d 73 74 72 20 . (statuses-str
71a0: 28 69 66 20 28 6f 72 20 28 6e 6f 74 20 73 74 61 (if (or (not sta
71b0: 74 75 73 65 73 29 0a 09 09 09 20 20 20 20 20 20 tuses)....
71c0: 20 28 6e 75 6c 6c 3f 20 73 74 61 74 75 73 65 73 (null? statuses
71d0: 29 29 0a 09 09 09 20 20 20 22 22 0a 09 09 09 20 )).... ""....
71e0: 20 20 28 63 6f 6e 63 20 22 20 2d 73 74 61 74 75 (conc " -statu
71f0: 73 20 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 s " (string-inte
7200: 72 73 70 65 72 73 65 20 73 74 61 74 75 73 65 73 rsperse statuses
7210: 20 22 2c 22 29 29 29 29 0a 09 20 28 66 75 6c 6c ",")))).. (full
7220: 2d 63 6d 64 20 20 22 6d 65 67 61 74 65 73 74 22 -cmd "megatest"
7230: 29 29 0a 20 20 20 20 28 63 61 73 65 20 28 73 74 )). (case (st
7240: 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 63 6d 64 ring->symbol cmd
7250: 29 0a 20 20 20 20 20 20 28 28 72 75 6e 29 0a 20 ). ((run).
7260: 20 20 20 20 20 20 28 73 65 74 21 20 66 75 6c 6c (set! full
7270: 2d 63 6d 64 20 28 63 6f 6e 63 20 66 75 6c 6c 2d -cmd (conc full-
7280: 63 6d 64 20 0a 09 09 09 20 20 20 20 22 20 2d 72 cmd .... " -r
7290: 75 6e 22 0a 09 09 09 20 20 20 20 22 20 2d 74 65 un".... " -te
72a0: 73 74 70 61 74 74 20 22 0a 09 09 09 20 20 20 20 stpatt "....
72b0: 74 65 73 74 2d 70 61 74 74 0a 09 09 09 20 20 20 test-patt....
72c0: 20 22 20 2d 74 61 72 67 65 74 20 22 0a 09 09 09 " -target "....
72d0: 20 20 20 20 74 61 72 67 65 74 0a 09 09 09 20 20 target....
72e0: 20 20 22 20 2d 72 75 6e 6e 61 6d 65 20 22 0a 09 " -runname "..
72f0: 09 09 20 20 20 20 72 75 6e 2d 6e 61 6d 65 0a 09 .. run-name..
7300: 09 09 20 20 20 20 22 20 2d 63 6c 65 61 6e 2d 63 .. " -clean-c
7310: 61 63 68 65 22 0a 09 09 09 20 20 20 20 29 29 29 ache".... )))
7320: 0a 20 20 20 20 20 20 28 28 72 65 6d 6f 76 65 2d . ((remove-
7330: 72 75 6e 73 29 0a 20 20 20 20 20 20 20 28 73 65 runs). (se
7340: 74 21 20 66 75 6c 6c 2d 63 6d 64 20 28 63 6f 6e t! full-cmd (con
7350: 63 20 66 75 6c 6c 2d 63 6d 64 0a 09 09 09 20 20 c full-cmd....
7360: 20 20 22 20 2d 72 65 6d 6f 76 65 2d 72 75 6e 73 " -remove-runs
7370: 20 2d 72 75 6e 6e 61 6d 65 20 22 0a 09 09 09 20 -runname "....
7380: 20 20 20 72 75 6e 2d 6e 61 6d 65 0a 09 09 09 20 run-name....
7390: 20 20 20 22 20 2d 74 61 72 67 65 74 20 22 20 0a " -target " .
73a0: 09 09 09 20 20 20 20 74 61 72 67 65 74 0a 09 09 ... target...
73b0: 09 20 20 20 20 22 20 2d 74 65 73 74 70 61 74 74 . " -testpatt
73c0: 20 22 0a 09 09 09 20 20 20 20 74 65 73 74 2d 70 ".... test-p
73d0: 61 74 74 0a 09 09 09 20 20 20 20 73 74 61 74 65 att.... state
73e0: 73 2d 73 74 72 0a 09 09 09 20 20 20 20 73 74 61 s-str.... sta
73f0: 74 75 73 65 73 2d 73 74 72 0a 09 09 09 20 20 20 tuses-str....
7400: 20 29 29 29 0a 20 20 20 20 20 20 28 65 6c 73 65 ))). (else
7410: 20 28 73 65 74 21 20 66 75 6c 6c 2d 63 6d 64 20 (set! full-cmd
7420: 22 20 6e 6f 20 76 61 6c 69 64 20 63 6f 6d 6d 61 " no valid comma
7430: 6e 64 20 22 29 29 29 0a 20 20 20 20 28 69 75 70 nd "))). (iup
7440: 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 :attribute-set!
7450: 63 6d 64 2d 74 62 20 22 56 41 4c 55 45 22 20 66 cmd-tb "VALUE" f
7460: 75 6c 6c 2d 63 6d 64 29 29 29 0a 0a 3b 3b 20 44 ull-cmd)))..;; D
7470: 69 73 70 6c 61 79 20 74 68 65 20 74 65 73 74 73 isplay the tests
7480: 20 61 73 20 72 6f 77 73 20 6f 66 20 62 6f 78 65 as rows of boxe
7490: 73 20 6f 6e 20 74 68 65 20 74 65 73 74 2f 74 61 s on the test/ta
74a0: 73 6b 20 70 61 6e 65 0a 3b 3b 0a 28 64 65 66 69 sk pane.;;.(defi
74b0: 6e 65 20 28 64 61 73 68 62 6f 61 72 64 3a 64 72 ne (dashboard:dr
74c0: 61 77 2d 74 65 73 74 73 20 63 6e 76 20 78 61 64 aw-tests cnv xad
74d0: 6a 20 79 61 64 6a 20 74 65 73 74 73 2d 64 72 61 j yadj tests-dra
74e0: 77 2d 73 74 61 74 65 20 73 6f 72 74 65 64 2d 74 w-state sorted-t
74f0: 65 73 74 6e 61 6d 65 73 20 74 65 73 74 2d 72 65 estnames test-re
7500: 63 6f 72 64 73 29 0a 20 20 28 63 61 6e 76 61 73 cords). (canvas
7510: 2d 63 6c 65 61 72 21 20 63 6e 76 29 0a 20 20 28 -clear! cnv). (
7520: 63 61 6e 76 61 73 2d 66 6f 6e 74 2d 73 65 74 21 canvas-font-set!
7530: 20 63 6e 76 20 22 48 65 6c 76 65 74 69 63 61 2c cnv "Helvetica,
7540: 20 2d 31 30 22 29 0a 20 20 28 6c 65 74 2d 76 61 -10"). (let-va
7550: 6c 75 65 73 20 28 28 28 73 69 7a 65 78 20 73 69 lues (((sizex si
7560: 7a 65 79 20 73 69 7a 65 78 6d 6d 20 73 69 7a 65 zey sizexmm size
7570: 79 6d 6d 29 20 28 63 61 6e 76 61 73 2d 73 69 7a ymm) (canvas-siz
7580: 65 20 63 6e 76 29 29 0a 09 20 20 20 20 20 20 20 e cnv))..
7590: 28 28 6f 72 69 67 69 6e 78 20 6f 72 69 67 69 6e ((originx origin
75a0: 79 29 20 20 20 20 20 20 20 20 20 20 20 20 20 28 y) (
75b0: 63 61 6e 76 61 73 2d 6f 72 69 67 69 6e 20 63 6e canvas-origin cn
75c0: 76 29 29 29 0a 20 20 20 20 3b 3b 20 28 70 72 69 v))). ;; (pri
75d0: 6e 74 20 22 6f 72 69 67 69 6e 78 3a 20 22 20 6f nt "originx: " o
75e0: 72 69 67 69 6e 78 20 22 20 6f 72 69 67 69 6e 79 riginx " originy
75f0: 3a 20 22 20 6f 72 69 67 69 6e 79 29 0a 20 20 20 : " originy).
7600: 20 3b 3b 20 28 63 61 6e 76 61 73 2d 6f 72 69 67 ;; (canvas-orig
7610: 69 6e 2d 73 65 74 21 20 63 6e 76 20 30 20 28 2d in-set! cnv 0 (-
7620: 20 28 2f 20 73 69 7a 65 79 20 32 29 29 29 0a 20 (/ sizey 2))).
7630: 20 20 20 28 69 66 20 28 68 61 73 68 2d 74 61 62 (if (hash-tab
7640: 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 74 le-ref/default t
7650: 65 73 74 73 2d 64 72 61 77 2d 73 74 61 74 65 20 ests-draw-state
7660: 27 66 69 72 73 74 2d 74 69 6d 65 20 23 74 29 0a 'first-time #t).
7670: 09 28 62 65 67 69 6e 0a 09 20 20 28 68 61 73 68 .(begin.. (hash
7680: 2d 74 61 62 6c 65 2d 73 65 74 21 20 74 65 73 74 -table-set! test
7690: 73 2d 64 72 61 77 2d 73 74 61 74 65 20 27 66 69 s-draw-state 'fi
76a0: 72 73 74 2d 74 69 6d 65 20 23 66 29 0a 09 20 20 rst-time #f)..
76b0: 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 (hash-table-set!
76c0: 20 74 65 73 74 73 2d 64 72 61 77 2d 73 74 61 74 tests-draw-stat
76d0: 65 20 27 73 63 61 6c 65 66 20 31 29 0a 09 20 20 e 'scalef 1)..
76e0: 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 (hash-table-set!
76f0: 20 74 65 73 74 73 2d 64 72 61 77 2d 73 74 61 74 tests-draw-stat
7700: 65 20 27 74 65 73 74 73 2d 69 6e 66 6f 20 28 6d e 'tests-info (m
7710: 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 ake-hash-table))
7720: 0a 09 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d .. (hash-table-
7730: 73 65 74 21 20 74 65 73 74 73 2d 64 72 61 77 2d set! tests-draw-
7740: 73 74 61 74 65 20 27 73 65 6c 65 63 74 65 64 2d state 'selected-
7750: 74 65 73 74 73 20 28 6d 61 6b 65 2d 68 61 73 68 tests (make-hash
7760: 2d 74 61 62 6c 65 29 29 0a 09 20 20 3b 3b 20 73 -table)).. ;; s
7770: 65 74 20 74 68 65 73 65 20 0a 09 20 20 28 64 63 et these .. (dc
7780: 6f 6d 6d 6f 6e 3a 69 6e 69 74 69 61 6c 2d 64 72 ommon:initial-dr
7790: 61 77 2d 74 65 73 74 73 20 63 6e 76 20 78 61 64 aw-tests cnv xad
77a0: 6a 20 79 61 64 6a 20 73 69 7a 65 78 20 73 69 7a j yadj sizex siz
77b0: 65 79 20 73 69 7a 65 78 6d 6d 20 73 69 7a 65 79 ey sizexmm sizey
77c0: 6d 6d 20 6f 72 69 67 69 6e 78 20 6f 72 69 67 69 mm originx origi
77d0: 6e 79 20 74 65 73 74 73 2d 64 72 61 77 2d 73 74 ny tests-draw-st
77e0: 61 74 65 20 73 6f 72 74 65 64 2d 74 65 73 74 6e ate sorted-testn
77f0: 61 6d 65 73 20 74 65 73 74 2d 72 65 63 6f 72 64 ames test-record
7800: 73 29 29 0a 09 28 64 63 6f 6d 6d 6f 6e 3a 72 65 s))..(dcommon:re
7810: 64 72 61 77 2d 74 65 73 74 73 20 63 6e 76 20 78 draw-tests cnv x
7820: 61 64 6a 20 79 61 64 6a 20 73 69 7a 65 78 20 73 adj yadj sizex s
7830: 69 7a 65 79 20 73 69 7a 65 78 6d 6d 20 73 69 7a izey sizexmm siz
7840: 65 79 6d 6d 20 6f 72 69 67 69 6e 78 20 6f 72 69 eymm originx ori
7850: 67 69 6e 79 20 74 65 73 74 73 2d 64 72 61 77 2d giny tests-draw-
7860: 73 74 61 74 65 20 73 6f 72 74 65 64 2d 74 65 73 state sorted-tes
7870: 74 6e 61 6d 65 73 20 74 65 73 74 2d 72 65 63 6f tnames test-reco
7880: 72 64 73 29 29 0a 20 20 20 20 29 29 0a 0a 3b 3b rds)). ))..;;
7890: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
78a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
78b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
78c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
78d0: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 52 20 55 20 4e 20 ======.;; R U N
78e0: 20 20 43 20 4f 20 4e 20 54 20 52 20 4f 20 4c 20 C O N T R O L
78f0: 53 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d S.;;============
7900: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7910: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7920: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7930: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 0a 3b 3b ==========.;;.;;
7940: 20 41 20 67 75 69 20 66 6f 72 20 6c 61 75 6e 63 A gui for launc
7950: 68 69 6e 67 20 74 65 73 74 73 0a 3b 3b 0a 28 64 hing tests.;;.(d
7960: 65 66 69 6e 65 20 28 64 61 73 68 62 6f 61 72 64 efine (dashboard
7970: 3a 72 75 6e 2d 63 6f 6e 74 72 6f 6c 73 29 0a 20 :run-controls).
7980: 20 28 6c 65 74 2a 20 28 28 74 61 72 67 65 74 73 (let* ((targets
7990: 20 20 20 20 20 20 20 28 6d 61 6b 65 2d 68 61 73 (make-has
79a0: 68 2d 74 61 62 6c 65 29 29 0a 09 20 28 74 65 73 h-table)).. (tes
79b0: 74 2d 72 65 63 6f 72 64 73 20 20 28 6d 61 6b 65 t-records (make
79c0: 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 0a 09 20 -hash-table))..
79d0: 28 61 6c 6c 2d 74 65 73 74 73 2d 72 65 67 69 73 (all-tests-regis
79e0: 74 72 79 20 28 74 65 73 74 73 3a 67 65 74 2d 61 try (tests:get-a
79f0: 6c 6c 29 29 20 3b 3b 20 28 74 65 73 74 73 3a 67 ll)) ;; (tests:g
7a00: 65 74 2d 76 61 6c 69 64 2d 74 65 73 74 73 20 2a et-valid-tests *
7a10: 74 6f 70 70 61 74 68 2a 20 27 28 29 29 29 0a 09 toppath* '()))..
7a20: 20 28 74 65 73 74 2d 6e 61 6d 65 73 20 20 20 20 (test-names
7a30: 28 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 (hash-table-keys
7a40: 20 61 6c 6c 2d 74 65 73 74 73 2d 72 65 67 69 73 all-tests-regis
7a50: 74 72 79 29 29 0a 09 20 28 73 6f 72 74 65 64 2d try)).. (sorted-
7a60: 74 65 73 74 6e 61 6d 65 73 20 23 66 29 0a 09 20 testnames #f)..
7a70: 28 61 63 74 69 6f 6e 20 20 20 20 20 20 20 20 22 (action "
7a80: 2d 72 75 6e 22 29 0a 09 20 28 63 6d 64 6c 6e 20 -run").. (cmdln
7a90: 20 20 20 20 20 20 20 20 22 22 29 0a 09 20 28 72 "").. (r
7aa0: 75 6e 6c 6f 67 73 20 20 20 20 20 20 20 28 6d 61 unlogs (ma
7ab0: 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 0a ke-hash-table)).
7ac0: 09 20 28 6b 65 79 2d 6c 69 73 74 62 6f 78 65 73 . (key-listboxes
7ad0: 20 23 66 29 0a 09 20 28 75 70 64 61 74 65 72 2d #f).. (updater-
7ae0: 66 6f 72 2d 72 75 6e 73 20 23 66 29 0a 09 20 28 for-runs #f).. (
7af0: 75 70 64 61 74 65 2d 6b 65 79 76 61 6c 73 20 28 update-keyvals (
7b00: 6c 61 6d 62 64 61 20 28 29 0a 09 09 09 20 20 20 lambda ()....
7b10: 28 6c 65 74 20 28 28 74 61 72 67 20 28 6d 61 70 (let ((targ (map
7b20: 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 09 (lambda (x)....
7b30: 09 09 20 20 20 20 20 20 28 69 75 70 3a 61 74 74 .. (iup:att
7b40: 72 69 62 75 74 65 20 78 20 22 56 41 4c 55 45 22 ribute x "VALUE"
7b50: 29 29 0a 09 09 09 09 09 20 20 20 20 28 63 61 72 ))...... (car
7b60: 20 28 64 61 73 68 62 6f 61 72 64 3a 75 70 64 61 (dashboard:upda
7b70: 74 65 2d 74 61 72 67 65 74 2d 73 65 6c 65 63 74 te-target-select
7b80: 6f 72 20 6b 65 79 2d 6c 69 73 74 62 6f 78 65 73 or key-listboxes
7b90: 29 29 29 29 0a 09 09 09 09 20 28 63 75 72 72 2d ))))..... (curr-
7ba0: 72 75 6e 6e 61 6d 65 20 28 64 62 6f 61 72 64 3a runname (dboard:
7bb0: 64 61 74 61 2d 67 65 74 2d 72 75 6e 2d 6e 61 6d data-get-run-nam
7bc0: 65 20 2a 64 61 74 61 2a 29 29 29 0a 09 09 09 20 e *data*)))....
7bd0: 20 20 20 20 28 64 62 6f 61 72 64 3a 64 61 74 61 (dboard:data
7be0: 2d 73 65 74 2d 74 61 72 67 65 74 21 20 2a 64 61 -set-target! *da
7bf0: 74 61 2a 20 74 61 72 67 29 0a 09 09 09 20 20 20 ta* targ)....
7c00: 20 20 28 69 66 20 75 70 64 61 74 65 72 2d 66 6f (if updater-fo
7c10: 72 2d 72 75 6e 73 20 28 75 70 64 61 74 65 72 2d r-runs (updater-
7c20: 66 6f 72 2d 72 75 6e 73 29 29 0a 09 09 09 20 20 for-runs))....
7c30: 20 20 20 28 69 66 20 28 6f 72 20 28 6e 6f 74 20 (if (or (not
7c40: 28 65 71 75 61 6c 3f 20 63 75 72 72 2d 72 75 6e (equal? curr-run
7c50: 6e 61 6d 65 20 28 64 62 6f 61 72 64 3a 64 61 74 name (dboard:dat
7c60: 61 2d 67 65 74 2d 72 75 6e 2d 6e 61 6d 65 20 2a a-get-run-name *
7c70: 64 61 74 61 2a 29 29 29 0a 09 09 09 09 20 20 20 data*))).....
7c80: 20 20 28 65 71 75 61 6c 3f 20 28 64 62 6f 61 72 (equal? (dboar
7c90: 64 3a 64 61 74 61 2d 67 65 74 2d 72 75 6e 2d 6e d:data-get-run-n
7ca0: 61 6d 65 20 2a 64 61 74 61 2a 29 20 22 22 29 29 ame *data*) ""))
7cb0: 0a 09 09 09 09 20 28 64 62 6f 61 72 64 3a 64 61 ..... (dboard:da
7cc0: 74 61 2d 73 65 74 2d 72 75 6e 2d 6e 61 6d 65 21 ta-set-run-name!
7cd0: 20 2a 64 61 74 61 2a 20 63 75 72 72 2d 72 75 6e *data* curr-run
7ce0: 6e 61 6d 65 29 29 0a 09 09 09 20 20 20 20 20 28 name)).... (
7cf0: 64 61 73 68 62 6f 61 72 64 3a 75 70 64 61 74 65 dashboard:update
7d00: 2d 72 75 6e 2d 63 6f 6d 6d 61 6e 64 29 29 29 29 -run-command))))
7d10: 0a 09 20 28 74 65 73 74 73 2d 64 72 61 77 2d 73 .. (tests-draw-s
7d20: 74 61 74 65 20 28 6d 61 6b 65 2d 68 61 73 68 2d tate (make-hash-
7d30: 74 61 62 6c 65 29 29 20 3b 3b 20 75 73 65 20 66 table)) ;; use f
7d40: 6f 72 20 6b 65 65 70 69 6e 67 20 73 74 61 74 65 or keeping state
7d50: 20 6f 66 20 74 68 65 20 74 65 73 74 20 63 61 6e of the test can
7d60: 76 61 73 0a 09 20 28 74 65 73 74 2d 70 61 74 74 vas.. (test-patt
7d70: 65 72 6e 73 2d 74 65 78 74 62 6f 78 20 20 23 66 erns-textbox #f
7d80: 29 29 0a 20 20 20 20 28 68 61 73 68 2d 74 61 62 )). (hash-tab
7d90: 6c 65 2d 73 65 74 21 20 74 65 73 74 73 2d 64 72 le-set! tests-dr
7da0: 61 77 2d 73 74 61 74 65 20 27 66 69 72 73 74 2d aw-state 'first-
7db0: 74 69 6d 65 20 23 74 29 0a 20 20 20 20 3b 3b 20 time #t). ;;
7dc0: 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 (hash-table-set!
7dd0: 20 74 65 73 74 73 2d 64 72 61 77 2d 73 74 61 74 tests-draw-stat
7de0: 65 20 27 73 63 61 6c 65 66 20 31 29 0a 20 20 20 e 'scalef 1).
7df0: 20 28 74 65 73 74 73 3a 67 65 74 2d 66 75 6c 6c (tests:get-full
7e00: 2d 64 61 74 61 20 74 65 73 74 2d 6e 61 6d 65 73 -data test-names
7e10: 20 74 65 73 74 2d 72 65 63 6f 72 64 73 20 27 28 test-records '(
7e20: 29 20 61 6c 6c 2d 74 65 73 74 73 2d 72 65 67 69 ) all-tests-regi
7e30: 73 74 72 79 29 0a 20 20 20 20 28 73 65 74 21 20 stry). (set!
7e40: 73 6f 72 74 65 64 2d 74 65 73 74 6e 61 6d 65 73 sorted-testnames
7e50: 20 28 74 65 73 74 73 3a 73 6f 72 74 2d 62 79 2d (tests:sort-by-
7e60: 70 72 69 6f 72 69 74 79 2d 61 6e 64 2d 77 61 69 priority-and-wai
7e70: 74 6f 6e 20 74 65 73 74 2d 72 65 63 6f 72 64 73 ton test-records
7e80: 29 29 0a 20 20 20 20 0a 20 20 20 20 3b 3b 20 72 )). . ;; r
7e90: 65 66 65 72 20 74 6f 20 28 64 3a 61 6c 6c 64 61 efer to (d:allda
7ea0: 74 2d 6b 65 79 73 20 2a 61 6c 6c 64 61 74 2a 29 t-keys *alldat*)
7eb0: 2c 20 28 64 3a 61 6c 6c 64 61 74 2d 64 62 6b 65 , (d:alldat-dbke
7ec0: 79 73 20 2a 61 6c 6c 64 61 74 2a 29 20 66 6f 72 ys *alldat*) for
7ed0: 20 6b 65 79 73 0a 20 20 20 20 28 69 75 70 3a 76 keys. (iup:v
7ee0: 62 6f 78 0a 20 20 20 20 20 3b 3b 20 54 68 65 20 box. ;; The
7ef0: 63 6f 6d 6d 61 6e 64 20 6c 69 6e 65 20 64 69 73 command line dis
7f00: 70 6c 61 79 2f 65 78 65 63 74 75 74 69 6f 6e 20 play/exectution
7f10: 63 6f 6e 74 72 6f 6c 0a 20 20 20 20 20 28 69 75 control. (iu
7f20: 70 3a 66 72 61 6d 65 0a 20 20 20 20 20 20 23 3a p:frame. #:
7f30: 74 69 74 6c 65 20 22 43 6f 6d 6d 61 6e 64 20 74 title "Command t
7f40: 6f 20 62 65 20 65 78 65 63 74 75 74 65 64 22 0a o be exectuted".
7f50: 20 20 20 20 20 20 28 69 75 70 3a 68 62 6f 78 0a (iup:hbox.
7f60: 20 20 20 20 20 20 20 28 69 75 70 3a 6c 61 62 65 (iup:labe
7f70: 6c 20 22 52 75 6e 20 6f 6e 22 20 23 3a 73 69 7a l "Run on" #:siz
7f80: 65 20 22 34 30 78 22 29 0a 20 20 20 20 20 20 20 e "40x").
7f90: 28 69 75 70 3a 72 61 64 69 6f 20 0a 09 28 69 75 (iup:radio ..(iu
7fa0: 70 3a 68 62 6f 78 0a 09 20 28 69 75 70 3a 74 6f p:hbox.. (iup:to
7fb0: 67 67 6c 65 20 22 4c 6f 63 61 6c 22 20 23 3a 73 ggle "Local" #:s
7fc0: 69 7a 65 20 22 34 30 78 22 29 0a 09 20 28 69 75 ize "40x").. (iu
7fd0: 70 3a 74 6f 67 67 6c 65 20 22 53 65 72 76 65 72 p:toggle "Server
7fe0: 22 20 23 3a 73 69 7a 65 20 22 34 30 78 22 29 29 " #:size "40x"))
7ff0: 29 0a 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 ). (let ((
8000: 74 62 20 28 69 75 70 3a 74 65 78 74 62 6f 78 20 tb (iup:textbox
8010: 0a 09 09 20 20 23 3a 76 61 6c 75 65 20 22 6d 65 ... #:value "me
8020: 67 61 74 65 73 74 20 22 0a 09 09 20 20 23 3a 65 gatest "... #:e
8030: 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 xpand "HORIZONTA
8040: 4c 22 0a 09 09 20 20 23 3a 72 65 61 64 6f 6e 6c L"... #:readonl
8050: 79 20 22 59 45 53 22 0a 09 09 20 20 23 3a 66 6f y "YES"... #:fo
8060: 6e 74 20 22 43 6f 75 72 69 65 72 20 4e 65 77 2c nt "Courier New,
8070: 20 2d 31 32 22 0a 09 09 20 20 29 29 29 0a 09 20 -12"... )))..
8080: 28 64 62 6f 61 72 64 3a 64 61 74 61 2d 73 65 74 (dboard:data-set
8090: 2d 63 6f 6d 6d 61 6e 64 2d 74 62 21 20 2a 64 61 -command-tb! *da
80a0: 74 61 2a 20 74 62 29 0a 09 20 74 62 29 0a 20 20 ta* tb).. tb).
80b0: 20 20 20 20 20 28 69 75 70 3a 62 75 74 74 6f 6e (iup:button
80c0: 20 22 45 78 65 63 75 74 65 22 20 23 3a 73 69 7a "Execute" #:siz
80d0: 65 20 22 35 30 78 22 0a 09 09 20 20 20 23 3a 61 e "50x"... #:a
80e0: 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f ction (lambda (o
80f0: 62 6a 29 0a 09 09 09 20 20 20 20 20 20 28 6c 65 bj).... (le
8100: 74 20 28 28 63 6d 64 20 28 63 6f 6e 63 20 22 78 t ((cmd (conc "x
8110: 74 65 72 6d 20 2d 67 65 6f 6d 65 74 72 79 20 31 term -geometry 1
8120: 38 30 78 32 30 20 2d 65 20 5c 22 22 0a 09 09 09 80x20 -e \""....
8130: 09 09 20 20 20 20 20 20 20 28 69 75 70 3a 61 74 .. (iup:at
8140: 74 72 69 62 75 74 65 20 28 64 62 6f 61 72 64 3a tribute (dboard:
8150: 64 61 74 61 2d 67 65 74 2d 63 6f 6d 6d 61 6e 64 data-get-command
8160: 2d 74 62 20 2a 64 61 74 61 2a 29 20 22 56 41 4c -tb *data*) "VAL
8170: 55 45 22 29 0a 09 09 09 09 09 20 20 20 20 20 20 UE")......
8180: 20 22 3b 65 63 68 6f 20 50 72 65 73 73 20 61 6e ";echo Press an
8190: 79 20 6b 65 79 20 74 6f 20 63 6f 6e 74 69 6e 75 y key to continu
81a0: 65 3b 62 61 73 68 20 2d 63 20 27 72 65 61 64 20 e;bash -c 'read
81b0: 2d 6e 20 31 20 2d 73 27 5c 22 20 26 22 29 29 29 -n 1 -s'\" &")))
81c0: 0a 09 09 09 09 28 73 79 73 74 65 6d 20 63 6d 64 .....(system cmd
81d0: 29 29 29 29 29 29 0a 0a 20 20 20 20 20 28 69 75 )))))).. (iu
81e0: 70 3a 73 70 6c 69 74 0a 20 20 20 20 20 20 23 3a p:split. #:
81f0: 6f 72 69 65 6e 74 61 74 69 6f 6e 20 22 48 4f 52 orientation "HOR
8200: 49 5a 4f 4e 54 41 4c 22 0a 20 20 20 20 20 20 0a IZONTAL". .
8210: 20 20 20 20 20 20 28 69 75 70 3a 73 70 6c 69 74 (iup:split
8220: 0a 20 20 20 20 20 20 20 23 3a 76 61 6c 75 65 20 . #:value
8230: 33 30 30 0a 0a 20 20 20 20 20 20 20 3b 3b 20 54 300.. ;; T
8240: 61 72 67 65 74 2c 20 74 65 73 74 70 61 74 74 2c arget, testpatt,
8250: 20 73 74 61 74 65 20 61 6e 64 20 73 74 61 74 75 state and statu
8260: 73 20 69 6e 70 75 74 20 62 6f 78 65 73 0a 20 20 s input boxes.
8270: 20 20 20 20 20 3b 3b 0a 20 20 20 20 20 20 20 28 ;;. (
8280: 69 75 70 3a 76 62 6f 78 0a 09 3b 3b 20 43 6f 6d iup:vbox..;; Com
8290: 6d 61 6e 64 20 74 6f 20 72 75 6e 0a 09 28 69 75 mand to run..(iu
82a0: 70 3a 66 72 61 6d 65 0a 09 20 23 3a 74 69 74 6c p:frame.. #:titl
82b0: 65 20 22 53 65 74 20 74 68 65 20 61 63 74 69 6f e "Set the actio
82c0: 6e 20 74 6f 20 74 61 6b 65 22 0a 09 20 28 69 75 n to take".. (iu
82d0: 70 3a 68 62 6f 78 0a 09 20 20 3b 3b 20 28 69 75 p:hbox.. ;; (iu
82e0: 70 3a 6c 61 62 65 6c 20 22 43 6f 6d 6d 61 6e 64 p:label "Command
82f0: 20 74 6f 20 72 75 6e 22 20 23 3a 65 78 70 61 6e to run" #:expan
8300: 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 20 23 d "HORIZONTAL" #
8310: 3a 73 69 7a 65 20 22 37 30 78 22 20 23 3a 61 6c :size "70x" #:al
8320: 69 67 6e 6d 65 6e 74 20 22 4c 45 46 54 3a 41 43 ignment "LEFT:AC
8330: 45 4e 54 45 52 22 29 0a 09 20 20 28 6c 65 74 2a ENTER").. (let*
8340: 20 28 28 63 6d 64 73 2d 6c 69 73 74 20 27 28 22 ((cmds-list '("
8350: 72 75 6e 22 20 22 72 65 6d 6f 76 65 2d 72 75 6e run" "remove-run
8360: 73 22 20 22 73 65 74 2d 73 74 61 74 65 2d 73 74 s" "set-state-st
8370: 61 74 75 73 22 20 22 6c 6f 63 6b 2d 72 75 6e 73 atus" "lock-runs
8380: 22 20 22 75 6e 6c 6f 63 6b 2d 72 75 6e 73 22 29 " "unlock-runs")
8390: 29 0a 09 09 20 28 6c 62 20 20 20 20 20 20 20 20 )... (lb
83a0: 20 28 69 75 70 3a 6c 69 73 74 62 6f 78 20 23 3a (iup:listbox #:
83b0: 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 expand "HORIZONT
83c0: 41 4c 22 0a 09 09 09 09 09 20 20 23 3a 64 72 6f AL"...... #:dro
83d0: 70 64 6f 77 6e 20 22 59 45 53 22 0a 09 09 09 09 pdown "YES".....
83e0: 09 20 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d . #:action (lam
83f0: 62 64 61 20 28 6f 62 6a 20 76 61 6c 20 69 6e 64 bda (obj val ind
8400: 65 78 20 6c 62 73 74 61 74 65 29 0a 09 09 09 09 ex lbstate).....
8410: 09 09 20 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 .. ;; (print
8420: 20 6f 62 6a 20 22 20 22 20 76 61 6c 20 22 20 22 obj " " val " "
8430: 20 69 6e 64 65 78 20 22 20 22 20 6c 62 73 74 61 index " " lbsta
8440: 74 65 29 0a 09 09 09 09 09 09 20 20 20 20 20 28 te)....... (
8450: 64 62 6f 61 72 64 3a 64 61 74 61 2d 73 65 74 2d dboard:data-set-
8460: 63 6f 6d 6d 61 6e 64 21 20 2a 64 61 74 61 2a 20 command! *data*
8470: 76 61 6c 29 0a 09 09 09 09 09 09 20 20 20 20 20 val).......
8480: 28 64 61 73 68 62 6f 61 72 64 3a 75 70 64 61 74 (dashboard:updat
8490: 65 2d 72 75 6e 2d 63 6f 6d 6d 61 6e 64 29 29 29 e-run-command)))
84a0: 29 0a 09 09 20 28 64 65 66 61 75 6c 74 2d 63 6d )... (default-cm
84b0: 64 20 28 63 61 72 20 63 6d 64 73 2d 6c 69 73 74 d (car cmds-list
84c0: 29 29 29 0a 09 20 20 20 20 28 69 75 70 6c 69 73 ))).. (iuplis
84d0: 74 62 6f 78 2d 66 69 6c 6c 2d 6c 69 73 74 20 6c tbox-fill-list l
84e0: 62 20 63 6d 64 73 2d 6c 69 73 74 20 73 65 6c 65 b cmds-list sele
84f0: 63 74 65 64 2d 69 74 65 6d 3a 20 64 65 66 61 75 cted-item: defau
8500: 6c 74 2d 63 6d 64 29 0a 09 20 20 20 20 28 64 62 lt-cmd).. (db
8510: 6f 61 72 64 3a 64 61 74 61 2d 73 65 74 2d 63 6f oard:data-set-co
8520: 6d 6d 61 6e 64 21 20 2a 64 61 74 61 2a 20 64 65 mmand! *data* de
8530: 66 61 75 6c 74 2d 63 6d 64 29 0a 09 20 20 20 20 fault-cmd)..
8540: 6c 62 29 29 29 0a 0a 09 28 69 75 70 3a 66 72 61 lb)))...(iup:fra
8550: 6d 65 0a 09 20 23 3a 74 69 74 6c 65 20 22 52 75 me.. #:title "Ru
8560: 6e 6e 61 6d 65 22 0a 09 20 28 6c 65 74 2a 20 28 nname".. (let* (
8570: 28 64 65 66 61 75 6c 74 2d 72 75 6e 2d 6e 61 6d (default-run-nam
8580: 65 20 28 73 65 63 6f 6e 64 73 2d 3e 77 6f 72 6b e (seconds->work
8590: 2d 77 65 65 6b 2f 64 61 79 20 28 63 75 72 72 65 -week/day (curre
85a0: 6e 74 2d 73 65 63 6f 6e 64 73 29 29 29 0a 09 09 nt-seconds)))...
85b0: 28 74 62 20 28 69 75 70 3a 74 65 78 74 62 6f 78 (tb (iup:textbox
85c0: 20 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a #:expand "HORIZ
85d0: 4f 4e 54 41 4c 22 0a 09 09 09 09 20 23 3a 61 63 ONTAL"..... #:ac
85e0: 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 tion (lambda (ob
85f0: 6a 20 76 61 6c 20 74 78 74 29 0a 09 09 09 09 09 j val txt)......
8600: 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 6f ;; (print "o
8610: 62 6a 3a 20 22 20 6f 62 6a 20 22 20 76 61 6c 3a bj: " obj " val:
8620: 20 22 20 76 61 6c 20 22 20 75 6e 6b 3a 20 22 20 " val " unk: "
8630: 75 6e 6b 29 0a 09 09 09 09 09 20 20 20 20 28 64 unk)...... (d
8640: 62 6f 61 72 64 3a 64 61 74 61 2d 73 65 74 2d 72 board:data-set-r
8650: 75 6e 2d 6e 61 6d 65 21 20 2a 64 61 74 61 2a 20 un-name! *data*
8660: 74 78 74 29 20 3b 3b 20 28 69 75 70 3a 61 74 74 txt) ;; (iup:att
8670: 72 69 62 75 74 65 20 6f 62 6a 20 22 56 41 4c 55 ribute obj "VALU
8680: 45 22 29 29 0a 09 09 09 09 09 20 20 20 20 28 64 E"))...... (d
8690: 61 73 68 62 6f 61 72 64 3a 75 70 64 61 74 65 2d ashboard:update-
86a0: 72 75 6e 2d 63 6f 6d 6d 61 6e 64 29 29 0a 09 09 run-command))...
86b0: 09 09 20 23 3a 76 61 6c 75 65 20 28 6f 72 20 64 .. #:value (or d
86c0: 65 66 61 75 6c 74 2d 72 75 6e 2d 6e 61 6d 65 20 efault-run-name
86d0: 28 64 62 6f 61 72 64 3a 64 61 74 61 2d 67 65 74 (dboard:data-get
86e0: 2d 72 75 6e 2d 6e 61 6d 65 20 2a 64 61 74 61 2a -run-name *data*
86f0: 29 29 29 29 0a 09 09 28 6c 62 20 28 69 75 70 3a ))))...(lb (iup:
8700: 6c 69 73 74 62 6f 78 20 23 3a 65 78 70 61 6e 64 listbox #:expand
8710: 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 0a 09 09 "HORIZONTAL"...
8720: 09 09 20 23 3a 64 72 6f 70 64 6f 77 6e 20 22 59 .. #:dropdown "Y
8730: 45 53 22 0a 09 09 09 09 20 23 3a 61 63 74 69 6f ES"..... #:actio
8740: 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 20 76 n (lambda (obj v
8750: 61 6c 20 69 6e 64 65 78 20 6c 62 73 74 61 74 65 al index lbstate
8760: 29 0a 09 09 09 09 09 20 20 20 20 28 69 66 20 28 )...... (if (
8770: 6e 6f 74 20 28 65 71 75 61 6c 3f 20 76 61 6c 20 not (equal? val
8780: 22 22 29 29 0a 09 09 09 09 09 09 28 62 65 67 69 "")).......(begi
8790: 6e 0a 09 09 09 09 09 09 20 20 28 69 75 70 3a 61 n....... (iup:a
87a0: 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 74 62 ttribute-set! tb
87b0: 20 22 56 41 4c 55 45 22 20 76 61 6c 29 0a 09 09 "VALUE" val)...
87c0: 09 09 09 09 20 20 28 64 62 6f 61 72 64 3a 64 61 .... (dboard:da
87d0: 74 61 2d 73 65 74 2d 72 75 6e 2d 6e 61 6d 65 21 ta-set-run-name!
87e0: 20 2a 64 61 74 61 2a 20 76 61 6c 29 0a 09 09 09 *data* val)....
87f0: 09 09 09 20 20 28 64 61 73 68 62 6f 61 72 64 3a ... (dashboard:
8800: 75 70 64 61 74 65 2d 72 75 6e 2d 63 6f 6d 6d 61 update-run-comma
8810: 6e 64 29 29 29 29 29 29 0a 09 09 28 72 65 66 72 nd))))))...(refr
8820: 65 73 68 2d 72 75 6e 73 2d 6c 69 73 74 20 28 6c esh-runs-list (l
8830: 61 6d 62 64 61 20 28 29 0a 09 09 09 09 20 20 20 ambda ().....
8840: 20 20 28 6c 65 74 2a 20 28 28 74 61 72 67 65 74 (let* ((target
8850: 20 20 20 20 20 20 20 20 28 64 62 6f 61 72 64 3a (dboard:
8860: 64 61 74 61 2d 67 65 74 2d 74 61 72 67 65 74 2d data-get-target-
8870: 73 74 72 69 6e 67 20 2a 64 61 74 61 2a 29 29 0a string *data*)).
8880: 09 09 09 09 09 20 20 20 20 28 72 75 6e 73 2d 66 ..... (runs-f
8890: 6f 72 2d 74 61 72 67 20 28 69 66 20 28 64 3a 61 or-targ (if (d:a
88a0: 6c 6c 64 61 74 2d 75 73 65 73 65 72 76 65 72 20 lldat-useserver
88b0: 2a 61 6c 6c 64 61 74 2a 29 0a 09 09 09 09 09 09 *alldat*).......
88c0: 09 20 20 20 20 20 20 20 28 72 6d 74 3a 67 65 74 . (rmt:get
88d0: 2d 72 75 6e 73 2d 62 79 2d 70 61 74 74 20 28 64 -runs-by-patt (d
88e0: 3a 61 6c 6c 64 61 74 2d 6b 65 79 73 20 2a 61 6c :alldat-keys *al
88f0: 6c 64 61 74 2a 29 20 22 25 22 20 74 61 72 67 65 ldat*) "%" targe
8900: 74 20 23 66 20 23 66 20 23 66 29 0a 09 09 09 09 t #f #f #f).....
8910: 09 09 09 20 20 20 20 20 20 20 28 64 62 3a 67 65 ... (db:ge
8920: 74 2d 72 75 6e 73 2d 62 79 2d 70 61 74 74 20 28 t-runs-by-patt (
8930: 64 3a 61 6c 6c 64 61 74 2d 64 62 6c 6f 63 61 6c d:alldat-dblocal
8940: 20 2a 61 6c 6c 64 61 74 2a 29 20 28 64 3a 61 6c *alldat*) (d:al
8950: 6c 64 61 74 2d 6b 65 79 73 20 2a 61 6c 6c 64 61 ldat-keys *allda
8960: 74 2a 29 20 22 25 22 20 74 61 72 67 65 74 20 23 t*) "%" target #
8970: 66 20 23 66 20 23 66 29 29 29 0a 09 09 09 09 09 f #f #f)))......
8980: 20 20 20 20 28 72 75 6e 73 2d 68 65 61 64 65 72 (runs-header
8990: 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 72 (vector-ref r
89a0: 75 6e 73 2d 66 6f 72 2d 74 61 72 67 20 30 29 29 uns-for-targ 0))
89b0: 0a 09 09 09 09 09 20 20 20 20 28 72 75 6e 73 2d ...... (runs-
89c0: 64 61 74 20 20 20 20 20 20 28 76 65 63 74 6f 72 dat (vector
89d0: 2d 72 65 66 20 72 75 6e 73 2d 66 6f 72 2d 74 61 -ref runs-for-ta
89e0: 72 67 20 31 29 29 0a 09 09 09 09 09 20 20 20 20 rg 1))......
89f0: 28 72 75 6e 2d 6e 61 6d 65 73 20 20 20 20 20 28 (run-names (
8a00: 63 6f 6e 73 20 64 65 66 61 75 6c 74 2d 72 75 6e cons default-run
8a10: 2d 6e 61 6d 65 20 0a 09 09 09 09 09 09 09 09 20 -name .........
8a20: 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 78 29 (map (lambda (x)
8a30: 0a 09 09 09 09 09 09 09 09 09 28 64 62 3a 67 65 ..........(db:ge
8a40: 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 t-value-by-heade
8a50: 72 20 78 20 72 75 6e 73 2d 68 65 61 64 65 72 20 r x runs-header
8a60: 22 72 75 6e 6e 61 6d 65 22 29 29 0a 09 09 09 09 "runname")).....
8a70: 09 09 09 09 20 20 20 20 20 20 72 75 6e 73 2d 64 .... runs-d
8a80: 61 74 29 29 29 29 0a 09 09 09 09 20 20 20 20 20 at)))).....
8a90: 20 20 3b 3b 20 28 69 75 70 3a 61 74 74 72 69 62 ;; (iup:attrib
8aa0: 75 74 65 2d 73 65 74 21 20 6c 62 20 22 52 45 4d ute-set! lb "REM
8ab0: 4f 56 45 49 54 45 4d 22 20 22 41 4c 4c 22 29 0a OVEITEM" "ALL").
8ac0: 09 09 09 09 20 20 20 20 20 20 20 28 69 75 70 6c .... (iupl
8ad0: 69 73 74 62 6f 78 2d 66 69 6c 6c 2d 6c 69 73 74 istbox-fill-list
8ae0: 20 6c 62 20 72 75 6e 2d 6e 61 6d 65 73 20 73 65 lb run-names se
8af0: 6c 65 63 74 65 64 2d 69 74 65 6d 3a 20 64 65 66 lected-item: def
8b00: 61 75 6c 74 2d 72 75 6e 2d 6e 61 6d 65 29 29 29 ault-run-name)))
8b10: 29 29 0a 09 20 20 20 28 73 65 74 21 20 75 70 64 )).. (set! upd
8b20: 61 74 65 72 2d 66 6f 72 2d 72 75 6e 73 20 72 65 ater-for-runs re
8b30: 66 72 65 73 68 2d 72 75 6e 73 2d 6c 69 73 74 29 fresh-runs-list)
8b40: 0a 09 20 20 20 28 72 65 66 72 65 73 68 2d 72 75 .. (refresh-ru
8b50: 6e 73 2d 6c 69 73 74 29 0a 09 20 20 20 28 64 62 ns-list).. (db
8b60: 6f 61 72 64 3a 64 61 74 61 2d 73 65 74 2d 72 75 oard:data-set-ru
8b70: 6e 2d 6e 61 6d 65 21 20 2a 64 61 74 61 2a 20 64 n-name! *data* d
8b80: 65 66 61 75 6c 74 2d 72 75 6e 2d 6e 61 6d 65 29 efault-run-name)
8b90: 0a 09 20 20 20 28 69 75 70 3a 68 62 6f 78 0a 09 .. (iup:hbox..
8ba0: 20 20 20 20 74 62 0a 09 20 20 20 20 6c 62 29 29 tb.. lb))
8bb0: 29 0a 0a 09 28 69 75 70 3a 66 72 61 6d 65 0a 09 )...(iup:frame..
8bc0: 20 23 3a 74 69 74 6c 65 20 22 53 45 4c 45 43 54 #:title "SELECT
8bd0: 4f 52 53 22 0a 09 20 28 69 75 70 3a 76 62 6f 78 ORS".. (iup:vbox
8be0: 0a 09 20 20 3b 3b 20 54 65 78 74 20 62 6f 78 20 .. ;; Text box
8bf0: 66 6f 72 20 74 65 73 74 20 70 61 74 74 65 72 6e for test pattern
8c00: 73 0a 09 20 20 28 69 75 70 3a 66 72 61 6d 65 0a s.. (iup:frame.
8c10: 09 20 20 20 23 3a 74 69 74 6c 65 20 22 54 65 73 . #:title "Tes
8c20: 74 20 70 61 74 74 65 72 6e 73 20 28 6f 6e 65 20 t patterns (one
8c30: 70 65 72 20 6c 69 6e 65 29 22 0a 09 20 20 20 28 per line)".. (
8c40: 6c 65 74 20 28 28 74 62 20 28 69 75 70 3a 74 65 let ((tb (iup:te
8c50: 78 74 62 6f 78 20 23 3a 61 63 74 69 6f 6e 20 28 xtbox #:action (
8c60: 6c 61 6d 62 64 61 20 28 76 61 6c 20 61 20 62 29 lambda (val a b)
8c70: 0a 09 09 09 09 09 20 20 20 20 20 28 64 62 6f 61 ...... (dboa
8c80: 72 64 3a 64 61 74 61 2d 73 65 74 2d 74 65 73 74 rd:data-set-test
8c90: 2d 70 61 74 74 73 21 0a 09 09 09 09 09 20 20 20 -patts!......
8ca0: 20 20 20 2a 64 61 74 61 2a 0a 09 09 09 09 09 20 *data*......
8cb0: 20 20 20 20 20 28 64 62 6f 61 72 64 3a 6c 69 6e (dboard:lin
8cc0: 65 73 2d 3e 74 65 73 74 2d 70 61 74 74 20 62 29 es->test-patt b)
8cd0: 29 0a 09 09 09 09 09 20 20 20 20 20 28 64 61 73 )...... (das
8ce0: 68 62 6f 61 72 64 3a 75 70 64 61 74 65 2d 72 75 hboard:update-ru
8cf0: 6e 2d 63 6f 6d 6d 61 6e 64 29 29 0a 09 09 09 09 n-command)).....
8d00: 20 20 23 3a 76 61 6c 75 65 20 28 64 62 6f 61 72 #:value (dboar
8d10: 64 3a 74 65 73 74 2d 70 61 74 74 2d 3e 6c 69 6e d:test-patt->lin
8d20: 65 73 0a 09 09 09 09 09 20 20 20 28 64 62 6f 61 es...... (dboa
8d30: 72 64 3a 64 61 74 61 2d 67 65 74 2d 74 65 73 74 rd:data-get-test
8d40: 2d 70 61 74 74 73 20 2a 64 61 74 61 2a 29 29 0a -patts *data*)).
8d50: 09 09 09 09 20 20 23 3a 65 78 70 61 6e 64 20 22 .... #:expand "
8d60: 59 45 53 22 0a 09 09 09 09 20 20 23 3a 73 69 7a YES"..... #:siz
8d70: 65 20 22 78 35 30 22 0a 09 09 09 09 20 20 23 3a e "x50"..... #:
8d80: 6d 75 6c 74 69 6c 69 6e 65 20 22 59 45 53 22 29 multiline "YES")
8d90: 29 29 0a 09 20 20 20 20 20 28 73 65 74 21 20 74 )).. (set! t
8da0: 65 73 74 2d 70 61 74 74 65 72 6e 73 2d 74 65 78 est-patterns-tex
8db0: 74 62 6f 78 20 74 62 29 0a 09 20 20 20 20 20 74 tbox tb).. t
8dc0: 62 29 29 0a 09 20 20 28 69 75 70 3a 66 72 61 6d b)).. (iup:fram
8dd0: 65 0a 09 20 20 20 23 3a 74 69 74 6c 65 20 22 54 e.. #:title "T
8de0: 61 72 67 65 74 22 0a 09 20 20 20 3b 3b 20 54 61 arget".. ;; Ta
8df0: 72 67 65 74 20 73 65 6c 65 63 74 6f 72 73 0a 09 rget selectors..
8e00: 20 20 20 28 61 70 70 6c 79 20 69 75 70 3a 68 62 (apply iup:hb
8e10: 6f 78 0a 09 09 20 20 28 6c 65 74 2a 20 28 28 64 ox... (let* ((d
8e20: 61 74 20 20 20 20 20 20 28 64 61 73 68 62 6f 61 at (dashboa
8e30: 72 64 3a 75 70 64 61 74 65 2d 74 61 72 67 65 74 rd:update-target
8e40: 2d 73 65 6c 65 63 74 6f 72 20 6b 65 79 2d 6c 69 -selector key-li
8e50: 73 74 62 6f 78 65 73 20 61 63 74 69 6f 6e 2d 70 stboxes action-p
8e60: 72 6f 63 3a 20 75 70 64 61 74 65 2d 6b 65 79 76 roc: update-keyv
8e70: 61 6c 73 29 29 0a 09 09 09 20 28 6b 65 79 2d 6c als)).... (key-l
8e80: 62 20 20 20 28 63 61 72 20 64 61 74 29 29 0a 09 b (car dat))..
8e90: 09 09 20 28 63 6f 6d 62 6f 73 20 20 20 28 63 61 .. (combos (ca
8ea0: 64 72 20 64 61 74 29 29 29 0a 09 09 20 20 20 20 dr dat)))...
8eb0: 28 73 65 74 21 20 6b 65 79 2d 6c 69 73 74 62 6f (set! key-listbo
8ec0: 78 65 73 20 6b 65 79 2d 6c 62 29 0a 09 09 20 20 xes key-lb)...
8ed0: 20 20 63 6f 6d 62 6f 73 29 29 29 0a 09 20 20 28 combos))).. (
8ee0: 69 75 70 3a 68 62 6f 78 0a 09 20 20 20 3b 3b 20 iup:hbox.. ;;
8ef0: 54 65 78 74 20 62 6f 78 20 66 6f 72 20 53 54 41 Text box for STA
8f00: 54 45 53 0a 09 20 20 20 28 69 75 70 3a 66 72 61 TES.. (iup:fra
8f10: 6d 65 0a 09 20 20 20 20 23 3a 74 69 74 6c 65 20 me.. #:title
8f20: 22 53 74 61 74 65 73 22 0a 09 20 20 20 20 28 64 "States".. (d
8f30: 61 73 68 62 6f 61 72 64 3a 74 65 78 74 2d 6c 69 ashboard:text-li
8f40: 73 74 2d 74 6f 67 67 6c 65 2d 62 6f 78 20 0a 09 st-toggle-box ..
8f50: 20 20 20 20 20 3b 3b 20 4d 6f 76 65 20 74 68 65 ;; Move the
8f60: 73 65 20 64 65 66 69 6e 69 74 69 6f 6e 73 20 74 se definitions t
8f70: 6f 20 63 6f 6d 6d 6f 6e 20 61 6e 64 20 66 69 6e o common and fin
8f80: 64 20 74 68 65 20 6f 74 68 65 72 20 75 73 65 61 d the other usea
8f90: 67 65 73 20 61 6e 64 20 72 65 70 6c 61 63 65 21 ges and replace!
8fa0: 0a 09 20 20 20 20 20 28 6d 61 70 20 63 61 64 72 .. (map cadr
8fb0: 20 2a 63 6f 6d 6d 6f 6e 3a 73 74 64 2d 73 74 61 *common:std-sta
8fc0: 74 65 73 2a 29 20 3b 3b 20 27 28 22 43 4f 4d 50 tes*) ;; '("COMP
8fd0: 4c 45 54 45 44 22 20 22 52 55 4e 4e 49 4e 47 22 LETED" "RUNNING"
8fe0: 20 22 53 54 55 43 4b 22 20 22 49 4e 43 4f 4d 50 "STUCK" "INCOMP
8ff0: 4c 45 54 45 22 20 22 4c 41 55 4e 43 48 45 44 22 LETE" "LAUNCHED"
9000: 20 22 52 45 4d 4f 54 45 48 4f 53 54 53 54 41 52 "REMOTEHOSTSTAR
9010: 54 22 20 22 4b 49 4c 4c 45 44 22 29 0a 09 20 20 T" "KILLED")..
9020: 20 20 20 28 6c 61 6d 62 64 61 20 28 61 6c 6c 29 (lambda (all)
9030: 0a 09 20 20 20 20 20 20 20 28 64 62 6f 61 72 64 .. (dboard
9040: 3a 64 61 74 61 2d 73 65 74 2d 73 74 61 74 65 73 :data-set-states
9050: 21 20 2a 64 61 74 61 2a 20 61 6c 6c 29 0a 09 20 ! *data* all)..
9060: 20 20 20 20 20 20 28 64 61 73 68 62 6f 61 72 64 (dashboard
9070: 3a 75 70 64 61 74 65 2d 72 75 6e 2d 63 6f 6d 6d :update-run-comm
9080: 61 6e 64 29 29 29 29 0a 09 20 20 20 3b 3b 20 54 and)))).. ;; T
9090: 65 78 74 20 62 6f 78 20 66 6f 72 20 53 54 41 54 ext box for STAT
90a0: 45 53 0a 09 20 20 20 28 69 75 70 3a 66 72 61 6d ES.. (iup:fram
90b0: 65 0a 09 20 20 20 20 23 3a 74 69 74 6c 65 20 22 e.. #:title "
90c0: 53 74 61 74 75 73 65 73 22 0a 09 20 20 20 20 28 Statuses".. (
90d0: 64 61 73 68 62 6f 61 72 64 3a 74 65 78 74 2d 6c dashboard:text-l
90e0: 69 73 74 2d 74 6f 67 67 6c 65 2d 62 6f 78 20 0a ist-toggle-box .
90f0: 09 20 20 20 20 20 28 6d 61 70 20 63 61 64 72 20 . (map cadr
9100: 2a 63 6f 6d 6d 6f 6e 3a 73 74 64 2d 73 74 61 74 *common:std-stat
9110: 75 73 65 73 2a 29 20 3b 3b 20 27 28 22 50 41 53 uses*) ;; '("PAS
9120: 53 22 20 22 46 41 49 4c 22 20 22 6e 2f 61 22 20 S" "FAIL" "n/a"
9130: 22 43 48 45 43 4b 22 20 22 57 41 49 56 45 44 22 "CHECK" "WAIVED"
9140: 20 22 53 4b 49 50 22 20 22 44 45 4c 45 54 45 44 "SKIP" "DELETED
9150: 22 20 22 53 54 55 43 4b 2f 44 45 41 44 22 29 0a " "STUCK/DEAD").
9160: 09 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 61 . (lambda (a
9170: 6c 6c 29 0a 09 20 20 20 20 20 20 20 28 64 62 6f ll).. (dbo
9180: 61 72 64 3a 64 61 74 61 2d 73 65 74 2d 73 74 61 ard:data-set-sta
9190: 74 75 73 65 73 21 20 2a 64 61 74 61 2a 20 61 6c tuses! *data* al
91a0: 6c 29 0a 09 20 20 20 20 20 20 20 28 64 61 73 68 l).. (dash
91b0: 62 6f 61 72 64 3a 75 70 64 61 74 65 2d 72 75 6e board:update-run
91c0: 2d 63 6f 6d 6d 61 6e 64 29 29 29 29 29 29 29 29 -command))))))))
91d0: 0a 20 20 20 20 20 20 20 0a 20 20 20 20 20 20 20 . .
91e0: 28 69 75 70 3a 66 72 61 6d 65 0a 09 23 3a 74 69 (iup:frame..#:ti
91f0: 74 6c 65 20 22 54 65 73 74 73 20 61 6e 64 20 54 tle "Tests and T
9200: 61 73 6b 73 22 0a 09 28 6c 65 74 2a 20 28 28 75 asks"..(let* ((u
9210: 70 64 61 74 65 72 20 23 66 29 0a 09 20 20 20 20 pdater #f)..
9220: 20 20 20 28 6c 61 73 74 2d 78 61 64 6a 20 30 29 (last-xadj 0)
9230: 0a 09 20 20 20 20 20 20 20 28 6c 61 73 74 2d 79 .. (last-y
9240: 61 64 6a 20 30 29 0a 09 20 20 20 20 20 20 20 28 adj 0).. (
9250: 74 68 65 2d 63 6e 76 20 20 20 23 66 29 0a 09 20 the-cnv #f)..
9260: 20 20 20 20 20 20 28 63 61 6e 76 61 73 2d 6f 62 (canvas-ob
9270: 6a 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 j .
9280: 20 20 20 28 69 75 70 3a 63 61 6e 76 61 73 20 23 (iup:canvas #
9290: 3a 61 63 74 69 6f 6e 20 28 6d 61 6b 65 2d 63 61 :action (make-ca
92a0: 6e 76 61 73 2d 61 63 74 69 6f 6e 0a 09 09 09 09 nvas-action.....
92b0: 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 63 (lambda (c
92c0: 6e 76 20 78 61 64 6a 20 79 61 64 6a 29 0a 09 09 nv xadj yadj)...
92d0: 09 09 09 28 69 66 20 28 6e 6f 74 20 75 70 64 61 ...(if (not upda
92e0: 74 65 72 29 0a 09 09 09 09 09 20 20 20 20 28 73 ter)...... (s
92f0: 65 74 21 20 75 70 64 61 74 65 72 20 28 6c 61 6d et! updater (lam
9300: 62 64 61 20 28 78 61 64 6a 20 79 61 64 6a 29 0a bda (xadj yadj).
9310: 09 09 09 09 09 09 09 20 20 20 20 3b 3b 20 28 70 ....... ;; (p
9320: 72 69 6e 74 20 22 63 6e 76 3a 20 22 20 63 6e 76 rint "cnv: " cnv
9330: 20 22 20 78 61 64 6a 3a 20 22 20 78 61 64 6a 20 " xadj: " xadj
9340: 22 20 79 61 64 6a 3a 20 22 20 79 61 64 6a 29 0a " yadj: " yadj).
9350: 09 09 09 09 09 09 09 20 20 20 20 28 64 61 73 68 ....... (dash
9360: 62 6f 61 72 64 3a 64 72 61 77 2d 74 65 73 74 73 board:draw-tests
9370: 20 63 6e 76 20 78 61 64 6a 20 79 61 64 6a 20 74 cnv xadj yadj t
9380: 65 73 74 73 2d 64 72 61 77 2d 73 74 61 74 65 20 ests-draw-state
9390: 73 6f 72 74 65 64 2d 74 65 73 74 6e 61 6d 65 73 sorted-testnames
93a0: 20 74 65 73 74 2d 72 65 63 6f 72 64 73 29 0a 09 test-records)..
93b0: 09 09 09 09 09 09 20 20 20 20 28 73 65 74 21 20 ...... (set!
93c0: 6c 61 73 74 2d 78 61 64 6a 20 78 61 64 6a 29 0a last-xadj xadj).
93d0: 09 09 09 09 09 09 09 20 20 20 20 28 73 65 74 21 ....... (set!
93e0: 20 6c 61 73 74 2d 79 61 64 6a 20 79 61 64 6a 29 last-yadj yadj)
93f0: 29 29 29 0a 09 09 09 09 09 28 75 70 64 61 74 65 )))......(update
9400: 72 20 78 61 64 6a 20 79 61 64 6a 29 0a 09 09 09 r xadj yadj)....
9410: 09 09 28 73 65 74 21 20 74 68 65 2d 63 6e 76 20 ..(set! the-cnv
9420: 63 6e 76 29 0a 09 09 09 09 09 29 29 0a 09 09 09 cnv)......))....
9430: 20 20 20 20 3b 3b 20 46 6f 6c 6c 6f 77 69 6e 67 ;; Following
9440: 20 64 6f 65 73 6e 27 74 20 77 6f 72 6b 20 0a 09 doesn't work ..
9450: 09 09 20 20 20 20 23 3a 77 68 65 65 6c 2d 63 62 .. #:wheel-cb
9460: 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 20 73 74 (lambda (obj st
9470: 65 70 20 78 20 79 20 64 69 72 29 20 3b 3b 20 64 ep x y dir) ;; d
9480: 69 72 20 69 73 20 34 20 66 6f 72 20 75 70 20 61 ir is 4 for up a
9490: 6e 64 20 35 20 66 6f 72 20 64 6f 77 6e 2e 20 49 nd 5 for down. I
94a0: 20 74 68 69 6e 6b 2e 0a 09 09 09 09 09 20 28 6c think....... (l
94b0: 65 74 20 28 28 73 63 61 6c 65 66 20 28 68 61 73 et ((scalef (has
94c0: 68 2d 74 61 62 6c 65 2d 72 65 66 20 74 65 73 74 h-table-ref test
94d0: 73 2d 64 72 61 77 2d 73 74 61 74 65 20 27 73 63 s-draw-state 'sc
94e0: 61 6c 65 66 29 29 29 0a 09 09 09 09 09 20 20 20 alef)))......
94f0: 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 (hash-table-set!
9500: 20 74 65 73 74 73 2d 64 72 61 77 2d 73 74 61 74 tests-draw-stat
9510: 65 20 27 73 63 61 6c 65 66 20 28 2b 20 73 63 61 e 'scalef (+ sca
9520: 6c 65 66 0a 09 09 09 09 09 09 09 09 09 09 09 28 lef............(
9530: 69 66 20 28 3e 20 73 74 65 70 20 30 29 0a 09 09 if (> step 0)...
9540: 09 09 09 09 09 09 09 09 09 20 20 20 20 28 2a 20 ......... (*
9550: 73 63 61 6c 65 66 20 30 2e 30 31 29 0a 09 09 09 scalef 0.01)....
9560: 09 09 09 09 09 09 09 09 20 20 20 20 28 2a 20 73 ........ (* s
9570: 63 61 6c 65 66 20 2d 30 2e 30 31 29 29 29 29 0a calef -0.01)))).
9580: 09 09 09 09 09 20 20 20 28 69 66 20 74 68 65 2d ..... (if the-
9590: 63 6e 76 0a 09 09 09 09 09 20 20 20 20 20 20 20 cnv......
95a0: 28 64 61 73 68 62 6f 61 72 64 3a 64 72 61 77 2d (dashboard:draw-
95b0: 74 65 73 74 73 20 74 68 65 2d 63 6e 76 20 6c 61 tests the-cnv la
95c0: 73 74 2d 78 61 64 6a 20 6c 61 73 74 2d 79 61 64 st-xadj last-yad
95d0: 6a 20 74 65 73 74 73 2d 64 72 61 77 2d 73 74 61 j tests-draw-sta
95e0: 74 65 20 73 6f 72 74 65 64 2d 74 65 73 74 6e 61 te sorted-testna
95f0: 6d 65 73 20 74 65 73 74 2d 72 65 63 6f 72 64 73 mes test-records
9600: 29 29 0a 09 09 09 09 09 20 20 20 29 29 0a 09 09 ))...... ))...
9610: 09 20 20 20 20 3b 3b 20 23 3a 73 69 7a 65 20 22 . ;; #:size "
9620: 35 30 78 35 30 22 0a 09 09 09 20 20 20 20 23 3a 50x50".... #:
9630: 65 78 70 61 6e 64 20 22 59 45 53 22 0a 09 09 09 expand "YES"....
9640: 20 20 20 20 23 3a 73 63 72 6f 6c 6c 62 61 72 20 #:scrollbar
9650: 22 59 45 53 22 0a 09 09 09 20 20 20 20 23 3a 70 "YES".... #:p
9660: 6f 73 78 20 22 30 2e 35 22 0a 09 09 09 20 20 20 osx "0.5"....
9670: 20 23 3a 70 6f 73 79 20 22 30 2e 35 22 0a 09 09 #:posy "0.5"...
9680: 09 20 20 20 20 23 3a 62 75 74 74 6f 6e 2d 63 62 . #:button-cb
9690: 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 20 62 74 (lambda (obj bt
96a0: 6e 20 70 72 65 73 73 65 64 20 78 20 79 20 73 74 n pressed x y st
96b0: 61 74 75 73 29 0a 09 09 09 09 09 20 20 3b 3b 20 atus)...... ;;
96c0: 28 70 72 69 6e 74 20 22 6f 62 6a 3a 20 22 20 6f (print "obj: " o
96d0: 62 6a 20 22 2c 20 70 72 65 73 73 65 64 20 22 20 bj ", pressed "
96e0: 70 72 65 73 73 65 64 20 22 2c 20 73 74 61 74 75 pressed ", statu
96f0: 73 20 22 20 73 74 61 74 75 73 29 0a 09 09 09 09 s " status).....
9700: 09 3b 20 28 70 72 69 6e 74 20 22 63 61 6e 76 61 .; (print "canva
9710: 73 2d 6f 72 69 67 69 6e 3a 20 22 20 28 63 61 6e s-origin: " (can
9720: 76 61 73 2d 6f 72 69 67 69 6e 20 74 68 65 2d 63 vas-origin the-c
9730: 6e 76 29 29 0a 09 09 09 09 09 20 20 3b 3b 20 28 nv))...... ;; (
9740: 6c 65 74 2d 76 61 6c 75 65 73 20 28 28 28 78 78 let-values (((xx
9750: 20 79 79 29 28 63 61 6e 76 61 73 2d 6f 72 69 67 yy)(canvas-orig
9760: 69 6e 20 74 68 65 2d 63 6e 76 29 29 29 0a 09 09 in the-cnv)))...
9770: 09 09 09 20 20 3b 3b 20 28 63 61 6e 76 61 73 2d ... ;; (canvas-
9780: 74 72 61 6e 73 66 6f 72 6d 2d 73 65 74 21 20 74 transform-set! t
9790: 68 65 2d 63 6e 76 20 23 66 29 0a 09 09 09 09 09 he-cnv #f)......
97a0: 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 63 61 6e ;; (print "can
97b0: 76 61 73 2d 6f 72 69 67 69 6e 3a 20 22 20 78 78 vas-origin: " xx
97c0: 20 22 20 22 20 79 79 20 22 20 63 6c 69 63 6b 20 " " yy " click
97d0: 61 74 20 22 20 78 20 22 20 22 20 79 29 29 0a 09 at " x " " y))..
97e0: 09 09 09 09 20 20 28 6c 65 74 2a 20 28 28 74 65 .... (let* ((te
97f0: 73 74 73 2d 69 6e 66 6f 20 20 20 20 20 28 68 61 sts-info (ha
9800: 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 74 65 73 sh-table-ref tes
9810: 74 73 2d 64 72 61 77 2d 73 74 61 74 65 20 27 74 ts-draw-state 't
9820: 65 73 74 73 2d 69 6e 66 6f 29 29 0a 09 09 09 09 ests-info)).....
9830: 09 09 20 28 73 65 6c 65 63 74 65 64 2d 74 65 73 .. (selected-tes
9840: 74 73 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 ts (hash-table-r
9850: 65 66 20 74 65 73 74 73 2d 64 72 61 77 2d 73 74 ef tests-draw-st
9860: 61 74 65 20 27 73 65 6c 65 63 74 65 64 2d 74 65 ate 'selected-te
9870: 73 74 73 29 29 0a 09 09 09 09 09 09 20 28 73 63 sts))....... (sc
9880: 61 6c 65 66 20 20 20 20 20 20 20 20 20 28 68 61 alef (ha
9890: 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 74 65 73 sh-table-ref tes
98a0: 74 73 2d 64 72 61 77 2d 73 74 61 74 65 20 27 73 ts-draw-state 's
98b0: 63 61 6c 65 66 29 29 0a 09 09 09 09 09 09 20 28 calef))....... (
98c0: 73 69 7a 65 79 20 20 20 20 20 20 20 20 20 20 28 sizey (
98d0: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 74 hash-table-ref t
98e0: 65 73 74 73 2d 64 72 61 77 2d 73 74 61 74 65 20 ests-draw-state
98f0: 27 73 69 7a 65 79 29 29 0a 09 09 09 09 09 09 20 'sizey)).......
9900: 28 78 6f 66 66 73 65 74 20 20 20 20 20 20 20 20 (xoffset
9910: 28 64 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 78 6f 66 (dcommon:get-xof
9920: 66 73 65 74 20 74 65 73 74 73 2d 64 72 61 77 2d fset tests-draw-
9930: 73 74 61 74 65 20 23 66 20 23 66 29 29 0a 09 09 state #f #f))...
9940: 09 09 09 09 20 28 79 6f 66 66 73 65 74 20 20 20 .... (yoffset
9950: 20 20 20 20 20 28 64 63 6f 6d 6d 6f 6e 3a 67 65 (dcommon:ge
9960: 74 2d 79 6f 66 66 73 65 74 20 74 65 73 74 73 2d t-yoffset tests-
9970: 64 72 61 77 2d 73 74 61 74 65 20 23 66 20 23 66 draw-state #f #f
9980: 29 29 0a 09 09 09 09 09 09 20 28 6e 65 77 2d 79 ))....... (new-y
9990: 20 20 20 20 20 20 20 20 20 20 28 2d 20 73 69 7a (- siz
99a0: 65 79 20 79 29 29 29 0a 09 09 09 09 09 20 20 20 ey y)))......
99b0: 20 3b 3b 20 28 70 72 69 6e 74 20 22 78 6f 66 66 ;; (print "xoff
99c0: 73 65 74 3d 22 20 78 6f 66 66 73 65 74 20 22 2c set=" xoffset ",
99d0: 20 79 6f 66 66 73 65 74 3d 22 20 79 6f 66 66 73 yoffset=" yoffs
99e0: 65 74 29 0a 09 09 09 09 09 20 20 20 20 3b 3b 20 et)...... ;;
99f0: 28 70 72 69 6e 74 20 22 5c 74 78 5c 74 79 5c 74 (print "\tx\ty\t
9a00: 6c 6c 78 5c 74 6c 6c 79 5c 74 75 72 78 5c 74 75 llx\tlly\turx\tu
9a10: 72 79 22 29 0a 09 09 09 09 09 20 20 20 20 28 66 ry")...... (f
9a20: 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 or-each (lambda
9a30: 28 74 65 73 74 2d 6e 61 6d 65 29 0a 09 09 09 09 (test-name).....
9a40: 09 09 09 28 6c 65 74 2a 20 28 28 72 65 63 2d 63 ...(let* ((rec-c
9a50: 6f 6f 72 64 73 20 28 68 61 73 68 2d 74 61 62 6c oords (hash-tabl
9a60: 65 2d 72 65 66 20 74 65 73 74 73 2d 69 6e 66 6f e-ref tests-info
9a70: 20 74 65 73 74 2d 6e 61 6d 65 29 29 0a 09 09 09 test-name))....
9a80: 09 09 09 09 20 20 20 20 20 20 20 28 6c 6c 78 20 .... (llx
9a90: 20 20 20 20 20 20 20 28 64 63 6f 6d 6d 6f 6e 3a (dcommon:
9aa0: 78 2d 3e 63 61 6e 76 61 73 20 28 6c 69 73 74 2d x->canvas (list-
9ab0: 72 65 66 20 72 65 63 2d 63 6f 6f 72 64 73 20 30 ref rec-coords 0
9ac0: 29 20 73 63 61 6c 65 66 20 78 6f 66 66 73 65 74 ) scalef xoffset
9ad0: 29 29 0a 09 09 09 09 09 09 09 20 20 20 20 20 20 ))........
9ae0: 20 28 6c 6c 79 20 20 20 20 20 20 20 20 28 64 63 (lly (dc
9af0: 6f 6d 6d 6f 6e 3a 79 2d 3e 63 61 6e 76 61 73 20 ommon:y->canvas
9b00: 28 6c 69 73 74 2d 72 65 66 20 72 65 63 2d 63 6f (list-ref rec-co
9b10: 6f 72 64 73 20 31 29 20 73 63 61 6c 65 66 20 79 ords 1) scalef y
9b20: 6f 66 66 73 65 74 29 29 0a 09 09 09 09 09 09 09 offset))........
9b30: 20 20 20 20 20 20 20 28 75 72 78 20 20 20 20 20 (urx
9b40: 20 20 20 28 64 63 6f 6d 6d 6f 6e 3a 78 2d 3e 63 (dcommon:x->c
9b50: 61 6e 76 61 73 20 28 6c 69 73 74 2d 72 65 66 20 anvas (list-ref
9b60: 72 65 63 2d 63 6f 6f 72 64 73 20 32 29 20 73 63 rec-coords 2) sc
9b70: 61 6c 65 66 20 78 6f 66 66 73 65 74 29 29 0a 09 alef xoffset))..
9b80: 09 09 09 09 09 09 20 20 20 20 20 20 20 28 75 72 ...... (ur
9b90: 79 20 20 20 20 20 20 20 20 28 64 63 6f 6d 6d 6f y (dcommo
9ba0: 6e 3a 79 2d 3e 63 61 6e 76 61 73 20 28 6c 69 73 n:y->canvas (lis
9bb0: 74 2d 72 65 66 20 72 65 63 2d 63 6f 6f 72 64 73 t-ref rec-coords
9bc0: 20 33 29 20 73 63 61 6c 65 66 20 79 6f 66 66 73 3) scalef yoffs
9bd0: 65 74 29 29 29 0a 09 09 09 09 09 09 09 20 20 3b et)))........ ;
9be0: 3b 20 28 69 66 20 28 65 71 3f 20 70 72 65 73 73 ; (if (eq? press
9bf0: 65 64 20 31 29 0a 09 09 09 09 09 09 09 20 20 3b ed 1)........ ;
9c00: 3b 20 20 20 20 28 70 72 69 6e 74 20 22 5c 74 78 ; (print "\tx
9c10: 3d 22 20 78 20 22 5c 74 79 3d 22 20 79 20 22 5c =" x "\ty=" y "\
9c20: 74 6e 65 77 2d 79 3d 22 20 6e 65 77 2d 79 20 22 tnew-y=" new-y "
9c30: 5c 74 6c 6c 78 3d 22 20 6c 6c 78 20 22 5c 74 6c \tllx=" llx "\tl
9c40: 6c 79 3d 22 20 6c 6c 79 20 22 5c 74 75 72 78 3d ly=" lly "\turx=
9c50: 22 20 75 72 78 20 22 5c 74 75 72 79 3d 22 20 75 " urx "\tury=" u
9c60: 72 79 20 22 5c 74 22 20 74 65 73 74 2d 6e 61 6d ry "\t" test-nam
9c70: 65 20 22 20 22 29 29 0a 09 09 09 09 09 09 09 20 e " "))........
9c80: 20 28 69 66 20 28 61 6e 64 20 28 65 71 3f 20 70 (if (and (eq? p
9c90: 72 65 73 73 65 64 20 31 29 0a 09 09 09 09 09 09 ressed 1).......
9ca0: 09 09 20 20 20 28 3e 3d 20 78 20 6c 6c 78 29 0a .. (>= x llx).
9cb0: 09 09 09 09 09 09 09 09 20 20 20 28 3e 3d 20 6e ........ (>= n
9cc0: 65 77 2d 79 20 6c 6c 79 29 0a 09 09 09 09 09 09 ew-y lly).......
9cd0: 09 09 20 20 20 28 3c 3d 20 78 20 75 72 78 29 0a .. (<= x urx).
9ce0: 09 09 09 09 09 09 09 09 20 20 20 28 3c 3d 20 6e ........ (<= n
9cf0: 65 77 2d 79 20 75 72 79 29 29 0a 09 09 09 09 09 ew-y ury))......
9d00: 09 09 20 20 20 20 20 20 28 6c 65 74 20 28 28 70 .. (let ((p
9d10: 61 74 74 65 72 6e 73 20 28 73 74 72 69 6e 67 2d atterns (string-
9d20: 73 70 6c 69 74 20 28 69 75 70 3a 61 74 74 72 69 split (iup:attri
9d30: 62 75 74 65 20 74 65 73 74 2d 70 61 74 74 65 72 bute test-patter
9d40: 6e 73 2d 74 65 78 74 62 6f 78 20 22 56 41 4c 55 ns-textbox "VALU
9d50: 45 22 29 29 29 29 0a 09 09 09 09 09 09 09 09 28 E")))).........(
9d60: 6c 65 74 2a 20 28 28 73 65 6c 65 63 74 65 64 20 let* ((selected
9d70: 20 20 20 20 28 6e 6f 74 20 28 6d 65 6d 62 65 72 (not (member
9d80: 20 74 65 73 74 2d 6e 61 6d 65 20 70 61 74 74 65 test-name patte
9d90: 72 6e 73 29 29 29 0a 09 09 09 09 09 09 09 09 20 rns))).........
9da0: 20 20 20 20 20 20 28 6e 65 77 70 61 74 74 2d 6c (newpatt-l
9db0: 69 73 74 20 28 69 66 20 73 65 6c 65 63 74 65 64 ist (if selected
9dc0: 0a 09 09 09 09 09 09 09 09 09 09 09 20 28 63 6f ............ (co
9dd0: 6e 73 20 74 65 73 74 2d 6e 61 6d 65 20 70 61 74 ns test-name pat
9de0: 74 65 72 6e 73 29 0a 09 09 09 09 09 09 09 09 09 terns)..........
9df0: 09 09 20 28 64 65 6c 65 74 65 20 74 65 73 74 2d .. (delete test-
9e00: 6e 61 6d 65 20 70 61 74 74 65 72 6e 73 29 29 29 name patterns)))
9e10: 0a 09 09 09 09 09 09 09 09 20 20 20 20 20 20 20 .........
9e20: 28 6e 65 77 70 61 74 74 20 20 20 20 20 20 28 73 (newpatt (s
9e30: 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 tring-interspers
9e40: 65 20 6e 65 77 70 61 74 74 2d 6c 69 73 74 20 22 e newpatt-list "
9e50: 5c 6e 22 29 29 29 0a 09 09 09 09 09 09 09 09 20 \n"))).........
9e60: 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d (iup:attribute-
9e70: 73 65 74 21 20 6f 62 6a 20 22 52 45 44 52 41 57 set! obj "REDRAW
9e80: 22 20 22 41 4c 4c 22 29 0a 09 09 09 09 09 09 09 " "ALL")........
9e90: 09 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 . (hash-table-s
9ea0: 65 74 21 20 73 65 6c 65 63 74 65 64 2d 74 65 73 et! selected-tes
9eb0: 74 73 20 74 65 73 74 2d 6e 61 6d 65 20 73 65 6c ts test-name sel
9ec0: 65 63 74 65 64 29 0a 09 09 09 09 09 09 09 09 20 ected).........
9ed0: 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d (iup:attribute-
9ee0: 73 65 74 21 20 74 65 73 74 2d 70 61 74 74 65 72 set! test-patter
9ef0: 6e 73 2d 74 65 78 74 62 6f 78 20 22 56 41 4c 55 ns-textbox "VALU
9f00: 45 22 20 6e 65 77 70 61 74 74 29 0a 09 09 09 09 E" newpatt).....
9f10: 09 09 09 09 20 20 28 64 62 6f 61 72 64 3a 64 61 .... (dboard:da
9f20: 74 61 2d 73 65 74 2d 74 65 73 74 2d 70 61 74 74 ta-set-test-patt
9f30: 73 21 20 2a 64 61 74 61 2a 20 28 64 62 6f 61 72 s! *data* (dboar
9f40: 64 3a 6c 69 6e 65 73 2d 3e 74 65 73 74 2d 70 61 d:lines->test-pa
9f50: 74 74 20 6e 65 77 70 61 74 74 29 29 0a 09 09 09 tt newpatt))....
9f60: 09 09 09 09 09 20 20 28 64 61 73 68 62 6f 61 72 ..... (dashboar
9f70: 64 3a 75 70 64 61 74 65 2d 72 75 6e 2d 63 6f 6d d:update-run-com
9f80: 6d 61 6e 64 29 0a 09 09 09 09 09 09 09 09 20 20 mand).........
9f90: 28 69 66 20 75 70 64 61 74 65 72 20 28 75 70 64 (if updater (upd
9fa0: 61 74 65 72 20 6c 61 73 74 2d 78 61 64 6a 20 6c ater last-xadj l
9fb0: 61 73 74 2d 79 61 64 6a 29 29 29 29 29 29 29 0a ast-yadj))))))).
9fc0: 09 09 09 09 09 09 20 20 20 20 20 20 28 68 61 73 ...... (has
9fd0: 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 74 65 73 h-table-keys tes
9fe0: 74 73 2d 69 6e 66 6f 29 29 29 29 29 29 29 0a 09 ts-info)))))))..
9ff0: 20 20 63 61 6e 76 61 73 2d 6f 62 6a 29 29 29 0a canvas-obj))).
a000: 20 20 20 20 20 20 0a 20 20 20 20 20 20 28 69 75 . (iu
a010: 70 3a 66 72 61 6d 65 0a 20 20 20 20 20 20 20 23 p:frame. #
a020: 3a 74 69 74 6c 65 20 22 4c 6f 67 73 22 20 3b 3b :title "Logs" ;;
a030: 20 54 6f 20 62 65 20 72 65 70 6c 61 63 65 64 20 To be replaced
a040: 77 69 74 68 20 74 61 62 73 0a 20 20 20 20 20 20 with tabs.
a050: 20 28 6c 65 74 20 28 28 6c 6f 67 73 2d 74 62 20 (let ((logs-tb
a060: 28 69 75 70 3a 74 65 78 74 62 6f 78 20 23 3a 65 (iup:textbox #:e
a070: 78 70 61 6e 64 20 22 59 45 53 22 0a 09 09 09 09 xpand "YES".....
a080: 20 20 20 23 3a 6d 75 6c 74 69 6c 69 6e 65 20 22 #:multiline "
a090: 59 45 53 22 29 29 29 0a 09 20 28 64 62 6f 61 72 YES"))).. (dboar
a0a0: 64 3a 64 61 74 61 2d 73 65 74 2d 6c 6f 67 73 2d d:data-set-logs-
a0b0: 74 65 78 74 62 6f 78 21 20 2a 64 61 74 61 2a 20 textbox! *data*
a0c0: 6c 6f 67 73 2d 74 62 29 0a 09 20 6c 6f 67 73 2d logs-tb).. logs-
a0d0: 74 62 29 29 29 29 29 29 0a 0a 0a 3b 3b 20 28 74 tb))))))...;; (t
a0e0: 72 61 63 65 20 64 61 73 68 62 6f 61 72 64 3a 70 race dashboard:p
a0f0: 6f 70 75 6c 61 74 65 2d 74 61 72 67 65 74 2d 64 opulate-target-d
a100: 72 6f 70 64 6f 77 6e 0a 3b 3b 20 20 20 20 20 20 ropdown.;;
a110: 20 20 63 6f 6d 6d 6f 6e 3a 6c 69 73 74 2d 69 73 common:list-is
a120: 2d 73 75 62 6c 69 73 74 29 0a 3b 3b 20 0a 3b 3b -sublist).;; .;;
a130: 20 20 20 20 20 20 20 3b 3b 20 6b 65 79 31 20 6b ;; key1 k
a140: 65 79 32 20 6b 65 79 33 20 2e 2e 2e 0a 3b 3b 20 ey2 key3 ....;;
a150: 20 20 20 20 20 20 3b 3b 20 74 61 72 67 65 74 20 ;; target
a160: 65 6e 74 72 79 20 28 77 69 6c 64 20 63 61 72 64 entry (wild card
a170: 73 20 61 6c 6c 6f 77 65 64 29 0a 3b 3b 20 20 20 s allowed).;;
a180: 20 20 20 20 0a 3b 3b 20 20 20 20 20 20 20 3b 3b .;; ;;
a190: 20 54 68 65 20 61 63 74 69 6f 6e 0a 3b 3b 20 20 The action.;;
a1a0: 20 20 20 20 20 28 69 75 70 3a 68 62 6f 78 0a 3b (iup:hbox.;
a1b0: 3b 20 20 20 20 20 20 20 20 3b 3b 20 6c 61 62 65 ; ;; labe
a1c0: 6c 20 41 63 74 69 6f 6e 20 7c 20 61 63 74 69 6f l Action | actio
a1d0: 6e 20 73 65 6c 65 63 74 6f 72 0a 3b 3b 20 20 20 n selector.;;
a1e0: 20 20 20 20 20 29 29 0a 3b 3b 20 20 20 20 20 20 )).;;
a1f0: 3b 3b 20 54 65 73 74 2f 69 74 65 6d 73 20 73 65 ;; Test/items se
a200: 6c 65 63 74 6f 72 0a 3b 3b 20 20 20 20 20 20 28 lector.;; (
a210: 69 75 70 3a 68 62 6f 78 0a 3b 3b 20 20 20 20 20 iup:hbox.;;
a220: 20 20 3b 3b 20 74 65 73 74 73 0a 3b 3b 20 20 20 ;; tests.;;
a230: 20 20 20 20 3b 3b 20 69 74 65 6d 73 0a 3b 3b 20 ;; items.;;
a240: 20 20 20 20 20 20 29 29 0a 3b 3b 20 20 20 20 20 )).;;
a250: 3b 3b 20 54 68 65 20 63 6f 6d 6d 61 6e 64 20 6c ;; The command l
a260: 69 6e 65 0a 3b 3b 20 20 20 20 20 28 69 75 70 3a ine.;; (iup:
a270: 68 62 6f 78 0a 3b 3b 20 20 20 20 20 20 3b 3b 20 hbox.;; ;;
a280: 63 6f 6d 6d 61 6e 64 6c 69 6e 65 20 65 6e 74 72 commandline entr
a290: 79 0a 3b 3b 20 20 20 20 20 20 3b 3b 20 47 4f 20 y.;; ;; GO
a2a0: 62 75 74 74 6f 6e 0a 3b 3b 20 20 20 20 20 20 29 button.;; )
a2b0: 0a 3b 3b 20 20 20 20 20 3b 3b 20 54 68 65 20 63 .;; ;; The c
a2c0: 6f 6d 6d 61 6e 64 20 6c 6f 67 20 6d 6f 6e 69 74 ommand log monit
a2d0: 6f 72 0a 3b 3b 20 20 20 20 20 28 69 75 70 3a 74 or.;; (iup:t
a2e0: 61 62 73 0a 3b 3b 20 20 20 20 20 20 3b 3b 20 6c abs.;; ;; l
a2f0: 6f 67 20 6d 6f 6e 69 74 6f 72 0a 3b 3b 20 20 20 og monitor.;;
a300: 20 20 20 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d )))..;;======
a310: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a320: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a330: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a340: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a350: 0a 3b 3b 20 53 20 55 20 4d 20 4d 20 41 20 52 20 .;; S U M M A R
a360: 59 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d Y .;;===========
a370: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a380: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a390: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a3a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 0a 3b ===========.;;.;
a3b0: 3b 20 47 65 6e 65 72 61 6c 20 69 6e 66 6f 20 61 ; General info a
a3c0: 62 6f 75 74 20 74 68 65 20 72 75 6e 28 73 29 20 bout the run(s)
a3d0: 61 6e 64 20 6d 65 67 61 74 65 73 74 20 61 72 65 and megatest are
a3e0: 61 0a 28 64 65 66 69 6e 65 20 28 64 61 73 68 62 a.(define (dashb
a3f0: 6f 61 72 64 3a 73 75 6d 6d 61 72 79 20 64 61 74 oard:summary dat
a400: 61 29 0a 20 20 28 6c 65 74 2a 20 28 28 64 62 20 a). (let* ((db
a410: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 64 (d
a420: 3a 61 6c 6c 64 61 74 2d 64 62 6c 6f 63 61 6c 20 :alldat-dblocal
a430: 64 61 74 61 29 29 0a 09 20 28 72 61 77 63 6f 6e data)).. (rawcon
a440: 66 69 67 20 20 20 20 20 20 20 20 28 72 65 61 64 fig (read
a450: 2d 63 6f 6e 66 69 67 20 28 63 6f 6e 63 20 2a 74 -config (conc *t
a460: 6f 70 70 61 74 68 2a 20 22 2f 6d 65 67 61 74 65 oppath* "/megate
a470: 73 74 2e 63 6f 6e 66 69 67 22 29 20 23 66 20 23 st.config") #f #
a480: 66 29 29 29 20 3b 3b 20 63 68 61 6e 67 65 64 20 f))) ;; changed
a490: 74 6f 20 23 66 20 73 69 6e 63 65 20 49 20 77 61 to #f since I wa
a4a0: 6e 74 20 23 7b 7d 20 74 6f 20 62 65 20 65 78 70 nt #{} to be exp
a4b0: 61 6e 64 65 64 20 62 79 20 5b 73 79 73 74 65 6d anded by [system
a4c0: 20 2e 2e 2e 5d 20 74 6f 20 4e 4f 54 20 62 65 20 ...] to NOT be
a4d0: 65 78 70 61 6e 64 65 64 2e 20 57 41 53 3a 20 27 expanded. WAS: '
a4e0: 72 65 74 75 72 6e 2d 73 74 72 69 6e 67 29 29 29 return-string)))
a4f0: 0a 20 20 20 20 28 69 75 70 3a 76 62 6f 78 0a 20 . (iup:vbox.
a500: 20 20 20 20 28 69 75 70 3a 73 70 6c 69 74 0a 20 (iup:split.
a510: 20 20 20 20 20 23 3a 76 61 6c 75 65 20 35 30 30 #:value 500
a520: 0a 20 20 20 20 20 20 28 69 75 70 3a 66 72 61 6d . (iup:fram
a530: 65 20 0a 20 20 20 20 20 20 20 23 3a 74 69 74 6c e . #:titl
a540: 65 20 22 47 65 6e 65 72 61 6c 20 49 6e 66 6f 22 e "General Info"
a550: 0a 20 20 20 20 20 20 20 28 69 75 70 3a 76 62 6f . (iup:vbo
a560: 78 0a 09 28 69 75 70 3a 68 62 6f 78 0a 09 20 28 x..(iup:hbox.. (
a570: 69 75 70 3a 6c 61 62 65 6c 20 22 41 72 65 61 20 iup:label "Area
a580: 50 61 74 68 22 29 0a 09 20 28 69 75 70 3a 74 65 Path").. (iup:te
a590: 78 74 62 6f 78 20 23 3a 76 61 6c 75 65 20 2a 74 xtbox #:value *t
a5a0: 6f 70 70 61 74 68 2a 20 23 3a 65 78 70 61 6e 64 oppath* #:expand
a5b0: 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 29 29 0a "HORIZONTAL")).
a5c0: 09 28 69 75 70 3a 68 62 6f 78 20 0a 09 20 28 64 .(iup:hbox .. (d
a5d0: 63 6f 6d 6d 6f 6e 3a 6b 65 79 73 2d 6d 61 74 72 common:keys-matr
a5e0: 69 78 20 72 61 77 63 6f 6e 66 69 67 29 0a 09 20 ix rawconfig)..
a5f0: 28 64 63 6f 6d 6d 6f 6e 3a 67 65 6e 65 72 61 6c (dcommon:general
a600: 2d 69 6e 66 6f 29 0a 09 20 29 29 29 0a 20 20 20 -info).. ))).
a610: 20 20 20 28 69 75 70 3a 66 72 61 6d 65 0a 20 20 (iup:frame.
a620: 20 20 20 20 20 23 3a 74 69 74 6c 65 20 22 53 65 #:title "Se
a630: 72 76 65 72 22 0a 20 20 20 20 20 20 20 28 64 63 rver". (dc
a640: 6f 6d 6d 6f 6e 3a 73 65 72 76 65 72 73 2d 74 61 ommon:servers-ta
a650: 62 6c 65 29 29 29 0a 20 20 20 20 20 28 69 75 70 ble))). (iup
a660: 3a 66 72 61 6d 65 20 0a 20 20 20 20 20 20 23 3a :frame . #:
a670: 74 69 74 6c 65 20 22 4d 65 67 61 74 65 73 74 20 title "Megatest
a680: 63 6f 6e 66 69 67 20 73 65 74 74 69 6e 67 73 22 config settings"
a690: 0a 20 20 20 20 20 20 28 69 75 70 3a 68 62 6f 78 . (iup:hbox
a6a0: 0a 20 20 20 20 20 20 20 28 64 63 6f 6d 6d 6f 6e . (dcommon
a6b0: 3a 73 65 63 74 69 6f 6e 2d 6d 61 74 72 69 78 20 :section-matrix
a6c0: 72 61 77 63 6f 6e 66 69 67 20 22 73 65 74 75 70 rawconfig "setup
a6d0: 22 20 22 56 61 72 6e 61 6d 65 22 20 22 56 61 6c " "Varname" "Val
a6e0: 75 65 22 29 0a 20 20 20 20 20 20 20 28 69 75 70 ue"). (iup
a6f0: 3a 76 62 6f 78 0a 09 28 64 63 6f 6d 6d 6f 6e 3a :vbox..(dcommon:
a700: 73 65 63 74 69 6f 6e 2d 6d 61 74 72 69 78 20 72 section-matrix r
a710: 61 77 63 6f 6e 66 69 67 20 22 73 65 72 76 65 72 awconfig "server
a720: 22 20 22 56 61 72 6e 61 6d 65 22 20 22 56 61 6c " "Varname" "Val
a730: 75 65 22 29 0a 09 3b 3b 20 28 69 75 70 3a 66 72 ue")..;; (iup:fr
a740: 61 6d 65 0a 09 3b 3b 20 23 3a 74 69 74 6c 65 20 ame..;; #:title
a750: 22 44 69 73 6b 73 20 41 72 65 61 73 22 0a 09 28 "Disks Areas"..(
a760: 64 63 6f 6d 6d 6f 6e 3a 73 65 63 74 69 6f 6e 2d dcommon:section-
a770: 6d 61 74 72 69 78 20 72 61 77 63 6f 6e 66 69 67 matrix rawconfig
a780: 20 22 64 69 73 6b 73 22 20 22 44 69 73 6b 20 61 "disks" "Disk a
a790: 72 65 61 22 20 22 50 61 74 68 22 29 29 29 29 0a rea" "Path")))).
a7a0: 20 20 20 20 20 28 69 75 70 3a 66 72 61 6d 65 0a (iup:frame.
a7b0: 20 20 20 20 20 20 23 3a 74 69 74 6c 65 20 22 52 #:title "R
a7c0: 75 6e 20 73 74 61 74 69 73 74 69 63 73 22 0a 20 un statistics".
a7d0: 20 20 20 20 20 28 64 63 6f 6d 6d 6f 6e 3a 72 75 (dcommon:ru
a7e0: 6e 2d 73 74 61 74 73 20 64 62 29 29 29 29 29 0a n-stats db))))).
a7f0: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
a800: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a810: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a820: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a830: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 52 20 55 =========.;; R U
a840: 20 4e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d N.;;===========
a850: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a860: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a870: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a880: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 0a 3b ===========.;;.;
a890: 3b 20 64 69 73 70 6c 61 79 20 61 6e 64 20 6d 61 ; display and ma
a8a0: 6e 61 67 65 20 61 20 73 69 6e 67 6c 65 20 72 75 nage a single ru
a8b0: 6e 20 61 74 20 61 20 74 69 6d 65 0a 0a 28 64 65 n at a time..(de
a8c0: 66 69 6e 65 20 28 74 72 65 65 2d 70 61 74 68 2d fine (tree-path-
a8d0: 3e 72 75 6e 2d 69 64 20 64 61 74 61 20 70 61 74 >run-id data pat
a8e0: 68 29 0a 20 20 28 69 66 20 28 6e 6f 74 20 28 6e h). (if (not (n
a8f0: 75 6c 6c 3f 20 70 61 74 68 29 29 0a 20 20 20 20 ull? path)).
a900: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 (hash-table-re
a910: 66 2f 64 65 66 61 75 6c 74 20 28 64 3a 64 61 74 f/default (d:dat
a920: 61 2d 70 61 74 68 2d 72 75 6e 2d 69 64 73 20 64 a-path-run-ids d
a930: 61 74 61 29 20 70 61 74 68 20 23 66 29 0a 20 20 ata) path #f).
a940: 20 20 20 20 23 66 29 29 0a 0a 28 64 65 66 69 6e #f))..(defin
a950: 65 20 64 61 73 68 62 6f 61 72 64 3a 75 70 64 61 e dashboard:upda
a960: 74 65 2d 72 75 6e 2d 73 75 6d 6d 61 72 79 2d 74 te-run-summary-t
a970: 61 62 20 23 66 29 0a 28 64 65 66 69 6e 65 20 64 ab #f).(define d
a980: 61 73 68 62 6f 61 72 64 3a 75 70 64 61 74 65 2d ashboard:update-
a990: 6e 65 77 2d 76 69 65 77 2d 74 61 62 20 23 66 29 new-view-tab #f)
a9a0: 0a 0a 28 64 65 66 69 6e 65 20 28 64 62 6f 61 72 ..(define (dboar
a9b0: 64 3a 67 65 74 2d 74 65 73 74 73 2d 64 61 74 20 d:get-tests-dat
a9c0: 64 61 74 61 20 72 75 6e 2d 69 64 20 6c 61 73 74 data run-id last
a9d0: 2d 75 70 64 61 74 65 29 0a 20 20 28 6c 65 74 20 -update). (let
a9e0: 28 28 74 64 61 74 20 28 69 66 20 72 75 6e 2d 69 ((tdat (if run-i
a9f0: 64 0a 09 09 20 20 28 69 66 20 28 64 3a 61 6c 6c d... (if (d:all
aa00: 64 61 74 2d 75 73 65 73 65 72 76 65 72 20 64 61 dat-useserver da
aa10: 74 61 29 0a 09 09 20 20 20 20 20 20 28 72 6d 74 ta)... (rmt
aa20: 3a 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 :get-tests-for-r
aa30: 75 6e 20 72 75 6e 2d 69 64 20 0a 09 09 09 09 09 un run-id ......
aa40: 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 (hash-table
aa50: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 28 64 3a -ref/default (d:
aa60: 61 6c 6c 64 61 74 2d 73 65 61 72 63 68 70 61 74 alldat-searchpat
aa70: 74 73 20 64 61 74 61 29 20 22 74 65 73 74 2d 6e ts data) "test-n
aa80: 61 6d 65 22 20 22 25 2f 25 22 29 0a 09 09 09 09 ame" "%/%").....
aa90: 09 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c . (hash-tabl
aaa0: 65 2d 6b 65 79 73 20 28 64 3a 61 6c 6c 64 61 74 e-keys (d:alldat
aab0: 2d 73 74 61 74 65 2d 69 67 6e 6f 72 65 2d 68 61 -state-ignore-ha
aac0: 73 68 20 64 61 74 61 29 29 20 3b 3b 20 27 28 29 sh data)) ;; '()
aad0: 0a 09 09 09 09 09 20 20 20 20 20 28 68 61 73 68 ...... (hash
aae0: 2d 74 61 62 6c 65 2d 6b 65 79 73 20 28 64 3a 61 -table-keys (d:a
aaf0: 6c 6c 64 61 74 2d 73 74 61 74 75 73 2d 69 67 6e lldat-status-ign
ab00: 6f 72 65 2d 68 61 73 68 20 64 61 74 61 29 29 20 ore-hash data))
ab10: 3b 3b 20 27 28 29 0a 09 09 09 09 09 20 20 20 20 ;; '()......
ab20: 20 23 66 20 23 66 0a 09 09 09 09 09 20 20 20 20 #f #f......
ab30: 20 28 64 3a 61 6c 6c 64 61 74 2d 68 69 64 65 2d (d:alldat-hide-
ab40: 6e 6f 74 2d 68 69 64 65 20 64 61 74 61 29 0a 09 not-hide data)..
ab50: 09 09 09 09 20 20 20 20 20 23 66 20 23 66 0a 09 .... #f #f..
ab60: 09 09 09 09 20 20 20 20 20 22 69 64 2c 74 65 73 .... "id,tes
ab70: 74 6e 61 6d 65 2c 69 74 65 6d 5f 70 61 74 68 2c tname,item_path,
ab80: 73 74 61 74 65 2c 73 74 61 74 75 73 22 0a 09 09 state,status"...
ab90: 09 09 09 20 20 20 20 20 28 69 66 20 28 64 3a 61 ... (if (d:a
aba0: 6c 6c 64 61 74 2d 66 69 6c 74 65 72 73 2d 63 68 lldat-filters-ch
abb0: 61 6e 67 65 64 20 64 61 74 61 29 0a 09 09 09 09 anged data).....
abc0: 09 09 20 30 0a 09 09 09 09 09 09 20 6c 61 73 74 .. 0....... last
abd0: 2d 75 70 64 61 74 65 29 0a 09 09 09 09 09 20 20 -update)......
abe0: 20 20 20 2a 64 61 73 68 62 6f 61 72 64 2d 6d 6f *dashboard-mo
abf0: 64 65 2a 29 20 3b 3b 20 67 65 74 20 27 65 6d 20 de*) ;; get 'em
ac00: 61 6c 6c 0a 09 09 20 20 20 20 20 20 28 64 62 3a all... (db:
ac10: 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 get-tests-for-ru
ac20: 6e 20 64 62 20 72 75 6e 2d 69 64 20 0a 09 09 09 n db run-id ....
ac30: 09 09 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c .. (hash-tabl
ac40: 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 28 64 e-ref/default (d
ac50: 3a 61 6c 6c 64 61 74 2d 73 65 61 72 63 68 70 61 :alldat-searchpa
ac60: 74 74 73 20 64 61 74 61 29 20 22 74 65 73 74 2d tts data) "test-
ac70: 6e 61 6d 65 22 20 22 25 2f 25 22 29 0a 09 09 09 name" "%/%")....
ac80: 09 09 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c .. (hash-tabl
ac90: 65 2d 6b 65 79 73 20 28 64 3a 61 6c 6c 64 61 74 e-keys (d:alldat
aca0: 2d 73 74 61 74 65 2d 69 67 6e 6f 72 65 2d 68 61 -state-ignore-ha
acb0: 73 68 20 64 61 74 61 29 29 20 3b 3b 20 27 28 29 sh data)) ;; '()
acc0: 0a 09 09 09 09 09 20 20 20 20 28 68 61 73 68 2d ...... (hash-
acd0: 74 61 62 6c 65 2d 6b 65 79 73 20 28 64 3a 61 6c table-keys (d:al
ace0: 6c 64 61 74 2d 73 74 61 74 75 73 2d 69 67 6e 6f ldat-status-igno
acf0: 72 65 2d 68 61 73 68 20 64 61 74 61 29 29 20 3b re-hash data)) ;
ad00: 3b 20 27 28 29 0a 09 09 09 09 09 20 20 20 20 23 ; '()...... #
ad10: 66 20 23 66 0a 09 09 09 09 09 20 20 20 20 28 64 f #f...... (d
ad20: 3a 61 6c 6c 64 61 74 2d 68 69 64 65 2d 6e 6f 74 :alldat-hide-not
ad30: 2d 68 69 64 65 20 64 61 74 61 29 0a 09 09 09 09 -hide data).....
ad40: 09 20 20 20 20 23 66 20 23 66 0a 09 09 09 09 09 . #f #f......
ad50: 20 20 20 20 22 69 64 2c 74 65 73 74 6e 61 6d 65 "id,testname
ad60: 2c 69 74 65 6d 5f 70 61 74 68 2c 73 74 61 74 65 ,item_path,state
ad70: 2c 73 74 61 74 75 73 22 0a 09 09 09 09 09 20 20 ,status"......
ad80: 20 20 28 69 66 20 28 64 3a 61 6c 6c 64 61 74 2d (if (d:alldat-
ad90: 66 69 6c 74 65 72 73 2d 63 68 61 6e 67 65 64 20 filters-changed
ada0: 64 61 74 61 29 0a 09 09 09 09 09 09 30 0a 09 09 data).......0...
adb0: 09 09 09 09 6c 61 73 74 2d 75 70 64 61 74 65 29 ....last-update)
adc0: 0a 09 09 09 09 09 20 20 20 20 2a 64 61 73 68 62 ...... *dashb
add0: 6f 61 72 64 2d 6d 6f 64 65 2a 29 29 0a 09 09 20 oard-mode*))...
ade0: 20 27 28 29 29 29 29 20 3b 3b 20 67 65 74 20 27 '()))) ;; get '
adf0: 65 6d 20 61 6c 6c 0a 20 20 20 20 28 64 65 62 75 em all. (debu
ae00: 67 3a 70 72 69 6e 74 20 30 20 22 64 62 6f 61 72 g:print 0 "dboar
ae10: 64 3a 67 65 74 2d 74 65 73 74 73 2d 64 61 74 3a d:get-tests-dat:
ae20: 20 67 6f 74 20 22 20 28 6c 65 6e 67 74 68 20 74 got " (length t
ae30: 64 61 74 29 20 22 20 74 65 73 74 20 72 65 63 6f dat) " test reco
ae40: 72 64 73 20 66 6f 72 20 72 75 6e 20 22 20 72 75 rds for run " ru
ae50: 6e 2d 69 64 29 0a 20 20 20 20 28 73 6f 72 74 20 n-id). (sort
ae60: 74 64 61 74 20 28 6c 61 6d 62 64 61 20 28 61 20 tdat (lambda (a
ae70: 62 29 0a 09 09 20 28 6c 65 74 2a 20 28 28 61 76 b)... (let* ((av
ae80: 61 6c 20 28 76 65 63 74 6f 72 2d 72 65 66 20 61 al (vector-ref a
ae90: 20 32 29 29 0a 09 09 09 28 62 76 61 6c 20 28 76 2))....(bval (v
aea0: 65 63 74 6f 72 2d 72 65 66 20 62 20 32 29 29 0a ector-ref b 2)).
aeb0: 09 09 09 28 61 6e 75 6d 20 28 73 74 72 69 6e 67 ...(anum (string
aec0: 2d 3e 6e 75 6d 62 65 72 20 61 76 61 6c 29 29 0a ->number aval)).
aed0: 09 09 09 28 62 6e 75 6d 20 28 73 74 72 69 6e 67 ...(bnum (string
aee0: 2d 3e 6e 75 6d 62 65 72 20 62 76 61 6c 29 29 29 ->number bval)))
aef0: 0a 09 09 20 20 20 28 69 66 20 28 61 6e 64 20 61 ... (if (and a
af00: 6e 75 6d 20 62 6e 75 6d 29 0a 09 09 20 20 20 20 num bnum)...
af10: 20 20 20 28 3c 20 61 6e 75 6d 20 62 6e 75 6d 29 (< anum bnum)
af20: 0a 09 09 20 20 20 20 20 20 20 28 73 74 72 69 6e ... (strin
af30: 67 3c 3d 20 61 76 61 6c 20 62 76 61 6c 29 29 29 g<= aval bval)))
af40: 29 29 29 29 0a 0a 3b 3b 20 54 68 69 73 20 69 73 ))))..;; This is
af50: 20 74 68 65 20 52 75 6e 20 53 75 6d 6d 61 72 79 the Run Summary
af60: 20 74 61 62 0a 3b 3b 20 0a 28 64 65 66 69 6e 65 tab.;; .(define
af70: 20 28 64 61 73 68 62 6f 61 72 64 3a 6f 6e 65 2d (dashboard:one-
af80: 72 75 6e 20 64 62 20 64 61 74 61 20 64 64 61 74 run db data ddat
af90: 61 29 0a 20 20 28 6c 65 74 2a 20 28 28 74 62 20 a). (let* ((tb
afa0: 20 20 20 20 20 28 69 75 70 3a 74 72 65 65 62 6f (iup:treebo
afb0: 78 0a 09 09 20 20 20 23 3a 76 61 6c 75 65 20 30 x... #:value 0
afc0: 0a 09 09 20 20 20 23 3a 6e 61 6d 65 20 22 52 75 ... #:name "Ru
afd0: 6e 73 22 0a 09 09 20 20 20 23 3a 65 78 70 61 6e ns"... #:expan
afe0: 64 20 22 59 45 53 22 0a 09 09 20 20 20 23 3a 61 d "YES"... #:a
aff0: 64 64 65 78 70 61 6e 64 65 64 20 22 4e 4f 22 0a ddexpanded "NO".
b000: 09 09 20 20 20 23 3a 73 65 6c 65 63 74 69 6f 6e .. #:selection
b010: 2d 63 62 0a 09 09 20 20 20 28 6c 61 6d 62 64 61 -cb... (lambda
b020: 20 28 6f 62 6a 20 69 64 20 73 74 61 74 65 29 0a (obj id state).
b030: 09 09 20 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 .. ;; (print
b040: 20 22 6f 62 6a 3a 20 22 20 6f 62 6a 20 22 2c 20 "obj: " obj ",
b050: 69 64 3a 20 22 20 69 64 20 22 2c 20 73 74 61 74 id: " id ", stat
b060: 65 3a 20 22 20 73 74 61 74 65 29 0a 09 09 20 20 e: " state)...
b070: 20 20 20 28 6c 65 74 2a 20 28 28 72 75 6e 2d 70 (let* ((run-p
b080: 61 74 68 20 28 74 72 65 65 3a 6e 6f 64 65 2d 3e ath (tree:node->
b090: 70 61 74 68 20 6f 62 6a 20 69 64 29 29 0a 09 09 path obj id))...
b0a0: 09 20 20 20 20 28 72 75 6e 2d 69 64 20 20 20 28 . (run-id (
b0b0: 74 72 65 65 2d 70 61 74 68 2d 3e 72 75 6e 2d 69 tree-path->run-i
b0c0: 64 20 64 64 61 74 61 20 28 63 64 72 20 72 75 6e d ddata (cdr run
b0d0: 2d 70 61 74 68 29 29 29 29 0a 09 09 20 20 20 20 -path))))...
b0e0: 20 20 20 28 69 66 20 28 6e 75 6d 62 65 72 3f 20 (if (number?
b0f0: 72 75 6e 2d 69 64 29 0a 09 09 09 20 20 20 28 62 run-id).... (b
b100: 65 67 69 6e 0a 09 09 09 20 20 20 20 20 28 64 3a egin.... (d:
b110: 64 61 74 61 2d 63 75 72 72 2d 72 75 6e 2d 69 64 data-curr-run-id
b120: 2d 73 65 74 21 20 64 64 61 74 61 20 72 75 6e 2d -set! ddata run-
b130: 69 64 29 0a 09 09 09 20 20 20 20 20 28 64 61 73 id).... (das
b140: 68 62 6f 61 72 64 3a 75 70 64 61 74 65 2d 72 75 hboard:update-ru
b150: 6e 2d 73 75 6d 6d 61 72 79 2d 74 61 62 29 29 0a n-summary-tab)).
b160: 09 09 09 20 20 20 28 64 65 62 75 67 3a 70 72 69 ... (debug:pri
b170: 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 74 72 65 nt 0 "ERROR: tre
b180: 65 2d 70 61 74 68 2d 3e 72 75 6e 2d 69 64 20 72 e-path->run-id r
b190: 65 74 75 72 6e 65 64 20 6e 6f 6e 2d 6e 75 6d 62 eturned non-numb
b1a0: 65 72 20 22 20 72 75 6e 2d 69 64 29 29 29 0a 09 er " run-id)))..
b1b0: 09 20 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 . ;; (print
b1c0: 22 70 61 74 68 3a 20 22 20 28 74 72 65 65 3a 6e "path: " (tree:n
b1d0: 6f 64 65 2d 3e 70 61 74 68 20 6f 62 6a 20 69 64 ode->path obj id
b1e0: 29 20 22 20 72 75 6e 2d 69 64 3a 20 22 20 72 75 ) " run-id: " ru
b1f0: 6e 2d 69 64 29 0a 09 09 20 20 20 20 20 29 29 29 n-id)... )))
b200: 0a 09 20 28 63 65 6c 6c 2d 6c 6f 6f 6b 75 70 20 .. (cell-lookup
b210: 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 (make-hash-table
b220: 29 29 0a 09 20 28 72 75 6e 2d 6d 61 74 72 69 78 )).. (run-matrix
b230: 20 28 69 75 70 3a 6d 61 74 72 69 78 0a 09 09 20 (iup:matrix...
b240: 20 20 20 20 20 23 3a 65 78 70 61 6e 64 20 22 59 #:expand "Y
b250: 45 53 22 0a 09 09 20 20 20 20 20 20 23 3a 63 6c ES"... #:cl
b260: 69 63 6b 2d 63 62 0a 09 09 20 20 20 20 20 20 28 ick-cb... (
b270: 6c 61 6d 62 64 61 20 28 6f 62 6a 20 6c 69 6e 20 lambda (obj lin
b280: 63 6f 6c 20 73 74 61 74 75 73 29 0a 09 09 09 28 col status)....(
b290: 6c 65 74 2a 20 28 28 74 6f 6f 6c 70 61 74 68 20 let* ((toolpath
b2a0: 28 63 61 72 20 28 61 72 67 76 29 29 29 0a 09 09 (car (argv)))...
b2b0: 09 20 20 20 20 20 20 20 28 6b 65 79 20 20 20 20 . (key
b2c0: 20 20 28 63 6f 6e 63 20 6c 69 6e 20 22 3a 22 20 (conc lin ":"
b2d0: 63 6f 6c 29 29 0a 09 09 09 20 20 20 20 20 20 20 col))....
b2e0: 28 74 65 73 74 2d 69 64 20 20 28 68 61 73 68 2d (test-id (hash-
b2f0: 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c table-ref/defaul
b300: 74 20 63 65 6c 6c 2d 6c 6f 6f 6b 75 70 20 6b 65 t cell-lookup ke
b310: 79 20 2d 31 29 29 0a 09 09 09 20 20 20 20 20 20 y -1))....
b320: 20 28 63 6d 64 20 20 20 20 20 20 28 63 6f 6e 63 (cmd (conc
b330: 20 74 6f 6f 6c 70 61 74 68 20 22 20 2d 74 65 73 toolpath " -tes
b340: 74 20 22 20 28 64 3a 64 61 74 61 2d 63 75 72 72 t " (d:data-curr
b350: 2d 72 75 6e 2d 69 64 20 64 64 61 74 61 29 20 22 -run-id ddata) "
b360: 2c 22 20 74 65 73 74 2d 69 64 20 22 26 22 29 29 ," test-id "&"))
b370: 29 0a 09 09 09 20 20 28 73 79 73 74 65 6d 20 63 ).... (system c
b380: 6d 64 29 29 29 29 29 0a 09 20 28 75 70 64 61 74 md))))).. (updat
b390: 65 72 20 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 er (lambda ()..
b3a0: 09 20 20 20 20 20 28 6c 65 74 2a 20 28 28 72 75 . (let* ((ru
b3b0: 6e 73 2d 64 61 74 20 20 20 20 20 28 69 66 20 28 ns-dat (if (
b3c0: 64 3a 61 6c 6c 64 61 74 2d 75 73 65 73 65 72 76 d:alldat-useserv
b3d0: 65 72 20 64 61 74 61 29 0a 09 09 09 09 09 20 20 er data)......
b3e0: 20 20 20 20 28 72 6d 74 3a 67 65 74 2d 72 75 6e (rmt:get-run
b3f0: 73 2d 62 79 2d 70 61 74 74 20 28 64 3a 61 6c 6c s-by-patt (d:all
b400: 64 61 74 2d 6b 65 79 73 20 64 61 74 61 29 20 22 dat-keys data) "
b410: 25 22 20 23 66 20 23 66 20 23 66 20 23 66 29 0a %" #f #f #f #f).
b420: 09 09 09 09 09 20 20 20 20 20 20 28 64 62 3a 67 ..... (db:g
b430: 65 74 2d 72 75 6e 73 2d 62 79 2d 70 61 74 74 20 et-runs-by-patt
b440: 64 62 20 28 64 3a 61 6c 6c 64 61 74 2d 6b 65 79 db (d:alldat-key
b450: 73 20 64 61 74 61 29 20 22 25 22 20 23 66 20 23 s data) "%" #f #
b460: 66 20 23 66 20 23 66 29 29 29 0a 09 09 09 20 20 f #f #f)))....
b470: 20 20 28 72 75 6e 73 2d 68 65 61 64 65 72 20 20 (runs-header
b480: 28 76 65 63 74 6f 72 2d 72 65 66 20 72 75 6e 73 (vector-ref runs
b490: 2d 64 61 74 20 30 29 29 20 3b 3b 20 30 20 69 73 -dat 0)) ;; 0 is
b4a0: 20 68 65 61 64 65 72 2c 20 31 20 69 73 20 6c 69 header, 1 is li
b4b0: 73 74 20 6f 66 20 72 65 63 6f 72 64 73 0a 09 09 st of records...
b4c0: 09 20 20 20 20 28 72 75 6e 2d 69 64 20 20 20 20 . (run-id
b4d0: 20 20 20 28 64 3a 64 61 74 61 2d 63 75 72 72 2d (d:data-curr-
b4e0: 72 75 6e 2d 69 64 20 64 64 61 74 61 29 29 0a 09 run-id ddata))..
b4f0: 09 09 20 20 20 20 28 6c 61 73 74 2d 75 70 64 61 .. (last-upda
b500: 74 65 20 20 30 29 20 3b 3b 20 66 69 78 20 6d 65 te 0) ;; fix me
b510: 0a 09 09 09 20 20 20 20 28 74 65 73 74 73 2d 64 .... (tests-d
b520: 61 74 20 20 20 20 28 64 62 6f 61 72 64 3a 67 65 at (dboard:ge
b530: 74 2d 74 65 73 74 73 2d 64 61 74 20 64 61 74 61 t-tests-dat data
b540: 20 72 75 6e 2d 69 64 20 6c 61 73 74 2d 75 70 64 run-id last-upd
b550: 61 74 65 29 29 0a 09 09 09 20 20 20 20 28 74 65 ate)).... (te
b560: 73 74 73 2d 6d 69 6e 64 61 74 20 28 64 63 6f 6d sts-mindat (dcom
b570: 6d 6f 6e 3a 6d 69 6e 69 6d 69 7a 65 2d 74 65 73 mon:minimize-tes
b580: 74 2d 64 61 74 61 20 74 65 73 74 73 2d 64 61 74 t-data tests-dat
b590: 29 29 0a 09 09 09 20 20 20 20 28 69 6e 64 69 63 )).... (indic
b5a0: 65 73 20 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a es (common:
b5b0: 73 70 61 72 73 65 2d 6c 69 73 74 2d 67 65 6e 65 sparse-list-gene
b5c0: 72 61 74 65 2d 69 6e 64 65 78 20 74 65 73 74 73 rate-index tests
b5d0: 2d 6d 69 6e 64 61 74 29 29 20 3b 3b 20 20 70 72 -mindat)) ;; pr
b5e0: 6f 63 3a 20 73 65 74 2d 63 65 6c 6c 29 29 0a 09 oc: set-cell))..
b5f0: 09 09 20 20 20 20 28 72 6f 77 2d 69 6e 64 69 63 .. (row-indic
b600: 65 73 20 20 28 63 61 64 72 20 69 6e 64 69 63 65 es (cadr indice
b610: 73 29 29 0a 09 09 09 20 20 20 20 28 63 6f 6c 2d s)).... (col-
b620: 69 6e 64 69 63 65 73 20 20 28 63 61 72 20 69 6e indices (car in
b630: 64 69 63 65 73 29 29 0a 09 09 09 20 20 20 20 28 dices)).... (
b640: 6d 61 78 2d 72 6f 77 20 20 20 20 20 20 28 69 66 max-row (if
b650: 20 28 6e 75 6c 6c 3f 20 72 6f 77 2d 69 6e 64 69 (null? row-indi
b660: 63 65 73 29 20 31 20 28 63 6f 6d 6d 6f 6e 3a 6d ces) 1 (common:m
b670: 61 78 20 28 6d 61 70 20 63 61 64 72 20 72 6f 77 ax (map cadr row
b680: 2d 69 6e 64 69 63 65 73 29 29 29 29 0a 09 09 09 -indices))))....
b690: 20 20 20 20 28 6d 61 78 2d 63 6f 6c 20 20 20 20 (max-col
b6a0: 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 63 6f 6c (if (null? col
b6b0: 2d 69 6e 64 69 63 65 73 29 20 31 20 28 63 6f 6d -indices) 1 (com
b6c0: 6d 6f 6e 3a 6d 61 78 20 28 6d 61 70 20 63 61 64 mon:max (map cad
b6d0: 72 20 63 6f 6c 2d 69 6e 64 69 63 65 73 29 29 29 r col-indices)))
b6e0: 29 0a 09 09 09 20 20 20 20 28 6d 61 78 2d 76 69 ).... (max-vi
b6f0: 73 69 62 6c 65 20 20 28 6d 61 78 20 28 2d 20 28 sible (max (- (
b700: 64 3a 61 6c 6c 64 61 74 2d 6e 75 6d 2d 74 65 73 d:alldat-num-tes
b710: 74 73 20 64 61 74 61 29 20 31 35 29 20 33 29 29 ts data) 15) 3))
b720: 20 3b 3b 20 28 64 3a 61 6c 6c 64 61 74 2d 6e 75 ;; (d:alldat-nu
b730: 6d 2d 74 65 73 74 73 20 64 61 74 61 29 20 69 73 m-tests data) is
b740: 20 70 72 6f 70 6f 72 74 69 6f 6e 61 6c 20 74 6f proportional to
b750: 20 74 68 65 20 73 69 7a 65 20 6f 66 20 74 68 65 the size of the
b760: 20 77 69 6e 64 6f 77 0a 09 09 09 20 20 20 20 28 window.... (
b770: 6e 75 6d 72 6f 77 73 20 20 20 20 20 20 31 29 0a numrows 1).
b780: 09 09 09 20 20 20 20 28 6e 75 6d 63 6f 6c 73 20 ... (numcols
b790: 20 20 20 20 20 31 29 0a 09 09 09 20 20 20 20 28 1).... (
b7a0: 63 68 61 6e 67 65 64 20 20 20 20 20 20 23 66 29 changed #f)
b7b0: 0a 09 09 09 20 20 20 20 28 72 75 6e 73 2d 68 61 .... (runs-ha
b7c0: 73 68 20 20 20 20 28 6c 65 74 20 28 28 68 74 20 sh (let ((ht
b7d0: 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 (make-hash-table
b7e0: 29 29 29 0a 09 09 09 09 09 20 20 20 20 28 66 6f )))...... (fo
b7f0: 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 r-each (lambda (
b800: 72 75 6e 29 0a 09 09 09 09 09 09 09 28 68 61 73 run)........(has
b810: 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 68 74 20 h-table-set! ht
b820: 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 (db:get-value-by
b830: 2d 68 65 61 64 65 72 20 72 75 6e 20 72 75 6e 73 -header run runs
b840: 2d 68 65 61 64 65 72 20 22 69 64 22 29 20 72 75 -header "id") ru
b850: 6e 29 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 n)).......
b860: 28 76 65 63 74 6f 72 2d 72 65 66 20 72 75 6e 73 (vector-ref runs
b870: 2d 64 61 74 20 31 29 29 0a 09 09 09 09 09 20 20 -dat 1))......
b880: 20 20 68 74 29 29 0a 09 09 09 20 20 20 20 28 72 ht)).... (r
b890: 75 6e 2d 69 64 73 20 20 20 20 20 20 28 73 6f 72 un-ids (sor
b8a0: 74 20 28 66 69 6c 74 65 72 20 6e 75 6d 62 65 72 t (filter number
b8b0: 3f 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 ? (hash-table-ke
b8c0: 79 73 20 72 75 6e 73 2d 68 61 73 68 29 29 0a 09 ys runs-hash))..
b8d0: 09 09 09 09 09 28 6c 61 6d 62 64 61 20 28 61 20 .....(lambda (a
b8e0: 62 29 0a 09 09 09 09 09 09 20 20 28 6c 65 74 2a b)....... (let*
b8f0: 20 28 28 72 65 63 6f 72 64 2d 61 20 28 68 61 73 ((record-a (has
b900: 68 2d 74 61 62 6c 65 2d 72 65 66 20 72 75 6e 73 h-table-ref runs
b910: 2d 68 61 73 68 20 61 29 29 0a 09 09 09 09 09 09 -hash a)).......
b920: 09 20 28 72 65 63 6f 72 64 2d 62 20 28 68 61 73 . (record-b (has
b930: 68 2d 74 61 62 6c 65 2d 72 65 66 20 72 75 6e 73 h-table-ref runs
b940: 2d 68 61 73 68 20 62 29 29 0a 09 09 09 09 09 09 -hash b)).......
b950: 09 20 28 74 69 6d 65 2d 61 20 20 20 28 64 62 3a . (time-a (db:
b960: 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 get-value-by-hea
b970: 64 65 72 20 72 65 63 6f 72 64 2d 61 20 72 75 6e der record-a run
b980: 73 2d 68 65 61 64 65 72 20 22 65 76 65 6e 74 5f s-header "event_
b990: 74 69 6d 65 22 29 29 0a 09 09 09 09 09 09 09 20 time"))........
b9a0: 28 74 69 6d 65 2d 62 20 20 20 28 64 62 3a 67 65 (time-b (db:ge
b9b0: 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 t-value-by-heade
b9c0: 72 20 72 65 63 6f 72 64 2d 62 20 72 75 6e 73 2d r record-b runs-
b9d0: 68 65 61 64 65 72 20 22 65 76 65 6e 74 5f 74 69 header "event_ti
b9e0: 6d 65 22 29 29 29 0a 09 09 09 09 09 09 20 20 20 me"))).......
b9f0: 20 28 3c 20 74 69 6d 65 2d 61 20 74 69 6d 65 2d (< time-a time-
ba00: 62 29 29 29 29 29 29 0a 09 09 20 20 20 20 20 20 b))))))...
ba10: 20 0a 09 09 20 20 20 20 20 20 20 28 64 3a 61 6c ... (d:al
ba20: 6c 64 61 74 2d 66 69 6c 74 65 72 73 2d 63 68 61 ldat-filters-cha
ba30: 6e 67 65 64 2d 73 65 74 21 20 64 61 74 61 20 23 nged-set! data #
ba40: 66 29 0a 09 09 20 20 20 20 20 20 20 3b 3b 20 28 f)... ;; (
ba50: 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 iup:attribute-se
ba60: 74 21 20 74 62 20 22 56 41 4c 55 45 22 20 22 30 t! tb "VALUE" "0
ba70: 22 29 0a 09 09 20 20 20 20 20 20 20 3b 3b 20 28 ")... ;; (
ba80: 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 iup:attribute-se
ba90: 74 21 20 74 62 20 22 4e 41 4d 45 22 20 22 52 75 t! tb "NAME" "Ru
baa0: 6e 73 22 29 0a 09 09 20 20 20 20 20 20 20 3b 3b ns")... ;;
bab0: 20 55 70 64 61 74 65 20 74 68 65 20 72 75 6e 73 Update the runs
bac0: 20 74 72 65 65 0a 09 09 20 20 20 20 20 20 20 28 tree... (
bad0: 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 for-each (lambda
bae0: 20 28 72 75 6e 2d 69 64 29 0a 09 09 09 09 20 20 (run-id).....
baf0: 20 28 6c 65 74 2a 20 28 28 72 75 6e 2d 72 65 63 (let* ((run-rec
bb00: 6f 72 64 20 28 68 61 73 68 2d 74 61 62 6c 65 2d ord (hash-table-
bb10: 72 65 66 2f 64 65 66 61 75 6c 74 20 72 75 6e 73 ref/default runs
bb20: 2d 68 61 73 68 20 72 75 6e 2d 69 64 20 23 66 29 -hash run-id #f)
bb30: 29 0a 09 09 09 09 09 20 20 28 6b 65 79 2d 76 61 )...... (key-va
bb40: 6c 73 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 ls (map (lambd
bb50: 61 20 28 6b 65 79 29 28 64 62 3a 67 65 74 2d 76 a (key)(db:get-v
bb60: 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 alue-by-header r
bb70: 75 6e 2d 72 65 63 6f 72 64 20 72 75 6e 73 2d 68 un-record runs-h
bb80: 65 61 64 65 72 20 6b 65 79 29 29 0a 09 09 09 09 eader key)).....
bb90: 09 09 09 20 20 20 28 64 3a 61 6c 6c 64 61 74 2d ... (d:alldat-
bba0: 6b 65 79 73 20 64 61 74 61 29 29 29 0a 09 09 09 keys data)))....
bbb0: 09 09 20 20 28 72 75 6e 2d 6e 61 6d 65 20 20 20 .. (run-name
bbc0: 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 (db:get-value-by
bbd0: 2d 68 65 61 64 65 72 20 72 75 6e 2d 72 65 63 6f -header run-reco
bbe0: 72 64 20 72 75 6e 73 2d 68 65 61 64 65 72 20 22 rd runs-header "
bbf0: 72 75 6e 6e 61 6d 65 22 29 29 0a 09 09 09 09 09 runname"))......
bc00: 20 20 28 63 6f 6c 2d 6e 61 6d 65 20 20 20 28 63 (col-name (c
bc10: 6f 6e 63 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 onc (string-inte
bc20: 72 73 70 65 72 73 65 20 6b 65 79 2d 76 61 6c 73 rsperse key-vals
bc30: 20 22 5c 6e 22 29 20 22 5c 6e 22 20 72 75 6e 2d "\n") "\n" run-
bc40: 6e 61 6d 65 29 29 0a 09 09 09 09 09 20 20 28 72 name))...... (r
bc50: 75 6e 2d 70 61 74 68 20 20 20 28 61 70 70 65 6e un-path (appen
bc60: 64 20 6b 65 79 2d 76 61 6c 73 20 28 6c 69 73 74 d key-vals (list
bc70: 20 72 75 6e 2d 6e 61 6d 65 29 29 29 0a 09 09 09 run-name)))....
bc80: 09 09 20 20 28 65 78 69 73 74 69 6e 67 20 20 20 .. (existing
bc90: 28 74 72 65 65 3a 66 69 6e 64 2d 6e 6f 64 65 20 (tree:find-node
bca0: 74 62 20 72 75 6e 2d 70 61 74 68 29 29 29 0a 09 tb run-path)))..
bcb0: 09 09 09 20 20 20 20 20 28 69 66 20 28 6e 6f 74 ... (if (not
bcc0: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
bcd0: 2f 64 65 66 61 75 6c 74 20 28 64 3a 64 61 74 61 /default (d:data
bce0: 2d 70 61 74 68 2d 72 75 6e 2d 69 64 73 20 64 64 -path-run-ids dd
bcf0: 61 74 61 29 20 72 75 6e 2d 70 61 74 68 20 23 66 ata) run-path #f
bd00: 29 29 0a 09 09 09 09 09 20 28 62 65 67 69 6e 0a ))...... (begin.
bd10: 09 09 09 09 09 20 20 20 28 68 61 73 68 2d 74 61 ..... (hash-ta
bd20: 62 6c 65 2d 73 65 74 21 20 28 64 3a 64 61 74 61 ble-set! (d:data
bd30: 2d 72 75 6e 2d 6b 65 79 73 20 64 64 61 74 61 29 -run-keys ddata)
bd40: 20 72 75 6e 2d 69 64 20 72 75 6e 2d 70 61 74 68 run-id run-path
bd50: 29 0a 09 09 09 09 09 20 20 20 3b 3b 20 28 69 75 )...... ;; (iu
bd60: 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 p:attribute-set!
bd70: 20 28 64 62 6f 61 72 64 3a 64 61 74 61 2d 67 65 (dboard:data-ge
bd80: 74 2d 72 75 6e 73 2d 6d 61 74 72 69 78 20 2a 64 t-runs-matrix *d
bd90: 61 74 61 2a 29 0a 09 09 09 09 09 20 20 20 3b 3b ata*)...... ;;
bda0: 20 20 20 20 09 09 20 28 63 6f 6e 63 20 72 6f 77 .. (conc row
bdb0: 6e 75 6d 20 22 3a 22 20 63 6f 6c 6e 75 6d 29 20 num ":" colnum)
bdc0: 63 6f 6c 2d 6e 61 6d 65 29 0a 09 09 09 09 09 20 col-name)......
bdd0: 20 20 3b 3b 20 28 68 61 73 68 2d 74 61 62 6c 65 ;; (hash-table
bde0: 2d 73 65 74 21 20 72 75 6e 69 64 2d 74 6f 2d 63 -set! runid-to-c
bdf0: 6f 6c 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 ol run-id (list
be00: 63 6f 6c 6e 75 6d 20 72 75 6e 2d 72 65 63 6f 72 colnum run-recor
be10: 64 29 29 0a 09 09 09 09 09 20 20 20 3b 3b 20 48 d))...... ;; H
be20: 65 72 65 20 77 65 20 75 70 64 61 74 65 20 74 68 ere we update th
be30: 65 20 74 65 73 74 73 20 74 72 65 65 62 6f 78 20 e tests treebox
be40: 61 6e 64 20 74 72 65 65 20 6b 65 79 73 0a 09 09 and tree keys...
be50: 09 09 09 20 20 20 28 74 72 65 65 3a 61 64 64 2d ... (tree:add-
be60: 6e 6f 64 65 20 74 62 20 22 52 75 6e 73 22 20 72 node tb "Runs" r
be70: 75 6e 2d 70 61 74 68 20 3b 3b 20 28 61 70 70 65 un-path ;; (appe
be80: 6e 64 20 6b 65 79 2d 76 61 6c 73 20 28 6c 69 73 nd key-vals (lis
be90: 74 20 72 75 6e 2d 6e 61 6d 65 29 29 0a 09 09 09 t run-name))....
bea0: 09 09 09 09 20 20 75 73 65 72 64 61 74 61 3a 20 .... userdata:
beb0: 28 63 6f 6e 63 20 22 72 75 6e 2d 69 64 3a 20 22 (conc "run-id: "
bec0: 20 72 75 6e 2d 69 64 29 29 0a 09 09 09 09 09 20 run-id))......
bed0: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 (hash-table-se
bee0: 74 21 20 28 64 3a 64 61 74 61 2d 70 61 74 68 2d t! (d:data-path-
bef0: 72 75 6e 2d 69 64 73 20 64 64 61 74 61 29 20 72 run-ids ddata) r
bf00: 75 6e 2d 70 61 74 68 20 72 75 6e 2d 69 64 29 0a un-path run-id).
bf10: 09 09 09 09 09 20 20 20 3b 3b 20 28 73 65 74 21 ..... ;; (set!
bf20: 20 63 6f 6c 6e 75 6d 20 28 2b 20 63 6f 6c 6e 75 colnum (+ colnu
bf30: 6d 20 31 29 29 0a 09 09 09 09 09 20 20 20 29 29 m 1))...... ))
bf40: 29 29 0a 09 09 09 09 20 72 75 6e 2d 69 64 73 29 ))..... run-ids)
bf50: 0a 09 09 20 20 20 20 20 20 20 28 69 75 70 3a 61 ... (iup:a
bf60: 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 72 75 ttribute-set! ru
bf70: 6e 2d 6d 61 74 72 69 78 20 22 43 4c 45 41 52 56 n-matrix "CLEARV
bf80: 41 4c 55 45 22 20 22 41 4c 4c 22 29 20 3b 3b 20 ALUE" "ALL") ;;
bf90: 4e 4f 54 45 3a 20 57 61 73 20 43 4f 4e 54 45 4e NOTE: Was CONTEN
bfa0: 54 53 0a 09 09 20 20 20 20 20 20 20 28 69 75 70 TS... (iup
bfb0: 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 :attribute-set!
bfc0: 72 75 6e 2d 6d 61 74 72 69 78 20 22 43 4c 45 41 run-matrix "CLEA
bfd0: 52 41 54 54 52 49 42 22 20 22 43 4f 4e 54 45 4e RATTRIB" "CONTEN
bfe0: 54 53 22 29 0a 09 09 20 20 20 20 20 20 20 28 69 TS")... (i
bff0: 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 up:attribute-set
c000: 21 20 72 75 6e 2d 6d 61 74 72 69 78 20 22 52 45 ! run-matrix "RE
c010: 53 49 5a 45 4d 41 54 52 49 58 22 20 22 59 45 53 SIZEMATRIX" "YES
c020: 22 29 0a 09 09 20 20 20 20 20 20 20 28 69 75 70 ")... (iup
c030: 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 :attribute-set!
c040: 72 75 6e 2d 6d 61 74 72 69 78 20 22 4e 55 4d 43 run-matrix "NUMC
c050: 4f 4c 22 20 6d 61 78 2d 63 6f 6c 20 29 0a 09 09 OL" max-col )...
c060: 20 20 20 20 20 20 20 28 69 75 70 3a 61 74 74 72 (iup:attr
c070: 69 62 75 74 65 2d 73 65 74 21 20 72 75 6e 2d 6d ibute-set! run-m
c080: 61 74 72 69 78 20 22 4e 55 4d 4c 49 4e 22 20 28 atrix "NUMLIN" (
c090: 69 66 20 28 3c 20 6d 61 78 2d 72 6f 77 20 6d 61 if (< max-row ma
c0a0: 78 2d 76 69 73 69 62 6c 65 29 20 6d 61 78 2d 76 x-visible) max-v
c0b0: 69 73 69 62 6c 65 20 6d 61 78 2d 72 6f 77 29 29 isible max-row))
c0c0: 20 3b 3b 20 6d 69 6e 20 6f 66 20 32 30 0a 09 09 ;; min of 20...
c0d0: 20 20 20 20 20 20 20 3b 3b 20 28 69 75 70 3a 61 ;; (iup:a
c0e0: 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 72 75 ttribute-set! ru
c0f0: 6e 2d 6d 61 74 72 69 78 20 22 4e 55 4d 43 4f 4c n-matrix "NUMCOL
c100: 5f 56 49 53 49 42 4c 45 22 20 6d 61 78 2d 63 6f _VISIBLE" max-co
c110: 6c 29 0a 09 09 20 20 20 20 20 20 20 3b 3b 20 28 l)... ;; (
c120: 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 iup:attribute-se
c130: 74 21 20 72 75 6e 2d 6d 61 74 72 69 78 20 22 4e t! run-matrix "N
c140: 55 4d 4c 49 4e 5f 56 49 53 49 42 4c 45 22 20 28 UMLIN_VISIBLE" (
c150: 69 66 20 28 3e 20 6d 61 78 2d 72 6f 77 20 6d 61 if (> max-row ma
c160: 78 2d 76 69 73 69 62 6c 65 29 20 6d 61 78 2d 76 x-visible) max-v
c170: 69 73 69 62 6c 65 20 6d 61 78 2d 72 6f 77 29 29 isible max-row))
c180: 0a 09 09 20 20 20 20 20 20 20 0a 09 09 20 20 20 ... ...
c190: 20 20 20 20 3b 3b 20 52 6f 77 20 6c 61 62 65 6c ;; Row label
c1a0: 73 0a 09 09 20 20 20 20 20 20 20 28 66 6f 72 2d s... (for-
c1b0: 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 69 6e each (lambda (in
c1c0: 64 29 0a 09 09 09 09 20 20 20 28 6c 65 74 2a 20 d)..... (let*
c1d0: 28 28 6e 61 6d 65 20 28 63 61 72 20 69 6e 64 29 ((name (car ind)
c1e0: 29 0a 09 09 09 09 09 20 20 28 6e 75 6d 20 20 28 )...... (num (
c1f0: 63 61 64 72 20 69 6e 64 29 29 0a 09 09 09 09 09 cadr ind))......
c200: 20 20 28 6b 65 79 20 20 28 63 6f 6e 63 20 6e 75 (key (conc nu
c210: 6d 20 22 3a 30 22 29 29 29 0a 09 09 09 09 20 20 m ":0"))).....
c220: 20 20 20 28 69 66 20 28 6e 6f 74 20 28 65 71 75 (if (not (equ
c230: 61 6c 3f 20 28 69 75 70 3a 61 74 74 72 69 62 75 al? (iup:attribu
c240: 74 65 20 72 75 6e 2d 6d 61 74 72 69 78 20 6b 65 te run-matrix ke
c250: 79 29 20 6e 61 6d 65 29 29 0a 09 09 09 09 09 20 y) name))......
c260: 28 62 65 67 69 6e 0a 09 09 09 09 09 20 20 20 28 (begin...... (
c270: 73 65 74 21 20 63 68 61 6e 67 65 64 20 23 74 29 set! changed #t)
c280: 0a 09 09 09 09 09 20 20 20 28 69 75 70 3a 61 74 ...... (iup:at
c290: 74 72 69 62 75 74 65 2d 73 65 74 21 20 72 75 6e tribute-set! run
c2a0: 2d 6d 61 74 72 69 78 20 6b 65 79 20 6e 61 6d 65 -matrix key name
c2b0: 29 29 29 29 29 0a 09 09 09 09 20 72 6f 77 2d 69 )))))..... row-i
c2c0: 6e 64 69 63 65 73 29 0a 09 09 20 20 20 20 20 20 ndices)...
c2d0: 20 0a 09 09 20 20 20 20 20 20 20 3b 3b 20 43 65 ... ;; Ce
c2e0: 6c 6c 20 63 6f 6e 74 65 6e 74 73 0a 09 09 20 20 ll contents...
c2f0: 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 (for-each (
c300: 6c 61 6d 62 64 61 20 28 65 6e 74 72 79 29 0a 09 lambda (entry)..
c310: 09 09 09 20 20 20 28 6c 65 74 2a 20 28 28 72 6f ... (let* ((ro
c320: 77 2d 6e 61 6d 65 20 20 28 63 61 64 72 20 65 6e w-name (cadr en
c330: 74 72 79 29 29 0a 09 09 09 09 09 20 20 28 63 6f try))...... (co
c340: 6c 2d 6e 61 6d 65 20 20 28 63 61 72 20 65 6e 74 l-name (car ent
c350: 72 79 29 29 0a 09 09 09 09 09 20 20 28 76 61 6c ry))...... (val
c360: 75 65 64 61 74 20 20 28 63 61 64 64 72 20 65 6e uedat (caddr en
c370: 74 72 79 29 29 0a 09 09 09 09 09 20 20 28 74 65 try))...... (te
c380: 73 74 2d 69 64 20 20 20 28 6c 69 73 74 2d 72 65 st-id (list-re
c390: 66 20 76 61 6c 75 65 64 61 74 20 30 29 29 0a 09 f valuedat 0))..
c3a0: 09 09 09 09 20 20 28 74 65 73 74 2d 6e 61 6d 65 .... (test-name
c3b0: 20 72 6f 77 2d 6e 61 6d 65 29 20 3b 3b 20 28 6c row-name) ;; (l
c3c0: 69 73 74 2d 72 65 66 20 76 61 6c 75 65 64 61 74 ist-ref valuedat
c3d0: 20 31 29 29 0a 09 09 09 09 09 20 20 28 69 74 65 1))...... (ite
c3e0: 6d 2d 70 61 74 68 20 63 6f 6c 2d 6e 61 6d 65 29 m-path col-name)
c3f0: 20 3b 3b 20 28 6c 69 73 74 2d 72 65 66 20 76 61 ;; (list-ref va
c400: 6c 75 65 64 61 74 20 32 29 29 0a 09 09 09 09 09 luedat 2))......
c410: 20 20 28 73 74 61 74 65 20 20 20 20 20 28 6c 69 (state (li
c420: 73 74 2d 72 65 66 20 76 61 6c 75 65 64 61 74 20 st-ref valuedat
c430: 31 29 29 0a 09 09 09 09 09 20 20 28 73 74 61 74 1))...... (stat
c440: 75 73 20 20 20 20 28 6c 69 73 74 2d 72 65 66 20 us (list-ref
c450: 76 61 6c 75 65 64 61 74 20 32 29 29 0a 09 09 09 valuedat 2))....
c460: 09 09 20 20 28 76 61 6c 75 65 20 20 20 20 20 28 .. (value (
c470: 67 75 74 69 6c 73 3a 67 65 74 2d 63 6f 6c 6f 72 gutils:get-color
c480: 2d 66 6f 72 2d 73 74 61 74 65 2d 73 74 61 74 75 -for-state-statu
c490: 73 20 73 74 61 74 65 20 73 74 61 74 75 73 29 29 s state status))
c4a0: 0a 09 09 09 09 09 20 20 28 72 6f 77 2d 6e 75 6d ...... (row-num
c4b0: 20 20 20 28 63 61 64 72 20 28 61 73 73 6f 63 20 (cadr (assoc
c4c0: 72 6f 77 2d 6e 61 6d 65 20 72 6f 77 2d 69 6e 64 row-name row-ind
c4d0: 69 63 65 73 29 29 29 0a 09 09 09 09 09 20 20 28 ices)))...... (
c4e0: 63 6f 6c 2d 6e 75 6d 20 20 20 28 63 61 64 72 20 col-num (cadr
c4f0: 28 61 73 73 6f 63 20 63 6f 6c 2d 6e 61 6d 65 20 (assoc col-name
c500: 63 6f 6c 2d 69 6e 64 69 63 65 73 29 29 29 0a 09 col-indices)))..
c510: 09 09 09 09 20 20 28 6b 65 79 20 20 20 20 20 20 .... (key
c520: 20 28 63 6f 6e 63 20 72 6f 77 2d 6e 75 6d 20 22 (conc row-num "
c530: 3a 22 20 63 6f 6c 2d 6e 75 6d 29 29 29 0a 09 09 :" col-num)))...
c540: 09 09 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 .. (hash-tab
c550: 6c 65 2d 73 65 74 21 20 63 65 6c 6c 2d 6c 6f 6f le-set! cell-loo
c560: 6b 75 70 20 6b 65 79 20 74 65 73 74 2d 69 64 29 kup key test-id)
c570: 0a 09 09 09 09 20 20 20 20 20 28 69 66 20 28 6e ..... (if (n
c580: 6f 74 20 28 65 71 75 61 6c 3f 20 28 69 75 70 3a ot (equal? (iup:
c590: 61 74 74 72 69 62 75 74 65 20 72 75 6e 2d 6d 61 attribute run-ma
c5a0: 74 72 69 78 20 6b 65 79 29 20 28 63 61 64 72 20 trix key) (cadr
c5b0: 76 61 6c 75 65 29 29 29 0a 09 09 09 09 09 20 28 value)))...... (
c5c0: 62 65 67 69 6e 0a 09 09 09 09 09 20 20 20 28 73 begin...... (s
c5d0: 65 74 21 20 63 68 61 6e 67 65 64 20 23 74 29 0a et! changed #t).
c5e0: 09 09 09 09 09 20 20 20 28 69 75 70 3a 61 74 74 ..... (iup:att
c5f0: 72 69 62 75 74 65 2d 73 65 74 21 20 72 75 6e 2d ribute-set! run-
c600: 6d 61 74 72 69 78 20 6b 65 79 20 28 63 61 64 72 matrix key (cadr
c610: 20 76 61 6c 75 65 29 29 0a 09 09 09 09 09 20 20 value))......
c620: 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d (iup:attribute-
c630: 73 65 74 21 20 72 75 6e 2d 6d 61 74 72 69 78 20 set! run-matrix
c640: 28 63 6f 6e 63 20 22 42 47 43 4f 4c 4f 52 22 20 (conc "BGCOLOR"
c650: 6b 65 79 29 20 28 63 61 72 20 76 61 6c 75 65 29 key) (car value)
c660: 29 29 29 29 29 0a 09 09 09 09 20 74 65 73 74 73 )))))..... tests
c670: 2d 6d 69 6e 64 61 74 29 0a 09 09 20 20 20 20 20 -mindat)...
c680: 20 20 0a 09 09 20 20 20 20 20 20 20 3b 3b 20 43 ... ;; C
c690: 6f 6c 20 6c 61 62 65 6c 73 20 2d 20 64 6f 20 61 ol labels - do a
c6a0: 66 74 65 72 20 73 65 74 74 69 6e 67 20 43 65 6c fter setting Cel
c6b0: 6c 20 63 6f 6e 74 65 6e 74 73 20 73 6f 20 74 68 l contents so th
c6c0: 65 79 20 61 72 65 20 61 63 63 6f 75 6e 74 65 64 ey are accounted
c6d0: 20 66 6f 72 20 69 6e 20 74 68 65 20 73 69 7a 65 for in the size
c6e0: 20 63 61 6c 63 2e 0a 0a 09 09 20 20 20 20 20 20 calc.....
c6f0: 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 (for-each (lamb
c700: 64 61 20 28 69 6e 64 29 0a 09 09 09 09 20 20 20 da (ind).....
c710: 28 6c 65 74 2a 20 28 28 6e 61 6d 65 20 28 63 61 (let* ((name (ca
c720: 72 20 69 6e 64 29 29 0a 09 09 09 09 09 20 20 28 r ind))...... (
c730: 6e 75 6d 20 20 28 63 61 64 72 20 69 6e 64 29 29 num (cadr ind))
c740: 0a 09 09 09 09 09 20 20 28 6b 65 79 20 20 28 63 ...... (key (c
c750: 6f 6e 63 20 22 30 3a 22 20 6e 75 6d 29 29 29 0a onc "0:" num))).
c760: 09 09 09 09 20 20 20 20 20 28 69 66 20 28 6e 6f .... (if (no
c770: 74 20 28 65 71 75 61 6c 3f 20 28 69 75 70 3a 61 t (equal? (iup:a
c780: 74 74 72 69 62 75 74 65 20 72 75 6e 2d 6d 61 74 ttribute run-mat
c790: 72 69 78 20 6b 65 79 29 20 6e 61 6d 65 29 29 0a rix key) name)).
c7a0: 09 09 09 09 09 20 28 62 65 67 69 6e 0a 09 09 09 ..... (begin....
c7b0: 09 09 20 20 20 28 73 65 74 21 20 63 68 61 6e 67 .. (set! chang
c7c0: 65 64 20 23 74 29 0a 09 09 09 09 09 20 20 20 28 ed #t)...... (
c7d0: 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 iup:attribute-se
c7e0: 74 21 20 72 75 6e 2d 6d 61 74 72 69 78 20 6b 65 t! run-matrix ke
c7f0: 79 20 6e 61 6d 65 29 0a 09 09 09 09 09 20 20 20 y name)......
c800: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 (iup:attribute-s
c810: 65 74 21 20 72 75 6e 2d 6d 61 74 72 69 78 20 22 et! run-matrix "
c820: 46 49 54 54 4f 54 45 58 54 22 20 28 63 6f 6e 63 FITTOTEXT" (conc
c830: 20 22 43 22 20 6e 75 6d 29 29 29 29 29 29 0a 09 "C" num))))))..
c840: 09 09 09 20 63 6f 6c 2d 69 6e 64 69 63 65 73 29 ... col-indices)
c850: 0a 09 09 20 20 20 20 20 20 20 28 69 66 20 63 68 ... (if ch
c860: 61 6e 67 65 64 20 28 69 75 70 3a 61 74 74 72 69 anged (iup:attri
c870: 62 75 74 65 2d 73 65 74 21 20 72 75 6e 2d 6d 61 bute-set! run-ma
c880: 74 72 69 78 20 22 52 45 44 52 41 57 22 20 22 41 trix "REDRAW" "A
c890: 4c 4c 22 29 29 29 29 29 29 0a 20 20 20 20 0a 20 LL")))))). .
c8a0: 20 20 20 28 73 65 74 21 20 64 61 73 68 62 6f 61 (set! dashboa
c8b0: 72 64 3a 75 70 64 61 74 65 2d 72 75 6e 2d 73 75 rd:update-run-su
c8c0: 6d 6d 61 72 79 2d 74 61 62 20 75 70 64 61 74 65 mmary-tab update
c8d0: 72 29 0a 20 20 20 20 28 64 3a 64 61 74 61 2d 72 r). (d:data-r
c8e0: 75 6e 73 2d 74 72 65 65 2d 73 65 74 21 20 64 64 uns-tree-set! dd
c8f0: 61 74 61 20 74 62 29 0a 20 20 20 20 28 69 75 70 ata tb). (iup
c900: 3a 73 70 6c 69 74 0a 20 20 20 20 20 74 62 0a 20 :split. tb.
c910: 20 20 20 20 72 75 6e 2d 6d 61 74 72 69 78 29 29 run-matrix))
c920: 29 0a 0a 3b 3b 20 54 68 69 73 20 69 73 20 74 68 )..;; This is th
c930: 65 20 4e 65 77 20 56 69 65 77 20 74 61 62 0a 3b e New View tab.;
c940: 3b 20 0a 28 64 65 66 69 6e 65 20 28 64 61 73 68 ; .(define (dash
c950: 62 6f 61 72 64 3a 6e 65 77 2d 76 69 65 77 20 64 board:new-view d
c960: 62 20 64 61 74 61 20 64 64 61 74 61 29 0a 20 20 b data ddata).
c970: 28 6c 65 74 2a 20 28 28 74 62 20 20 20 20 20 20 (let* ((tb
c980: 28 69 75 70 3a 74 72 65 65 62 6f 78 0a 09 09 20 (iup:treebox...
c990: 20 20 23 3a 76 61 6c 75 65 20 30 0a 09 09 20 20 #:value 0...
c9a0: 20 23 3a 6e 61 6d 65 20 22 52 75 6e 73 22 0a 09 #:name "Runs"..
c9b0: 09 20 20 20 23 3a 65 78 70 61 6e 64 20 22 59 45 . #:expand "YE
c9c0: 53 22 0a 09 09 20 20 20 23 3a 61 64 64 65 78 70 S"... #:addexp
c9d0: 61 6e 64 65 64 20 22 4e 4f 22 0a 09 09 20 20 20 anded "NO"...
c9e0: 23 3a 73 65 6c 65 63 74 69 6f 6e 2d 63 62 0a 09 #:selection-cb..
c9f0: 09 20 20 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a . (lambda (obj
ca00: 20 69 64 20 73 74 61 74 65 29 0a 09 09 20 20 20 id state)...
ca10: 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 6f 62 6a ;; (print "obj
ca20: 3a 20 22 20 6f 62 6a 20 22 2c 20 69 64 3a 20 22 : " obj ", id: "
ca30: 20 69 64 20 22 2c 20 73 74 61 74 65 3a 20 22 20 id ", state: "
ca40: 73 74 61 74 65 29 0a 09 09 20 20 20 20 20 28 6c state)... (l
ca50: 65 74 2a 20 28 28 72 75 6e 2d 70 61 74 68 20 28 et* ((run-path (
ca60: 74 72 65 65 3a 6e 6f 64 65 2d 3e 70 61 74 68 20 tree:node->path
ca70: 6f 62 6a 20 69 64 29 29 0a 09 09 09 20 20 20 20 obj id))....
ca80: 28 72 75 6e 2d 69 64 20 20 20 28 74 72 65 65 2d (run-id (tree-
ca90: 70 61 74 68 2d 3e 72 75 6e 2d 69 64 20 64 64 61 path->run-id dda
caa0: 74 61 20 28 63 64 72 20 72 75 6e 2d 70 61 74 68 ta (cdr run-path
cab0: 29 29 29 29 0a 09 09 20 20 20 20 20 20 20 28 69 ))))... (i
cac0: 66 20 28 6e 75 6d 62 65 72 3f 20 72 75 6e 2d 69 f (number? run-i
cad0: 64 29 0a 09 09 09 20 20 20 28 62 65 67 69 6e 0a d).... (begin.
cae0: 09 09 09 20 20 20 20 20 28 64 3a 64 61 74 61 2d ... (d:data-
caf0: 63 75 72 72 2d 72 75 6e 2d 69 64 2d 73 65 74 21 curr-run-id-set!
cb00: 20 64 64 61 74 61 20 72 75 6e 2d 69 64 29 0a 09 ddata run-id)..
cb10: 09 09 20 20 20 20 20 28 64 61 73 68 62 6f 61 72 .. (dashboar
cb20: 64 3a 75 70 64 61 74 65 2d 6e 65 77 2d 76 69 65 d:update-new-vie
cb30: 77 2d 74 61 62 29 29 0a 09 09 09 20 20 20 28 64 w-tab)).... (d
cb40: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 ebug:print 0 "ER
cb50: 52 4f 52 3a 20 74 72 65 65 2d 70 61 74 68 2d 3e ROR: tree-path->
cb60: 72 75 6e 2d 69 64 20 72 65 74 75 72 6e 65 64 20 run-id returned
cb70: 6e 6f 6e 2d 6e 75 6d 62 65 72 20 22 20 72 75 6e non-number " run
cb80: 2d 69 64 29 29 29 0a 09 09 20 20 20 20 20 3b 3b -id)))... ;;
cb90: 20 28 70 72 69 6e 74 20 22 70 61 74 68 3a 20 22 (print "path: "
cba0: 20 28 74 72 65 65 3a 6e 6f 64 65 2d 3e 70 61 74 (tree:node->pat
cbb0: 68 20 6f 62 6a 20 69 64 29 20 22 20 72 75 6e 2d h obj id) " run-
cbc0: 69 64 3a 20 22 20 72 75 6e 2d 69 64 29 0a 09 09 id: " run-id)...
cbd0: 20 20 20 20 20 29 29 29 0a 09 20 28 63 65 6c 6c ))).. (cell
cbe0: 2d 6c 6f 6f 6b 75 70 20 28 6d 61 6b 65 2d 68 61 -lookup (make-ha
cbf0: 73 68 2d 74 61 62 6c 65 29 29 0a 09 20 28 72 75 sh-table)).. (ru
cc00: 6e 2d 6d 61 74 72 69 78 20 28 69 75 70 3a 6d 61 n-matrix (iup:ma
cc10: 74 72 69 78 0a 09 09 20 20 20 20 20 20 23 3a 65 trix... #:e
cc20: 78 70 61 6e 64 20 22 59 45 53 22 0a 09 09 20 20 xpand "YES"...
cc30: 20 20 20 20 23 3a 63 6c 69 63 6b 2d 63 62 0a 09 #:click-cb..
cc40: 09 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 . (lambda (
cc50: 6f 62 6a 20 6c 69 6e 20 63 6f 6c 20 73 74 61 74 obj lin col stat
cc60: 75 73 29 0a 09 09 09 28 6c 65 74 2a 20 28 28 74 us)....(let* ((t
cc70: 6f 6f 6c 70 61 74 68 20 28 63 61 72 20 28 61 72 oolpath (car (ar
cc80: 67 76 29 29 29 0a 09 09 09 20 20 20 20 20 20 20 gv)))....
cc90: 28 6b 65 79 20 20 20 20 20 20 28 63 6f 6e 63 20 (key (conc
cca0: 6c 69 6e 20 22 3a 22 20 63 6f 6c 29 29 0a 09 09 lin ":" col))...
ccb0: 09 20 20 20 20 20 20 20 28 74 65 73 74 2d 69 64 . (test-id
ccc0: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 (hash-table-re
ccd0: 66 2f 64 65 66 61 75 6c 74 20 63 65 6c 6c 2d 6c f/default cell-l
cce0: 6f 6f 6b 75 70 20 6b 65 79 20 2d 31 29 29 0a 09 ookup key -1))..
ccf0: 09 09 20 20 20 20 20 20 20 28 63 6d 64 20 20 20 .. (cmd
cd00: 20 20 20 28 63 6f 6e 63 20 74 6f 6f 6c 70 61 74 (conc toolpat
cd10: 68 20 22 20 2d 74 65 73 74 20 22 20 28 64 3a 64 h " -test " (d:d
cd20: 61 74 61 2d 63 75 72 72 2d 72 75 6e 2d 69 64 20 ata-curr-run-id
cd30: 64 64 61 74 61 29 20 22 2c 22 20 74 65 73 74 2d ddata) "," test-
cd40: 69 64 20 22 26 22 29 29 29 0a 09 09 09 20 20 28 id "&"))).... (
cd50: 73 79 73 74 65 6d 20 63 6d 64 29 29 29 29 29 0a system cmd))))).
cd60: 09 20 28 75 70 64 61 74 65 72 20 20 28 6c 61 6d . (updater (lam
cd70: 62 64 61 20 28 29 0a 09 09 20 20 20 20 20 28 6c bda ()... (l
cd80: 65 74 2a 20 28 28 72 75 6e 73 2d 64 61 74 20 20 et* ((runs-dat
cd90: 20 20 20 28 69 66 20 28 64 3a 61 6c 6c 64 61 74 (if (d:alldat
cda0: 2d 75 73 65 73 65 72 76 65 72 20 64 61 74 61 29 -useserver data)
cdb0: 0a 09 09 09 09 09 20 20 20 20 20 20 28 72 6d 74 ...... (rmt
cdc0: 3a 67 65 74 2d 72 75 6e 73 2d 62 79 2d 70 61 74 :get-runs-by-pat
cdd0: 74 20 28 64 3a 61 6c 6c 64 61 74 2d 6b 65 79 73 t (d:alldat-keys
cde0: 20 64 61 74 61 29 20 22 25 22 20 23 66 20 23 66 data) "%" #f #f
cdf0: 20 23 66 20 23 66 29 0a 09 09 09 09 09 20 20 20 #f #f)......
ce00: 20 20 20 28 64 62 3a 67 65 74 2d 72 75 6e 73 2d (db:get-runs-
ce10: 62 79 2d 70 61 74 74 20 64 62 20 28 64 3a 61 6c by-patt db (d:al
ce20: 6c 64 61 74 2d 6b 65 79 73 20 64 61 74 61 29 20 ldat-keys data)
ce30: 22 25 22 20 23 66 20 23 66 20 23 66 20 23 66 29 "%" #f #f #f #f)
ce40: 29 29 0a 09 09 09 20 20 20 20 28 72 75 6e 73 2d )).... (runs-
ce50: 68 65 61 64 65 72 20 20 28 76 65 63 74 6f 72 2d header (vector-
ce60: 72 65 66 20 72 75 6e 73 2d 64 61 74 20 30 29 29 ref runs-dat 0))
ce70: 20 3b 3b 20 30 20 69 73 20 68 65 61 64 65 72 2c ;; 0 is header,
ce80: 20 31 20 69 73 20 6c 69 73 74 20 6f 66 20 72 65 1 is list of re
ce90: 63 6f 72 64 73 0a 09 09 09 20 20 20 20 28 72 75 cords.... (ru
cea0: 6e 2d 69 64 20 20 20 20 20 20 20 28 64 3a 64 61 n-id (d:da
ceb0: 74 61 2d 63 75 72 72 2d 72 75 6e 2d 69 64 20 64 ta-curr-run-id d
cec0: 64 61 74 61 29 29 0a 09 09 09 20 20 20 20 28 6c data)).... (l
ced0: 61 73 74 2d 75 70 64 61 74 65 20 20 30 29 20 3b ast-update 0) ;
cee0: 3b 20 66 69 78 20 6d 65 0a 09 09 09 20 20 20 20 ; fix me....
cef0: 28 74 65 73 74 73 2d 64 61 74 20 20 20 20 28 64 (tests-dat (d
cf00: 62 6f 61 72 64 3a 67 65 74 2d 74 65 73 74 73 2d board:get-tests-
cf10: 64 61 74 20 64 61 74 61 20 72 75 6e 2d 69 64 20 dat data run-id
cf20: 6c 61 73 74 2d 75 70 64 61 74 65 29 29 0a 09 09 last-update))...
cf30: 09 20 20 20 20 28 74 65 73 74 73 2d 6d 69 6e 64 . (tests-mind
cf40: 61 74 20 28 64 63 6f 6d 6d 6f 6e 3a 6d 69 6e 69 at (dcommon:mini
cf50: 6d 69 7a 65 2d 74 65 73 74 2d 64 61 74 61 20 74 mize-test-data t
cf60: 65 73 74 73 2d 64 61 74 29 29 0a 09 09 09 20 20 ests-dat))....
cf70: 20 20 28 69 6e 64 69 63 65 73 20 20 20 20 20 20 (indices
cf80: 28 63 6f 6d 6d 6f 6e 3a 73 70 61 72 73 65 2d 6c (common:sparse-l
cf90: 69 73 74 2d 67 65 6e 65 72 61 74 65 2d 69 6e 64 ist-generate-ind
cfa0: 65 78 20 74 65 73 74 73 2d 6d 69 6e 64 61 74 29 ex tests-mindat)
cfb0: 29 20 3b 3b 20 20 70 72 6f 63 3a 20 73 65 74 2d ) ;; proc: set-
cfc0: 63 65 6c 6c 29 29 0a 09 09 09 20 20 20 20 28 72 cell)).... (r
cfd0: 6f 77 2d 69 6e 64 69 63 65 73 20 20 28 63 61 64 ow-indices (cad
cfe0: 72 20 69 6e 64 69 63 65 73 29 29 0a 09 09 09 20 r indices))....
cff0: 20 20 20 28 63 6f 6c 2d 69 6e 64 69 63 65 73 20 (col-indices
d000: 20 28 63 61 72 20 69 6e 64 69 63 65 73 29 29 0a (car indices)).
d010: 09 09 09 20 20 20 20 28 6d 61 78 2d 72 6f 77 20 ... (max-row
d020: 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 (if (null?
d030: 72 6f 77 2d 69 6e 64 69 63 65 73 29 20 31 20 28 row-indices) 1 (
d040: 63 6f 6d 6d 6f 6e 3a 6d 61 78 20 28 6d 61 70 20 common:max (map
d050: 63 61 64 72 20 72 6f 77 2d 69 6e 64 69 63 65 73 cadr row-indices
d060: 29 29 29 29 0a 09 09 09 20 20 20 20 28 6d 61 78 )))).... (max
d070: 2d 63 6f 6c 20 20 20 20 20 20 28 69 66 20 28 6e -col (if (n
d080: 75 6c 6c 3f 20 63 6f 6c 2d 69 6e 64 69 63 65 73 ull? col-indices
d090: 29 20 31 20 28 63 6f 6d 6d 6f 6e 3a 6d 61 78 20 ) 1 (common:max
d0a0: 28 6d 61 70 20 63 61 64 72 20 63 6f 6c 2d 69 6e (map cadr col-in
d0b0: 64 69 63 65 73 29 29 29 29 0a 09 09 09 20 20 20 dices))))....
d0c0: 20 28 6d 61 78 2d 76 69 73 69 62 6c 65 20 20 28 (max-visible (
d0d0: 6d 61 78 20 28 2d 20 28 64 3a 61 6c 6c 64 61 74 max (- (d:alldat
d0e0: 2d 6e 75 6d 2d 74 65 73 74 73 20 64 61 74 61 29 -num-tests data)
d0f0: 20 31 35 29 20 33 29 29 20 3b 3b 20 28 64 3a 61 15) 3)) ;; (d:a
d100: 6c 6c 64 61 74 2d 6e 75 6d 2d 74 65 73 74 73 20 lldat-num-tests
d110: 64 61 74 61 29 20 69 73 20 70 72 6f 70 6f 72 74 data) is proport
d120: 69 6f 6e 61 6c 20 74 6f 20 74 68 65 20 73 69 7a ional to the siz
d130: 65 20 6f 66 20 74 68 65 20 77 69 6e 64 6f 77 0a e of the window.
d140: 09 09 09 20 20 20 20 28 6e 75 6d 72 6f 77 73 20 ... (numrows
d150: 20 20 20 20 20 31 29 0a 09 09 09 20 20 20 20 28 1).... (
d160: 6e 75 6d 63 6f 6c 73 20 20 20 20 20 20 31 29 0a numcols 1).
d170: 09 09 09 20 20 20 20 28 63 68 61 6e 67 65 64 20 ... (changed
d180: 20 20 20 20 20 23 66 29 0a 09 09 09 20 20 20 20 #f)....
d190: 28 72 75 6e 73 2d 68 61 73 68 20 20 20 20 28 6c (runs-hash (l
d1a0: 65 74 20 28 28 68 74 20 28 6d 61 6b 65 2d 68 61 et ((ht (make-ha
d1b0: 73 68 2d 74 61 62 6c 65 29 29 29 0a 09 09 09 09 sh-table))).....
d1c0: 09 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 . (for-each (
d1d0: 6c 61 6d 62 64 61 20 28 72 75 6e 29 0a 09 09 09 lambda (run)....
d1e0: 09 09 09 09 28 68 61 73 68 2d 74 61 62 6c 65 2d ....(hash-table-
d1f0: 73 65 74 21 20 68 74 20 28 64 62 3a 67 65 74 2d set! ht (db:get-
d200: 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 value-by-header
d210: 72 75 6e 20 72 75 6e 73 2d 68 65 61 64 65 72 20 run runs-header
d220: 22 69 64 22 29 20 72 75 6e 29 29 0a 09 09 09 09 "id") run)).....
d230: 09 09 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d .. (vector-
d240: 72 65 66 20 72 75 6e 73 2d 64 61 74 20 31 29 29 ref runs-dat 1))
d250: 0a 09 09 09 09 09 20 20 20 20 68 74 29 29 0a 09 ...... ht))..
d260: 09 09 20 20 20 20 28 72 75 6e 2d 69 64 73 20 20 .. (run-ids
d270: 20 20 20 20 28 73 6f 72 74 20 28 66 69 6c 74 65 (sort (filte
d280: 72 20 6e 75 6d 62 65 72 3f 20 28 68 61 73 68 2d r number? (hash-
d290: 74 61 62 6c 65 2d 6b 65 79 73 20 72 75 6e 73 2d table-keys runs-
d2a0: 68 61 73 68 29 29 0a 09 09 09 09 09 09 28 6c 61 hash)).......(la
d2b0: 6d 62 64 61 20 28 61 20 62 29 0a 09 09 09 09 09 mbda (a b)......
d2c0: 09 20 20 28 6c 65 74 2a 20 28 28 72 65 63 6f 72 . (let* ((recor
d2d0: 64 2d 61 20 28 68 61 73 68 2d 74 61 62 6c 65 2d d-a (hash-table-
d2e0: 72 65 66 20 72 75 6e 73 2d 68 61 73 68 20 61 29 ref runs-hash a)
d2f0: 29 0a 09 09 09 09 09 09 09 20 28 72 65 63 6f 72 )........ (recor
d300: 64 2d 62 20 28 68 61 73 68 2d 74 61 62 6c 65 2d d-b (hash-table-
d310: 72 65 66 20 72 75 6e 73 2d 68 61 73 68 20 62 29 ref runs-hash b)
d320: 29 0a 09 09 09 09 09 09 09 20 28 74 69 6d 65 2d )........ (time-
d330: 61 20 20 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 a (db:get-valu
d340: 65 2d 62 79 2d 68 65 61 64 65 72 20 72 65 63 6f e-by-header reco
d350: 72 64 2d 61 20 72 75 6e 73 2d 68 65 61 64 65 72 rd-a runs-header
d360: 20 22 65 76 65 6e 74 5f 74 69 6d 65 22 29 29 0a "event_time")).
d370: 09 09 09 09 09 09 09 20 28 74 69 6d 65 2d 62 20 ....... (time-b
d380: 20 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d (db:get-value-
d390: 62 79 2d 68 65 61 64 65 72 20 72 65 63 6f 72 64 by-header record
d3a0: 2d 62 20 72 75 6e 73 2d 68 65 61 64 65 72 20 22 -b runs-header "
d3b0: 65 76 65 6e 74 5f 74 69 6d 65 22 29 29 29 0a 09 event_time")))..
d3c0: 09 09 09 09 09 20 20 20 20 28 3c 20 74 69 6d 65 ..... (< time
d3d0: 2d 61 20 74 69 6d 65 2d 62 29 29 29 29 29 29 0a -a time-b)))))).
d3e0: 09 09 20 20 20 20 20 20 20 0a 09 09 20 20 20 20 .. ...
d3f0: 20 20 20 3b 3b 20 28 69 75 70 3a 61 74 74 72 69 ;; (iup:attri
d400: 62 75 74 65 2d 73 65 74 21 20 74 62 20 22 56 41 bute-set! tb "VA
d410: 4c 55 45 22 20 22 30 22 29 0a 09 09 20 20 20 20 LUE" "0")...
d420: 20 20 20 3b 3b 20 28 69 75 70 3a 61 74 74 72 69 ;; (iup:attri
d430: 62 75 74 65 2d 73 65 74 21 20 74 62 20 22 4e 41 bute-set! tb "NA
d440: 4d 45 22 20 22 52 75 6e 73 22 29 0a 09 09 20 20 ME" "Runs")...
d450: 20 20 20 20 20 3b 3b 20 55 70 64 61 74 65 20 74 ;; Update t
d460: 68 65 20 72 75 6e 73 20 74 72 65 65 0a 09 09 20 he runs tree...
d470: 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 (for-each
d480: 28 6c 61 6d 62 64 61 20 28 72 75 6e 2d 69 64 29 (lambda (run-id)
d490: 0a 09 09 09 09 20 20 20 28 6c 65 74 2a 20 28 28 ..... (let* ((
d4a0: 72 75 6e 2d 72 65 63 6f 72 64 20 28 68 61 73 68 run-record (hash
d4b0: 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 -table-ref/defau
d4c0: 6c 74 20 72 75 6e 73 2d 68 61 73 68 20 72 75 6e lt runs-hash run
d4d0: 2d 69 64 20 23 66 29 29 0a 09 09 09 09 09 20 20 -id #f))......
d4e0: 28 6b 65 79 2d 76 61 6c 73 20 20 20 28 6d 61 70 (key-vals (map
d4f0: 20 28 6c 61 6d 62 64 61 20 28 6b 65 79 29 28 64 (lambda (key)(d
d500: 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 b:get-value-by-h
d510: 65 61 64 65 72 20 72 75 6e 2d 72 65 63 6f 72 64 eader run-record
d520: 20 72 75 6e 73 2d 68 65 61 64 65 72 20 6b 65 79 runs-header key
d530: 29 29 0a 09 09 09 09 09 09 09 20 20 20 28 64 3a ))........ (d:
d540: 61 6c 6c 64 61 74 2d 6b 65 79 73 20 64 61 74 61 alldat-keys data
d550: 29 29 29 0a 09 09 09 09 09 20 20 28 72 75 6e 2d )))...... (run-
d560: 6e 61 6d 65 20 20 20 28 64 62 3a 67 65 74 2d 76 name (db:get-v
d570: 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 alue-by-header r
d580: 75 6e 2d 72 65 63 6f 72 64 20 72 75 6e 73 2d 68 un-record runs-h
d590: 65 61 64 65 72 20 22 72 75 6e 6e 61 6d 65 22 29 eader "runname")
d5a0: 29 0a 09 09 09 09 09 20 20 28 63 6f 6c 2d 6e 61 )...... (col-na
d5b0: 6d 65 20 20 20 28 63 6f 6e 63 20 28 73 74 72 69 me (conc (stri
d5c0: 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 6b ng-intersperse k
d5d0: 65 79 2d 76 61 6c 73 20 22 5c 6e 22 29 20 22 5c ey-vals "\n") "\
d5e0: 6e 22 20 72 75 6e 2d 6e 61 6d 65 29 29 0a 09 09 n" run-name))...
d5f0: 09 09 09 20 20 28 72 75 6e 2d 70 61 74 68 20 20 ... (run-path
d600: 20 28 61 70 70 65 6e 64 20 6b 65 79 2d 76 61 6c (append key-val
d610: 73 20 28 6c 69 73 74 20 72 75 6e 2d 6e 61 6d 65 s (list run-name
d620: 29 29 29 0a 09 09 09 09 09 20 20 28 65 78 69 73 )))...... (exis
d630: 74 69 6e 67 20 20 20 28 74 72 65 65 3a 66 69 6e ting (tree:fin
d640: 64 2d 6e 6f 64 65 20 74 62 20 72 75 6e 2d 70 61 d-node tb run-pa
d650: 74 68 29 29 29 0a 09 09 09 09 20 20 20 20 20 28 th)))..... (
d660: 69 66 20 28 6e 6f 74 20 28 68 61 73 68 2d 74 61 if (not (hash-ta
d670: 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 ble-ref/default
d680: 28 64 3a 64 61 74 61 2d 70 61 74 68 2d 72 75 6e (d:data-path-run
d690: 2d 69 64 73 20 64 64 61 74 61 29 20 72 75 6e 2d -ids ddata) run-
d6a0: 70 61 74 68 20 23 66 29 29 0a 09 09 09 09 09 20 path #f))......
d6b0: 28 62 65 67 69 6e 0a 09 09 09 09 09 20 20 20 28 (begin...... (
d6c0: 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 hash-table-set!
d6d0: 28 64 3a 64 61 74 61 2d 72 75 6e 2d 6b 65 79 73 (d:data-run-keys
d6e0: 20 64 64 61 74 61 29 20 72 75 6e 2d 69 64 20 72 ddata) run-id r
d6f0: 75 6e 2d 70 61 74 68 29 0a 09 09 09 09 09 20 20 un-path)......
d700: 20 3b 3b 20 28 69 75 70 3a 61 74 74 72 69 62 75 ;; (iup:attribu
d710: 74 65 2d 73 65 74 21 20 28 64 62 6f 61 72 64 3a te-set! (dboard:
d720: 64 61 74 61 2d 67 65 74 2d 72 75 6e 73 2d 6d 61 data-get-runs-ma
d730: 74 72 69 78 20 2a 64 61 74 61 2a 29 0a 09 09 09 trix *data*)....
d740: 09 09 20 20 20 3b 3b 20 20 20 20 09 09 20 28 63 .. ;; .. (c
d750: 6f 6e 63 20 72 6f 77 6e 75 6d 20 22 3a 22 20 63 onc rownum ":" c
d760: 6f 6c 6e 75 6d 29 20 63 6f 6c 2d 6e 61 6d 65 29 olnum) col-name)
d770: 0a 09 09 09 09 09 20 20 20 3b 3b 20 28 68 61 73 ...... ;; (has
d780: 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 72 75 6e h-table-set! run
d790: 69 64 2d 74 6f 2d 63 6f 6c 20 72 75 6e 2d 69 64 id-to-col run-id
d7a0: 20 28 6c 69 73 74 20 63 6f 6c 6e 75 6d 20 72 75 (list colnum ru
d7b0: 6e 2d 72 65 63 6f 72 64 29 29 0a 09 09 09 09 09 n-record))......
d7c0: 20 20 20 3b 3b 20 48 65 72 65 20 77 65 20 75 70 ;; Here we up
d7d0: 64 61 74 65 20 74 68 65 20 74 65 73 74 73 20 74 date the tests t
d7e0: 72 65 65 62 6f 78 20 61 6e 64 20 74 72 65 65 20 reebox and tree
d7f0: 6b 65 79 73 0a 09 09 09 09 09 20 20 20 28 74 72 keys...... (tr
d800: 65 65 3a 61 64 64 2d 6e 6f 64 65 20 74 62 20 22 ee:add-node tb "
d810: 52 75 6e 73 22 20 72 75 6e 2d 70 61 74 68 20 3b Runs" run-path ;
d820: 3b 20 28 61 70 70 65 6e 64 20 6b 65 79 2d 76 61 ; (append key-va
d830: 6c 73 20 28 6c 69 73 74 20 72 75 6e 2d 6e 61 6d ls (list run-nam
d840: 65 29 29 0a 09 09 09 09 09 09 09 20 20 75 73 65 e))........ use
d850: 72 64 61 74 61 3a 20 28 63 6f 6e 63 20 22 72 75 rdata: (conc "ru
d860: 6e 2d 69 64 3a 20 22 20 72 75 6e 2d 69 64 29 29 n-id: " run-id))
d870: 0a 09 09 09 09 09 20 20 20 28 68 61 73 68 2d 74 ...... (hash-t
d880: 61 62 6c 65 2d 73 65 74 21 20 28 64 3a 64 61 74 able-set! (d:dat
d890: 61 2d 70 61 74 68 2d 72 75 6e 2d 69 64 73 20 64 a-path-run-ids d
d8a0: 64 61 74 61 29 20 72 75 6e 2d 70 61 74 68 20 72 data) run-path r
d8b0: 75 6e 2d 69 64 29 0a 09 09 09 09 09 20 20 20 3b un-id)...... ;
d8c0: 3b 20 28 73 65 74 21 20 63 6f 6c 6e 75 6d 20 28 ; (set! colnum (
d8d0: 2b 20 63 6f 6c 6e 75 6d 20 31 29 29 0a 09 09 09 + colnum 1))....
d8e0: 09 09 20 20 20 29 29 29 29 0a 09 09 09 09 20 72 .. ))))..... r
d8f0: 75 6e 2d 69 64 73 29 0a 09 09 20 20 20 20 20 20 un-ids)...
d900: 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d (iup:attribute-
d910: 73 65 74 21 20 72 75 6e 2d 6d 61 74 72 69 78 20 set! run-matrix
d920: 22 43 4c 45 41 52 56 41 4c 55 45 22 20 22 41 4c "CLEARVALUE" "AL
d930: 4c 22 29 20 3b 3b 20 4e 4f 54 45 3a 20 57 61 73 L") ;; NOTE: Was
d940: 20 43 4f 4e 54 45 4e 54 53 0a 09 09 20 20 20 20 CONTENTS...
d950: 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 (iup:attribut
d960: 65 2d 73 65 74 21 20 72 75 6e 2d 6d 61 74 72 69 e-set! run-matri
d970: 78 20 22 43 4c 45 41 52 41 54 54 52 49 42 22 20 x "CLEARATTRIB"
d980: 22 43 4f 4e 54 45 4e 54 53 22 29 0a 09 09 20 20 "CONTENTS")...
d990: 20 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 (iup:attrib
d9a0: 75 74 65 2d 73 65 74 21 20 72 75 6e 2d 6d 61 74 ute-set! run-mat
d9b0: 72 69 78 20 22 52 45 53 49 5a 45 4d 41 54 52 49 rix "RESIZEMATRI
d9c0: 58 22 20 22 59 45 53 22 29 0a 09 09 20 20 20 20 X" "YES")...
d9d0: 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 (iup:attribut
d9e0: 65 2d 73 65 74 21 20 72 75 6e 2d 6d 61 74 72 69 e-set! run-matri
d9f0: 78 20 22 4e 55 4d 43 4f 4c 22 20 6d 61 78 2d 63 x "NUMCOL" max-c
da00: 6f 6c 20 29 0a 09 09 20 20 20 20 20 20 20 28 69 ol )... (i
da10: 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 up:attribute-set
da20: 21 20 72 75 6e 2d 6d 61 74 72 69 78 20 22 4e 55 ! run-matrix "NU
da30: 4d 4c 49 4e 22 20 28 69 66 20 28 3c 20 6d 61 78 MLIN" (if (< max
da40: 2d 72 6f 77 20 6d 61 78 2d 76 69 73 69 62 6c 65 -row max-visible
da50: 29 20 6d 61 78 2d 76 69 73 69 62 6c 65 20 6d 61 ) max-visible ma
da60: 78 2d 72 6f 77 29 29 20 3b 3b 20 6d 69 6e 20 6f x-row)) ;; min o
da70: 66 20 32 30 0a 09 09 20 20 20 20 20 20 20 3b 3b f 20... ;;
da80: 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d (iup:attribute-
da90: 73 65 74 21 20 72 75 6e 2d 6d 61 74 72 69 78 20 set! run-matrix
daa0: 22 4e 55 4d 43 4f 4c 5f 56 49 53 49 42 4c 45 22 "NUMCOL_VISIBLE"
dab0: 20 6d 61 78 2d 63 6f 6c 29 0a 09 09 20 20 20 20 max-col)...
dac0: 20 20 20 3b 3b 20 28 69 75 70 3a 61 74 74 72 69 ;; (iup:attri
dad0: 62 75 74 65 2d 73 65 74 21 20 72 75 6e 2d 6d 61 bute-set! run-ma
dae0: 74 72 69 78 20 22 4e 55 4d 4c 49 4e 5f 56 49 53 trix "NUMLIN_VIS
daf0: 49 42 4c 45 22 20 28 69 66 20 28 3e 20 6d 61 78 IBLE" (if (> max
db00: 2d 72 6f 77 20 6d 61 78 2d 76 69 73 69 62 6c 65 -row max-visible
db10: 29 20 6d 61 78 2d 76 69 73 69 62 6c 65 20 6d 61 ) max-visible ma
db20: 78 2d 72 6f 77 29 29 0a 09 09 20 20 20 20 20 20 x-row))...
db30: 20 0a 09 09 20 20 20 20 20 20 20 3b 3b 20 52 6f ... ;; Ro
db40: 77 20 6c 61 62 65 6c 73 0a 09 09 20 20 20 20 20 w labels...
db50: 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d (for-each (lam
db60: 62 64 61 20 28 69 6e 64 29 0a 09 09 09 09 20 20 bda (ind).....
db70: 20 28 6c 65 74 2a 20 28 28 6e 61 6d 65 20 28 63 (let* ((name (c
db80: 61 72 20 69 6e 64 29 29 0a 09 09 09 09 09 20 20 ar ind))......
db90: 28 6e 75 6d 20 20 28 63 61 64 72 20 69 6e 64 29 (num (cadr ind)
dba0: 29 0a 09 09 09 09 09 20 20 28 6b 65 79 20 20 28 )...... (key (
dbb0: 63 6f 6e 63 20 6e 75 6d 20 22 3a 30 22 29 29 29 conc num ":0")))
dbc0: 0a 09 09 09 09 20 20 20 20 20 28 69 66 20 28 6e ..... (if (n
dbd0: 6f 74 20 28 65 71 75 61 6c 3f 20 28 69 75 70 3a ot (equal? (iup:
dbe0: 61 74 74 72 69 62 75 74 65 20 72 75 6e 2d 6d 61 attribute run-ma
dbf0: 74 72 69 78 20 6b 65 79 29 20 6e 61 6d 65 29 29 trix key) name))
dc00: 0a 09 09 09 09 09 20 28 62 65 67 69 6e 0a 09 09 ...... (begin...
dc10: 09 09 09 20 20 20 28 73 65 74 21 20 63 68 61 6e ... (set! chan
dc20: 67 65 64 20 23 74 29 0a 09 09 09 09 09 20 20 20 ged #t)......
dc30: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 (iup:attribute-s
dc40: 65 74 21 20 72 75 6e 2d 6d 61 74 72 69 78 20 6b et! run-matrix k
dc50: 65 79 20 6e 61 6d 65 29 29 29 29 29 0a 09 09 09 ey name)))))....
dc60: 09 20 72 6f 77 2d 69 6e 64 69 63 65 73 29 0a 09 . row-indices)..
dc70: 09 20 20 20 20 20 20 20 0a 09 09 20 20 20 20 20 . ...
dc80: 20 20 3b 3b 20 43 65 6c 6c 20 63 6f 6e 74 65 6e ;; Cell conten
dc90: 74 73 0a 09 09 20 20 20 20 20 20 20 28 66 6f 72 ts... (for
dca0: 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 65 -each (lambda (e
dcb0: 6e 74 72 79 29 0a 09 09 09 09 20 20 20 28 6c 65 ntry)..... (le
dcc0: 74 2a 20 28 28 72 6f 77 2d 6e 61 6d 65 20 20 28 t* ((row-name (
dcd0: 63 61 64 72 20 65 6e 74 72 79 29 29 0a 09 09 09 cadr entry))....
dce0: 09 09 20 20 28 63 6f 6c 2d 6e 61 6d 65 20 20 28 .. (col-name (
dcf0: 63 61 72 20 65 6e 74 72 79 29 29 0a 09 09 09 09 car entry)).....
dd00: 09 20 20 28 76 61 6c 75 65 64 61 74 20 20 28 63 . (valuedat (c
dd10: 61 64 64 72 20 65 6e 74 72 79 29 29 0a 09 09 09 addr entry))....
dd20: 09 09 20 20 28 74 65 73 74 2d 69 64 20 20 20 28 .. (test-id (
dd30: 6c 69 73 74 2d 72 65 66 20 76 61 6c 75 65 64 61 list-ref valueda
dd40: 74 20 30 29 29 0a 09 09 09 09 09 20 20 28 74 65 t 0))...... (te
dd50: 73 74 2d 6e 61 6d 65 20 72 6f 77 2d 6e 61 6d 65 st-name row-name
dd60: 29 20 3b 3b 20 28 6c 69 73 74 2d 72 65 66 20 76 ) ;; (list-ref v
dd70: 61 6c 75 65 64 61 74 20 31 29 29 0a 09 09 09 09 aluedat 1)).....
dd80: 09 20 20 28 69 74 65 6d 2d 70 61 74 68 20 63 6f . (item-path co
dd90: 6c 2d 6e 61 6d 65 29 20 3b 3b 20 28 6c 69 73 74 l-name) ;; (list
dda0: 2d 72 65 66 20 76 61 6c 75 65 64 61 74 20 32 29 -ref valuedat 2)
ddb0: 29 0a 09 09 09 09 09 20 20 28 73 74 61 74 65 20 )...... (state
ddc0: 20 20 20 20 28 6c 69 73 74 2d 72 65 66 20 76 61 (list-ref va
ddd0: 6c 75 65 64 61 74 20 31 29 29 0a 09 09 09 09 09 luedat 1))......
dde0: 20 20 28 73 74 61 74 75 73 20 20 20 20 28 6c 69 (status (li
ddf0: 73 74 2d 72 65 66 20 76 61 6c 75 65 64 61 74 20 st-ref valuedat
de00: 32 29 29 0a 09 09 09 09 09 20 20 28 76 61 6c 75 2))...... (valu
de10: 65 20 20 20 20 20 28 67 75 74 69 6c 73 3a 67 65 e (gutils:ge
de20: 74 2d 63 6f 6c 6f 72 2d 66 6f 72 2d 73 74 61 74 t-color-for-stat
de30: 65 2d 73 74 61 74 75 73 20 73 74 61 74 65 20 73 e-status state s
de40: 74 61 74 75 73 29 29 0a 09 09 09 09 09 20 20 28 tatus))...... (
de50: 72 6f 77 2d 6e 75 6d 20 20 20 28 63 61 64 72 20 row-num (cadr
de60: 28 61 73 73 6f 63 20 72 6f 77 2d 6e 61 6d 65 20 (assoc row-name
de70: 72 6f 77 2d 69 6e 64 69 63 65 73 29 29 29 0a 09 row-indices)))..
de80: 09 09 09 09 20 20 28 63 6f 6c 2d 6e 75 6d 20 20 .... (col-num
de90: 20 28 63 61 64 72 20 28 61 73 73 6f 63 20 63 6f (cadr (assoc co
dea0: 6c 2d 6e 61 6d 65 20 63 6f 6c 2d 69 6e 64 69 63 l-name col-indic
deb0: 65 73 29 29 29 0a 09 09 09 09 09 20 20 28 6b 65 es)))...... (ke
dec0: 79 20 20 20 20 20 20 20 28 63 6f 6e 63 20 72 6f y (conc ro
ded0: 77 2d 6e 75 6d 20 22 3a 22 20 63 6f 6c 2d 6e 75 w-num ":" col-nu
dee0: 6d 29 29 29 0a 09 09 09 09 20 20 20 20 20 28 68 m)))..... (h
def0: 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 63 ash-table-set! c
df00: 65 6c 6c 2d 6c 6f 6f 6b 75 70 20 6b 65 79 20 74 ell-lookup key t
df10: 65 73 74 2d 69 64 29 0a 09 09 09 09 20 20 20 20 est-id).....
df20: 20 28 69 66 20 28 6e 6f 74 20 28 65 71 75 61 6c (if (not (equal
df30: 3f 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 ? (iup:attribute
df40: 20 72 75 6e 2d 6d 61 74 72 69 78 20 6b 65 79 29 run-matrix key)
df50: 20 28 63 61 64 72 20 76 61 6c 75 65 29 29 29 0a (cadr value))).
df60: 09 09 09 09 09 20 28 62 65 67 69 6e 0a 09 09 09 ..... (begin....
df70: 09 09 20 20 20 28 73 65 74 21 20 63 68 61 6e 67 .. (set! chang
df80: 65 64 20 23 74 29 0a 09 09 09 09 09 20 20 20 28 ed #t)...... (
df90: 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 iup:attribute-se
dfa0: 74 21 20 72 75 6e 2d 6d 61 74 72 69 78 20 6b 65 t! run-matrix ke
dfb0: 79 20 28 63 61 64 72 20 76 61 6c 75 65 29 29 0a y (cadr value)).
dfc0: 09 09 09 09 09 20 20 20 28 69 75 70 3a 61 74 74 ..... (iup:att
dfd0: 72 69 62 75 74 65 2d 73 65 74 21 20 72 75 6e 2d ribute-set! run-
dfe0: 6d 61 74 72 69 78 20 28 63 6f 6e 63 20 22 42 47 matrix (conc "BG
dff0: 43 4f 4c 4f 52 22 20 6b 65 79 29 20 28 63 61 72 COLOR" key) (car
e000: 20 76 61 6c 75 65 29 29 29 29 29 29 0a 09 09 09 value))))))....
e010: 09 20 74 65 73 74 73 2d 6d 69 6e 64 61 74 29 0a . tests-mindat).
e020: 09 09 20 20 20 20 20 20 20 0a 09 09 20 20 20 20 .. ...
e030: 20 20 20 3b 3b 20 43 6f 6c 20 6c 61 62 65 6c 73 ;; Col labels
e040: 20 2d 20 64 6f 20 61 66 74 65 72 20 73 65 74 74 - do after sett
e050: 69 6e 67 20 43 65 6c 6c 20 63 6f 6e 74 65 6e 74 ing Cell content
e060: 73 20 73 6f 20 74 68 65 79 20 61 72 65 20 61 63 s so they are ac
e070: 63 6f 75 6e 74 65 64 20 66 6f 72 20 69 6e 20 74 counted for in t
e080: 68 65 20 73 69 7a 65 20 63 61 6c 63 2e 0a 0a 09 he size calc....
e090: 09 20 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 . (for-eac
e0a0: 68 20 28 6c 61 6d 62 64 61 20 28 69 6e 64 29 0a h (lambda (ind).
e0b0: 09 09 09 09 20 20 20 28 6c 65 74 2a 20 28 28 6e .... (let* ((n
e0c0: 61 6d 65 20 28 63 61 72 20 69 6e 64 29 29 0a 09 ame (car ind))..
e0d0: 09 09 09 09 20 20 28 6e 75 6d 20 20 28 63 61 64 .... (num (cad
e0e0: 72 20 69 6e 64 29 29 0a 09 09 09 09 09 20 20 28 r ind))...... (
e0f0: 6b 65 79 20 20 28 63 6f 6e 63 20 22 30 3a 22 20 key (conc "0:"
e100: 6e 75 6d 29 29 29 0a 09 09 09 09 20 20 20 20 20 num))).....
e110: 28 69 66 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f (if (not (equal?
e120: 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 20 (iup:attribute
e130: 72 75 6e 2d 6d 61 74 72 69 78 20 6b 65 79 29 20 run-matrix key)
e140: 6e 61 6d 65 29 29 0a 09 09 09 09 09 20 28 62 65 name))...... (be
e150: 67 69 6e 0a 09 09 09 09 09 20 20 20 28 73 65 74 gin...... (set
e160: 21 20 63 68 61 6e 67 65 64 20 23 74 29 0a 09 09 ! changed #t)...
e170: 09 09 09 20 20 20 28 69 75 70 3a 61 74 74 72 69 ... (iup:attri
e180: 62 75 74 65 2d 73 65 74 21 20 72 75 6e 2d 6d 61 bute-set! run-ma
e190: 74 72 69 78 20 6b 65 79 20 6e 61 6d 65 29 0a 09 trix key name)..
e1a0: 09 09 09 09 20 20 20 28 69 75 70 3a 61 74 74 72 .... (iup:attr
e1b0: 69 62 75 74 65 2d 73 65 74 21 20 72 75 6e 2d 6d ibute-set! run-m
e1c0: 61 74 72 69 78 20 22 46 49 54 54 4f 54 45 58 54 atrix "FITTOTEXT
e1d0: 22 20 28 63 6f 6e 63 20 22 43 22 20 6e 75 6d 29 " (conc "C" num)
e1e0: 29 29 29 29 29 0a 09 09 09 09 20 63 6f 6c 2d 69 )))))..... col-i
e1f0: 6e 64 69 63 65 73 29 0a 09 09 20 20 20 20 20 20 ndices)...
e200: 20 28 69 66 20 63 68 61 6e 67 65 64 20 28 69 75 (if changed (iu
e210: 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 p:attribute-set!
e220: 20 72 75 6e 2d 6d 61 74 72 69 78 20 22 52 45 44 run-matrix "RED
e230: 52 41 57 22 20 22 41 4c 4c 22 29 29 29 29 29 29 RAW" "ALL"))))))
e240: 0a 20 20 20 20 0a 20 20 20 20 28 73 65 74 21 20 . . (set!
e250: 64 61 73 68 62 6f 61 72 64 3a 75 70 64 61 74 65 dashboard:update
e260: 2d 6e 65 77 2d 76 69 65 77 2d 74 61 62 20 75 70 -new-view-tab up
e270: 64 61 74 65 72 29 0a 20 20 20 20 28 64 3a 64 61 dater). (d:da
e280: 74 61 2d 72 75 6e 73 2d 74 72 65 65 2d 73 65 74 ta-runs-tree-set
e290: 21 20 64 64 61 74 61 20 74 62 29 0a 20 20 20 20 ! ddata tb).
e2a0: 28 69 75 70 3a 73 70 6c 69 74 0a 20 20 20 20 20 (iup:split.
e2b0: 74 62 0a 20 20 20 20 20 72 75 6e 2d 6d 61 74 72 tb. run-matr
e2c0: 69 78 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d ix)))..;;=======
e2d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e2e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e2f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e300: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
e310: 3b 3b 20 52 20 55 20 4e 20 53 20 0a 3b 3b 3d 3d ;; R U N S .;;==
e320: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e330: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e340: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e350: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e360: 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28 64 ====..(define (d
e370: 62 6f 61 72 64 3a 6d 61 6b 65 2d 63 6f 6e 74 72 board:make-contr
e380: 6f 6c 73 20 64 61 74 61 29 0a 09 20 20 28 69 75 ols data).. (iu
e390: 70 3a 68 62 6f 78 0a 09 20 20 20 28 69 75 70 3a p:hbox.. (iup:
e3a0: 76 62 6f 78 0a 09 20 20 20 20 28 69 75 70 3a 66 vbox.. (iup:f
e3b0: 72 61 6d 65 20 0a 09 20 20 20 20 20 23 3a 74 69 rame .. #:ti
e3c0: 74 6c 65 20 22 66 69 6c 74 65 72 20 74 65 73 74 tle "filter test
e3d0: 20 61 6e 64 20 69 74 65 6d 73 22 0a 09 20 20 20 and items"..
e3e0: 20 20 28 69 75 70 3a 68 62 6f 78 0a 09 20 20 20 (iup:hbox..
e3f0: 20 20 20 28 69 75 70 3a 76 62 6f 78 0a 09 20 20 (iup:vbox..
e400: 20 20 20 20 20 28 69 75 70 3a 74 65 78 74 62 6f (iup:textbo
e410: 78 20 23 3a 73 69 7a 65 20 22 31 32 30 78 31 35 x #:size "120x15
e420: 22 20 23 3a 66 6f 6e 74 73 69 7a 65 20 22 31 30 " #:fontsize "10
e430: 22 20 23 3a 76 61 6c 75 65 20 22 25 22 0a 09 09 " #:value "%"...
e440: 09 20 20 20 20 23 3a 61 63 74 69 6f 6e 20 28 6c . #:action (l
e450: 61 6d 62 64 61 20 28 6f 62 6a 20 75 6e 6b 20 76 ambda (obj unk v
e460: 61 6c 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 al)..... (
e470: 6d 61 72 6b 2d 66 6f 72 2d 75 70 64 61 74 65 29 mark-for-update)
e480: 0a 09 09 09 09 20 20 20 20 20 20 20 28 75 70 64 ..... (upd
e490: 61 74 65 2d 73 65 61 72 63 68 20 22 74 65 73 74 ate-search "test
e4a0: 2d 6e 61 6d 65 22 20 76 61 6c 29 29 29 0a 09 20 -name" val)))..
e4b0: 20 20 20 20 20 20 28 69 75 70 3a 68 62 6f 78 0a (iup:hbox.
e4c0: 09 09 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 51 ..(iup:button "Q
e4d0: 75 69 74 22 20 20 20 20 20 20 23 3a 61 63 74 69 uit" #:acti
e4e0: 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 29 on (lambda (obj)
e4f0: 0a 09 09 09 09 09 09 20 20 20 3b 3b 20 28 69 66 ....... ;; (if
e500: 20 28 64 3a 61 6c 6c 64 61 74 2d 64 62 6c 6f 63 (d:alldat-dbloc
e510: 61 6c 20 64 61 74 61 29 20 28 64 62 3a 63 6c 6f al data) (db:clo
e520: 73 65 2d 61 6c 6c 20 28 64 3a 61 6c 6c 64 61 74 se-all (d:alldat
e530: 2d 64 62 6c 6f 63 61 6c 20 64 61 74 61 29 29 29 -dblocal data)))
e540: 0a 09 09 09 09 09 09 20 20 20 28 65 78 69 74 29 ....... (exit)
e550: 29 29 0a 09 09 28 69 75 70 3a 62 75 74 74 6f 6e ))...(iup:button
e560: 20 22 52 65 66 72 65 73 68 22 20 20 20 23 3a 61 "Refresh" #:a
e570: 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f ction (lambda (o
e580: 62 6a 29 0a 09 09 09 09 09 09 20 20 20 28 6d 61 bj)....... (ma
e590: 72 6b 2d 66 6f 72 2d 75 70 64 61 74 65 29 29 29 rk-for-update)))
e5a0: 0a 09 09 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 ...(iup:button "
e5b0: 43 6f 6c 6c 61 70 73 65 22 20 20 23 3a 61 63 74 Collapse" #:act
e5c0: 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a ion (lambda (obj
e5d0: 29 0a 09 09 09 09 09 09 20 20 20 28 6c 65 74 20 )....... (let
e5e0: 28 28 6d 79 6e 61 6d 65 20 28 69 75 70 3a 61 74 ((myname (iup:at
e5f0: 74 72 69 62 75 74 65 20 6f 62 6a 20 22 54 49 54 tribute obj "TIT
e600: 4c 45 22 29 29 29 0a 09 09 09 09 09 09 20 20 20 LE"))).......
e610: 20 20 28 69 66 20 28 65 71 75 61 6c 3f 20 6d 79 (if (equal? my
e620: 6e 61 6d 65 20 22 43 6f 6c 6c 61 70 73 65 22 29 name "Collapse")
e630: 0a 09 09 09 09 09 09 09 20 28 62 65 67 69 6e 0a ........ (begin.
e640: 09 09 09 09 09 09 09 20 20 20 28 66 6f 72 2d 65 ....... (for-e
e650: 61 63 68 20 28 6c 61 6d 62 64 61 20 28 74 6e 61 ach (lambda (tna
e660: 6d 65 29 0a 09 09 09 09 09 09 09 09 20 20 20 20 me).........
e670: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 (hash-table-s
e680: 65 74 21 20 2a 63 6f 6c 6c 61 70 73 65 64 2a 20 et! *collapsed*
e690: 74 6e 61 6d 65 20 23 74 29 29 0a 09 09 09 09 09 tname #t))......
e6a0: 09 09 09 20 20 20 20 20 28 64 3a 61 6c 6c 64 61 ... (d:allda
e6b0: 74 2d 69 74 65 6d 2d 74 65 73 74 2d 6e 61 6d 65 t-item-test-name
e6c0: 73 20 64 61 74 61 29 29 0a 09 09 09 09 09 09 09 s data))........
e6d0: 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 (iup:attribut
e6e0: 65 2d 73 65 74 21 20 6f 62 6a 20 22 54 49 54 4c e-set! obj "TITL
e6f0: 45 22 20 22 45 78 70 61 6e 64 22 29 29 0a 09 09 E" "Expand"))...
e700: 09 09 09 09 09 20 28 62 65 67 69 6e 0a 09 09 09 ..... (begin....
e710: 09 09 09 09 20 20 20 28 66 6f 72 2d 65 61 63 68 .... (for-each
e720: 20 28 6c 61 6d 62 64 61 20 28 74 6e 61 6d 65 29 (lambda (tname)
e730: 0a 09 09 09 09 09 09 09 09 20 20 20 20 20 20 20 .........
e740: 28 68 61 73 68 2d 74 61 62 6c 65 2d 64 65 6c 65 (hash-table-dele
e750: 74 65 21 20 2a 63 6f 6c 6c 61 70 73 65 64 2a 20 te! *collapsed*
e760: 74 6e 61 6d 65 29 29 0a 09 09 09 09 09 09 09 09 tname)).........
e770: 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 (hash-table
e780: 2d 6b 65 79 73 20 2a 63 6f 6c 6c 61 70 73 65 64 -keys *collapsed
e790: 2a 29 29 0a 09 09 09 09 09 09 09 20 20 20 28 69 *))........ (i
e7a0: 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 up:attribute-set
e7b0: 21 20 6f 62 6a 20 22 54 49 54 4c 45 22 20 22 43 ! obj "TITLE" "C
e7c0: 6f 6c 6c 61 70 73 65 22 29 29 29 29 0a 09 09 09 ollapse"))))....
e7d0: 09 09 09 20 20 20 28 6d 61 72 6b 2d 66 6f 72 2d ... (mark-for-
e7e0: 75 70 64 61 74 65 29 29 29 29 0a 09 20 20 20 20 update))))..
e7f0: 20 20 20 29 0a 09 20 20 20 20 20 20 28 69 75 70 ).. (iup
e800: 3a 76 62 6f 78 0a 09 20 20 20 20 20 20 20 3b 3b :vbox.. ;;
e810: 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 53 6f (iup:button "So
e820: 72 74 20 2d 74 22 20 20 20 23 3a 61 63 74 69 6f rt -t" #:actio
e830: 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 29 0a n (lambda (obj).
e840: 09 20 20 20 20 20 20 20 3b 3b 20 20 20 09 09 09 . ;; ...
e850: 09 20 28 6e 65 78 74 2d 73 6f 72 74 2d 6f 70 74 . (next-sort-opt
e860: 69 6f 6e 29 0a 09 20 20 20 20 20 20 20 3b 3b 20 ion).. ;;
e870: 20 20 09 09 09 09 20 28 69 75 70 3a 61 74 74 72 .... (iup:attr
e880: 69 62 75 74 65 2d 73 65 74 21 20 6f 62 6a 20 22 ibute-set! obj "
e890: 54 49 54 4c 45 22 20 28 76 65 63 74 6f 72 2d 72 TITLE" (vector-r
e8a0: 65 66 20 28 76 65 63 74 6f 72 2d 72 65 66 20 2a ef (vector-ref *
e8b0: 74 65 73 74 73 2d 73 6f 72 74 2d 6f 70 74 69 6f tests-sort-optio
e8c0: 6e 73 2a 20 2a 74 65 73 74 73 2d 73 6f 72 74 2d ns* *tests-sort-
e8d0: 72 65 76 65 72 73 65 2a 29 20 30 29 29 0a 09 20 reverse*) 0))..
e8e0: 20 20 20 20 20 20 3b 3b 20 20 20 09 09 09 09 20 ;; ....
e8f0: 28 6d 61 72 6b 2d 66 6f 72 2d 75 70 64 61 74 65 (mark-for-update
e900: 29 29 29 0a 09 20 20 20 20 20 20 20 0a 09 20 20 ))).. ..
e910: 20 20 20 20 20 28 6c 65 74 2a 20 28 28 68 69 64 (let* ((hid
e920: 65 20 23 66 29 0a 09 09 20 20 20 20 20 20 28 73 e #f)... (s
e930: 68 6f 77 20 23 66 29 0a 09 09 20 20 20 20 20 20 how #f)...
e940: 28 68 69 64 65 2d 65 6d 70 74 79 20 23 66 29 0a (hide-empty #f).
e950: 09 09 20 20 20 20 20 20 28 73 65 6c 2d 63 6f 6c .. (sel-col
e960: 6f 72 20 20 20 20 22 31 38 30 20 31 30 30 20 31 or "180 100 1
e970: 30 30 22 29 0a 09 09 20 20 20 20 20 20 28 6e 6f 00")... (no
e980: 6e 73 65 6c 2d 63 6f 6c 6f 72 20 22 31 37 30 20 nsel-color "170
e990: 31 37 30 20 31 37 30 22 29 0a 09 09 20 20 20 20 170 170")...
e9a0: 20 20 28 63 6d 64 73 2d 6c 69 73 74 20 27 28 22 (cmds-list '("
e9b0: 2b 74 65 73 74 6e 61 6d 65 22 20 22 2d 74 65 73 +testname" "-tes
e9c0: 74 6e 61 6d 65 22 20 22 2b 65 76 65 6e 74 5f 74 tname" "+event_t
e9d0: 69 6d 65 22 20 22 2d 65 76 65 6e 74 5f 74 69 6d ime" "-event_tim
e9e0: 65 22 20 22 2b 73 74 61 74 65 73 74 61 74 75 73 e" "+statestatus
e9f0: 22 20 22 2d 73 74 61 74 65 73 74 61 74 75 73 22 " "-statestatus"
ea00: 29 29 0a 09 09 20 20 20 20 20 20 28 73 6f 72 74 ))... (sort
ea10: 2d 6c 62 20 20 20 20 28 69 75 70 3a 6c 69 73 74 -lb (iup:list
ea20: 62 6f 78 20 23 3a 65 78 70 61 6e 64 20 22 48 4f box #:expand "HO
ea30: 52 49 5a 4f 4e 54 41 4c 22 0a 09 09 09 09 09 20 RIZONTAL"......
ea40: 20 20 20 20 20 20 23 3a 64 72 6f 70 64 6f 77 6e #:dropdown
ea50: 20 22 59 45 53 22 0a 09 09 09 09 09 20 20 20 20 "YES"......
ea60: 20 20 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d #:action (lam
ea70: 62 64 61 20 28 6f 62 6a 20 76 61 6c 20 69 6e 64 bda (obj val ind
ea80: 65 78 20 6c 62 73 74 61 74 65 29 0a 09 09 09 09 ex lbstate).....
ea90: 09 09 09 20 20 28 73 65 74 21 20 2a 74 65 73 74 ... (set! *test
eaa0: 73 2d 73 6f 72 74 2d 72 65 76 65 72 73 65 2a 20 s-sort-reverse*
eab0: 69 6e 64 65 78 29 0a 09 09 09 09 09 09 09 20 20 index)........
eac0: 28 6d 61 72 6b 2d 66 6f 72 2d 75 70 64 61 74 65 (mark-for-update
ead0: 29 29 29 29 0a 09 09 20 20 20 20 20 20 28 64 65 ))))... (de
eae0: 66 61 75 6c 74 2d 63 6d 64 20 28 63 61 72 20 28 fault-cmd (car (
eaf0: 6c 69 73 74 2d 72 65 66 20 2a 74 65 73 74 73 2d list-ref *tests-
eb00: 73 6f 72 74 2d 74 79 70 65 2d 69 6e 64 65 78 2a sort-type-index*
eb10: 20 2a 74 65 73 74 73 2d 73 6f 72 74 2d 72 65 76 *tests-sort-rev
eb20: 65 72 73 65 2a 29 29 29 29 0a 09 09 20 28 69 75 erse*))))... (iu
eb30: 70 6c 69 73 74 62 6f 78 2d 66 69 6c 6c 2d 6c 69 plistbox-fill-li
eb40: 73 74 20 73 6f 72 74 2d 6c 62 20 63 6d 64 73 2d st sort-lb cmds-
eb50: 6c 69 73 74 20 73 65 6c 65 63 74 65 64 2d 69 74 list selected-it
eb60: 65 6d 3a 20 64 65 66 61 75 6c 74 2d 63 6d 64 29 em: default-cmd)
eb70: 0a 09 09 20 0a 09 09 20 28 73 65 74 21 20 68 69 ... ... (set! hi
eb80: 64 65 2d 65 6d 70 74 79 20 28 69 75 70 3a 62 75 de-empty (iup:bu
eb90: 74 74 6f 6e 20 22 48 69 64 65 45 6d 70 74 79 22 tton "HideEmpty"
eba0: 0a 09 09 09 09 09 20 20 20 20 20 20 23 3a 65 78 ...... #:ex
ebb0: 70 61 6e 64 20 22 59 45 53 22 0a 09 09 09 09 09 pand "YES"......
ebc0: 20 20 20 20 20 20 23 3a 61 63 74 69 6f 6e 20 28 #:action (
ebd0: 6c 61 6d 62 64 61 20 28 6f 62 6a 29 0a 09 09 09 lambda (obj)....
ebe0: 09 09 09 09 20 28 64 3a 61 6c 6c 64 61 74 2d 68 .... (d:alldat-h
ebf0: 69 64 65 2d 65 6d 70 74 79 2d 72 75 6e 73 2d 73 ide-empty-runs-s
ec00: 65 74 21 20 64 61 74 61 20 28 6e 6f 74 20 28 64 et! data (not (d
ec10: 3a 61 6c 6c 64 61 74 2d 68 69 64 65 2d 65 6d 70 :alldat-hide-emp
ec20: 74 79 2d 72 75 6e 73 20 64 61 74 61 29 29 29 0a ty-runs data))).
ec30: 09 09 09 09 09 09 09 20 28 69 75 70 3a 61 74 74 ....... (iup:att
ec40: 72 69 62 75 74 65 2d 73 65 74 21 20 6f 62 6a 20 ribute-set! obj
ec50: 22 54 49 54 4c 45 22 20 28 69 66 20 28 64 3a 61 "TITLE" (if (d:a
ec60: 6c 6c 64 61 74 2d 68 69 64 65 2d 65 6d 70 74 79 lldat-hide-empty
ec70: 2d 72 75 6e 73 20 64 61 74 61 29 20 22 2b 48 69 -runs data) "+Hi
ec80: 64 65 45 22 20 22 2d 48 69 64 65 45 22 29 29 0a deE" "-HideE")).
ec90: 09 09 09 09 09 09 09 20 28 6d 61 72 6b 2d 66 6f ....... (mark-fo
eca0: 72 2d 75 70 64 61 74 65 29 29 29 29 0a 09 09 20 r-update))))...
ecb0: 28 73 65 74 21 20 68 69 64 65 20 28 69 75 70 3a (set! hide (iup:
ecc0: 62 75 74 74 6f 6e 20 22 48 69 64 65 22 0a 09 09 button "Hide"...
ecd0: 09 09 09 23 3a 65 78 70 61 6e 64 20 22 59 45 53 ...#:expand "YES
ece0: 22 0a 09 09 09 09 09 23 3a 61 63 74 69 6f 6e 20 "......#:action
ecf0: 28 6c 61 6d 62 64 61 20 28 6f 62 6a 29 0a 09 09 (lambda (obj)...
ed00: 09 09 09 09 20 20 20 28 64 3a 61 6c 6c 64 61 74 .... (d:alldat
ed10: 2d 68 69 64 65 2d 6e 6f 74 2d 68 69 64 65 2d 73 -hide-not-hide-s
ed20: 65 74 21 20 64 61 74 61 20 23 74 29 20 3b 3b 20 et! data #t) ;;
ed30: 28 6e 6f 74 20 28 64 3a 61 6c 6c 64 61 74 2d 68 (not (d:alldat-h
ed40: 69 64 65 2d 6e 6f 74 2d 68 69 64 65 20 64 61 74 ide-not-hide dat
ed50: 61 29 29 29 0a 09 09 09 09 09 09 20 20 20 3b 3b a)))....... ;;
ed60: 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d (iup:attribute-
ed70: 73 65 74 21 20 6f 62 6a 20 22 54 49 54 4c 45 22 set! obj "TITLE"
ed80: 20 28 69 66 20 28 64 3a 61 6c 6c 64 61 74 2d 68 (if (d:alldat-h
ed90: 69 64 65 2d 6e 6f 74 2d 68 69 64 65 20 64 61 74 ide-not-hide dat
eda0: 61 29 20 22 48 69 64 65 54 65 73 74 73 22 20 22 a) "HideTests" "
edb0: 4e 6f 74 48 69 64 65 22 29 29 0a 09 09 09 09 09 NotHide"))......
edc0: 09 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 . (iup:attribu
edd0: 74 65 2d 73 65 74 21 20 68 69 64 65 20 22 42 47 te-set! hide "BG
ede0: 43 4f 4c 4f 52 22 20 73 65 6c 2d 63 6f 6c 6f 72 COLOR" sel-color
edf0: 29 0a 09 09 09 09 09 09 20 20 20 28 69 75 70 3a )....... (iup:
ee00: 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 73 attribute-set! s
ee10: 68 6f 77 20 22 42 47 43 4f 4c 4f 52 22 20 6e 6f how "BGCOLOR" no
ee20: 6e 73 65 6c 2d 63 6f 6c 6f 72 29 0a 09 09 09 09 nsel-color).....
ee30: 09 09 20 20 20 28 6d 61 72 6b 2d 66 6f 72 2d 75 .. (mark-for-u
ee40: 70 64 61 74 65 29 29 29 29 0a 09 09 20 28 73 65 pdate))))... (se
ee50: 74 21 20 73 68 6f 77 20 28 69 75 70 3a 62 75 74 t! show (iup:but
ee60: 74 6f 6e 20 22 53 68 6f 77 22 0a 09 09 09 09 09 ton "Show"......
ee70: 23 3a 65 78 70 61 6e 64 20 22 59 45 53 22 0a 09 #:expand "YES"..
ee80: 09 09 09 09 23 3a 61 63 74 69 6f 6e 20 28 6c 61 ....#:action (la
ee90: 6d 62 64 61 20 28 6f 62 6a 29 0a 09 09 09 09 09 mbda (obj)......
eea0: 09 20 20 20 28 64 3a 61 6c 6c 64 61 74 2d 68 69 . (d:alldat-hi
eeb0: 64 65 2d 6e 6f 74 2d 68 69 64 65 2d 73 65 74 21 de-not-hide-set!
eec0: 20 64 61 74 61 20 28 6e 6f 74 20 28 64 3a 61 6c data (not (d:al
eed0: 6c 64 61 74 2d 68 69 64 65 2d 6e 6f 74 2d 68 69 ldat-hide-not-hi
eee0: 64 65 20 64 61 74 61 29 29 29 0a 09 09 09 09 09 de data)))......
eef0: 09 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 . (iup:attribu
ef00: 74 65 2d 73 65 74 21 20 73 68 6f 77 20 22 42 47 te-set! show "BG
ef10: 43 4f 4c 4f 52 22 20 73 65 6c 2d 63 6f 6c 6f 72 COLOR" sel-color
ef20: 29 0a 09 09 09 09 09 09 20 20 20 28 69 75 70 3a )....... (iup:
ef30: 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 68 attribute-set! h
ef40: 69 64 65 20 22 42 47 43 4f 4c 4f 52 22 20 6e 6f ide "BGCOLOR" no
ef50: 6e 73 65 6c 2d 63 6f 6c 6f 72 29 0a 09 09 09 09 nsel-color).....
ef60: 09 09 20 20 20 28 6d 61 72 6b 2d 66 6f 72 2d 75 .. (mark-for-u
ef70: 70 64 61 74 65 29 29 29 29 0a 09 09 20 28 69 75 pdate))))... (iu
ef80: 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 p:attribute-set!
ef90: 20 68 69 64 65 20 22 42 47 43 4f 4c 4f 52 22 20 hide "BGCOLOR"
efa0: 73 65 6c 2d 63 6f 6c 6f 72 29 0a 09 09 20 28 69 sel-color)... (i
efb0: 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 up:attribute-set
efc0: 21 20 73 68 6f 77 20 22 42 47 43 4f 4c 4f 52 22 ! show "BGCOLOR"
efd0: 20 6e 6f 6e 73 65 6c 2d 63 6f 6c 6f 72 29 0a 09 nonsel-color)..
efe0: 09 20 3b 3b 20 28 64 3a 61 6c 6c 64 61 74 2d 68 . ;; (d:alldat-h
eff0: 69 64 65 2d 6e 6f 74 2d 68 69 64 65 2d 62 75 74 ide-not-hide-but
f000: 74 6f 6e 2d 73 65 74 21 20 64 61 74 61 20 68 69 ton-set! data hi
f010: 64 65 69 74 29 20 3b 3b 20 6e 65 76 65 72 20 75 deit) ;; never u
f020: 73 65 64 2c 20 63 61 6e 20 65 6c 69 6d 69 6e 61 sed, can elimina
f030: 74 65 20 2e 2e 2e 0a 09 09 20 28 69 75 70 3a 76 te ...... (iup:v
f040: 62 6f 78 0a 09 09 20 20 28 69 75 70 3a 68 62 6f box... (iup:hbo
f050: 78 20 68 69 64 65 20 73 68 6f 77 29 0a 09 09 20 x hide show)...
f060: 20 68 69 64 65 2d 65 6d 70 74 79 20 73 6f 72 74 hide-empty sort
f070: 2d 6c 62 29 29 29 0a 09 20 20 20 20 20 20 29 29 -lb))).. ))
f080: 29 0a 09 20 20 20 28 69 75 70 3a 66 72 61 6d 65 ).. (iup:frame
f090: 20 0a 09 20 20 20 20 23 3a 74 69 74 6c 65 20 22 .. #:title "
f0a0: 73 74 61 74 65 2f 73 74 61 74 75 73 20 66 69 6c state/status fil
f0b0: 74 65 72 22 0a 09 20 20 20 20 28 69 75 70 3a 76 ter".. (iup:v
f0c0: 62 6f 78 0a 09 20 20 20 20 20 28 61 70 70 6c 79 box.. (apply
f0d0: 20 0a 09 20 20 20 20 20 20 69 75 70 3a 68 62 6f .. iup:hbo
f0e0: 78 0a 09 20 20 20 20 20 20 28 6d 61 70 20 28 6c x.. (map (l
f0f0: 61 6d 62 64 61 20 28 73 74 61 74 75 73 29 0a 09 ambda (status)..
f100: 09 20 20 20 20 20 28 69 75 70 3a 74 6f 67 67 6c . (iup:toggl
f110: 65 20 28 63 6f 6e 63 20 73 74 61 74 75 73 20 22 e (conc status "
f120: 20 20 22 29 0a 09 09 09 09 20 23 3a 61 63 74 69 ")..... #:acti
f130: 6f 6e 20 20 20 28 6c 61 6d 62 64 61 20 28 6f 62 on (lambda (ob
f140: 6a 20 76 61 6c 29 0a 09 09 09 09 09 20 20 20 20 j val)......
f150: 20 20 28 6d 61 72 6b 2d 66 6f 72 2d 75 70 64 61 (mark-for-upda
f160: 74 65 29 0a 09 09 09 09 09 20 20 20 20 20 20 28 te)...... (
f170: 69 66 20 28 65 71 3f 20 76 61 6c 20 31 29 0a 09 if (eq? val 1)..
f180: 09 09 09 09 09 20 20 28 68 61 73 68 2d 74 61 62 ..... (hash-tab
f190: 6c 65 2d 73 65 74 21 20 28 64 3a 61 6c 6c 64 61 le-set! (d:allda
f1a0: 74 2d 73 74 61 74 75 73 2d 69 67 6e 6f 72 65 2d t-status-ignore-
f1b0: 68 61 73 68 20 64 61 74 61 29 20 73 74 61 74 75 hash data) statu
f1c0: 73 20 23 74 29 0a 09 09 09 09 09 09 20 20 28 68 s #t)....... (h
f1d0: 61 73 68 2d 74 61 62 6c 65 2d 64 65 6c 65 74 65 ash-table-delete
f1e0: 21 20 28 64 3a 61 6c 6c 64 61 74 2d 73 74 61 74 ! (d:alldat-stat
f1f0: 75 73 2d 69 67 6e 6f 72 65 2d 68 61 73 68 20 64 us-ignore-hash d
f200: 61 74 61 29 20 73 74 61 74 75 73 29 29 0a 09 09 ata) status))...
f210: 09 09 09 20 20 20 20 20 20 28 73 65 74 2d 62 67 ... (set-bg
f220: 2d 6f 6e 2d 66 69 6c 74 65 72 29 29 29 29 0a 09 -on-filter))))..
f230: 09 20 20 20 28 6d 61 70 20 63 61 64 72 20 2a 63 . (map cadr *c
f240: 6f 6d 6d 6f 6e 3a 73 74 64 2d 73 74 61 74 75 73 ommon:std-status
f250: 65 73 2a 29 29 29 20 3b 3b 20 27 28 22 50 41 53 es*))) ;; '("PAS
f260: 53 22 20 22 46 41 49 4c 22 20 22 57 41 52 4e 22 S" "FAIL" "WARN"
f270: 20 22 43 48 45 43 4b 22 20 22 57 41 49 56 45 44 "CHECK" "WAIVED
f280: 22 20 22 53 54 55 43 4b 2f 44 45 41 44 22 20 22 " "STUCK/DEAD" "
f290: 6e 2f 61 22 20 22 53 4b 49 50 22 29 29 29 0a 09 n/a" "SKIP")))..
f2a0: 20 20 20 20 20 28 61 70 70 6c 79 20 0a 09 20 20 (apply ..
f2b0: 20 20 20 20 69 75 70 3a 68 62 6f 78 0a 09 20 20 iup:hbox..
f2c0: 20 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 (map (lambda
f2d0: 20 28 73 74 61 74 65 29 0a 09 09 20 20 20 20 20 (state)...
f2e0: 28 69 75 70 3a 74 6f 67 67 6c 65 20 28 63 6f 6e (iup:toggle (con
f2f0: 63 20 73 74 61 74 65 20 22 20 20 22 29 0a 09 09 c state " ")...
f300: 09 09 20 23 3a 61 63 74 69 6f 6e 20 20 20 28 6c .. #:action (l
f310: 61 6d 62 64 61 20 28 6f 62 6a 20 76 61 6c 29 0a ambda (obj val).
f320: 09 09 09 09 09 20 20 20 20 20 20 28 6d 61 72 6b ..... (mark
f330: 2d 66 6f 72 2d 75 70 64 61 74 65 29 0a 09 09 09 -for-update)....
f340: 09 09 20 20 20 20 20 20 28 69 66 20 28 65 71 3f .. (if (eq?
f350: 20 76 61 6c 20 31 29 0a 09 09 09 09 09 09 20 20 val 1).......
f360: 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 (hash-table-set!
f370: 20 28 64 3a 61 6c 6c 64 61 74 2d 73 74 61 74 65 (d:alldat-state
f380: 2d 69 67 6e 6f 72 65 2d 68 61 73 68 20 64 61 74 -ignore-hash dat
f390: 61 29 20 73 74 61 74 65 20 23 74 29 0a 09 09 09 a) state #t)....
f3a0: 09 09 09 20 20 28 68 61 73 68 2d 74 61 62 6c 65 ... (hash-table
f3b0: 2d 64 65 6c 65 74 65 21 20 28 64 3a 61 6c 6c 64 -delete! (d:alld
f3c0: 61 74 2d 73 74 61 74 65 2d 69 67 6e 6f 72 65 2d at-state-ignore-
f3d0: 68 61 73 68 20 64 61 74 61 29 20 73 74 61 74 65 hash data) state
f3e0: 29 29 0a 09 09 09 09 09 20 20 20 20 20 20 28 73 ))...... (s
f3f0: 65 74 2d 62 67 2d 6f 6e 2d 66 69 6c 74 65 72 29 et-bg-on-filter)
f400: 29 29 29 0a 09 09 20 20 20 28 6d 61 70 20 63 61 )))... (map ca
f410: 64 72 20 2a 63 6f 6d 6d 6f 6e 3a 73 74 64 2d 73 dr *common:std-s
f420: 74 61 74 65 73 2a 29 29 29 20 3b 3b 20 27 28 22 tates*))) ;; '("
f430: 52 55 4e 4e 49 4e 47 22 20 22 43 4f 4d 50 4c 45 RUNNING" "COMPLE
f440: 54 45 44 22 20 22 49 4e 43 4f 4d 50 4c 45 54 45 TED" "INCOMPLETE
f450: 22 20 22 4c 41 55 4e 43 48 45 44 22 20 22 4e 4f " "LAUNCHED" "NO
f460: 54 5f 53 54 41 52 54 45 44 22 20 22 4b 49 4c 4c T_STARTED" "KILL
f470: 45 44 22 20 22 44 45 4c 45 54 45 44 22 29 29 29 ED" "DELETED")))
f480: 0a 09 20 20 20 20 20 28 69 75 70 3a 76 61 6c 75 .. (iup:valu
f490: 61 74 6f 72 20 23 3a 76 61 6c 75 65 63 68 61 6e ator #:valuechan
f4a0: 67 65 64 5f 63 62 20 28 6c 61 6d 62 64 61 20 28 ged_cb (lambda (
f4b0: 6f 62 6a 29 0a 09 09 09 09 09 20 20 20 20 20 20 obj)......
f4c0: 20 28 6c 65 74 20 28 28 76 61 6c 20 28 69 6e 65 (let ((val (ine
f4d0: 78 61 63 74 2d 3e 65 78 61 63 74 20 28 72 6f 75 xact->exact (rou
f4e0: 6e 64 20 28 2f 20 28 73 74 72 69 6e 67 2d 3e 6e nd (/ (string->n
f4f0: 75 6d 62 65 72 20 28 69 75 70 3a 61 74 74 72 69 umber (iup:attri
f500: 62 75 74 65 20 6f 62 6a 20 22 56 41 4c 55 45 22 bute obj "VALUE"
f510: 29 29 20 31 30 29 29 29 29 0a 09 09 09 09 09 09 )) 10)))).......
f520: 20 20 20 20 20 28 6f 6c 64 6d 61 78 20 20 20 28 (oldmax (
f530: 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 string->number (
f540: 69 75 70 3a 61 74 74 72 69 62 75 74 65 20 6f 62 iup:attribute ob
f550: 6a 20 22 4d 41 58 22 29 29 29 0a 09 09 09 09 09 j "MAX")))......
f560: 09 20 20 20 20 20 28 6d 61 78 72 75 6e 73 20 20 . (maxruns
f570: 28 64 3a 61 6c 6c 64 61 74 2d 74 6f 74 2d 72 75 (d:alldat-tot-ru
f580: 6e 73 20 64 61 74 61 29 29 29 0a 09 09 09 09 09 ns data)))......
f590: 09 20 28 64 3a 61 6c 6c 64 61 74 2d 73 74 61 72 . (d:alldat-star
f5a0: 74 2d 72 75 6e 2d 6f 66 66 73 65 74 2d 73 65 74 t-run-offset-set
f5b0: 21 20 64 61 74 61 20 76 61 6c 29 0a 09 09 09 09 ! data val).....
f5c0: 09 09 20 28 6d 61 72 6b 2d 66 6f 72 2d 75 70 64 .. (mark-for-upd
f5d0: 61 74 65 29 0a 09 09 09 09 09 09 20 28 64 65 62 ate)....... (deb
f5e0: 75 67 3a 70 72 69 6e 74 20 36 20 22 28 64 3a 61 ug:print 6 "(d:a
f5f0: 6c 6c 64 61 74 2d 73 74 61 72 74 2d 72 75 6e 2d lldat-start-run-
f600: 6f 66 66 73 65 74 20 64 61 74 61 29 20 22 20 28 offset data) " (
f610: 64 3a 61 6c 6c 64 61 74 2d 73 74 61 72 74 2d 72 d:alldat-start-r
f620: 75 6e 2d 6f 66 66 73 65 74 20 64 61 74 61 29 20 un-offset data)
f630: 22 20 6d 61 78 72 75 6e 73 3a 20 22 20 6d 61 78 " maxruns: " max
f640: 72 75 6e 73 20 22 2c 20 76 61 6c 3a 20 22 20 76 runs ", val: " v
f650: 61 6c 20 22 20 6f 6c 64 6d 61 78 3a 20 22 20 6f al " oldmax: " o
f660: 6c 64 6d 61 78 29 0a 09 09 09 09 09 09 20 28 69 ldmax)....... (i
f670: 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 up:attribute-set
f680: 21 20 6f 62 6a 20 22 4d 41 58 22 20 28 2a 20 6d ! obj "MAX" (* m
f690: 61 78 72 75 6e 73 20 31 30 29 29 29 29 0a 09 09 axruns 10))))...
f6a0: 09 20 20 20 23 3a 65 78 70 61 6e 64 20 22 48 4f . #:expand "HO
f6b0: 52 49 5a 4f 4e 54 41 4c 22 0a 09 09 09 20 20 20 RIZONTAL"....
f6c0: 23 3a 6d 61 78 20 28 2a 20 31 30 20 28 6c 65 6e #:max (* 10 (len
f6d0: 67 74 68 20 28 64 3a 61 6c 6c 64 61 74 2d 61 6c gth (d:alldat-al
f6e0: 6c 72 75 6e 73 20 64 61 74 61 29 29 29 0a 09 09 lruns data)))...
f6f0: 09 20 20 20 23 3a 6d 69 6e 20 30 0a 09 09 09 20 . #:min 0....
f700: 20 20 23 3a 73 74 65 70 20 30 2e 30 31 29 29 29 #:step 0.01)))
f710: 0a 09 09 09 09 09 3b 28 69 75 70 3a 62 75 74 74 ......;(iup:butt
f720: 6f 6e 20 22 69 6e 63 20 72 6f 77 73 22 20 23 3a on "inc rows" #:
f730: 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 action (lambda (
f740: 6f 62 6a 29 28 64 3a 61 6c 6c 64 61 74 2d 6e 75 obj)(d:alldat-nu
f750: 6d 2d 74 65 73 74 73 2d 73 65 74 21 20 64 61 74 m-tests-set! dat
f760: 61 20 28 2b 20 28 64 3a 61 6c 6c 64 61 74 2d 6e a (+ (d:alldat-n
f770: 75 6d 2d 74 65 73 74 73 20 64 61 74 61 29 20 31 um-tests data) 1
f780: 29 29 29 29 0a 09 09 09 09 09 3b 28 69 75 70 3a ))))......;(iup:
f790: 62 75 74 74 6f 6e 20 22 64 65 63 20 72 6f 77 73 button "dec rows
f7a0: 22 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 " #:action (lamb
f7b0: 64 61 20 28 6f 62 6a 29 28 64 3a 61 6c 6c 64 61 da (obj)(d:allda
f7c0: 74 2d 6e 75 6d 2d 74 65 73 74 73 2d 73 65 74 21 t-num-tests-set!
f7d0: 20 64 61 74 61 20 28 69 66 20 28 3e 20 28 64 3a data (if (> (d:
f7e0: 61 6c 6c 64 61 74 2d 6e 75 6d 2d 74 65 73 74 73 alldat-num-tests
f7f0: 20 64 61 74 61 29 20 30 29 28 2d 20 28 64 3a 61 data) 0)(- (d:a
f800: 6c 6c 64 61 74 2d 6e 75 6d 2d 74 65 73 74 73 20 lldat-num-tests
f810: 64 61 74 61 29 20 31 29 20 30 29 29 29 29 0a 09 data) 1) 0))))..
f820: 20 20 20 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 ))..(define (
f830: 6d 61 6b 65 2d 64 61 73 68 62 6f 61 72 64 2d 62 make-dashboard-b
f840: 75 74 74 6f 6e 73 20 64 61 74 61 20 6e 72 75 6e uttons data nrun
f850: 73 20 6e 74 65 73 74 73 20 6b 65 79 6e 61 6d 65 s ntests keyname
f860: 73 20 72 75 6e 73 2d 73 75 6d 2d 64 61 74 20 6e s runs-sum-dat n
f870: 65 77 2d 76 69 65 77 2d 64 61 74 29 0a 20 20 28 ew-view-dat). (
f880: 6c 65 74 2a 20 28 28 64 62 20 20 20 20 20 20 28 let* ((db (
f890: 64 3a 61 6c 6c 64 61 74 2d 64 62 6c 6f 63 61 6c d:alldat-dblocal
f8a0: 20 64 61 74 61 29 29 0a 09 20 28 6e 6b 65 79 73 data)).. (nkeys
f8b0: 20 20 20 28 6c 65 6e 67 74 68 20 6b 65 79 6e 61 (length keyna
f8c0: 6d 65 73 29 29 0a 09 20 28 72 75 6e 73 76 65 63 mes)).. (runsvec
f8d0: 20 28 6d 61 6b 65 2d 76 65 63 74 6f 72 20 6e 72 (make-vector nr
f8e0: 75 6e 73 29 29 0a 09 20 28 68 65 61 64 65 72 20 uns)).. (header
f8f0: 20 28 6d 61 6b 65 2d 76 65 63 74 6f 72 20 6e 72 (make-vector nr
f900: 75 6e 73 29 29 0a 09 20 28 6c 66 74 63 6f 6c 20 uns)).. (lftcol
f910: 20 28 6d 61 6b 65 2d 76 65 63 74 6f 72 20 6e 74 (make-vector nt
f920: 65 73 74 73 29 29 0a 09 20 28 6b 65 79 63 6f 6c ests)).. (keycol
f930: 20 20 28 6d 61 6b 65 2d 76 65 63 74 6f 72 20 6e (make-vector n
f940: 74 65 73 74 73 29 29 0a 09 20 28 63 6f 6e 74 72 tests)).. (contr
f950: 6f 6c 73 20 27 28 29 29 0a 09 20 28 6c 66 74 6c ols '()).. (lftl
f960: 73 74 20 20 27 28 29 29 0a 09 20 28 68 64 72 6c st '()).. (hdrl
f970: 73 74 20 20 27 28 29 29 0a 09 20 28 62 64 79 6c st '()).. (bdyl
f980: 73 74 20 20 27 28 29 29 0a 09 20 28 72 65 73 75 st '()).. (resu
f990: 6c 74 20 20 27 28 29 29 0a 09 20 28 69 20 20 20 lt '()).. (i
f9a0: 20 20 20 20 30 29 29 0a 20 20 20 20 3b 3b 20 63 0)). ;; c
f9b0: 6f 6e 74 72 6f 6c 73 20 28 61 6c 6f 6e 67 20 62 ontrols (along b
f9c0: 6f 74 74 6f 6d 29 0a 20 20 20 20 28 73 65 74 21 ottom). (set!
f9d0: 20 63 6f 6e 74 72 6f 6c 73 20 28 64 62 6f 61 72 controls (dboar
f9e0: 64 3a 6d 61 6b 65 2d 63 6f 6e 74 72 6f 6c 73 20 d:make-controls
f9f0: 64 61 74 61 29 29 0a 20 20 20 20 0a 20 20 20 20 data)). .
fa00: 3b 3b 20 63 72 65 61 74 65 20 74 68 65 20 6c 65 ;; create the le
fa10: 66 74 20 6d 6f 73 74 20 63 6f 6c 75 6d 6e 20 66 ft most column f
fa20: 6f 72 20 74 68 65 20 72 75 6e 20 6b 65 79 20 6e or the run key n
fa30: 61 6d 65 73 20 61 6e 64 20 74 68 65 20 74 65 73 ames and the tes
fa40: 74 20 6e 61 6d 65 73 20 0a 20 20 20 20 28 73 65 t names . (se
fa50: 74 21 20 6c 66 74 6c 73 74 20 28 6c 69 73 74 20 t! lftlst (list
fa60: 28 69 75 70 3a 68 62 6f 78 0a 09 09 09 28 69 75 (iup:hbox....(iu
fa70: 70 3a 6c 61 62 65 6c 29 20 3b 3b 20 28 69 75 70 p:label) ;; (iup
fa80: 3a 76 61 6c 75 61 74 6f 72 29 0a 09 09 09 28 61 :valuator)....(a
fa90: 70 70 6c 79 20 69 75 70 3a 76 62 6f 78 20 0a 09 pply iup:vbox ..
faa0: 09 09 20 20 20 20 20 20 20 28 6d 61 70 20 28 6c .. (map (l
fab0: 61 6d 62 64 61 20 28 78 29 09 09 0a 09 09 09 09 ambda (x).......
fac0: 20 20 20 20 20 20 28 6c 65 74 20 28 28 72 65 73 (let ((res
fad0: 20 28 69 75 70 3a 68 62 6f 78 20 23 3a 65 78 70 (iup:hbox #:exp
fae0: 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 and "HORIZONTAL"
faf0: 0a 09 09 09 09 09 09 09 20 20 20 28 69 75 70 3a ........ (iup:
fb00: 6c 61 62 65 6c 20 78 20 23 3a 73 69 7a 65 20 22 label x #:size "
fb10: 78 31 35 22 20 23 3a 66 6f 6e 74 73 69 7a 65 20 x15" #:fontsize
fb20: 22 31 30 22 20 23 3a 65 78 70 61 6e 64 20 22 48 "10" #:expand "H
fb30: 4f 52 49 5a 4f 4e 54 41 4c 22 29 0a 09 09 09 09 ORIZONTAL").....
fb40: 09 09 09 20 20 20 28 69 75 70 3a 74 65 78 74 62 ... (iup:textb
fb50: 6f 78 20 23 3a 73 69 7a 65 20 22 78 31 35 22 20 ox #:size "x15"
fb60: 23 3a 66 6f 6e 74 73 69 7a 65 20 22 31 30 22 20 #:fontsize "10"
fb70: 23 3a 76 61 6c 75 65 20 22 25 22 20 23 3a 65 78 #:value "%" #:ex
fb80: 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c pand "HORIZONTAL
fb90: 22 0a 09 09 09 09 09 09 09 09 09 23 3a 61 63 74 "..........#:act
fba0: 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a ion (lambda (obj
fbb0: 20 75 6e 6b 20 76 61 6c 29 0a 09 09 09 09 09 09 unk val).......
fbc0: 09 09 09 09 20 20 20 28 6d 61 72 6b 2d 66 6f 72 .... (mark-for
fbd0: 2d 75 70 64 61 74 65 29 0a 09 09 09 09 09 09 09 -update)........
fbe0: 09 09 09 20 20 20 28 75 70 64 61 74 65 2d 73 65 ... (update-se
fbf0: 61 72 63 68 20 78 20 76 61 6c 29 29 29 29 29 29 arch x val))))))
fc00: 0a 09 09 09 09 09 28 73 65 74 21 20 69 20 28 2b ......(set! i (+
fc10: 20 69 20 31 29 29 0a 09 09 09 09 09 72 65 73 29 i 1))......res)
fc20: 29 0a 09 09 09 09 20 20 20 20 6b 65 79 6e 61 6d )..... keynam
fc30: 65 73 29 29 29 29 29 0a 20 20 20 20 28 6c 65 74 es))))). (let
fc40: 20 6c 6f 6f 70 20 28 28 74 65 73 74 6e 75 6d 20 loop ((testnum
fc50: 20 30 29 0a 09 20 20 20 20 20 20 20 28 72 65 73 0).. (res
fc60: 20 20 20 20 20 20 27 28 29 29 29 0a 20 20 20 20 '())).
fc70: 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 28 (cond. (
fc80: 28 3e 3d 20 74 65 73 74 6e 75 6d 20 6e 74 65 73 (>= testnum ntes
fc90: 74 73 29 0a 09 3b 3b 20 6e 6f 77 20 6c 66 74 6c ts)..;; now lftl
fca0: 73 74 20 77 69 6c 6c 20 62 65 20 61 6e 20 68 62 st will be an hb
fcb0: 6f 78 20 77 69 74 68 20 74 68 65 20 74 65 73 74 ox with the test
fcc0: 20 6b 65 79 73 20 61 6e 64 20 74 68 65 20 74 65 keys and the te
fcd0: 73 74 20 6e 61 6d 65 20 6c 61 62 65 6c 73 0a 09 st name labels..
fce0: 28 73 65 74 21 20 6c 66 74 6c 73 74 20 28 61 70 (set! lftlst (ap
fcf0: 70 65 6e 64 20 6c 66 74 6c 73 74 20 28 6c 69 73 pend lftlst (lis
fd00: 74 20 28 69 75 70 3a 68 62 6f 78 20 20 23 3a 65 t (iup:hbox #:e
fd10: 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 xpand "HORIZONTA
fd20: 4c 22 0a 09 09 09 09 09 09 20 20 20 20 20 28 69 L"....... (i
fd30: 75 70 3a 76 61 6c 75 61 74 6f 72 20 23 3a 76 61 up:valuator #:va
fd40: 6c 75 65 63 68 61 6e 67 65 64 5f 63 62 20 28 6c luechanged_cb (l
fd50: 61 6d 62 64 61 20 28 6f 62 6a 29 0a 09 09 09 09 ambda (obj).....
fd60: 09 09 09 09 09 09 20 20 20 20 20 20 20 28 6c 65 ...... (le
fd70: 74 20 28 28 76 61 6c 20 28 73 74 72 69 6e 67 2d t ((val (string-
fd80: 3e 6e 75 6d 62 65 72 20 28 69 75 70 3a 61 74 74 >number (iup:att
fd90: 72 69 62 75 74 65 20 6f 62 6a 20 22 56 41 4c 55 ribute obj "VALU
fda0: 45 22 29 29 29 0a 09 09 09 09 09 09 09 09 09 09 E")))...........
fdb0: 09 20 20 20 20 20 28 6f 6c 64 6d 61 78 20 20 28 . (oldmax (
fdc0: 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 string->number (
fdd0: 69 75 70 3a 61 74 74 72 69 62 75 74 65 20 6f 62 iup:attribute ob
fde0: 6a 20 22 4d 41 58 22 29 29 29 0a 09 09 09 09 09 j "MAX")))......
fdf0: 09 09 09 09 09 09 20 20 20 20 20 28 6e 65 77 6d ...... (newm
fe00: 61 78 20 20 28 2a 20 31 30 20 28 6c 65 6e 67 74 ax (* 10 (lengt
fe10: 68 20 2a 61 6c 6c 74 65 73 74 6e 61 6d 65 6c 73 h *alltestnamels
fe20: 74 2a 29 29 29 29 0a 09 09 09 09 09 09 09 09 09 t*))))..........
fe30: 09 09 20 28 64 3a 61 6c 6c 64 61 74 2d 70 6c 65 .. (d:alldat-ple
fe40: 61 73 65 2d 75 70 64 61 74 65 2d 73 65 74 21 20 ase-update-set!
fe50: 64 61 74 61 20 23 74 29 0a 09 09 09 09 09 09 09 data #t)........
fe60: 09 09 09 09 20 28 64 3a 61 6c 6c 64 61 74 2d 73 .... (d:alldat-s
fe70: 74 61 72 74 2d 74 65 73 74 2d 6f 66 66 73 65 74 tart-test-offset
fe80: 2d 73 65 74 21 20 2a 61 6c 6c 64 61 74 2a 20 28 -set! *alldat* (
fe90: 69 6e 65 78 61 63 74 2d 3e 65 78 61 63 74 20 28 inexact->exact (
fea0: 72 6f 75 6e 64 20 28 2f 20 76 61 6c 20 31 30 29 round (/ val 10)
feb0: 29 29 29 0a 09 09 09 09 09 09 09 09 09 09 09 20 )))............
fec0: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 36 20 22 (debug:print 6 "
fed0: 28 64 3a 61 6c 6c 64 61 74 2d 73 74 61 72 74 2d (d:alldat-start-
fee0: 74 65 73 74 2d 6f 66 66 73 65 74 20 2a 61 6c 6c test-offset *all
fef0: 64 61 74 2a 29 20 22 20 28 64 3a 61 6c 6c 64 61 dat*) " (d:allda
ff00: 74 2d 73 74 61 72 74 2d 74 65 73 74 2d 6f 66 66 t-start-test-off
ff10: 73 65 74 20 2a 61 6c 6c 64 61 74 2a 29 20 22 20 set *alldat*) "
ff20: 76 61 6c 3a 20 22 20 76 61 6c 20 22 20 6e 65 77 val: " val " new
ff30: 6d 61 78 3a 20 22 20 6e 65 77 6d 61 78 20 22 20 max: " newmax "
ff40: 6f 6c 64 6d 61 78 3a 20 22 20 6f 6c 64 6d 61 78 oldmax: " oldmax
ff50: 29 0a 09 09 09 09 09 09 09 09 09 09 09 20 28 69 )............ (i
ff60: 66 20 28 3c 20 76 61 6c 20 31 30 29 0a 09 09 09 f (< val 10)....
ff70: 09 09 09 09 09 09 09 09 20 20 20 20 20 28 69 75 ........ (iu
ff80: 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 p:attribute-set!
ff90: 20 6f 62 6a 20 22 4d 41 58 22 20 6e 65 77 6d 61 obj "MAX" newma
ffa0: 78 29 29 0a 09 09 09 09 09 09 09 09 09 09 09 20 x))............
ffb0: 29 29 0a 09 09 09 09 09 09 09 09 20 20 20 23 3a ))......... #:
ffc0: 65 78 70 61 6e 64 20 22 56 45 52 54 49 43 41 4c expand "VERTICAL
ffd0: 22 20 0a 09 09 09 09 09 09 09 09 20 20 20 23 3a " ......... #:
ffe0: 6f 72 69 65 6e 74 61 74 69 6f 6e 20 22 56 45 52 orientation "VER
fff0: 54 49 43 41 4c 22 0a 09 09 09 09 09 09 09 09 20 TICAL".........
10000 20 20 23 3a 6d 69 6e 20 30 0a 09 09 09 09 09 09 #:min 0.......
10010 09 09 20 20 20 23 3a 73 74 65 70 20 30 2e 30 31 .. #:step 0.01
10020 29 0a 09 09 09 09 09 09 20 20 20 20 20 28 61 70 )....... (ap
10030 70 6c 79 20 69 75 70 3a 76 62 6f 78 20 28 72 65 ply iup:vbox (re
10040 76 65 72 73 65 20 72 65 73 29 29 29 29 29 29 29 verse res)))))))
10050 0a 20 20 20 20 20 20 20 28 65 6c 73 65 0a 09 28 . (else..(
10060 6c 65 74 20 28 28 6c 61 62 6c 20 20 28 69 75 70 let ((labl (iup
10070 3a 62 75 74 74 6f 6e 20 22 22 20 0a 09 09 09 09 :button "" .....
10080 20 23 3a 66 6c 61 74 20 22 59 45 53 22 20 0a 09 #:flat "YES" ..
10090 09 09 09 20 23 3a 61 6c 69 67 6e 6d 65 6e 74 20 ... #:alignment
100a0 22 41 4c 45 46 54 22 0a 09 09 09 09 09 3b 20 23 "ALEFT"......; #
100b0 3a 69 6d 61 67 65 20 69 6d 67 31 0a 09 09 09 09 :image img1.....
100c0 09 3b 20 23 3a 69 6d 70 72 65 73 73 20 69 6d 67 .; #:impress img
100d0 32 0a 09 09 09 09 20 23 3a 73 69 7a 65 20 22 78 2..... #:size "x
100e0 31 35 22 0a 09 09 09 09 20 23 3a 65 78 70 61 6e 15"..... #:expan
100f0 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 0a 09 d "HORIZONTAL"..
10100 09 09 09 20 23 3a 66 6f 6e 74 73 69 7a 65 20 22 ... #:fontsize "
10110 31 30 22 0a 09 09 09 09 20 23 3a 61 63 74 69 6f 10"..... #:actio
10120 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 29 0a n (lambda (obj).
10130 09 09 09 09 09 20 20 20 20 28 6d 61 72 6b 2d 66 ..... (mark-f
10140 6f 72 2d 75 70 64 61 74 65 29 0a 09 09 09 09 09 or-update)......
10150 20 20 20 20 28 74 6f 67 67 6c 65 2d 68 69 64 65 (toggle-hide
10160 20 74 65 73 74 6e 75 6d 29 29 29 29 29 20 3b 3b testnum))))) ;;
10170 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 20 (iup:attribute
10180 6f 62 6a 20 22 54 49 54 4c 45 22 29 29 29 29 0a obj "TITLE")))).
10190 09 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 . (vector-set!
101a0 6c 66 74 63 6f 6c 20 74 65 73 74 6e 75 6d 20 6c lftcol testnum l
101b0 61 62 6c 29 0a 09 20 20 28 6c 6f 6f 70 20 28 2b abl).. (loop (+
101c0 20 74 65 73 74 6e 75 6d 20 31 29 28 63 6f 6e 73 testnum 1)(cons
101d0 20 6c 61 62 6c 20 72 65 73 29 29 29 29 29 29 0a labl res)))))).
101e0 20 20 20 20 3b 3b 20 0a 20 20 20 20 28 6c 65 74 ;; . (let
101f0 20 6c 6f 6f 70 20 28 28 72 75 6e 6e 75 6d 20 20 loop ((runnum
10200 30 29 0a 09 20 20 20 20 20 20 20 28 6b 65 79 6e 0).. (keyn
10210 75 6d 20 20 30 29 0a 09 20 20 20 20 20 20 20 28 um 0).. (
10220 6b 65 79 76 65 63 20 20 28 6d 61 6b 65 2d 76 65 keyvec (make-ve
10230 63 74 6f 72 20 6e 6b 65 79 73 29 29 0a 09 20 20 ctor nkeys))..
10240 20 20 20 20 20 28 72 65 73 20 20 20 20 27 28 29 (res '()
10250 29 29 0a 20 20 20 20 20 20 28 63 6f 6e 64 20 3b )). (cond ;
10260 3b 20 6e 62 2f 2f 20 6e 6f 20 65 6c 73 65 20 66 ; nb// no else f
10270 6f 72 20 74 68 69 73 20 61 70 70 72 6f 61 63 68 or this approach
10280 2e 0a 20 20 20 20 20 20 20 28 28 3e 3d 20 72 75 .. ((>= ru
10290 6e 6e 75 6d 20 6e 72 75 6e 73 29 20 23 66 29 0a nnum nruns) #f).
102a0 20 20 20 20 20 20 20 28 28 3e 3d 20 6b 65 79 6e ((>= keyn
102b0 75 6d 20 6e 6b 65 79 73 29 20 0a 09 28 76 65 63 um nkeys) ..(vec
102c0 74 6f 72 2d 73 65 74 21 20 68 65 61 64 65 72 20 tor-set! header
102d0 72 75 6e 6e 75 6d 20 6b 65 79 76 65 63 29 0a 09 runnum keyvec)..
102e0 28 73 65 74 21 20 68 64 72 6c 73 74 20 28 63 6f (set! hdrlst (co
102f0 6e 73 20 28 61 70 70 6c 79 20 69 75 70 3a 76 62 ns (apply iup:vb
10300 6f 78 20 28 72 65 76 65 72 73 65 20 72 65 73 29 ox (reverse res)
10310 29 20 68 64 72 6c 73 74 29 29 0a 09 28 6c 6f 6f ) hdrlst))..(loo
10320 70 20 28 2b 20 72 75 6e 6e 75 6d 20 31 29 20 30 p (+ runnum 1) 0
10330 20 28 6d 61 6b 65 2d 76 65 63 74 6f 72 20 6e 6b (make-vector nk
10340 65 79 73 29 20 27 28 29 29 29 0a 20 20 20 20 20 eys) '())).
10350 20 20 28 65 6c 73 65 0a 09 28 6c 65 74 20 28 28 (else..(let ((
10360 6c 61 62 6c 20 20 28 69 75 70 3a 6c 61 62 65 6c labl (iup:label
10370 20 22 22 20 23 3a 73 69 7a 65 20 22 36 30 78 31 "" #:size "60x1
10380 35 22 20 23 3a 66 6f 6e 74 73 69 7a 65 20 22 31 5" #:fontsize "1
10390 30 22 20 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 0" #:expand "HOR
103a0 49 5a 4f 4e 54 41 4c 22 29 29 29 20 3b 3b 20 23 IZONTAL"))) ;; #
103b0 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e :expand "HORIZON
103c0 54 41 4c 22 0a 09 20 20 28 76 65 63 74 6f 72 2d TAL".. (vector-
103d0 73 65 74 21 20 6b 65 79 76 65 63 20 6b 65 79 6e set! keyvec keyn
103e0 75 6d 20 6c 61 62 6c 29 0a 09 20 20 28 6c 6f 6f um labl).. (loo
103f0 70 20 72 75 6e 6e 75 6d 20 28 2b 20 6b 65 79 6e p runnum (+ keyn
10400 75 6d 20 31 29 20 6b 65 79 76 65 63 20 28 63 6f um 1) keyvec (co
10410 6e 73 20 6c 61 62 6c 20 72 65 73 29 29 29 29 29 ns labl res)))))
10420 29 0a 20 20 20 20 3b 3b 20 42 79 20 68 65 72 65 ). ;; By here
10430 20 74 68 65 20 68 64 72 6c 73 74 20 63 6f 6e 74 the hdrlst cont
10440 61 69 6e 73 20 61 20 6c 69 73 74 20 6f 66 20 76 ains a list of v
10450 62 6f 78 65 73 20 63 6f 6e 74 61 69 6e 69 6e 67 boxes containing
10460 20 6e 6b 65 79 73 20 6c 61 62 65 6c 73 0a 20 20 nkeys labels.
10470 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 72 75 (let loop ((ru
10480 6e 6e 75 6d 20 20 30 29 0a 09 20 20 20 20 20 20 nnum 0)..
10490 20 28 74 65 73 74 6e 75 6d 20 30 29 0a 09 20 20 (testnum 0)..
104a0 20 20 20 20 20 28 74 65 73 74 76 65 63 20 20 28 (testvec (
104b0 6d 61 6b 65 2d 76 65 63 74 6f 72 20 6e 74 65 73 make-vector ntes
104c0 74 73 29 29 0a 09 20 20 20 20 20 20 20 28 72 65 ts)).. (re
104d0 73 20 20 20 20 27 28 29 29 29 0a 20 20 20 20 20 s '())).
104e0 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 28 28 (cond. ((
104f0 3e 3d 20 72 75 6e 6e 75 6d 20 6e 72 75 6e 73 29 >= runnum nruns)
10500 20 23 66 29 20 3b 3b 20 20 28 76 65 63 74 6f 72 #f) ;; (vector
10510 20 74 61 62 6c 65 68 65 61 64 65 72 20 72 75 6e tableheader run
10520 73 76 65 63 29 29 0a 20 20 20 20 20 20 20 28 28 svec)). ((
10530 3e 3d 20 74 65 73 74 6e 75 6d 20 6e 74 65 73 74 >= testnum ntest
10540 73 29 20 0a 09 28 76 65 63 74 6f 72 2d 73 65 74 s) ..(vector-set
10550 21 20 72 75 6e 73 76 65 63 20 72 75 6e 6e 75 6d ! runsvec runnum
10560 20 74 65 73 74 76 65 63 29 0a 09 28 73 65 74 21 testvec)..(set!
10570 20 62 64 79 6c 73 74 20 28 63 6f 6e 73 20 28 61 bdylst (cons (a
10580 70 70 6c 79 20 69 75 70 3a 76 62 6f 78 20 28 72 pply iup:vbox (r
10590 65 76 65 72 73 65 20 72 65 73 29 29 20 62 64 79 everse res)) bdy
105a0 6c 73 74 29 29 0a 09 28 6c 6f 6f 70 20 28 2b 20 lst))..(loop (+
105b0 72 75 6e 6e 75 6d 20 31 29 20 30 20 28 6d 61 6b runnum 1) 0 (mak
105c0 65 2d 76 65 63 74 6f 72 20 6e 74 65 73 74 73 29 e-vector ntests)
105d0 20 27 28 29 29 29 0a 20 20 20 20 20 20 20 28 65 '())). (e
105e0 6c 73 65 0a 09 28 6c 65 74 2a 20 28 28 62 75 74 lse..(let* ((but
105f0 74 6f 6e 2d 6b 65 79 20 28 6d 6b 73 74 72 20 72 ton-key (mkstr r
10600 75 6e 6e 75 6d 20 74 65 73 74 6e 75 6d 29 29 0a unnum testnum)).
10610 09 20 20 20 20 20 20 20 28 62 75 74 6e 20 20 20 . (butn
10620 20 20 20 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 (iup:button
10630 22 22 20 3b 3b 20 62 75 74 74 6f 6e 2d 6b 65 79 "" ;; button-key
10640 20 0a 09 09 09 09 20 20 20 20 20 20 20 23 3a 73 ..... #:s
10650 69 7a 65 20 22 36 30 78 31 35 22 20 0a 09 09 09 ize "60x15" ....
10660 09 20 20 20 20 20 20 20 23 3a 65 78 70 61 6e 64 . #:expand
10670 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 0a 09 09 "HORIZONTAL"...
10680 09 09 20 20 20 20 20 20 20 23 3a 66 6f 6e 74 73 .. #:fonts
10690 69 7a 65 20 22 31 30 22 20 0a 09 09 09 09 20 20 ize "10" .....
106a0 20 20 20 20 20 23 3a 61 63 74 69 6f 6e 20 28 6c #:action (l
106b0 61 6d 62 64 61 20 28 78 29 0a 09 09 09 09 09 09 ambda (x).......
106c0 20 20 28 6c 65 74 2a 20 28 28 74 6f 6f 6c 70 61 (let* ((toolpa
106d0 74 68 20 28 63 61 72 20 28 61 72 67 76 29 29 29 th (car (argv)))
106e0 0a 09 09 09 09 09 09 09 20 28 62 75 74 74 6e 64 ........ (buttnd
106f0 61 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 at (hash-table-r
10700 65 66 20 28 64 3a 61 6c 6c 64 61 74 2d 62 75 74 ef (d:alldat-but
10710 74 6f 6e 64 61 74 20 2a 61 6c 6c 64 61 74 2a 29 tondat *alldat*)
10720 20 62 75 74 74 6f 6e 2d 6b 65 79 29 29 0a 09 09 button-key))...
10730 09 09 09 09 09 20 28 74 65 73 74 2d 69 64 20 20 ..... (test-id
10740 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 64 20 (db:test-get-id
10750 28 76 65 63 74 6f 72 2d 72 65 66 20 62 75 74 74 (vector-ref butt
10760 6e 64 61 74 20 33 29 29 29 0a 09 09 09 09 09 09 ndat 3))).......
10770 09 20 28 72 75 6e 2d 69 64 20 20 20 28 64 62 3a . (run-id (db:
10780 74 65 73 74 2d 67 65 74 2d 72 75 6e 5f 69 64 20 test-get-run_id
10790 28 76 65 63 74 6f 72 2d 72 65 66 20 62 75 74 74 (vector-ref butt
107a0 6e 64 61 74 20 33 29 29 29 0a 09 09 09 09 09 09 ndat 3))).......
107b0 09 20 28 63 6d 64 20 20 28 63 6f 6e 63 20 74 6f . (cmd (conc to
107c0 6f 6c 70 61 74 68 20 22 20 2d 74 65 73 74 20 22 olpath " -test "
107d0 20 72 75 6e 2d 69 64 20 22 2c 22 20 74 65 73 74 run-id "," test
107e0 2d 69 64 20 22 26 22 29 29 29 0a 09 09 09 09 09 -id "&")))......
107f0 3b 28 70 72 69 6e 74 20 22 4c 61 75 6e 63 68 69 ;(print "Launchi
10800 6e 67 20 22 20 63 6d 64 29 0a 09 09 09 09 09 09 ng " cmd).......
10810 20 20 20 20 28 73 79 73 74 65 6d 20 63 6d 64 29 (system cmd)
10820 29 29 29 29 29 0a 09 20 20 28 68 61 73 68 2d 74 ))))).. (hash-t
10830 61 62 6c 65 2d 73 65 74 21 20 28 64 3a 61 6c 6c able-set! (d:all
10840 64 61 74 2d 62 75 74 74 6f 6e 64 61 74 20 2a 61 dat-buttondat *a
10850 6c 6c 64 61 74 2a 29 20 62 75 74 74 6f 6e 2d 6b lldat*) button-k
10860 65 79 20 28 76 65 63 74 6f 72 20 30 20 22 31 30 ey (vector 0 "10
10870 30 20 31 30 30 20 31 30 30 22 20 62 75 74 74 6f 0 100 100" butto
10880 6e 2d 6b 65 79 20 23 66 20 23 66 29 29 20 0a 09 n-key #f #f)) ..
10890 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 74 (vector-set! t
108a0 65 73 74 76 65 63 20 74 65 73 74 6e 75 6d 20 62 estvec testnum b
108b0 75 74 6e 29 0a 09 20 20 28 6c 6f 6f 70 20 72 75 utn).. (loop ru
108c0 6e 6e 75 6d 20 28 2b 20 74 65 73 74 6e 75 6d 20 nnum (+ testnum
108d0 31 29 20 74 65 73 74 76 65 63 20 28 63 6f 6e 73 1) testvec (cons
108e0 20 62 75 74 6e 20 72 65 73 29 29 29 29 29 29 0a butn res)))))).
108f0 20 20 20 20 3b 3b 20 6e 6f 77 20 61 73 73 65 6d ;; now assem
10900 62 6c 65 20 74 68 65 20 68 64 72 6c 73 74 20 61 ble the hdrlst a
10910 6e 64 20 62 64 79 6c 73 74 20 61 6e 64 20 6b 69 nd bdylst and ki
10920 63 6b 20 6f 66 66 20 74 68 65 20 64 69 61 6c 6f ck off the dialo
10930 67 0a 20 20 20 20 28 69 75 70 3a 73 68 6f 77 0a g. (iup:show.
10940 20 20 20 20 20 28 69 75 70 3a 64 69 61 6c 6f 67 (iup:dialog
10950 20 0a 20 20 20 20 20 20 23 3a 74 69 74 6c 65 20 . #:title
10960 28 63 6f 6e 63 20 22 4d 65 67 61 74 65 73 74 20 (conc "Megatest
10970 64 61 73 68 62 6f 61 72 64 20 22 20 28 63 75 72 dashboard " (cur
10980 72 65 6e 74 2d 75 73 65 72 2d 6e 61 6d 65 29 20 rent-user-name)
10990 22 3a 22 20 2a 74 6f 70 70 61 74 68 2a 29 0a 20 ":" *toppath*).
109a0 20 20 20 20 20 23 3a 6d 65 6e 75 20 28 64 63 6f #:menu (dco
109b0 6d 6d 6f 6e 3a 6d 61 69 6e 2d 6d 65 6e 75 29 0a mmon:main-menu).
109c0 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 72 75 (let* ((ru
109d0 6e 73 2d 76 69 65 77 20 28 69 75 70 3a 76 62 6f ns-view (iup:vbo
109e0 78 0a 09 09 09 20 28 61 70 70 6c 79 20 69 75 70 x.... (apply iup
109f0 3a 68 62 6f 78 20 0a 09 09 09 09 28 63 6f 6e 73 :hbox .....(cons
10a00 20 28 61 70 70 6c 79 20 69 75 70 3a 76 62 6f 78 (apply iup:vbox
10a10 20 6c 66 74 6c 73 74 29 0a 09 09 09 09 20 20 20 lftlst).....
10a20 20 20 20 28 6c 69 73 74 20 0a 09 09 09 09 20 20 (list .....
10a30 20 20 20 20 20 28 69 75 70 3a 76 62 6f 78 0a 09 (iup:vbox..
10a40 09 09 09 09 3b 3b 20 74 68 65 20 68 65 61 64 65 ....;; the heade
10a50 72 0a 09 09 09 09 09 28 61 70 70 6c 79 20 69 75 r......(apply iu
10a60 70 3a 68 62 6f 78 20 28 72 65 76 65 72 73 65 20 p:hbox (reverse
10a70 68 64 72 6c 73 74 29 29 0a 09 09 09 09 09 28 61 hdrlst))......(a
10a80 70 70 6c 79 20 69 75 70 3a 68 62 6f 78 20 28 72 pply iup:hbox (r
10a90 65 76 65 72 73 65 20 62 64 79 6c 73 74 29 29 29 everse bdylst)))
10aa0 29 29 29 0a 09 09 09 20 3b 3b 20 63 6f 6e 74 72 ))).... ;; contr
10ab0 6f 6c 73 0a 09 09 09 20 29 29 0a 09 20 20 20 20 ols.... ))..
10ac0 20 3b 3b 20 28 64 61 74 61 20 28 64 3a 64 61 74 ;; (data (d:dat
10ad0 61 2d 69 6e 69 74 20 28 6d 61 6b 65 2d 64 3a 64 a-init (make-d:d
10ae0 61 74 61 29 29 29 0a 09 20 20 20 20 20 28 74 61 ata))).. (ta
10af0 62 73 20 28 69 75 70 3a 74 61 62 73 0a 09 09 20 bs (iup:tabs...
10b00 20 20 20 23 3a 74 61 62 63 68 61 6e 67 65 70 6f #:tabchangepo
10b10 73 2d 63 62 20 28 6c 61 6d 62 64 61 20 28 6f 62 s-cb (lambda (ob
10b20 6a 20 63 75 72 72 20 70 72 65 76 29 0a 09 09 09 j curr prev)....
10b30 09 09 28 64 3a 61 6c 6c 64 61 74 2d 70 6c 65 61 ..(d:alldat-plea
10b40 73 65 2d 75 70 64 61 74 65 2d 73 65 74 21 20 2a se-update-set! *
10b50 61 6c 6c 64 61 74 2a 20 23 74 29 0a 09 09 09 09 alldat* #t).....
10b60 09 28 64 3a 61 6c 6c 64 61 74 2d 63 75 72 72 2d .(d:alldat-curr-
10b70 74 61 62 2d 6e 75 6d 2d 73 65 74 21 20 2a 61 6c tab-num-set! *al
10b80 6c 64 61 74 2a 20 63 75 72 72 29 29 0a 09 09 20 ldat* curr))...
10b90 20 20 20 28 64 61 73 68 62 6f 61 72 64 3a 73 75 (dashboard:su
10ba0 6d 6d 61 72 79 20 2a 61 6c 6c 64 61 74 2a 29 0a mmary *alldat*).
10bb0 09 09 20 20 20 20 72 75 6e 73 2d 76 69 65 77 0a .. runs-view.
10bc0 09 09 20 20 20 20 28 64 61 73 68 62 6f 61 72 64 .. (dashboard
10bd0 3a 6f 6e 65 2d 72 75 6e 20 64 62 20 20 64 61 74 :one-run db dat
10be0 61 20 72 75 6e 73 2d 73 75 6d 2d 64 61 74 29 0a a runs-sum-dat).
10bf0 09 09 20 20 20 20 3b 3b 20 28 64 61 73 68 62 6f .. ;; (dashbo
10c00 61 72 64 3a 6e 65 77 2d 76 69 65 77 20 64 62 20 ard:new-view db
10c10 64 61 74 61 20 6e 65 77 2d 76 69 65 77 2d 64 61 data new-view-da
10c20 74 29 0a 09 09 20 20 20 20 28 64 61 73 68 62 6f t)... (dashbo
10c30 61 72 64 3a 72 75 6e 2d 63 6f 6e 74 72 6f 6c 73 ard:run-controls
10c40 29 0a 09 09 20 20 20 20 29 29 29 0a 09 3b 3b 20 )... )))..;;
10c50 28 73 65 74 21 20 28 69 75 70 3a 63 61 6c 6c 62 (set! (iup:callb
10c60 61 63 6b 20 74 61 62 73 20 74 61 62 63 68 61 6e ack tabs tabchan
10c70 67 65 2d 63 62 3a 29 20 28 6c 61 6d 62 64 61 20 ge-cb:) (lambda
10c80 28 61 20 62 20 63 29 28 70 72 69 6e 74 20 22 53 (a b c)(print "S
10c90 57 49 54 43 48 45 44 20 54 4f 20 54 41 42 3a 20 WITCHED TO TAB:
10ca0 22 20 61 20 22 20 22 20 62 20 22 20 22 20 63 29 " a " " b " " c)
10cb0 29 29 0a 09 28 69 75 70 3a 61 74 74 72 69 62 75 ))..(iup:attribu
10cc0 74 65 2d 73 65 74 21 20 74 61 62 73 20 22 54 41 te-set! tabs "TA
10cd0 42 54 49 54 4c 45 30 22 20 22 53 75 6d 6d 61 72 BTITLE0" "Summar
10ce0 79 22 29 0a 09 28 69 75 70 3a 61 74 74 72 69 62 y")..(iup:attrib
10cf0 75 74 65 2d 73 65 74 21 20 74 61 62 73 20 22 54 ute-set! tabs "T
10d00 41 42 54 49 54 4c 45 31 22 20 22 52 75 6e 73 22 ABTITLE1" "Runs"
10d10 29 0a 09 28 69 75 70 3a 61 74 74 72 69 62 75 74 )..(iup:attribut
10d20 65 2d 73 65 74 21 20 74 61 62 73 20 22 54 41 42 e-set! tabs "TAB
10d30 54 49 54 4c 45 32 22 20 22 52 75 6e 20 53 75 6d TITLE2" "Run Sum
10d40 6d 61 72 79 22 29 0a 09 28 69 75 70 3a 61 74 74 mary")..(iup:att
10d50 72 69 62 75 74 65 2d 73 65 74 21 20 74 61 62 73 ribute-set! tabs
10d60 20 22 54 41 42 54 49 54 4c 45 33 22 20 22 52 75 "TABTITLE3" "Ru
10d70 6e 20 43 6f 6e 74 72 6f 6c 22 29 0a 09 3b 3b 20 n Control")..;;
10d80 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 (iup:attribute-s
10d90 65 74 21 20 74 61 62 73 20 22 54 41 42 54 49 54 et! tabs "TABTIT
10da0 4c 45 33 22 20 22 4e 65 77 20 56 69 65 77 22 29 LE3" "New View")
10db0 0a 09 3b 3b 20 28 69 75 70 3a 61 74 74 72 69 62 ..;; (iup:attrib
10dc0 75 74 65 2d 73 65 74 21 20 74 61 62 73 20 22 54 ute-set! tabs "T
10dd0 41 42 54 49 54 4c 45 34 22 20 22 52 75 6e 20 43 ABTITLE4" "Run C
10de0 6f 6e 74 72 6f 6c 22 29 0a 09 28 69 75 70 3a 61 ontrol")..(iup:a
10df0 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 74 61 ttribute-set! ta
10e00 62 73 20 22 42 47 43 4f 4c 4f 52 22 20 22 31 39 bs "BGCOLOR" "19
10e10 30 20 31 39 30 20 31 39 30 22 29 0a 09 28 64 3a 0 190 190")..(d:
10e20 61 6c 6c 64 61 74 2d 68 69 64 65 2d 6e 6f 74 2d alldat-hide-not-
10e30 68 69 64 65 2d 74 61 62 73 2d 73 65 74 21 20 2a hide-tabs-set! *
10e40 61 6c 6c 64 61 74 2a 20 74 61 62 73 29 0a 09 28 alldat* tabs)..(
10e50 69 75 70 3a 76 62 6f 78 0a 09 20 74 61 62 73 0a iup:vbox.. tabs.
10e60 09 20 63 6f 6e 74 72 6f 6c 73 29 29 29 29 0a 20 . controls)))).
10e70 20 20 20 28 76 65 63 74 6f 72 20 6b 65 79 63 6f (vector keyco
10e80 6c 20 6c 66 74 63 6f 6c 20 68 65 61 64 65 72 20 l lftcol header
10e90 72 75 6e 73 76 65 63 29 29 29 0a 0a 28 69 66 20 runsvec)))..(if
10ea0 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (or (args:get-ar
10eb0 67 20 22 2d 72 6f 77 73 22 29 0a 09 28 67 65 74 g "-rows")..(get
10ec0 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 -environment-var
10ed0 69 61 62 6c 65 20 22 44 41 53 48 42 4f 41 52 44 iable "DASHBOARD
10ee0 52 4f 57 53 22 20 29 29 0a 20 20 20 20 28 62 65 ROWS" )). (be
10ef0 67 69 6e 0a 20 20 20 20 20 20 28 64 3a 61 6c 6c gin. (d:all
10f00 64 61 74 2d 6e 75 6d 2d 74 65 73 74 73 2d 73 65 dat-num-tests-se
10f10 74 21 20 2a 61 6c 6c 64 61 74 2a 20 28 73 74 72 t! *alldat* (str
10f20 69 6e 67 2d 3e 6e 75 6d 62 65 72 0a 09 09 09 09 ing->number.....
10f30 09 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d . (or (args:get-
10f40 61 72 67 20 22 2d 72 6f 77 73 22 29 0a 09 09 09 arg "-rows")....
10f50 09 09 20 20 20 20 20 28 67 65 74 2d 65 6e 76 69 .. (get-envi
10f60 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 ronment-variable
10f70 20 22 44 41 53 48 42 4f 41 52 44 52 4f 57 53 22 "DASHBOARDROWS"
10f80 29 29 29 29 0a 20 20 20 20 20 20 28 75 70 64 61 )))). (upda
10f90 74 65 2d 72 75 6e 64 61 74 20 2a 61 6c 6c 64 61 te-rundat *allda
10fa0 74 2a 20 22 25 22 20 28 64 3a 61 6c 6c 64 61 74 t* "%" (d:alldat
10fb0 2d 6e 75 6d 72 75 6e 73 20 2a 61 6c 6c 64 61 74 -numruns *alldat
10fc0 2a 29 20 22 25 2f 25 22 20 27 28 29 29 29 0a 20 *) "%/%" '())).
10fd0 20 20 20 28 64 3a 61 6c 6c 64 61 74 2d 6e 75 6d (d:alldat-num
10fe0 2d 74 65 73 74 73 2d 73 65 74 21 20 2a 61 6c 6c -tests-set! *all
10ff0 64 61 74 2a 20 28 6d 69 6e 20 28 6d 61 78 20 28 dat* (min (max (
11000 75 70 64 61 74 65 2d 72 75 6e 64 61 74 20 2a 61 update-rundat *a
11010 6c 6c 64 61 74 2a 20 22 25 22 20 28 64 3a 61 6c lldat* "%" (d:al
11020 6c 64 61 74 2d 6e 75 6d 72 75 6e 73 20 2a 61 6c ldat-numruns *al
11030 6c 64 61 74 2a 29 20 22 25 2f 25 22 20 27 28 29 ldat*) "%/%" '()
11040 29 20 38 29 20 32 30 29 29 29 0a 0a 28 64 65 66 ) 8) 20)))..(def
11050 69 6e 65 20 2a 74 69 6d 2a 20 28 69 75 70 3a 74 ine *tim* (iup:t
11060 69 6d 65 72 29 29 0a 28 64 65 66 69 6e 65 20 2a imer)).(define *
11070 6f 72 64 2a 20 23 66 29 0a 28 69 75 70 3a 61 74 ord* #f).(iup:at
11080 74 72 69 62 75 74 65 2d 73 65 74 21 20 2a 74 69 tribute-set! *ti
11090 6d 2a 20 22 54 49 4d 45 22 20 33 30 30 29 0a 28 m* "TIME" 300).(
110a0 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 iup:attribute-se
110b0 74 21 20 2a 74 69 6d 2a 20 22 52 55 4e 22 20 22 t! *tim* "RUN" "
110c0 59 45 53 22 29 0a 0a 3b 3b 20 4d 6f 76 65 20 74 YES")..;; Move t
110d0 68 69 73 20 73 74 75 66 66 20 74 6f 20 64 62 2e his stuff to db.
110e0 73 63 6d 3f 20 49 27 6d 20 6e 6f 74 20 73 75 72 scm? I'm not sur
110f0 65 20 74 68 61 74 20 69 73 20 74 68 65 20 72 69 e that is the ri
11100 67 68 74 20 74 68 69 6e 67 20 74 6f 20 64 6f 2e ght thing to do.
11110 2e 2e 0a 3b 3b 0a 28 64 3a 61 6c 6c 64 61 74 2d ...;;.(d:alldat-
11120 6c 61 73 74 2d 64 62 2d 75 70 64 61 74 65 2d 73 last-db-update-s
11130 65 74 21 20 2a 61 6c 6c 64 61 74 2a 20 28 66 69 et! *alldat* (fi
11140 6c 65 2d 6d 6f 64 69 66 69 63 61 74 69 6f 6e 2d le-modification-
11150 74 69 6d 65 20 28 64 3a 61 6c 6c 64 61 74 2d 64 time (d:alldat-d
11160 62 66 70 61 74 68 20 2a 61 6c 6c 64 61 74 2a 29 bfpath *alldat*)
11170 29 29 20 3b 3b 20 28 63 6f 6e 63 20 2a 74 6f 70 )) ;; (conc *top
11180 70 61 74 68 2a 20 22 2f 64 62 2f 6d 61 69 6e 2e path* "/db/main.
11190 64 62 22 29 29 29 0a 28 64 65 66 69 6e 65 20 2a db"))).(define *
111a0 6c 61 73 74 2d 72 65 63 61 6c 63 2d 65 6e 64 65 last-recalc-ende
111b0 64 2d 74 69 6d 65 2a 20 30 29 0a 0a 28 64 65 66 d-time* 0)..(def
111c0 69 6e 65 20 28 64 61 73 68 62 6f 61 72 64 3a 62 ine (dashboard:b
111d0 65 65 6e 2d 63 68 61 6e 67 65 64 29 0a 20 20 28 een-changed). (
111e0 3e 20 28 66 69 6c 65 2d 6d 6f 64 69 66 69 63 61 > (file-modifica
111f0 74 69 6f 6e 2d 74 69 6d 65 20 28 64 3a 61 6c 6c tion-time (d:all
11200 64 61 74 2d 64 62 66 70 61 74 68 20 2a 61 6c 6c dat-dbfpath *all
11210 64 61 74 2a 29 29 20 28 64 3a 61 6c 6c 64 61 74 dat*)) (d:alldat
11220 2d 6c 61 73 74 2d 64 62 2d 75 70 64 61 74 65 20 -last-db-update
11230 2a 61 6c 6c 64 61 74 2a 29 29 29 0a 0a 28 64 65 *alldat*)))..(de
11240 66 69 6e 65 20 28 64 61 73 68 62 6f 61 72 64 3a fine (dashboard:
11250 73 65 74 2d 64 62 2d 75 70 64 61 74 65 2d 74 69 set-db-update-ti
11260 6d 65 29 0a 20 20 28 64 3a 61 6c 6c 64 61 74 2d me). (d:alldat-
11270 6c 61 73 74 2d 64 62 2d 75 70 64 61 74 65 2d 73 last-db-update-s
11280 65 74 21 20 2a 61 6c 6c 64 61 74 2a 20 28 66 69 et! *alldat* (fi
11290 6c 65 2d 6d 6f 64 69 66 69 63 61 74 69 6f 6e 2d le-modification-
112a0 74 69 6d 65 20 28 64 3a 61 6c 6c 64 61 74 2d 64 time (d:alldat-d
112b0 62 66 70 61 74 68 20 2a 61 6c 6c 64 61 74 2a 29 bfpath *alldat*)
112c0 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 61 )))..(define (da
112d0 73 68 62 6f 61 72 64 3a 72 65 63 61 6c 63 20 6d shboard:recalc m
112e0 6f 64 74 69 6d 65 20 70 6c 65 61 73 65 2d 75 70 odtime please-up
112f0 64 61 74 65 2d 62 75 74 74 6f 6e 73 20 6c 61 73 date-buttons las
11300 74 2d 64 62 2d 75 70 64 61 74 65 2d 74 69 6d 65 t-db-update-time
11310 29 0a 20 20 28 6f 72 20 70 6c 65 61 73 65 2d 75 ). (or please-u
11320 70 64 61 74 65 2d 62 75 74 74 6f 6e 73 0a 20 20 pdate-buttons.
11330 20 20 20 20 28 61 6e 64 20 28 3e 20 28 63 75 72 (and (> (cur
11340 72 65 6e 74 2d 6d 69 6c 6c 69 73 65 63 6f 6e 64 rent-millisecond
11350 73 29 28 2b 20 2a 6c 61 73 74 2d 72 65 63 61 6c s)(+ *last-recal
11360 63 2d 65 6e 64 65 64 2d 74 69 6d 65 2a 20 31 35 c-ended-time* 15
11370 30 29 29 0a 09 20 20 20 28 3e 20 6d 6f 64 74 69 0)).. (> modti
11380 6d 65 20 6c 61 73 74 2d 64 62 2d 75 70 64 61 74 me last-db-updat
11390 65 2d 74 69 6d 65 29 0a 09 20 20 20 28 3e 20 28 e-time).. (> (
113a0 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 current-seconds)
113b0 28 2b 20 6c 61 73 74 2d 64 62 2d 75 70 64 61 74 (+ last-db-updat
113c0 65 2d 74 69 6d 65 20 31 29 29 29 29 29 0a 0a 28 e-time 1)))))..(
113d0 64 65 66 69 6e 65 20 2a 6d 6f 6e 69 74 6f 72 2d define *monitor-
113e0 64 62 2d 70 61 74 68 2a 20 28 63 6f 6e 63 20 28 db-path* (conc (
113f0 64 3a 61 6c 6c 64 61 74 2d 64 62 64 69 72 20 2a d:alldat-dbdir *
11400 61 6c 6c 64 61 74 2a 29 20 22 2f 6d 6f 6e 69 74 alldat*) "/monit
11410 6f 72 2e 64 62 22 29 29 0a 28 64 65 66 69 6e 65 or.db")).(define
11420 20 2a 6c 61 73 74 2d 6d 6f 6e 69 74 6f 72 2d 75 *last-monitor-u
11430 70 64 61 74 65 2d 74 69 6d 65 2a 20 30 29 0a 0a pdate-time* 0)..
11440 3b 3b 20 46 6f 72 63 65 20 63 72 65 61 74 69 6f ;; Force creatio
11450 6e 20 6f 66 20 74 68 65 20 64 62 20 69 6e 20 63 n of the db in c
11460 61 73 65 20 69 74 20 69 73 6e 27 74 20 61 6c 72 ase it isn't alr
11470 65 61 64 79 20 74 68 65 72 65 2e 0a 28 74 61 73 eady there..(tas
11480 6b 73 3a 6f 70 65 6e 2d 64 62 29 0a 0a 28 64 65 ks:open-db)..(de
11490 66 69 6e 65 20 28 64 61 73 68 62 6f 61 72 64 3a fine (dashboard:
114a0 67 65 74 2d 79 6f 75 6e 67 65 73 74 2d 72 75 6e get-youngest-run
114b0 2d 64 62 2d 6d 6f 64 2d 74 69 6d 65 29 0a 20 20 -db-mod-time).
114c0 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f (handle-exceptio
114d0 6e 73 0a 20 20 20 65 78 6e 0a 20 20 20 28 62 65 ns. exn. (be
114e0 67 69 6e 0a 20 20 20 20 20 28 64 65 62 75 67 3a gin. (debug:
114f0 70 72 69 6e 74 20 30 20 22 57 41 52 4e 49 4e 47 print 0 "WARNING
11500 3a 20 65 72 72 6f 72 20 69 6e 20 61 63 63 65 73 : error in acces
11510 73 69 6e 67 20 64 61 74 61 62 61 73 65 73 20 69 sing databases i
11520 6e 20 67 65 74 2d 79 6f 75 6e 67 65 73 74 2d 72 n get-youngest-r
11530 75 6e 2d 64 62 2d 6d 6f 64 2d 74 69 6d 65 3a 20 un-db-mod-time:
11540 22 20 28 28 63 6f 6e 64 69 74 69 6f 6e 2d 70 72 " ((condition-pr
11550 6f 70 65 72 74 79 2d 61 63 63 65 73 73 6f 72 20 operty-accessor
11560 27 65 78 6e 20 27 6d 65 73 73 61 67 65 29 20 65 'exn 'message) e
11570 78 6e 29 29 0a 20 20 20 20 20 28 63 75 72 72 65 xn)). (curre
11580 6e 74 2d 73 65 63 6f 6e 64 73 29 29 20 3b 3b 20 nt-seconds)) ;;
11590 73 6f 6d 65 74 68 69 6e 67 20 77 65 6e 74 20 77 something went w
115a0 72 6f 6e 67 20 2d 20 6a 75 73 74 20 70 72 69 6e rong - just prin
115b0 74 20 61 6e 20 65 72 72 6f 72 20 61 6e 64 20 72 t an error and r
115c0 65 74 75 72 6e 20 63 75 72 72 65 6e 74 2d 73 65 eturn current-se
115d0 63 6f 6e 64 73 0a 20 20 20 28 61 70 70 6c 79 20 conds. (apply
115e0 6d 61 78 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 max (map (lambda
115f0 20 28 66 69 6c 65 6e 29 0a 09 09 20 20 20 20 20 (filen)...
11600 28 66 69 6c 65 2d 6d 6f 64 69 66 69 63 61 74 69 (file-modificati
11610 6f 6e 2d 74 69 6d 65 20 66 69 6c 65 6e 29 29 0a on-time filen)).
11620 09 09 20 20 20 28 67 6c 6f 62 20 28 63 6f 6e 63 .. (glob (conc
11630 20 28 64 3a 61 6c 6c 64 61 74 2d 64 62 64 69 72 (d:alldat-dbdir
11640 20 2a 61 6c 6c 64 61 74 2a 29 20 22 2f 2a 2e 64 *alldat*) "/*.d
11650 62 22 29 29 29 29 29 29 0a 0a 28 64 65 66 69 6e b"))))))..(defin
11660 65 20 28 64 61 73 68 62 6f 61 72 64 3a 72 75 6e e (dashboard:run
11670 2d 75 70 64 61 74 65 20 78 29 0a 20 20 28 6c 65 -update x). (le
11680 74 2a 20 28 28 6d 6f 64 74 69 6d 65 20 20 20 20 t* ((modtime
11690 20 20 20 20 20 28 64 61 73 68 62 6f 61 72 64 3a (dashboard:
116a0 67 65 74 2d 79 6f 75 6e 67 65 73 74 2d 72 75 6e get-youngest-run
116b0 2d 64 62 2d 6d 6f 64 2d 74 69 6d 65 29 29 20 3b -db-mod-time)) ;
116c0 3b 20 28 66 69 6c 65 2d 6d 6f 64 69 66 69 63 61 ; (file-modifica
116d0 74 69 6f 6e 2d 74 69 6d 65 20 28 64 3a 61 6c 6c tion-time (d:all
116e0 64 61 74 2d 64 62 66 70 61 74 68 20 2a 61 6c 6c dat-dbfpath *all
116f0 64 61 74 2a 29 29 29 0a 09 20 28 6d 6f 6e 69 74 dat*))).. (monit
11700 6f 72 2d 6d 6f 64 74 69 6d 65 20 28 69 66 20 28 or-modtime (if (
11710 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 2a 6d 6f file-exists? *mo
11720 6e 69 74 6f 72 2d 64 62 2d 70 61 74 68 2a 29 0a nitor-db-path*).
11730 09 09 09 20 20 20 20 20 20 28 66 69 6c 65 2d 6d ... (file-m
11740 6f 64 69 66 69 63 61 74 69 6f 6e 2d 74 69 6d 65 odification-time
11750 20 2a 6d 6f 6e 69 74 6f 72 2d 64 62 2d 70 61 74 *monitor-db-pat
11760 68 2a 29 0a 09 09 09 20 20 20 20 20 20 2d 31 29 h*).... -1)
11770 29 0a 09 20 28 72 75 6e 2d 75 70 64 61 74 65 2d ).. (run-update-
11780 74 69 6d 65 20 28 63 75 72 72 65 6e 74 2d 73 65 time (current-se
11790 63 6f 6e 64 73 29 29 0a 09 20 28 72 65 63 61 6c conds)).. (recal
117a0 63 20 20 20 20 20 20 20 20 20 20 28 64 61 73 68 c (dash
117b0 62 6f 61 72 64 3a 72 65 63 61 6c 63 20 6d 6f 64 board:recalc mod
117c0 74 69 6d 65 20 28 64 3a 61 6c 6c 64 61 74 2d 70 time (d:alldat-p
117d0 6c 65 61 73 65 2d 75 70 64 61 74 65 20 2a 61 6c lease-update *al
117e0 6c 64 61 74 2a 29 20 28 64 3a 61 6c 6c 64 61 74 ldat*) (d:alldat
117f0 2d 6c 61 73 74 2d 64 62 2d 75 70 64 61 74 65 20 -last-db-update
11800 2a 61 6c 6c 64 61 74 2a 29 29 29 29 0a 20 20 20 *alldat*)))).
11810 20 28 69 66 20 28 61 6e 64 20 28 65 71 3f 20 28 (if (and (eq? (
11820 64 3a 61 6c 6c 64 61 74 2d 63 75 72 72 2d 74 61 d:alldat-curr-ta
11830 62 2d 6e 75 6d 20 2a 61 6c 6c 64 61 74 2a 29 20 b-num *alldat*)
11840 30 29 0a 09 20 20 20 20 20 28 6f 72 20 28 3e 20 0).. (or (>
11850 6d 6f 6e 69 74 6f 72 2d 6d 6f 64 74 69 6d 65 20 monitor-modtime
11860 2a 6c 61 73 74 2d 6d 6f 6e 69 74 6f 72 2d 75 70 *last-monitor-up
11870 64 61 74 65 2d 74 69 6d 65 2a 29 0a 09 09 20 28 date-time*)... (
11880 3e 20 28 2d 20 72 75 6e 2d 75 70 64 61 74 65 2d > (- run-update-
11890 74 69 6d 65 20 2a 6c 61 73 74 2d 6d 6f 6e 69 74 time *last-monit
118a0 6f 72 2d 75 70 64 61 74 65 2d 74 69 6d 65 2a 29 or-update-time*)
118b0 20 35 29 29 29 20 3b 3b 20 75 70 64 61 74 65 20 5))) ;; update
118c0 65 76 65 72 79 20 31 2f 32 20 6d 69 6e 75 74 65 every 1/2 minute
118d0 20 6a 75 73 74 20 69 6e 20 63 61 73 65 0a 09 28 just in case..(
118e0 62 65 67 69 6e 0a 09 20 20 28 73 65 74 21 20 2a begin.. (set! *
118f0 6c 61 73 74 2d 6d 6f 6e 69 74 6f 72 2d 75 70 64 last-monitor-upd
11900 61 74 65 2d 74 69 6d 65 2a 20 72 75 6e 2d 75 70 ate-time* run-up
11910 64 61 74 65 2d 74 69 6d 65 29 20 3b 3b 20 6d 6f date-time) ;; mo
11920 6e 69 74 6f 72 2d 6d 6f 64 74 69 6d 65 29 0a 09 nitor-modtime)..
11930 20 20 28 69 66 20 64 61 73 68 62 6f 61 72 64 3a (if dashboard:
11940 75 70 64 61 74 65 2d 73 65 72 76 65 72 73 2d 74 update-servers-t
11950 61 62 6c 65 20 28 64 61 73 68 62 6f 61 72 64 3a able (dashboard:
11960 75 70 64 61 74 65 2d 73 65 72 76 65 72 73 2d 74 update-servers-t
11970 61 62 6c 65 29 29 29 29 0a 20 20 20 20 28 69 66 able)))). (if
11980 20 72 65 63 61 6c 63 0a 09 28 62 65 67 69 6e 09 recalc..(begin.
11990 0a 09 20 20 28 63 61 73 65 20 28 64 3a 61 6c 6c .. (case (d:all
119a0 64 61 74 2d 63 75 72 72 2d 74 61 62 2d 6e 75 6d dat-curr-tab-num
119b0 20 2a 61 6c 6c 64 61 74 2a 29 20 0a 09 20 20 20 *alldat*) ..
119c0 20 28 28 30 29 20 0a 09 20 20 20 20 20 28 69 66 ((0) .. (if
119d0 20 64 61 73 68 62 6f 61 72 64 3a 75 70 64 61 74 dashboard:updat
119e0 65 2d 73 75 6d 6d 61 72 79 2d 74 61 62 20 28 64 e-summary-tab (d
119f0 61 73 68 62 6f 61 72 64 3a 75 70 64 61 74 65 2d ashboard:update-
11a00 73 75 6d 6d 61 72 79 2d 74 61 62 29 29 29 0a 09 summary-tab)))..
11a10 20 20 20 20 28 28 31 29 20 3b 3b 20 54 68 65 20 ((1) ;; The
11a20 72 75 6e 73 20 74 61 62 6c 65 20 69 73 20 61 63 runs table is ac
11a30 74 69 76 65 0a 09 20 20 20 20 20 28 75 70 64 61 tive.. (upda
11a40 74 65 2d 72 75 6e 64 61 74 20 2a 61 6c 6c 64 61 te-rundat *allda
11a50 74 2a 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 t* (hash-table-r
11a60 65 66 2f 64 65 66 61 75 6c 74 20 28 64 3a 61 6c ef/default (d:al
11a70 6c 64 61 74 2d 73 65 61 72 63 68 70 61 74 74 73 ldat-searchpatts
11a80 20 2a 61 6c 6c 64 61 74 2a 29 20 22 72 75 6e 6e *alldat*) "runn
11a90 61 6d 65 22 20 22 25 22 29 20 28 64 3a 61 6c 6c ame" "%") (d:all
11aa0 64 61 74 2d 6e 75 6d 72 75 6e 73 20 2a 61 6c 6c dat-numruns *all
11ab0 64 61 74 2a 29 0a 09 09 09 20 20 20 20 28 68 61 dat*).... (ha
11ac0 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 sh-table-ref/def
11ad0 61 75 6c 74 20 28 64 3a 61 6c 6c 64 61 74 2d 73 ault (d:alldat-s
11ae0 65 61 72 63 68 70 61 74 74 73 20 2a 61 6c 6c 64 earchpatts *alld
11af0 61 74 2a 29 20 22 74 65 73 74 2d 6e 61 6d 65 22 at*) "test-name"
11b00 20 22 25 2f 25 22 29 0a 09 09 09 20 20 20 20 3b "%/%").... ;
11b10 3b 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 ; (hash-table-re
11b20 66 2f 64 65 66 61 75 6c 74 20 28 64 3a 61 6c 6c f/default (d:all
11b30 64 61 74 2d 73 65 61 72 63 68 70 61 74 74 73 20 dat-searchpatts
11b40 2a 61 6c 6c 64 61 74 2a 29 20 22 69 74 65 6d 2d *alldat*) "item-
11b50 6e 61 6d 65 22 20 22 25 22 29 0a 09 09 09 20 20 name" "%")....
11b60 20 20 28 6c 65 74 20 28 28 72 65 73 20 27 28 29 (let ((res '()
11b70 29 29 0a 09 09 09 20 20 20 20 20 20 28 66 6f 72 )).... (for
11b80 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 6b -each (lambda (k
11b90 65 79 29 0a 09 09 09 09 09 20 20 28 69 66 20 28 ey)...... (if (
11ba0 6e 6f 74 20 28 65 71 75 61 6c 3f 20 6b 65 79 20 not (equal? key
11bb0 22 72 75 6e 6e 61 6d 65 22 29 29 0a 09 09 09 09 "runname")).....
11bc0 09 20 20 20 20 20 20 28 6c 65 74 20 28 28 76 61 . (let ((va
11bd0 6c 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 l (hash-table-re
11be0 66 2f 64 65 66 61 75 6c 74 20 28 64 3a 61 6c 6c f/default (d:all
11bf0 64 61 74 2d 73 65 61 72 63 68 70 61 74 74 73 20 dat-searchpatts
11c00 2a 61 6c 6c 64 61 74 2a 29 20 6b 65 79 20 23 66 *alldat*) key #f
11c10 29 29 29 0a 09 09 09 09 09 09 28 69 66 20 76 61 ))).......(if va
11c20 6c 20 28 73 65 74 21 20 72 65 73 20 28 63 6f 6e l (set! res (con
11c30 73 20 28 6c 69 73 74 20 6b 65 79 20 76 61 6c 29 s (list key val)
11c40 20 72 65 73 29 29 29 29 29 29 0a 09 09 09 09 09 res))))))......
11c50 28 64 3a 61 6c 6c 64 61 74 2d 64 62 6b 65 79 73 (d:alldat-dbkeys
11c60 20 2a 61 6c 6c 64 61 74 2a 29 29 0a 09 09 09 20 *alldat*))....
11c70 20 20 20 20 20 72 65 73 29 29 0a 09 20 20 20 20 res))..
11c80 20 28 75 70 64 61 74 65 2d 62 75 74 74 6f 6e 73 (update-buttons
11c90 20 75 69 64 61 74 20 28 64 3a 61 6c 6c 64 61 74 uidat (d:alldat
11ca0 2d 6e 75 6d 72 75 6e 73 20 2a 61 6c 6c 64 61 74 -numruns *alldat
11cb0 2a 29 20 28 64 3a 61 6c 6c 64 61 74 2d 6e 75 6d *) (d:alldat-num
11cc0 2d 74 65 73 74 73 20 2a 61 6c 6c 64 61 74 2a 29 -tests *alldat*)
11cd0 29 29 0a 09 20 20 20 20 28 28 32 29 0a 09 20 20 )).. ((2)..
11ce0 20 20 20 28 64 61 73 68 62 6f 61 72 64 3a 75 70 (dashboard:up
11cf0 64 61 74 65 2d 72 75 6e 2d 73 75 6d 6d 61 72 79 date-run-summary
11d00 2d 74 61 62 29 29 0a 09 20 20 20 20 28 28 33 29 -tab)).. ((3)
11d10 0a 09 20 20 20 20 20 28 64 61 73 68 62 6f 61 72 .. (dashboar
11d20 64 3a 75 70 64 61 74 65 2d 6e 65 77 2d 76 69 65 d:update-new-vie
11d30 77 2d 74 61 62 29 29 0a 09 20 20 20 20 28 65 6c w-tab)).. (el
11d40 73 65 0a 09 20 20 20 20 20 28 6c 65 74 20 28 28 se.. (let ((
11d50 75 70 64 61 74 65 72 20 28 68 61 73 68 2d 74 61 updater (hash-ta
11d60 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 ble-ref/default
11d70 28 64 3a 61 6c 6c 64 61 74 2d 75 70 64 61 74 65 (d:alldat-update
11d80 72 73 20 2a 61 6c 6c 64 61 74 2a 29 0a 09 09 09 rs *alldat*)....
11d90 09 09 09 20 20 20 20 28 64 3a 61 6c 6c 64 61 74 ... (d:alldat
11da0 2d 63 75 72 72 2d 74 61 62 2d 6e 75 6d 20 2a 61 -curr-tab-num *a
11db0 6c 6c 64 61 74 2a 29 20 23 66 29 29 29 0a 09 20 lldat*) #f)))..
11dc0 20 20 20 20 20 20 28 69 66 20 75 70 64 61 74 65 (if update
11dd0 72 20 28 75 70 64 61 74 65 72 29 29 29 29 29 0a r (updater))))).
11de0 09 20 20 28 64 3a 61 6c 6c 64 61 74 2d 70 6c 65 . (d:alldat-ple
11df0 61 73 65 2d 75 70 64 61 74 65 2d 73 65 74 21 20 ase-update-set!
11e00 2a 61 6c 6c 64 61 74 2a 20 23 66 29 0a 09 20 20 *alldat* #f)..
11e10 28 64 3a 61 6c 6c 64 61 74 2d 6c 61 73 74 2d 64 (d:alldat-last-d
11e20 62 2d 75 70 64 61 74 65 2d 73 65 74 21 20 2a 61 b-update-set! *a
11e30 6c 6c 64 61 74 2a 20 6d 6f 64 74 69 6d 65 29 0a lldat* modtime).
11e40 09 20 20 28 73 65 74 21 20 2a 6c 61 73 74 2d 72 . (set! *last-r
11e50 65 63 61 6c 63 2d 65 6e 64 65 64 2d 74 69 6d 65 ecalc-ended-time
11e60 2a 20 28 63 75 72 72 65 6e 74 2d 6d 69 6c 6c 69 * (current-milli
11e70 73 65 63 6f 6e 64 73 29 29 29 29 29 29 0a 0a 3b seconds))))))..;
11e80 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
11e90 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11ea0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11eb0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11ec0 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 54 68 65 20 68 =======.;; The h
11ed0 65 61 76 79 20 6c 69 66 74 69 6e 67 20 73 74 61 eavy lifting sta
11ee0 72 74 73 20 68 65 72 65 0a 3b 3b 3d 3d 3d 3d 3d rts here.;;=====
11ef0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11f00 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11f10 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11f20 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11f30 3d 0a 0a 3b 3b 20 65 61 73 65 20 64 65 62 75 67 =..;; ease debug
11f40 67 69 6e 67 20 62 79 20 6c 6f 61 64 69 6e 67 20 ging by loading
11f50 7e 2f 2e 64 61 73 68 62 6f 61 72 64 72 63 0a 28 ~/.dashboardrc.(
11f60 6c 65 74 20 28 28 64 65 62 75 67 63 6f 6e 74 72 let ((debugcontr
11f70 6f 6c 66 20 28 63 6f 6e 63 20 28 67 65 74 2d 65 olf (conc (get-e
11f80 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 nvironment-varia
11f90 62 6c 65 20 22 48 4f 4d 45 22 29 20 22 2f 2e 64 ble "HOME") "/.d
11fa0 61 73 68 62 6f 61 72 64 72 63 22 29 29 29 0a 20 ashboardrc"))).
11fb0 20 28 69 66 20 28 66 69 6c 65 2d 65 78 69 73 74 (if (file-exist
11fc0 73 3f 20 64 65 62 75 67 63 6f 6e 74 72 6f 6c 66 s? debugcontrolf
11fd0 29 0a 20 20 20 20 20 20 28 6c 6f 61 64 20 64 65 ). (load de
11fe0 62 75 67 63 6f 6e 74 72 6f 6c 66 29 29 29 0a 0a bugcontrolf)))..
11ff0 28 64 65 66 69 6e 65 20 28 6d 61 69 6e 29 0a 20 (define (main).
12000 20 28 63 6f 6d 6d 6f 6e 3a 65 78 69 74 2d 6f 6e (common:exit-on
12010 2d 76 65 72 73 69 6f 6e 2d 63 68 61 6e 67 65 64 -version-changed
12020 29 0a 20 20 28 6c 65 74 2a 20 28 28 72 75 6e 73 ). (let* ((runs
12030 2d 73 75 6d 2d 64 61 74 20 28 64 3a 64 61 74 61 -sum-dat (d:data
12040 2d 69 6e 69 74 20 28 6d 61 6b 65 2d 64 3a 64 61 -init (make-d:da
12050 74 61 29 29 29 20 3b 3b 20 64 61 74 61 20 66 6f ta))) ;; data fo
12060 72 20 72 75 6e 2d 73 75 6d 6d 61 72 79 20 74 61 r run-summary ta
12070 62 0a 09 20 28 6e 65 77 2d 76 69 65 77 2d 64 61 b.. (new-view-da
12080 74 20 28 64 3a 64 61 74 61 2d 69 6e 69 74 20 28 t (d:data-init (
12090 6d 61 6b 65 2d 64 3a 64 61 74 61 29 29 29 0a 09 make-d:data)))..
120a0 20 28 64 61 74 61 20 20 20 20 20 20 20 20 20 2a (data *
120b0 61 6c 6c 64 61 74 2a 29 29 0a 20 20 20 20 28 63 alldat*)). (c
120c0 6f 6e 64 20 0a 20 20 20 20 20 28 28 61 72 67 73 ond . ((args
120d0 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 22 29 :get-arg "-run")
120e0 0a 20 20 20 20 20 20 28 6c 65 74 20 28 28 72 75 . (let ((ru
120f0 6e 69 64 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d nid (string->num
12100 62 65 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 ber (args:get-ar
12110 67 20 22 2d 72 75 6e 22 29 29 29 29 0a 09 28 69 g "-run"))))..(i
12120 66 20 72 75 6e 69 64 0a 09 20 20 20 20 28 62 65 f runid.. (be
12130 67 69 6e 0a 09 20 20 20 20 20 20 28 6c 61 6d 62 gin.. (lamb
12140 64 61 20 28 78 29 0a 09 09 28 6f 6e 2d 65 78 69 da (x)...(on-exi
12150 74 20 73 74 64 2d 65 78 69 74 2d 70 72 6f 63 65 t std-exit-proce
12160 64 75 72 65 29 0a 09 09 28 65 78 61 6d 69 6e 65 dure)...(examine
12170 2d 72 75 6e 20 28 64 3a 61 6c 6c 64 61 74 2d 64 -run (d:alldat-d
12180 62 6c 6f 63 61 6c 20 64 61 74 61 29 20 72 75 6e blocal data) run
12190 69 64 29 29 29 0a 09 20 20 20 20 28 62 65 67 69 id))).. (begi
121a0 6e 0a 09 20 20 20 20 20 20 28 70 72 69 6e 74 20 n.. (print
121b0 22 45 52 52 4f 52 3a 20 72 75 6e 69 64 20 69 73 "ERROR: runid is
121c0 20 6e 6f 74 20 61 20 6e 75 6d 62 65 72 20 22 20 not a number "
121d0 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
121e0 72 75 6e 22 29 29 0a 09 20 20 20 20 20 20 28 65 run")).. (e
121f0 78 69 74 20 31 29 29 29 29 29 0a 20 20 20 20 20 xit 1))))).
12200 28 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 ((args:get-arg "
12210 2d 74 65 73 74 22 29 20 3b 3b 20 72 75 6e 2d 69 -test") ;; run-i
12220 64 2c 74 65 73 74 2d 69 64 0a 20 20 20 20 20 20 d,test-id.
12230 28 6c 65 74 2a 20 28 28 64 61 74 20 20 20 20 20 (let* ((dat
12240 28 6c 65 74 20 28 28 64 20 28 6d 61 70 20 73 74 (let ((d (map st
12250 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 73 74 ring->number (st
12260 72 69 6e 67 2d 73 70 6c 69 74 20 28 61 72 67 73 ring-split (args
12270 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 22 :get-arg "-test"
12280 29 20 22 2c 22 29 29 29 29 0a 09 09 09 28 69 66 ) ","))))....(if
12290 20 28 3e 20 28 6c 65 6e 67 74 68 20 64 29 20 31 (> (length d) 1
122a0 29 0a 09 09 09 20 20 20 20 64 0a 09 09 09 20 20 ).... d....
122b0 20 20 28 6c 69 73 74 20 23 66 20 23 66 29 29 29 (list #f #f)))
122c0 29 0a 09 20 20 20 20 20 28 72 75 6e 2d 69 64 20 ).. (run-id
122d0 20 28 63 61 72 20 64 61 74 29 29 0a 09 20 20 20 (car dat))..
122e0 20 20 28 74 65 73 74 2d 69 64 20 28 63 61 64 72 (test-id (cadr
122f0 20 64 61 74 29 29 29 0a 09 28 69 66 20 28 61 6e dat)))..(if (an
12300 64 20 28 6e 75 6d 62 65 72 3f 20 72 75 6e 2d 69 d (number? run-i
12310 64 29 0a 09 09 20 28 6e 75 6d 62 65 72 3f 20 74 d)... (number? t
12320 65 73 74 2d 69 64 29 0a 09 09 20 28 3e 3d 20 74 est-id)... (>= t
12330 65 73 74 2d 69 64 20 30 29 29 0a 09 20 20 20 20 est-id 0))..
12340 28 65 78 61 6d 69 6e 65 2d 74 65 73 74 20 72 75 (examine-test ru
12350 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 0a 09 20 n-id test-id)..
12360 20 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 20 (begin..
12370 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 33 20 (debug:print 3
12380 22 49 4e 46 4f 3a 20 74 72 69 65 64 20 74 6f 20 "INFO: tried to
12390 6f 70 65 6e 20 74 65 73 74 20 77 69 74 68 20 69 open test with i
123a0 6e 76 61 6c 69 64 20 72 75 6e 2d 69 64 2c 74 65 nvalid run-id,te
123b0 73 74 2d 69 64 2e 20 22 20 28 61 72 67 73 3a 67 st-id. " (args:g
123c0 65 74 2d 61 72 67 20 22 2d 74 65 73 74 22 29 29 et-arg "-test"))
123d0 0a 09 20 20 20 20 20 20 28 65 78 69 74 20 31 29 .. (exit 1)
123e0 29 29 29 29 0a 20 20 20 20 20 28 28 61 72 67 73 )))). ((args
123f0 3a 67 65 74 2d 61 72 67 20 22 2d 67 75 69 6d 6f :get-arg "-guimo
12400 6e 69 74 6f 72 22 29 0a 20 20 20 20 20 20 28 67 nitor"). (g
12410 75 69 2d 6d 6f 6e 69 74 6f 72 20 28 64 3a 61 6c ui-monitor (d:al
12420 6c 64 61 74 2d 64 62 6c 6f 63 61 6c 20 64 61 74 ldat-dblocal dat
12430 61 29 29 29 0a 20 20 20 20 20 28 65 6c 73 65 0a a))). (else.
12440 20 20 20 20 20 20 28 73 65 74 21 20 75 69 64 61 (set! uida
12450 74 20 28 6d 61 6b 65 2d 64 61 73 68 62 6f 61 72 t (make-dashboar
12460 64 2d 62 75 74 74 6f 6e 73 20 64 61 74 61 20 3b d-buttons data ;
12470 3b 20 28 64 3a 61 6c 6c 64 61 74 2d 64 62 6c 6f ; (d:alldat-dblo
12480 63 61 6c 20 64 61 74 61 29 0a 09 09 09 09 09 20 cal data)......
12490 20 28 64 3a 61 6c 6c 64 61 74 2d 6e 75 6d 72 75 (d:alldat-numru
124a0 6e 73 20 64 61 74 61 29 0a 09 09 09 09 09 20 20 ns data)......
124b0 28 64 3a 61 6c 6c 64 61 74 2d 6e 75 6d 2d 74 65 (d:alldat-num-te
124c0 73 74 73 20 64 61 74 61 29 0a 09 09 09 09 09 20 sts data)......
124d0 20 28 64 3a 61 6c 6c 64 61 74 2d 64 62 6b 65 79 (d:alldat-dbkey
124e0 73 20 64 61 74 61 29 0a 09 09 09 09 09 20 20 72 s data)...... r
124f0 75 6e 73 2d 73 75 6d 2d 64 61 74 20 6e 65 77 2d uns-sum-dat new-
12500 76 69 65 77 2d 64 61 74 29 29 0a 20 20 20 20 20 view-dat)).
12510 20 28 69 75 70 3a 63 61 6c 6c 62 61 63 6b 2d 73 (iup:callback-s
12520 65 74 21 20 2a 74 69 6d 2a 0a 09 09 09 20 22 41 et! *tim*.... "A
12530 43 54 49 4f 4e 5f 43 42 22 0a 09 09 09 20 28 6c CTION_CB".... (l
12540 61 6d 62 64 61 20 28 78 29 0a 09 09 09 20 20 20 ambda (x)....
12550 28 6c 65 74 20 28 28 75 70 64 61 74 65 2d 69 73 (let ((update-is
12560 2d 72 75 6e 6e 69 6e 67 20 23 66 29 29 0a 09 09 -running #f))...
12570 09 20 20 20 20 20 28 6d 75 74 65 78 2d 6c 6f 63 . (mutex-loc
12580 6b 21 20 28 64 3a 61 6c 6c 64 61 74 2d 75 70 64 k! (d:alldat-upd
12590 61 74 65 2d 6d 75 74 65 78 20 64 61 74 61 29 29 ate-mutex data))
125a0 0a 09 09 09 20 20 20 20 20 28 73 65 74 21 20 75 .... (set! u
125b0 70 64 61 74 65 2d 69 73 2d 72 75 6e 6e 69 6e 67 pdate-is-running
125c0 20 28 64 3a 61 6c 6c 64 61 74 2d 75 70 64 61 74 (d:alldat-updat
125d0 69 6e 67 20 64 61 74 61 29 29 0a 09 09 09 20 20 ing data))....
125e0 20 20 20 28 69 66 20 28 6e 6f 74 20 75 70 64 61 (if (not upda
125f0 74 65 2d 69 73 2d 72 75 6e 6e 69 6e 67 29 0a 09 te-is-running)..
12600 09 09 09 20 28 64 3a 61 6c 6c 64 61 74 2d 75 70 ... (d:alldat-up
12610 64 61 74 69 6e 67 2d 73 65 74 21 20 64 61 74 61 dating-set! data
12620 20 23 74 29 29 0a 09 09 09 20 20 20 20 20 28 6d #t)).... (m
12630 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 28 64 3a utex-unlock! (d:
12640 61 6c 6c 64 61 74 2d 75 70 64 61 74 65 2d 6d 75 alldat-update-mu
12650 74 65 78 20 64 61 74 61 29 29 0a 09 09 09 20 20 tex data))....
12660 20 20 20 28 69 66 20 28 6e 6f 74 20 75 70 64 61 (if (not upda
12670 74 65 2d 69 73 2d 72 75 6e 6e 69 6e 67 29 0a 09 te-is-running)..
12680 09 09 09 20 28 62 65 67 69 6e 0a 09 09 09 09 20 ... (begin.....
12690 20 20 28 64 61 73 68 62 6f 61 72 64 3a 72 75 6e (dashboard:run
126a0 2d 75 70 64 61 74 65 20 78 29 0a 09 09 09 09 20 -update x).....
126b0 20 20 28 6d 75 74 65 78 2d 6c 6f 63 6b 21 20 28 (mutex-lock! (
126c0 64 3a 61 6c 6c 64 61 74 2d 75 70 64 61 74 65 2d d:alldat-update-
126d0 6d 75 74 65 78 20 64 61 74 61 29 29 0a 09 09 09 mutex data))....
126e0 09 20 20 20 28 64 3a 61 6c 6c 64 61 74 2d 75 70 . (d:alldat-up
126f0 64 61 74 69 6e 67 2d 73 65 74 21 20 64 61 74 61 dating-set! data
12700 20 23 66 29 0a 09 09 09 09 20 20 20 28 6d 75 74 #f)..... (mut
12710 65 78 2d 75 6e 6c 6f 63 6b 21 20 28 64 3a 61 6c ex-unlock! (d:al
12720 6c 64 61 74 2d 75 70 64 61 74 65 2d 6d 75 74 65 ldat-update-mute
12730 78 20 64 61 74 61 29 29 29 29 29 0a 09 09 09 20 x data)))))....
12740 20 20 31 29 29 29 29 0a 20 20 20 20 0a 20 20 20 1)))). .
12750 20 28 6c 65 74 20 28 28 74 68 31 20 28 6d 61 6b (let ((th1 (mak
12760 65 2d 74 68 72 65 61 64 20 28 6c 61 6d 62 64 61 e-thread (lambda
12770 20 28 29 0a 09 09 09 20 20 20 20 20 20 28 74 68 ().... (th
12780 72 65 61 64 2d 73 6c 65 65 70 21 20 31 29 0a 09 read-sleep! 1)..
12790 09 09 20 20 20 20 20 20 28 64 3a 61 6c 6c 64 61 .. (d:allda
127a0 74 2d 70 6c 65 61 73 65 2d 75 70 64 61 74 65 2d t-please-update-
127b0 73 65 74 21 20 64 61 74 61 20 23 74 29 0a 09 09 set! data #t)...
127c0 09 20 20 20 20 20 20 28 64 61 73 68 62 6f 61 72 . (dashboar
127d0 64 3a 72 75 6e 2d 75 70 64 61 74 65 20 31 29 29 d:run-update 1))
127e0 20 22 75 70 64 61 74 65 20 62 75 74 74 6f 6e 73 "update buttons
127f0 20 6f 6e 63 65 22 29 29 0a 09 20 20 28 74 68 32 once")).. (th2
12800 20 28 6d 61 6b 65 2d 74 68 72 65 61 64 20 69 75 (make-thread iu
12810 70 3a 6d 61 69 6e 2d 6c 6f 6f 70 20 22 4d 61 69 p:main-loop "Mai
12820 6e 20 6c 6f 6f 70 22 29 29 29 0a 20 20 20 20 20 n loop"))).
12830 20 28 74 68 72 65 61 64 2d 73 74 61 72 74 21 20 (thread-start!
12840 74 68 31 29 0a 20 20 20 20 20 20 28 74 68 72 65 th1). (thre
12850 61 64 2d 73 74 61 72 74 21 20 74 68 32 29 0a 20 ad-start! th2).
12860 20 20 20 20 20 28 74 68 72 65 61 64 2d 6a 6f 69 (thread-joi
12870 6e 21 20 74 68 32 29 29 29 29 0a 0a 28 6d 61 69 n! th2))))..(mai
12880 6e 29 0a n).