Artifact d12532b9413f4c775dbfedf1ec8d05ad3bffb69e:
- File dashboard.scm — part of check-in [7f668b637d] at 2011-05-05 18:35:21 on branch trunk — Added stuck test handling (user: mrwellan size: 16093)
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 31 2c right 2006-2011, 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 72 65 71 ==========..(req 01e0: 75 69 72 65 2d 6c 69 62 72 61 72 79 20 69 75 70 uire-library iup 01f0: 29 0a 28 69 6d 70 6f 72 74 20 28 70 72 65 66 69 ).(import (prefi 0200: 78 20 69 75 70 20 69 75 70 3a 29 29 0a 0a 3b 3b x iup iup:))..;; 0210: 20 28 75 73 65 20 63 61 6e 76 61 73 2d 64 72 61 (use canvas-dra 0220: 77 29 0a 0a 28 75 73 65 20 73 71 6c 69 74 65 33 w)..(use sqlite3 0230: 20 73 72 66 69 2d 31 20 70 6f 73 69 78 20 72 65 srfi-1 posix re 0240: 67 65 78 20 72 65 67 65 78 2d 63 61 73 65 20 73 gex regex-case s 0250: 72 66 69 2d 36 39 29 0a 0a 28 69 6d 70 6f 72 74 rfi-69)..(import 0260: 20 28 70 72 65 66 69 78 20 73 71 6c 69 74 65 33 (prefix sqlite3 0270: 20 73 71 6c 69 74 65 33 3a 29 29 0a 0a 28 69 6e sqlite3:))..(in 0280: 63 6c 75 64 65 20 22 6d 61 72 67 73 2e 73 63 6d clude "margs.scm 0290: 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 6b 65 79 ").(include "key 02a0: 73 2e 73 63 6d 22 29 0a 28 69 6e 63 6c 75 64 65 s.scm").(include 02b0: 20 22 69 74 65 6d 73 2e 73 63 6d 22 29 0a 28 69 "items.scm").(i 02c0: 6e 63 6c 75 64 65 20 22 64 62 2e 73 63 6d 22 29 nclude "db.scm") 02d0: 0a 28 69 6e 63 6c 75 64 65 20 22 63 6f 6e 66 69 .(include "confi 02e0: 67 66 2e 73 63 6d 22 29 0a 28 69 6e 63 6c 75 64 gf.scm").(includ 02f0: 65 20 22 70 72 6f 63 65 73 73 2e 73 63 6d 22 29 e "process.scm") 0300: 0a 28 69 6e 63 6c 75 64 65 20 22 6c 61 75 6e 63 .(include "launc 0310: 68 2e 73 63 6d 22 29 0a 28 69 6e 63 6c 75 64 65 h.scm").(include 0320: 20 22 72 75 6e 73 2e 73 63 6d 22 29 0a 28 69 6e "runs.scm").(in 0330: 63 6c 75 64 65 20 22 67 75 69 2e 73 63 6d 22 29 clude "gui.scm") 0340: 0a 0a 28 69 66 20 28 6e 6f 74 20 28 73 65 74 75 ..(if (not (setu 0350: 70 2d 66 6f 72 2d 72 75 6e 29 29 0a 20 20 20 20 p-for-run)). 0360: 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 70 72 (begin. (pr 0370: 69 6e 74 20 22 46 61 69 6c 65 64 20 74 6f 20 66 int "Failed to f 0380: 69 6e 64 20 6d 65 67 61 74 65 73 74 2e 63 6f 6e ind megatest.con 0390: 66 69 67 2c 20 65 78 69 74 69 6e 67 22 29 20 0a fig, exiting") . 03a0: 20 20 20 20 20 20 28 65 78 69 74 20 31 29 29 29 (exit 1))) 03b0: 0a 0a 28 64 65 66 69 6e 65 20 2a 64 62 2a 20 28 ..(define *db* ( 03c0: 6f 70 65 6e 2d 64 62 29 29 0a 0a 28 64 65 66 69 open-db))..(defi 03d0: 6e 65 20 74 6f 70 6c 65 76 65 6c 20 23 66 29 0a ne toplevel #f). 03e0: 28 64 65 66 69 6e 65 20 64 6c 67 20 20 20 20 20 (define dlg 03f0: 20 23 66 29 0a 28 64 65 66 69 6e 65 20 6d 61 78 #f).(define max 0400: 2d 74 65 73 74 2d 6e 75 6d 20 30 29 0a 28 64 65 -test-num 0).(de 0410: 66 69 6e 65 20 2a 6b 65 79 73 2a 20 20 20 28 67 fine *keys* (g 0420: 65 74 2d 6b 65 79 73 20 20 20 2a 64 62 2a 29 29 et-keys *db*)) 0430: 0a 28 64 65 66 69 6e 65 20 64 62 6b 65 79 73 20 .(define dbkeys 0440: 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 (map (lambda ( 0450: 78 29 28 76 65 63 74 6f 72 2d 72 65 66 20 78 20 x)(vector-ref x 0460: 30 29 29 0a 09 09 20 20 20 20 20 20 28 61 70 70 0))... (app 0470: 65 6e 64 20 2a 6b 65 79 73 2a 20 28 6c 69 73 74 end *keys* (list 0480: 20 28 76 65 63 74 6f 72 20 22 72 75 6e 6e 61 6d (vector "runnam 0490: 65 22 20 22 62 6c 61 68 22 29 29 29 29 29 0a 28 e" "blah"))))).( 04a0: 64 65 66 69 6e 65 20 2a 68 65 61 64 65 72 2a 20 define *header* 04b0: 20 20 20 20 20 20 23 66 29 0a 28 64 65 66 69 6e #f).(defin 04c0: 65 20 2a 61 6c 6c 72 75 6e 73 2a 20 20 20 20 20 e *allruns* 04d0: 27 28 29 29 0a 28 64 65 66 69 6e 65 20 2a 62 75 '()).(define *bu 04e0: 74 74 6f 6e 64 61 74 2a 20 20 20 20 28 6d 61 6b ttondat* (mak 04f0: 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 20 3b e-hash-table)) ; 0500: 3b 20 3c 72 75 6e 2d 69 64 20 63 6f 6c 6f 72 20 ; <run-id color 0510: 74 65 78 74 20 74 65 73 74 20 72 75 6e 2d 6b 65 text test run-ke 0520: 79 3e 0a 28 64 65 66 69 6e 65 20 2a 61 6c 6c 74 y>.(define *allt 0530: 65 73 74 6e 61 6d 65 73 2a 20 28 6d 61 6b 65 2d estnames* (make- 0540: 68 61 73 68 2d 74 61 62 6c 65 29 29 20 3b 3b 20 hash-table)) ;; 0550: 62 75 69 6c 64 20 61 20 6d 69 6e 69 6d 61 6c 69 build a minimali 0560: 7a 65 64 20 6c 69 73 74 20 6f 66 20 74 65 73 74 zed list of test 0570: 20 6e 61 6d 65 73 0a 28 64 65 66 69 6e 65 20 2a names.(define * 0580: 61 6c 6c 74 65 73 74 6e 61 6d 65 6c 73 74 2a 20 alltestnamelst* 0590: 27 28 29 29 0a 28 64 65 66 69 6e 65 20 2a 73 65 '()).(define *se 05a0: 61 72 63 68 70 61 74 74 73 2a 20 20 28 6d 61 6b archpatts* (mak 05b0: 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 0a 28 e-hash-table)).( 05c0: 64 65 66 69 6e 65 20 2a 6e 75 6d 2d 72 75 6e 73 define *num-runs 05d0: 2a 20 20 20 20 20 20 31 30 29 0a 28 64 65 66 69 * 10).(defi 05e0: 6e 65 20 2a 6e 75 6d 2d 74 65 73 74 73 2a 20 20 ne *num-tests* 05f0: 20 20 20 31 35 29 0a 28 64 65 66 69 6e 65 20 2a 15).(define * 0600: 73 74 61 72 74 2d 72 75 6e 2d 6f 66 66 73 65 74 start-run-offset 0610: 2a 20 20 30 29 0a 28 64 65 66 69 6e 65 20 2a 73 * 0).(define *s 0620: 74 61 72 74 2d 74 65 73 74 2d 6f 66 66 73 65 74 tart-test-offset 0630: 2a 20 30 29 0a 0a 0a 28 64 65 66 69 6e 65 20 28 * 0)...(define ( 0640: 6d 65 73 73 61 67 65 2d 77 69 6e 64 6f 77 20 6d message-window m 0650: 73 67 29 0a 20 20 28 69 75 70 3a 73 68 6f 77 0a sg). (iup:show. 0660: 20 20 20 28 69 75 70 3a 64 69 61 6c 6f 67 0a 20 (iup:dialog. 0670: 20 20 20 28 69 75 70 3a 76 62 6f 78 20 0a 20 20 (iup:vbox . 0680: 20 20 20 28 69 75 70 3a 6c 61 62 65 6c 20 6d 73 (iup:label ms 0690: 67 20 23 3a 6d 61 72 67 69 6e 20 22 34 30 78 34 g #:margin "40x4 06a0: 30 22 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 0")))))..(define 06b0: 20 28 69 75 70 6c 69 73 74 62 6f 78 2d 66 69 6c (iuplistbox-fil 06c0: 6c 2d 6c 69 73 74 20 6c 62 20 69 74 65 6d 73 20 l-list lb items 06d0: 2e 20 64 65 66 61 75 6c 74 29 0a 20 20 28 6c 65 . default). (le 06e0: 74 20 28 28 69 20 31 29 0a 09 28 73 65 6c 65 63 t ((i 1)..(selec 06f0: 74 65 64 2d 69 74 65 6d 20 28 69 66 20 28 6e 75 ted-item (if (nu 0700: 6c 6c 3f 20 64 65 66 61 75 6c 74 29 20 23 66 20 ll? default) #f 0710: 28 63 61 72 20 64 65 66 61 75 6c 74 29 29 29 29 (car default)))) 0720: 0a 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 . (iup:attrib 0730: 75 74 65 2d 73 65 74 21 20 6c 62 20 22 56 41 4c ute-set! lb "VAL 0740: 55 45 22 20 28 69 66 20 73 65 6c 65 63 74 65 64 UE" (if selected 0750: 2d 69 74 65 6d 20 73 65 6c 65 63 74 65 64 2d 69 -item selected-i 0760: 74 65 6d 20 22 22 29 29 0a 20 20 20 20 28 66 6f tem "")). (fo 0770: 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 r-each (lambda ( 0780: 69 74 65 6d 29 0a 09 09 28 69 75 70 3a 61 74 74 item)...(iup:att 0790: 72 69 62 75 74 65 2d 73 65 74 21 20 6c 62 20 28 ribute-set! lb ( 07a0: 6e 75 6d 62 65 72 2d 3e 73 74 72 69 6e 67 20 69 number->string i 07b0: 29 20 69 74 65 6d 29 0a 09 09 28 69 66 20 73 65 ) item)...(if se 07c0: 6c 65 63 74 65 64 2d 69 74 65 6d 0a 09 09 20 20 lected-item... 07d0: 20 20 28 69 66 20 28 65 71 75 61 6c 3f 20 73 65 (if (equal? se 07e0: 6c 65 63 74 65 64 2d 69 74 65 6d 20 69 74 65 6d lected-item item 07f0: 29 0a 09 09 09 28 69 75 70 3a 61 74 74 72 69 62 )....(iup:attrib 0800: 75 74 65 2d 73 65 74 21 20 6c 62 20 22 56 41 4c ute-set! lb "VAL 0810: 55 45 22 20 69 74 65 6d 29 29 29 20 3b 3b 20 28 UE" item))) ;; ( 0820: 6e 75 6d 62 65 72 2d 3e 73 74 72 69 6e 67 20 69 number->string i 0830: 29 29 29 29 0a 09 09 28 73 65 74 21 20 69 20 28 ))))...(set! i ( 0840: 2b 20 69 20 31 29 29 29 0a 09 20 20 20 20 20 20 + i 1))).. 0850: 69 74 65 6d 73 29 0a 20 20 20 20 69 29 29 0a 0a items). i)).. 0860: 28 64 65 66 69 6e 65 20 28 70 61 64 2d 6c 69 73 (define (pad-lis 0870: 74 20 6c 20 6e 29 28 61 70 70 65 6e 64 20 6c 20 t l n)(append l 0880: 28 6d 61 6b 65 2d 6c 69 73 74 20 28 2d 20 6e 20 (make-list (- n 0890: 28 6c 65 6e 67 74 68 20 6c 29 29 29 29 29 0a 0a (length l))))).. 08a0: 28 64 65 66 69 6e 65 20 28 65 78 61 6d 69 6e 65 (define (examine 08b0: 2d 74 65 73 74 20 62 75 74 74 6f 6e 2d 6b 65 79 -test button-key 08c0: 29 20 3b 3b 20 72 75 6e 2d 69 64 20 72 75 6e 2d ) ;; run-id run- 08d0: 6b 65 79 20 6f 72 69 67 74 65 73 74 29 0a 20 20 key origtest). 08e0: 28 6c 65 74 20 28 28 62 75 74 74 6f 6e 64 61 74 (let ((buttondat 08f0: 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 (hash-table 0900: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 2a 62 75 -ref/default *bu 0910: 74 74 6f 6e 64 61 74 2a 20 62 75 74 74 6f 6e 2d ttondat* button- 0920: 6b 65 79 20 23 66 29 29 29 0a 20 20 20 20 3b 3b key #f))). ;; 0930: 20 28 70 72 69 6e 74 20 22 62 75 74 74 6f 6e 64 (print "buttond 0940: 61 74 3a 20 22 20 62 75 74 74 6f 6e 64 61 74 29 at: " buttondat) 0950: 0a 20 20 20 20 28 69 66 20 28 61 6e 64 20 62 75 . (if (and bu 0960: 74 74 6f 6e 64 61 74 0a 09 20 20 20 20 20 28 76 ttondat.. (v 0970: 65 63 74 6f 72 20 62 75 74 74 6f 6e 64 61 74 29 ector buttondat) 0980: 0a 09 20 20 20 20 20 28 76 65 63 74 6f 72 2d 72 .. (vector-r 0990: 65 66 20 62 75 74 74 6f 6e 64 61 74 20 30 29 0a ef buttondat 0). 09a0: 09 20 20 20 20 20 28 3e 20 28 76 65 63 74 6f 72 . (> (vector 09b0: 2d 72 65 66 20 62 75 74 74 6f 6e 64 61 74 20 30 -ref buttondat 0 09c0: 29 20 30 29 0a 09 20 20 20 20 20 28 76 65 63 74 ) 0).. (vect 09d0: 6f 72 3f 20 28 76 65 63 74 6f 72 2d 72 65 66 20 or? (vector-ref 09e0: 62 75 74 74 6f 6e 64 61 74 20 33 29 29 0a 09 20 buttondat 3)).. 09f0: 20 20 20 20 28 3e 20 28 76 65 63 74 6f 72 2d 72 (> (vector-r 0a00: 65 66 20 28 76 65 63 74 6f 72 2d 72 65 66 20 62 ef (vector-ref b 0a10: 75 74 74 6f 6e 64 61 74 20 33 29 20 30 29 20 30 uttondat 3) 0) 0 0a20: 29 29 0a 09 28 6c 65 74 2a 20 28 28 72 75 6e 2d ))..(let* ((run- 0a30: 69 64 20 20 20 20 20 20 20 28 76 65 63 74 6f 72 id (vector 0a40: 2d 72 65 66 20 62 75 74 74 6f 6e 64 61 74 20 30 -ref buttondat 0 0a50: 29 29 0a 09 20 20 20 20 20 20 20 28 6f 72 69 67 )).. (orig 0a60: 74 65 73 74 20 20 20 20 20 28 76 65 63 74 6f 72 test (vector 0a70: 2d 72 65 66 20 62 75 74 74 6f 6e 64 61 74 20 33 -ref buttondat 3 0a80: 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e 2d )).. (run- 0a90: 6b 65 79 20 20 20 20 20 20 28 76 65 63 74 6f 72 key (vector 0aa0: 2d 72 65 66 20 62 75 74 74 6f 6e 64 61 74 20 34 -ref buttondat 4 0ab0: 29 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 )).. (test 0ac0: 20 20 20 20 20 20 20 20 20 28 64 62 3a 67 65 74 (db:get 0ad0: 2d 74 65 73 74 2d 69 6e 66 6f 20 2a 64 62 2a 0a -test-info *db*. 0ae0: 09 09 09 09 09 20 20 20 20 20 20 20 72 75 6e 2d ..... run- 0af0: 69 64 0a 09 09 09 09 09 20 20 20 20 20 20 20 28 id...... ( 0b00: 64 62 3a 74 65 73 74 2d 67 65 74 2d 74 65 73 74 db:test-get-test 0b10: 6e 61 6d 65 20 20 6f 72 69 67 74 65 73 74 29 0a name origtest). 0b20: 09 09 09 09 09 20 20 20 20 20 20 20 28 64 62 3a ..... (db: 0b30: 74 65 73 74 2d 67 65 74 2d 69 74 65 6d 2d 70 61 test-get-item-pa 0b40: 74 68 20 6f 72 69 67 74 65 73 74 29 29 29 0a 09 th origtest))).. 0b50: 20 20 20 20 20 20 20 28 72 75 6e 64 69 72 20 20 (rundir 0b60: 20 20 20 20 20 28 64 62 3a 74 65 73 74 2d 67 65 (db:test-ge 0b70: 74 2d 72 75 6e 64 69 72 20 74 65 73 74 29 29 0a t-rundir test)). 0b80: 09 20 20 20 20 20 20 20 28 74 65 73 74 6e 61 6d . (testnam 0b90: 65 20 20 20 20 20 28 64 62 3a 74 65 73 74 2d 67 e (db:test-g 0ba0: 65 74 2d 74 65 73 74 6e 61 6d 65 20 20 20 74 65 et-testname te 0bb0: 73 74 29 29 0a 09 20 20 20 20 20 20 20 28 69 74 st)).. (it 0bc0: 65 6d 70 61 74 68 20 20 20 20 20 28 64 62 3a 74 empath (db:t 0bd0: 65 73 74 2d 67 65 74 2d 69 74 65 6d 2d 70 61 74 est-get-item-pat 0be0: 68 20 74 65 73 74 29 29 0a 09 20 20 20 20 20 20 h test)).. 0bf0: 20 28 74 65 73 74 66 75 6c 6c 6e 61 6d 65 20 28 (testfullname ( 0c00: 72 75 6e 73 3a 74 65 73 74 2d 67 65 74 2d 66 75 runs:test-get-fu 0c10: 6c 6c 2d 70 61 74 68 20 74 65 73 74 29 29 0a 09 ll-path test)).. 0c20: 20 20 20 20 20 20 20 28 63 75 72 72 73 74 61 74 (currstat 0c30: 75 73 20 20 20 28 64 62 3a 74 65 73 74 2d 67 65 us (db:test-ge 0c40: 74 2d 73 74 61 74 75 73 20 74 65 73 74 29 29 0a t-status test)). 0c50: 09 20 20 20 20 20 20 20 28 63 75 72 72 73 74 61 . (currsta 0c60: 74 65 20 20 20 20 28 64 62 3a 74 65 73 74 2d 67 te (db:test-g 0c70: 65 74 2d 73 74 61 74 65 20 20 74 65 73 74 29 29 et-state test)) 0c80: 0a 09 20 20 20 20 20 20 20 28 63 75 72 72 63 6f .. (currco 0c90: 6d 6d 65 6e 74 20 20 28 64 62 3a 74 65 73 74 2d mment (db:test- 0ca0: 67 65 74 2d 63 6f 6d 6d 65 6e 74 20 74 65 73 74 get-comment test 0cb0: 29 29 0a 09 20 20 20 20 20 20 20 28 68 6f 73 74 )).. (host 0cc0: 20 20 20 20 20 20 20 20 20 28 64 62 3a 74 65 73 (db:tes 0cd0: 74 2d 67 65 74 2d 68 6f 73 74 20 74 65 73 74 29 t-get-host test) 0ce0: 29 0a 09 20 20 20 20 20 20 20 28 63 70 75 6c 6f ).. (cpulo 0cf0: 61 64 20 20 20 20 20 20 28 64 62 3a 74 65 73 74 ad (db:test 0d00: 2d 67 65 74 2d 63 70 75 6c 6f 61 64 20 74 65 73 -get-cpuload tes 0d10: 74 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e t)).. (run 0d20: 74 69 6d 65 20 20 20 20 20 20 28 64 62 3a 74 65 time (db:te 0d30: 73 74 2d 67 65 74 2d 72 75 6e 29 64 75 72 61 74 st-get-run)durat 0d40: 69 6f 6e 20 74 65 73 74 29 0a 09 20 20 20 20 20 ion test).. 0d50: 20 20 28 6c 6f 67 66 69 6c 65 20 20 20 20 20 20 (logfile 0d60: 28 63 6f 6e 63 20 28 64 62 3a 74 65 73 74 2d 67 (conc (db:test-g 0d70: 65 74 2d 72 75 6e 64 69 72 20 74 65 73 74 29 20 et-rundir test) 0d80: 22 2f 22 20 28 64 62 3a 74 65 73 74 2d 67 65 74 "/" (db:test-get 0d90: 2d 66 69 6e 61 6c 5f 6c 6f 67 66 20 74 65 73 74 -final_logf test 0da0: 29 29 29 0a 09 20 20 20 20 20 20 20 28 76 69 65 ))).. (vie 0db0: 77 6c 6f 67 20 20 20 20 20 20 28 6c 61 6d 62 64 wlog (lambd 0dc0: 61 20 28 78 29 0a 09 09 09 20 20 20 20 20 20 20 a (x).... 0dd0: 28 69 66 20 28 66 69 6c 65 2d 65 78 69 73 74 73 (if (file-exists 0de0: 3f 20 6c 6f 67 66 69 6c 65 29 0a 09 09 09 09 20 ? logfile)..... 0df0: 20 20 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 20 (system (conc 0e00: 22 66 69 72 65 66 6f 78 20 22 20 6c 6f 67 66 69 "firefox " logfi 0e10: 6c 65 20 22 26 22 29 29 0a 09 09 09 09 20 20 20 le "&"))..... 0e20: 28 6d 65 73 73 61 67 65 2d 77 69 6e 64 6f 77 20 (message-window 0e30: 28 63 6f 6e 63 20 22 46 69 6c 65 20 22 20 6c 6f (conc "File " lo 0e40: 67 66 69 6c 65 20 22 20 6e 6f 74 20 66 6f 75 6e gfile " not foun 0e50: 64 22 29 29 29 29 29 0a 09 20 20 20 20 20 20 20 d"))))).. 0e60: 28 78 74 65 72 6d 20 20 20 20 20 20 20 20 28 6c (xterm (l 0e70: 61 6d 62 64 61 20 28 78 29 0a 09 09 09 20 20 20 ambda (x).... 0e80: 20 20 20 20 28 69 66 20 28 64 69 72 65 63 74 6f (if (directo 0e90: 72 79 2d 65 78 69 73 74 73 3f 20 72 75 6e 64 69 ry-exists? rundi 0ea0: 72 29 0a 09 09 09 09 20 20 20 28 73 79 73 74 65 r)..... (syste 0eb0: 6d 20 28 63 6f 6e 63 20 22 63 64 20 22 20 72 75 m (conc "cd " ru 0ec0: 6e 64 69 72 20 22 3b 78 74 65 72 6d 20 2d 54 20 ndir ";xterm -T 0ed0: 22 20 28 73 74 72 69 6e 67 2d 74 72 61 6e 73 6c " (string-transl 0ee0: 61 74 65 20 74 65 73 74 66 75 6c 6c 6e 61 6d 65 ate testfullname 0ef0: 20 22 28 29 22 20 22 20 20 22 29 20 22 26 22 29 "()" " ") "&") 0f00: 29 0a 09 09 09 09 20 20 20 28 6d 65 73 73 61 67 )..... (messag 0f10: 65 2d 77 69 6e 64 6f 77 20 20 28 63 6f 6e 63 20 e-window (conc 0f20: 22 44 69 72 65 63 74 6f 72 79 20 22 20 72 75 6e "Directory " run 0f30: 64 69 72 20 22 20 6e 6f 74 20 66 6f 75 6e 64 22 dir " not found" 0f40: 29 29 29 29 29 0a 09 20 20 20 20 20 20 20 28 6e ))))).. (n 0f50: 65 77 73 74 61 74 75 73 20 20 20 20 63 75 72 72 ewstatus curr 0f60: 73 74 61 74 75 73 29 0a 09 20 20 20 20 20 20 20 status).. 0f70: 28 6e 65 77 73 74 61 74 65 20 20 20 20 20 63 75 (newstate cu 0f80: 72 72 73 74 61 74 65 29 0a 09 20 20 20 20 20 20 rrstate).. 0f90: 20 28 73 65 6c 66 20 20 20 20 20 20 20 20 20 23 (self # 0fa0: 66 29 29 0a 09 20 20 0a 09 20 20 3b 3b 20 20 28 f)).. .. ;; ( 0fb0: 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 test-set-status! 0fc0: 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 2d db run-id test- 0fd0: 6e 61 6d 65 20 73 74 61 74 65 20 73 74 61 74 75 name state statu 0fe0: 73 20 69 74 65 6d 64 61 74 29 0a 09 20 20 28 73 s itemdat).. (s 0ff0: 65 74 21 20 73 65 6c 66 20 0a 09 09 28 69 75 70 et! self ...(iup 1000: 3a 64 69 61 6c 6f 67 0a 09 09 20 28 69 75 70 3a :dialog... (iup: 1010: 76 62 6f 78 0a 09 09 20 20 28 69 75 70 3a 68 62 vbox... (iup:hb 1020: 6f 78 20 0a 09 09 20 20 20 28 69 75 70 3a 66 72 ox ... (iup:fr 1030: 61 6d 65 20 28 69 75 70 3a 6c 61 62 65 6c 20 72 ame (iup:label r 1040: 75 6e 2d 6b 65 79 29 29 0a 09 09 20 20 20 28 69 un-key))... (i 1050: 75 70 3a 66 72 61 6d 65 20 28 69 75 70 3a 6c 61 up:frame (iup:la 1060: 62 65 6c 20 28 63 6f 6e 63 20 22 54 45 53 54 4e bel (conc "TESTN 1070: 41 4d 45 3a 5c 6e 22 20 74 65 73 74 66 75 6c 6c AME:\n" testfull 1080: 6e 61 6d 65 29 20 23 3a 65 78 70 61 6e 64 20 22 name) #:expand " 1090: 59 45 53 22 29 29 29 0a 09 09 20 20 28 69 75 70 YES")))... (iup 10a0: 3a 66 72 61 6d 65 20 23 3a 74 69 74 6c 65 20 22 :frame #:title " 10b0: 41 63 74 69 6f 6e 73 22 20 23 3a 65 78 70 61 6e Actions" #:expan 10c0: 64 20 22 59 45 53 22 0a 09 09 09 20 20 20 20 20 d "YES".... 10d0: 28 69 75 70 3a 68 62 6f 78 20 3b 3b 20 74 68 65 (iup:hbox ;; the 10e0: 20 61 63 74 69 6f 6e 73 20 62 6f 78 0a 09 09 09 actions box.... 10f0: 20 20 20 20 20 20 28 69 75 70 3a 62 75 74 74 6f (iup:butto 1100: 6e 20 22 56 69 65 77 20 4c 6f 67 22 20 20 20 20 n "View Log" 1110: 23 3a 61 63 74 69 6f 6e 20 76 69 65 77 6c 6f 67 #:action viewlog 1120: 20 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53 22 #:expand "YES" 1130: 29 0a 09 09 09 20 20 20 20 20 20 28 69 75 70 3a ).... (iup: 1140: 62 75 74 74 6f 6e 20 22 53 74 61 72 74 20 58 74 button "Start Xt 1150: 65 72 6d 22 20 23 3a 61 63 74 69 6f 6e 20 78 74 erm" #:action xt 1160: 65 72 6d 20 20 23 3a 65 78 70 61 6e 64 20 22 59 erm #:expand "Y 1170: 45 53 22 29 29 29 0a 09 09 20 20 28 69 75 70 3a ES")))... (iup: 1180: 66 72 61 6d 65 20 23 3a 74 69 74 6c 65 20 22 53 frame #:title "S 1190: 65 74 20 66 69 65 6c 64 73 22 0a 09 09 09 20 20 et fields".... 11a0: 20 20 20 28 69 75 70 3a 76 62 6f 78 0a 09 09 09 (iup:vbox.... 11b0: 20 20 20 20 20 20 28 69 75 70 3a 68 62 6f 78 20 (iup:hbox 11c0: 0a 09 09 09 20 20 20 20 20 20 20 28 69 75 70 3a .... (iup: 11d0: 76 62 6f 78 20 3b 3b 20 74 68 65 20 73 74 61 74 vbox ;; the stat 11e0: 65 0a 09 09 09 09 28 69 75 70 3a 6c 61 62 65 6c e.....(iup:label 11f0: 20 22 53 54 41 54 45 3a 22 20 23 3a 73 69 7a 65 "STATE:" #:size 1200: 20 22 33 30 78 22 29 0a 09 09 09 09 28 6c 65 74 "30x").....(let 1210: 20 28 28 6c 62 20 28 69 75 70 3a 6c 69 73 74 62 ((lb (iup:listb 1220: 6f 78 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d ox #:action (lam 1230: 62 64 61 20 28 76 61 6c 20 61 20 62 20 63 29 0a bda (val a b c). 1240: 09 09 09 09 09 09 09 09 20 20 3b 3b 20 28 70 72 ........ ;; (pr 1250: 69 6e 74 20 76 61 6c 20 22 20 61 3a 20 22 20 61 int val " a: " a 1260: 20 22 20 62 3a 20 22 20 62 20 22 20 63 3a 20 22 " b: " b " c: " 1270: 20 63 29 0a 09 09 09 09 09 09 09 09 20 20 28 73 c)......... (s 1280: 65 74 21 20 6e 65 77 73 74 61 74 65 20 61 29 29 et! newstate a)) 1290: 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 23 3a ....... #: 12a0: 65 64 69 74 62 6f 78 20 22 59 45 53 22 0a 09 09 editbox "YES"... 12b0: 09 09 09 09 20 20 20 20 20 20 20 23 3a 65 78 70 .... #:exp 12c0: 61 6e 64 20 22 59 45 53 22 29 29 29 0a 09 09 09 and "YES"))).... 12d0: 09 20 20 28 69 75 70 6c 69 73 74 62 6f 78 2d 66 . (iuplistbox-f 12e0: 69 6c 6c 2d 6c 69 73 74 20 6c 62 0a 09 09 09 09 ill-list lb..... 12f0: 09 09 09 28 6c 69 73 74 20 22 43 4f 4d 50 4c 45 ...(list "COMPLE 1300: 54 45 44 22 20 22 4e 4f 54 5f 53 54 41 52 54 45 TED" "NOT_STARTE 1310: 44 22 20 22 52 55 4e 4e 49 4e 47 22 20 22 52 45 D" "RUNNING" "RE 1320: 4d 4f 54 45 48 4f 53 54 53 54 41 52 54 22 20 22 MOTEHOSTSTART" " 1330: 4b 49 4c 4c 45 44 22 20 22 4b 49 4c 4c 52 45 51 KILLED" "KILLREQ 1340: 22 20 22 43 48 45 43 4b 22 29 0a 09 09 09 09 09 " "CHECK")...... 1350: 09 09 63 75 72 72 73 74 61 74 65 29 0a 09 09 09 ..currstate).... 1360: 09 20 20 6c 62 29 29 0a 09 09 09 20 20 20 20 20 . lb)).... 1370: 20 20 28 69 75 70 3a 76 62 6f 78 20 3b 3b 20 74 (iup:vbox ;; t 1380: 68 65 20 73 74 61 74 75 73 0a 09 09 09 09 28 69 he status.....(i 1390: 75 70 3a 6c 61 62 65 6c 20 22 53 54 41 54 55 53 up:label "STATUS 13a0: 3a 22 20 23 3a 73 69 7a 65 20 22 33 30 78 22 29 :" #:size "30x") 13b0: 0a 09 09 09 09 28 6c 65 74 20 28 28 6c 62 20 28 .....(let ((lb ( 13c0: 69 75 70 3a 6c 69 73 74 62 6f 78 20 23 3a 61 63 iup:listbox #:ac 13d0: 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 76 61 tion (lambda (va 13e0: 6c 20 61 20 62 20 63 29 0a 09 09 09 09 09 09 09 l a b c)........ 13f0: 09 20 20 28 73 65 74 21 20 6e 65 77 73 74 61 74 . (set! newstat 1400: 75 73 20 61 29 29 0a 09 09 09 09 09 09 20 20 20 us a))....... 1410: 20 20 20 20 23 3a 65 64 69 74 62 6f 78 20 22 59 #:editbox "Y 1420: 45 53 22 0a 09 09 09 09 09 09 20 20 20 20 20 20 ES"....... 1430: 20 23 3a 76 61 6c 75 65 20 63 75 72 72 73 74 61 #:value currsta 1440: 74 75 73 0a 09 09 09 09 09 09 20 20 20 20 20 20 tus....... 1450: 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53 22 29 #:expand "YES") 1460: 29 29 0a 09 09 09 09 20 20 28 69 75 70 6c 69 73 ))..... (iuplis 1470: 74 62 6f 78 2d 66 69 6c 6c 2d 6c 69 73 74 20 6c tbox-fill-list l 1480: 62 0a 09 09 09 09 09 09 09 28 6c 69 73 74 20 22 b........(list " 1490: 50 41 53 53 22 20 22 46 41 49 4c 22 20 22 6e 2f PASS" "FAIL" "n/ 14a0: 61 22 29 0a 09 09 09 09 09 09 09 63 75 72 72 73 a")........currs 14b0: 74 61 74 75 73 29 0a 09 09 09 09 20 20 6c 62 29 tatus)..... lb) 14c0: 29 29 0a 09 09 09 20 20 20 20 20 20 28 69 75 70 )).... (iup 14d0: 3a 68 62 6f 78 20 28 69 75 70 3a 6c 61 62 65 6c :hbox (iup:label 14e0: 20 22 43 6f 6d 6d 65 6e 74 3a 22 29 0a 09 09 09 "Comment:").... 14f0: 09 09 28 69 75 70 3a 74 65 78 74 62 6f 78 20 23 ..(iup:textbox # 1500: 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 :action (lambda 1510: 28 76 61 6c 20 61 20 62 29 0a 09 09 09 09 09 09 (val a b)....... 1520: 09 09 28 73 65 74 21 20 63 75 72 72 63 6f 6d 6d ..(set! currcomm 1530: 65 6e 74 20 62 29 29 0a 09 09 09 09 09 09 20 20 ent b))....... 1540: 20 20 20 23 3a 76 61 6c 75 65 20 63 75 72 72 63 #:value currc 1550: 6f 6d 6d 65 6e 74 20 0a 09 09 09 09 09 09 20 20 omment ....... 1560: 20 20 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53 #:expand "YES 1570: 22 29 29 0a 09 09 09 20 20 20 20 20 20 28 69 75 ")).... (iu 1580: 70 3a 62 75 74 74 6f 6e 20 22 41 70 70 6c 79 22 p:button "Apply" 1590: 0a 09 09 09 09 09 20 20 23 3a 65 78 70 61 6e 64 ...... #:expand 15a0: 20 22 59 45 53 22 0a 09 09 09 09 09 20 20 23 3a "YES"...... #: 15b0: 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 action (lambda ( 15c0: 78 29 0a 09 09 09 09 09 09 20 20 20 20 20 28 74 x)....... (t 15d0: 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 est-set-status! 15e0: 2a 64 62 2a 20 72 75 6e 2d 69 64 20 74 65 73 74 *db* run-id test 15f0: 6e 61 6d 65 20 6e 65 77 73 74 61 74 65 20 6e 65 name newstate ne 1600: 77 73 74 61 74 75 73 20 69 74 65 6d 70 61 74 68 wstatus itempath 1610: 20 63 75 72 72 63 6f 6d 6d 65 6e 74 29 29 29 0a currcomment))). 1620: 09 09 09 20 20 20 20 20 20 28 69 75 70 3a 68 62 ... (iup:hb 1630: 6f 78 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 ox (iup:button " 1640: 41 70 70 6c 79 20 61 6e 64 20 63 6c 6f 73 65 22 Apply and close" 1650: 0a 09 09 09 09 09 09 20 20 20 20 23 3a 65 78 70 ....... #:exp 1660: 61 6e 64 20 22 59 45 53 22 0a 09 09 09 09 09 09 and "YES"....... 1670: 20 20 20 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 #:action (la 1680: 6d 62 64 61 20 28 78 29 0a 09 09 09 09 09 09 09 mbda (x)........ 1690: 20 20 20 20 20 20 20 28 74 65 73 74 2d 73 65 74 (test-set 16a0: 2d 73 74 61 74 75 73 21 20 2a 64 62 2a 20 72 75 -status! *db* ru 16b0: 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 20 6e 65 n-id testname ne 16c0: 77 73 74 61 74 65 20 6e 65 77 73 74 61 74 75 73 wstate newstatus 16d0: 20 69 74 65 6d 70 61 74 68 20 63 75 72 72 63 6f itempath currco 16e0: 6d 6d 65 6e 74 29 0a 09 09 09 09 09 09 09 20 20 mment)........ 16f0: 20 20 20 20 20 28 69 75 70 3a 64 65 73 74 72 6f (iup:destro 1700: 79 21 20 73 65 6c 66 29 29 29 0a 09 09 09 09 09 y! self)))...... 1710: 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 43 61 6e (iup:button "Can 1720: 63 65 6c 20 61 6e 64 20 63 6c 6f 73 65 22 0a 09 cel and close".. 1730: 09 09 09 09 09 20 20 20 20 23 3a 65 78 70 61 6e ..... #:expan 1740: 64 20 22 59 45 53 22 0a 09 09 09 09 09 09 20 20 d "YES"....... 1750: 20 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 #:action (lamb 1760: 64 61 20 28 78 29 0a 09 09 09 09 09 09 09 20 20 da (x)........ 1770: 20 20 20 20 20 28 69 75 70 3a 64 65 73 74 72 6f (iup:destro 1780: 79 21 20 73 65 6c 66 29 29 29 29 0a 09 09 09 20 y! self)))).... 1790: 20 20 20 20 20 29 29 29 29 29 0a 09 20 20 28 69 ))))).. (i 17a0: 75 70 3a 73 68 6f 77 20 73 65 6c 66 29 0a 09 20 up:show self).. 17b0: 20 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 ))))..(define ( 17c0: 63 6f 6c 6f 72 73 2d 73 69 6d 69 6c 61 72 3f 20 colors-similar? 17d0: 63 6f 6c 6f 72 31 20 63 6f 6c 6f 72 32 29 0a 20 color1 color2). 17e0: 20 28 6c 65 74 2a 20 28 28 63 31 20 28 6d 61 70 (let* ((c1 (map 17f0: 20 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 string->number 1800: 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 63 6f (string-split co 1810: 6c 6f 72 31 29 29 29 0a 09 20 28 63 32 20 28 6d lor1))).. (c2 (m 1820: 61 70 20 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 ap string->numbe 1830: 72 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 r (string-split 1840: 63 6f 6c 6f 72 32 29 29 29 0a 09 20 28 64 65 6c color2))).. (del 1850: 74 61 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 ta (map (lambda 1860: 28 61 20 62 29 28 61 62 73 20 28 2d 20 61 20 62 (a b)(abs (- a b 1870: 29 29 29 20 63 31 20 63 32 29 29 29 0a 20 20 20 ))) c1 c2))). 1880: 20 28 6e 75 6c 6c 3f 20 28 66 69 6c 74 65 72 20 (null? (filter 1890: 28 6c 61 6d 62 64 61 20 28 78 29 28 3e 20 78 20 (lambda (x)(> x 18a0: 33 29 29 20 64 65 6c 74 61 29 29 29 29 0a 0a 28 3)) delta))))..( 18b0: 64 65 66 69 6e 65 20 28 75 70 64 61 74 65 2d 72 define (update-r 18c0: 75 6e 64 61 74 20 70 61 74 74 20 6e 75 6d 72 75 undat patt numru 18d0: 6e 73 29 0a 20 20 28 6c 65 74 2a 20 28 28 61 6c ns). (let* ((al 18e0: 6c 72 75 6e 73 20 20 20 20 20 28 64 62 2d 67 65 lruns (db-ge 18f0: 74 2d 72 75 6e 73 20 2a 64 62 2a 20 70 61 74 74 t-runs *db* patt 1900: 20 6e 75 6d 72 75 6e 73 20 2a 73 74 61 72 74 2d numruns *start- 1910: 72 75 6e 2d 6f 66 66 73 65 74 2a 29 29 0a 09 20 run-offset*)).. 1920: 28 68 65 61 64 65 72 20 20 20 20 20 20 28 64 62 (header (db 1930: 3a 67 65 74 2d 68 65 61 64 65 72 20 61 6c 6c 72 :get-header allr 1940: 75 6e 73 29 29 0a 09 20 28 72 75 6e 73 20 20 20 uns)).. (runs 1950: 20 20 20 20 20 28 64 62 3a 67 65 74 2d 72 6f 77 (db:get-row 1960: 73 20 20 20 61 6c 6c 72 75 6e 73 29 29 0a 09 20 s allruns)).. 1970: 28 72 65 73 75 6c 74 20 20 20 20 20 20 27 28 29 (result '() 1980: 29 0a 09 20 28 6d 61 78 74 65 73 74 73 20 20 20 ).. (maxtests 1990: 20 30 29 29 0a 20 20 20 20 28 66 6f 72 2d 65 61 0)). (for-ea 19a0: 63 68 20 28 6c 61 6d 62 64 61 20 28 72 75 6e 29 ch (lambda (run) 19b0: 0a 09 09 28 6c 65 74 2a 20 28 28 72 75 6e 2d 69 ...(let* ((run-i 19c0: 64 20 20 20 28 64 62 2d 67 65 74 2d 76 61 6c 75 d (db-get-valu 19d0: 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 6e 20 e-by-header run 19e0: 68 65 61 64 65 72 20 22 69 64 22 29 29 0a 09 09 header "id"))... 19f0: 20 20 20 20 20 20 20 28 74 65 73 74 73 20 20 20 (tests 1a00: 20 28 64 62 2d 67 65 74 2d 74 65 73 74 73 2d 66 (db-get-tests-f 1a10: 6f 72 2d 72 75 6e 20 2a 64 62 2a 20 72 75 6e 2d or-run *db* run- 1a20: 69 64 29 29 0a 09 09 20 20 20 20 20 20 20 28 6b id))... (k 1a30: 65 79 2d 76 61 6c 73 20 28 67 65 74 2d 6b 65 79 ey-vals (get-key 1a40: 2d 76 61 6c 73 20 2a 64 62 2a 20 72 75 6e 2d 69 -vals *db* run-i 1a50: 64 29 29 29 0a 09 09 20 20 28 69 66 20 28 3e 20 d)))... (if (> 1a60: 28 6c 65 6e 67 74 68 20 74 65 73 74 73 29 20 6d (length tests) m 1a70: 61 78 74 65 73 74 73 29 0a 09 09 20 20 20 20 20 axtests)... 1a80: 20 28 73 65 74 21 20 6d 61 78 74 65 73 74 73 20 (set! maxtests 1a90: 28 6c 65 6e 67 74 68 20 74 65 73 74 73 29 29 29 (length tests))) 1aa0: 0a 09 09 20 20 28 73 65 74 21 20 72 65 73 75 6c ... (set! resul 1ab0: 74 20 28 63 6f 6e 73 20 28 76 65 63 74 6f 72 20 t (cons (vector 1ac0: 72 75 6e 20 74 65 73 74 73 20 6b 65 79 2d 76 61 run tests key-va 1ad0: 6c 73 29 20 72 65 73 75 6c 74 29 29 29 29 0a 09 ls) result)))).. 1ae0: 20 20 20 20 20 20 72 75 6e 73 29 0a 20 20 20 20 runs). 1af0: 28 73 65 74 21 20 2a 68 65 61 64 65 72 2a 20 20 (set! *header* 1b00: 68 65 61 64 65 72 29 0a 20 20 20 20 28 73 65 74 header). (set 1b10: 21 20 2a 61 6c 6c 72 75 6e 73 2a 20 28 72 65 76 ! *allruns* (rev 1b20: 65 72 73 65 20 72 65 73 75 6c 74 29 29 0a 20 20 erse result)). 1b30: 20 20 6d 61 78 74 65 73 74 73 29 29 0a 0a 28 64 maxtests))..(d 1b40: 65 66 69 6e 65 20 28 75 70 64 61 74 65 2d 6c 61 efine (update-la 1b50: 62 65 6c 73 20 75 69 64 61 74 29 0a 20 20 28 6c bels uidat). (l 1b60: 65 74 2a 20 28 28 72 6f 77 6e 20 20 20 20 30 29 et* ((rown 0) 1b70: 0a 09 20 28 6c 66 74 63 6f 6c 20 28 76 65 63 74 .. (lftcol (vect 1b80: 6f 72 2d 72 65 66 20 75 69 64 61 74 20 30 29 29 or-ref uidat 0)) 1b90: 0a 09 20 28 6d 61 78 6e 20 20 20 28 2d 20 28 76 .. (maxn (- (v 1ba0: 65 63 74 6f 72 2d 6c 65 6e 67 74 68 20 6c 66 74 ector-length lft 1bb0: 63 6f 6c 29 20 31 29 29 29 0a 20 20 20 20 28 6c col) 1))). (l 1bc0: 65 74 20 6c 6f 6f 70 20 28 28 69 20 30 29 29 0a et loop ((i 0)). 1bd0: 20 20 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 (iup:attri 1be0: 62 75 74 65 2d 73 65 74 21 20 28 76 65 63 74 6f bute-set! (vecto 1bf0: 72 2d 72 65 66 20 6c 66 74 63 6f 6c 20 69 29 20 r-ref lftcol i) 1c00: 22 54 49 54 4c 45 22 20 22 22 29 0a 20 20 20 20 "TITLE" ""). 1c10: 20 20 28 69 66 20 28 3c 3d 20 69 20 72 6f 77 6e (if (<= i rown 1c20: 29 0a 09 20 20 28 6c 6f 6f 70 20 28 2b 20 69 20 ).. (loop (+ i 1c30: 31 29 29 29 29 0a 20 20 20 20 28 66 6f 72 2d 65 1)))). (for-e 1c40: 61 63 68 20 28 6c 61 6d 62 64 61 20 28 6e 61 6d ach (lambda (nam 1c50: 65 29 0a 09 09 28 69 66 20 28 3c 3d 20 72 6f 77 e)...(if (<= row 1c60: 6e 20 6d 61 78 6e 29 0a 09 09 20 20 20 20 28 6c n maxn)... (l 1c70: 65 74 20 28 28 6c 61 62 6c 20 28 76 65 63 74 6f et ((labl (vecto 1c80: 72 2d 72 65 66 20 6c 66 74 63 6f 6c 20 72 6f 77 r-ref lftcol row 1c90: 6e 29 29 29 0a 09 09 20 20 20 20 20 20 28 69 75 n)))... (iu 1ca0: 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 p:attribute-set! 1cb0: 20 6c 61 62 6c 20 22 54 49 54 4c 45 22 20 6e 61 labl "TITLE" na 1cc0: 6d 65 29 29 29 0a 09 09 28 73 65 74 21 20 72 6f me)))...(set! ro 1cd0: 77 6e 20 28 2b 20 31 20 72 6f 77 6e 29 29 29 0a wn (+ 1 rown))). 1ce0: 09 20 20 20 20 20 20 28 64 72 6f 70 20 2a 61 6c . (drop *al 1cf0: 6c 74 65 73 74 6e 61 6d 65 6c 73 74 2a 20 2a 73 ltestnamelst* *s 1d00: 74 61 72 74 2d 74 65 73 74 2d 6f 66 66 73 65 74 tart-test-offset 1d10: 2a 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 *))))..(define ( 1d20: 75 70 64 61 74 65 2d 62 75 74 74 6f 6e 73 20 75 update-buttons u 1d30: 69 64 61 74 20 6e 75 6d 72 75 6e 73 20 6e 75 6d idat numruns num 1d40: 74 65 73 74 73 29 0a 20 20 28 6c 65 74 2a 20 28 tests). (let* ( 1d50: 28 72 75 6e 73 20 20 20 20 20 20 20 20 28 69 66 (runs (if 1d60: 20 28 3e 20 28 6c 65 6e 67 74 68 20 2a 61 6c 6c (> (length *all 1d70: 72 75 6e 73 2a 29 20 6e 75 6d 72 75 6e 73 29 0a runs*) numruns). 1d80: 09 09 09 20 20 28 74 61 6b 65 2d 72 69 67 68 74 ... (take-right 1d90: 20 2a 61 6c 6c 72 75 6e 73 2a 20 6e 75 6d 72 75 *allruns* numru 1da0: 6e 73 29 0a 09 09 09 20 20 28 70 61 64 2d 6c 69 ns).... (pad-li 1db0: 73 74 20 2a 61 6c 6c 72 75 6e 73 2a 20 6e 75 6d st *allruns* num 1dc0: 72 75 6e 73 29 29 29 0a 09 20 28 6c 66 74 63 6f runs))).. (lftco 1dd0: 6c 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d 72 l (vector-r 1de0: 65 66 20 75 69 64 61 74 20 30 29 29 0a 09 20 28 ef uidat 0)).. ( 1df0: 74 61 62 6c 65 68 65 61 64 65 72 20 28 76 65 63 tableheader (vec 1e00: 74 6f 72 2d 72 65 66 20 75 69 64 61 74 20 31 29 tor-ref uidat 1) 1e10: 29 0a 09 20 28 74 61 62 6c 65 20 20 20 20 20 20 ).. (table 1e20: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 75 69 64 (vector-ref uid 1e30: 61 74 20 32 29 29 0a 09 20 28 63 6f 6c 6e 20 20 at 2)).. (coln 1e40: 20 20 20 20 20 20 30 29 29 0a 20 20 20 20 28 75 0)). (u 1e50: 70 64 61 74 65 2d 6c 61 62 65 6c 73 20 75 69 64 pdate-labels uid 1e60: 61 74 29 0a 20 20 20 20 28 66 6f 72 2d 65 61 63 at). (for-eac 1e70: 68 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 h. (lambda ( 1e80: 72 75 6e 64 61 74 29 0a 20 20 20 20 20 20 20 28 rundat). ( 1e90: 69 66 20 28 6e 6f 74 20 72 75 6e 64 61 74 29 20 if (not rundat) 1ea0: 3b 3b 20 68 61 6e 64 6c 65 20 70 61 64 64 65 64 ;; handle padded 1eb0: 20 72 75 6e 73 0a 09 20 20 20 3b 3b 20 20 20 20 runs.. ;; 1ec0: 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 69 ;; i 1ed0: 64 20 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d d run-id testnam 1ee0: 65 20 73 74 61 74 65 20 73 74 61 74 75 73 20 65 e state status e 1ef0: 76 65 6e 74 2d 74 69 6d 65 20 68 6f 73 74 20 63 vent-time host c 1f00: 70 75 6c 6f 61 64 20 64 69 73 6b 66 72 65 65 20 puload diskfree 1f10: 75 6e 61 6d 65 20 72 75 6e 64 69 72 20 69 74 65 uname rundir ite 1f20: 6d 2d 70 61 74 68 20 72 75 6e 2d 64 75 72 61 74 m-path run-durat 1f30: 69 6f 6e 0a 09 20 20 20 28 73 65 74 21 20 72 75 ion.. (set! ru 1f40: 6e 64 61 74 20 28 76 65 63 74 6f 72 20 28 6d 61 ndat (vector (ma 1f50: 6b 65 2d 76 65 63 74 6f 72 20 32 30 20 23 66 29 ke-vector 20 #f) 1f60: 20 27 28 29 20 28 6d 61 70 20 28 6c 61 6d 62 64 '() (map (lambd 1f70: 61 20 28 78 29 20 22 22 29 20 2a 6b 65 79 73 2a a (x) "") *keys* 1f80: 29 29 29 29 3b 3b 20 33 29 29 29 0a 20 20 20 20 ))));; 3))). 1f90: 20 20 20 28 6c 65 74 2a 20 28 28 72 75 6e 20 20 (let* ((run 1fa0: 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 (vector-ref 1fb0: 72 75 6e 64 61 74 20 30 29 29 0a 09 20 20 20 20 rundat 0)).. 1fc0: 20 20 28 74 65 73 74 73 64 61 74 20 28 76 65 63 (testsdat (vec 1fd0: 74 6f 72 2d 72 65 66 20 72 75 6e 64 61 74 20 31 tor-ref rundat 1 1fe0: 29 29 0a 09 20 20 20 20 20 20 28 6b 65 79 2d 76 )).. (key-v 1ff0: 61 6c 2d 64 61 74 20 28 76 65 63 74 6f 72 2d 72 al-dat (vector-r 2000: 65 66 20 72 75 6e 64 61 74 20 32 29 29 0a 09 20 ef rundat 2)).. 2010: 20 20 20 20 20 28 72 75 6e 2d 69 64 20 20 20 28 (run-id ( 2020: 64 62 2d 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d db-get-value-by- 2030: 68 65 61 64 65 72 20 72 75 6e 20 2a 68 65 61 64 header run *head 2040: 65 72 2a 20 22 69 64 22 29 29 0a 09 20 20 20 20 er* "id")).. 2050: 20 20 28 74 65 73 74 6e 61 6d 65 73 20 28 64 65 (testnames (de 2060: 6c 65 74 65 2d 64 75 70 6c 69 63 61 74 65 73 20 lete-duplicates 2070: 28 61 70 70 65 6e 64 20 2a 61 6c 6c 74 65 73 74 (append *alltest 2080: 6e 61 6d 65 6c 73 74 2a 20 0a 09 09 09 09 09 09 namelst* ....... 2090: 20 20 20 20 28 6d 61 70 20 74 65 73 74 3a 74 65 (map test:te 20a0: 73 74 2d 67 65 74 2d 66 75 6c 6c 6e 61 6d 65 20 st-get-fullname 20b0: 74 65 73 74 73 64 61 74 29 29 29 29 20 3b 3b 20 testsdat)))) ;; 20c0: 28 74 61 6b 65 20 28 70 61 64 2d 6c 69 73 74 20 (take (pad-list 20d0: 74 65 73 74 73 64 61 74 20 6e 75 6d 74 65 73 74 testsdat numtest 20e0: 73 29 20 6e 75 6d 74 65 73 74 73 29 29 0a 09 20 s) numtests)).. 20f0: 20 20 20 20 20 28 6b 65 79 2d 76 61 6c 73 20 28 (key-vals ( 2100: 61 70 70 65 6e 64 20 6b 65 79 2d 76 61 6c 2d 64 append key-val-d 2110: 61 74 0a 09 09 09 09 28 6c 69 73 74 20 28 6c 65 at.....(list (le 2120: 74 20 28 28 78 20 28 64 62 2d 67 65 74 2d 76 61 t ((x (db-get-va 2130: 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 lue-by-header ru 2140: 6e 20 2a 68 65 61 64 65 72 2a 20 22 72 75 6e 6e n *header* "runn 2150: 61 6d 65 22 29 29 29 0a 09 09 09 09 09 28 69 66 ame")))......(if 2160: 20 78 20 78 20 22 22 29 29 29 29 29 0a 09 20 20 x x ""))))).. 2170: 20 20 20 20 28 72 75 6e 2d 6b 65 79 20 20 28 73 (run-key (s 2180: 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 tring-interspers 2190: 65 20 6b 65 79 2d 76 61 6c 73 20 22 5c 6e 22 29 e key-vals "\n") 21a0: 29 29 0a 09 20 3b 3b 20 28 72 75 6e 2d 68 74 20 )).. ;; (run-ht 21b0: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref 21c0: 2f 64 65 66 61 75 6c 74 20 61 6c 6c 64 61 74 20 /default alldat 21d0: 72 75 6e 2d 6b 65 79 20 23 66 29 29 29 0a 09 20 run-key #f))).. 21e0: 3b 3b 20 66 69 6c 6c 20 69 6e 20 74 68 65 20 72 ;; fill in the r 21f0: 75 6e 20 68 65 61 64 65 72 20 6b 65 79 20 76 61 un header key va 2200: 6c 75 65 73 0a 09 20 28 6c 65 74 20 28 28 72 6f lues.. (let ((ro 2210: 77 6e 20 20 20 20 20 20 30 29 0a 09 20 20 20 20 wn 0).. 2220: 20 20 20 28 68 65 61 64 65 72 63 6f 6c 20 28 76 (headercol (v 2230: 65 63 74 6f 72 2d 72 65 66 20 74 61 62 6c 65 68 ector-ref tableh 2240: 65 61 64 65 72 20 63 6f 6c 6e 29 29 29 0a 09 20 eader coln))).. 2250: 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d (for-each (lam 2260: 62 64 61 20 28 6b 76 61 6c 29 0a 09 09 20 20 20 bda (kval)... 2270: 20 20 20 20 28 6c 65 74 2a 20 28 28 6c 61 62 6c (let* ((labl 2280: 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 (vector-re 2290: 66 20 68 65 61 64 65 72 63 6f 6c 20 72 6f 77 6e f headercol rown 22a0: 29 29 29 0a 09 09 09 20 28 69 66 20 28 6e 6f 74 ))).... (if (not 22b0: 20 28 65 71 75 61 6c 3f 20 6b 76 61 6c 20 28 69 (equal? kval (i 22c0: 75 70 3a 61 74 74 72 69 62 75 74 65 20 6c 61 62 up:attribute lab 22d0: 6c 20 22 54 49 54 4c 45 22 29 29 29 0a 09 09 09 l "TITLE"))).... 22e0: 20 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 (iup:attrib 22f0: 75 74 65 2d 73 65 74 21 20 28 76 65 63 74 6f 72 ute-set! (vector 2300: 2d 72 65 66 20 68 65 61 64 65 72 63 6f 6c 20 72 -ref headercol r 2310: 6f 77 6e 29 20 22 54 49 54 4c 45 22 20 6b 76 61 own) "TITLE" kva 2320: 6c 29 29 0a 09 09 09 20 28 73 65 74 21 20 72 6f l)).... (set! ro 2330: 77 6e 20 28 2b 20 72 6f 77 6e 20 31 29 29 29 29 wn (+ rown 1)))) 2340: 0a 09 09 20 20 20 20 20 6b 65 79 2d 76 61 6c 73 ... key-vals 2350: 29 29 0a 0a 09 20 3b 3b 20 46 6f 72 20 74 68 69 ))... ;; For thi 2360: 73 20 72 75 6e 20 6e 6f 77 20 66 69 6c 6c 20 69 s run now fill i 2370: 6e 20 74 68 65 20 62 75 74 74 6f 6e 73 20 66 6f n the buttons fo 2380: 72 20 65 61 63 68 20 74 65 73 74 0a 09 20 28 6c r each test.. (l 2390: 65 74 20 28 28 72 6f 77 6e 20 30 29 0a 09 20 20 et ((rown 0).. 23a0: 20 20 20 20 20 28 63 6f 6c 75 6d 6e 64 61 74 20 (columndat 23b0: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 74 61 62 (vector-ref tab 23c0: 6c 65 20 63 6f 6c 6e 29 29 29 0a 09 20 20 20 28 le coln))).. ( 23d0: 66 6f 72 2d 65 61 63 68 0a 09 20 20 20 20 28 6c for-each.. (l 23e0: 61 6d 62 64 61 20 28 74 65 73 74 6e 61 6d 65 29 ambda (testname) 23f0: 0a 09 20 20 20 20 20 20 28 6c 65 74 20 28 28 62 .. (let ((b 2400: 75 74 74 6f 6e 64 61 74 20 20 28 68 61 73 68 2d uttondat (hash- 2410: 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c table-ref/defaul 2420: 74 20 2a 62 75 74 74 6f 6e 64 61 74 2a 20 28 6d t *buttondat* (m 2430: 6b 73 74 72 20 63 6f 6c 6e 20 72 6f 77 6e 29 20 kstr coln rown) 2440: 23 66 29 29 29 0a 09 09 28 69 66 20 62 75 74 74 #f)))...(if butt 2450: 6f 6e 64 61 74 0a 09 09 20 20 20 20 28 6c 65 74 ondat... (let 2460: 2a 20 28 28 74 65 73 74 20 20 20 20 20 20 20 28 * ((test ( 2470: 6c 65 74 20 28 28 6d 61 74 63 68 69 6e 67 20 28 let ((matching ( 2480: 66 69 6c 74 65 72 20 0a 09 09 09 09 09 09 09 28 filter ........( 2490: 6c 61 6d 62 64 61 20 28 78 29 28 65 71 75 61 6c lambda (x)(equal 24a0: 3f 20 28 74 65 73 74 3a 74 65 73 74 2d 67 65 74 ? (test:test-get 24b0: 2d 66 75 6c 6c 6e 61 6d 65 20 78 29 20 74 65 73 -fullname x) tes 24c0: 74 6e 61 6d 65 29 29 0a 09 09 09 09 09 09 09 74 tname))........t 24d0: 65 73 74 73 64 61 74 29 29 29 0a 09 09 09 09 09 estsdat)))...... 24e0: 20 28 69 66 20 28 6e 75 6c 6c 3f 20 6d 61 74 63 (if (null? matc 24f0: 68 69 6e 67 29 0a 09 09 09 09 09 20 20 20 20 20 hing)...... 2500: 28 76 65 63 74 6f 72 20 2d 31 20 2d 31 20 22 22 (vector -1 -1 "" 2510: 20 22 22 20 22 22 20 30 20 22 22 20 22 22 20 30 "" "" 0 "" "" 0 2520: 20 22 22 20 22 22 20 22 22 20 30 20 22 22 20 22 "" "" "" 0 "" " 2530: 22 29 0a 09 09 09 09 09 20 20 20 20 20 28 63 61 ")...... (ca 2540: 72 20 6d 61 74 63 68 69 6e 67 29 29 29 29 0a 09 r matching)))).. 2550: 09 09 20 20 20 3b 3b 20 28 74 65 73 74 20 20 20 .. ;; (test 2560: 20 20 20 20 28 69 66 20 72 65 61 6c 2d 74 65 73 (if real-tes 2570: 74 20 72 65 61 6c 2d 74 65 73 74 0a 09 09 09 20 t real-test.... 2580: 20 20 28 74 65 73 74 6e 61 6d 65 20 20 20 28 64 (testname (d 2590: 62 3a 74 65 73 74 2d 67 65 74 2d 74 65 73 74 6e b:test-get-testn 25a0: 61 6d 65 20 20 74 65 73 74 29 29 0a 09 09 09 20 ame test)).... 25b0: 20 20 28 69 74 65 6d 70 61 74 68 20 20 20 28 64 (itempath (d 25c0: 62 3a 74 65 73 74 2d 67 65 74 2d 69 74 65 6d 2d b:test-get-item- 25d0: 70 61 74 68 20 74 65 73 74 29 29 0a 09 09 09 20 path test)).... 25e0: 20 20 28 74 65 73 74 66 75 6c 6c 6e 61 6d 65 20 (testfullname 25f0: 28 74 65 73 74 3a 74 65 73 74 2d 67 65 74 2d 66 (test:test-get-f 2600: 75 6c 6c 6e 61 6d 65 20 74 65 73 74 29 29 0a 09 ullname test)).. 2610: 09 09 20 20 20 28 74 65 73 74 73 74 61 74 75 73 .. (teststatus 2620: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 (db:test-get-st 2630: 61 74 75 73 20 20 20 74 65 73 74 29 29 0a 09 09 atus test))... 2640: 09 20 20 20 28 74 65 73 74 73 74 61 74 65 20 20 . (teststate 2650: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 (db:test-get-sta 2660: 74 65 20 20 20 20 74 65 73 74 29 29 0a 09 09 09 te test)).... 2670: 20 20 20 28 74 65 73 74 73 74 61 72 74 20 20 28 (teststart ( 2680: 64 62 3a 74 65 73 74 2d 67 65 74 2d 65 76 65 6e db:test-get-even 2690: 74 5f 74 69 6d 65 20 74 65 73 74 29 29 0a 09 09 t_time test))... 26a0: 09 20 20 20 28 72 75 6e 74 69 6d 65 20 20 20 20 . (runtime 26b0: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e (db:test-get-run 26c0: 5f 64 75 72 61 74 69 6f 6e 20 74 65 73 74 29 29 _duration test)) 26d0: 0a 09 09 09 20 20 20 28 62 75 74 74 6f 6e 74 78 .... (buttontx 26e0: 74 20 20 28 69 66 20 28 65 71 75 61 6c 3f 20 74 t (if (equal? t 26f0: 65 73 74 73 74 61 74 65 20 22 43 4f 4d 50 4c 45 eststate "COMPLE 2700: 54 45 44 22 29 20 74 65 73 74 73 74 61 74 75 73 TED") teststatus 2710: 20 74 65 73 74 73 74 61 74 65 29 29 0a 09 09 09 teststate)).... 2720: 20 20 20 28 62 75 74 74 6f 6e 20 20 20 20 20 28 (button ( 2730: 76 65 63 74 6f 72 2d 72 65 66 20 63 6f 6c 75 6d vector-ref colum 2740: 6e 64 61 74 20 72 6f 77 6e 29 29 0a 09 09 09 20 ndat rown)).... 2750: 20 20 28 63 6f 6c 6f 72 20 20 20 20 20 20 28 63 (color (c 2760: 61 73 65 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d ase (string->sym 2770: 62 6f 6c 20 74 65 73 74 73 74 61 74 65 29 0a 09 bol teststate).. 2780: 09 09 09 09 20 28 28 43 4f 4d 50 4c 45 54 45 44 .... ((COMPLETED 2790: 29 0a 09 09 09 09 09 20 20 28 69 66 20 28 65 71 )...... (if (eq 27a0: 75 61 6c 3f 20 74 65 73 74 73 74 61 74 75 73 20 ual? teststatus 27b0: 22 50 41 53 53 22 29 20 22 37 30 20 32 34 39 20 "PASS") "70 249 27c0: 37 33 22 20 22 32 32 33 20 33 33 20 34 39 22 29 73" "223 33 49") 27d0: 29 20 3b 3b 20 67 72 65 65 6e 69 73 68 20 72 65 ) ;; greenish re 27e0: 64 69 73 68 0a 09 09 09 09 09 20 28 28 4c 41 55 dish...... ((LAU 27f0: 4e 43 48 45 44 29 20 20 20 20 20 20 20 20 20 22 NCHED) " 2800: 31 30 31 20 31 32 33 20 31 34 32 22 29 0a 09 09 101 123 142")... 2810: 09 09 09 20 28 28 43 48 45 43 4b 29 20 20 20 20 ... ((CHECK) 2820: 20 20 20 20 20 20 20 20 22 32 35 35 20 31 30 30 "255 100 2830: 20 35 30 22 29 0a 09 09 09 09 09 20 28 28 52 45 50")...... ((RE 2840: 4d 4f 54 45 48 4f 53 54 53 54 41 52 54 29 20 20 MOTEHOSTSTART) 2850: 22 35 30 20 31 33 30 20 31 39 35 22 29 0a 09 09 "50 130 195")... 2860: 09 09 09 20 28 28 52 55 4e 4e 49 4e 47 29 20 20 ... ((RUNNING) 2870: 20 20 20 20 20 20 20 20 22 39 20 31 33 31 20 32 "9 131 2 2880: 33 32 22 29 0a 09 09 09 09 09 20 28 28 4b 49 4c 32")...... ((KIL 2890: 4c 52 45 51 29 20 20 20 20 20 20 20 20 20 20 22 LREQ) " 28a0: 33 39 20 38 32 20 32 30 36 22 29 0a 09 09 09 09 39 82 206")..... 28b0: 09 20 28 28 4b 49 4c 4c 45 44 29 20 20 20 20 20 . ((KILLED) 28c0: 20 20 20 20 20 20 22 32 33 34 20 31 30 31 20 31 "234 101 1 28d0: 37 22 29 0a 09 09 09 09 09 20 28 65 6c 73 65 20 7")...... (else 28e0: 22 31 39 32 20 31 39 32 20 31 39 32 22 29 29 29 "192 192 192"))) 28f0: 0a 09 09 09 20 20 20 28 63 75 72 72 2d 63 6f 6c .... (curr-col 2900: 6f 72 20 28 76 65 63 74 6f 72 2d 72 65 66 20 62 or (vector-ref b 2910: 75 74 74 6f 6e 64 61 74 20 31 29 29 20 3b 3b 20 uttondat 1)) ;; 2920: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 20 62 (iup:attribute b 2930: 75 74 74 6f 6e 20 22 42 47 43 4f 4c 4f 52 22 29 utton "BGCOLOR") 2940: 29 0a 09 09 09 20 20 20 28 63 75 72 72 2d 74 69 ).... (curr-ti 2950: 74 6c 65 20 28 76 65 63 74 6f 72 2d 72 65 66 20 tle (vector-ref 2960: 62 75 74 74 6f 6e 64 61 74 20 32 29 29 29 20 3b buttondat 2))) ; 2970: 3b 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 ; (iup:attribute 2980: 20 62 75 74 74 6f 6e 20 22 54 49 54 4c 45 22 29 button "TITLE") 2990: 29 29 0a 09 09 3b 3b 20 20 20 20 20 20 20 28 69 ))...;; (i 29a0: 66 20 28 61 6e 64 20 28 65 71 75 61 6c 3f 20 74 f (and (equal? t 29b0: 65 73 74 73 74 61 74 65 20 22 52 55 4e 4e 49 4e eststate "RUNNIN 29c0: 47 22 29 0a 09 09 3b 3b 20 09 20 20 20 20 20 20 G")...;; . 29d0: 20 28 3e 20 28 2d 20 28 63 75 72 72 65 6e 74 2d (> (- (current- 29e0: 73 65 63 6f 6e 64 73 29 20 28 2b 20 74 65 73 74 seconds) (+ test 29f0: 73 74 61 72 74 20 72 75 6e 74 69 6d 65 29 29 20 start runtime)) 2a00: 31 30 30 29 29 20 3b 3b 20 69 66 20 74 65 73 74 100)) ;; if test 2a10: 20 68 61 73 20 62 65 65 6e 20 64 65 61 64 20 66 has been dead f 2a20: 6f 72 20 6d 6f 72 65 20 74 68 61 6e 20 31 30 30 or more than 100 2a30: 20 73 65 63 6f 6e 64 73 2c 20 63 61 6c 6c 20 69 seconds, call i 2a40: 74 20 64 65 61 64 0a 09 09 09 20 20 0a 09 09 20 t dead.... ... 2a50: 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 65 (if (not (e 2a60: 71 75 61 6c 3f 20 63 75 72 72 2d 63 6f 6c 6f 72 qual? curr-color 2a70: 20 63 6f 6c 6f 72 29 29 0a 09 09 09 20 20 28 69 color)).... (i 2a80: 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 up:attribute-set 2a90: 21 20 62 75 74 74 6f 6e 20 22 42 47 43 4f 4c 4f ! button "BGCOLO 2aa0: 52 22 20 63 6f 6c 6f 72 29 29 0a 09 09 20 20 20 R" color))... 2ab0: 20 20 20 28 69 66 20 28 6e 6f 74 20 28 65 71 75 (if (not (equ 2ac0: 61 6c 3f 20 63 75 72 72 2d 74 69 74 6c 65 20 62 al? curr-title b 2ad0: 75 74 74 6f 6e 74 78 74 29 29 0a 09 09 09 20 20 uttontxt)).... 2ae0: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 (iup:attribute-s 2af0: 65 74 21 20 62 75 74 74 6f 6e 20 22 54 49 54 4c et! button "TITL 2b00: 45 22 20 20 20 62 75 74 74 6f 6e 74 78 74 29 29 E" buttontxt)) 2b10: 0a 09 09 20 20 20 20 20 20 28 76 65 63 74 6f 72 ... (vector 2b20: 2d 73 65 74 21 20 62 75 74 74 6f 6e 64 61 74 20 -set! buttondat 2b30: 30 20 72 75 6e 2d 69 64 29 0a 09 09 20 20 20 20 0 run-id)... 2b40: 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 62 (vector-set! b 2b50: 75 74 74 6f 6e 64 61 74 20 31 20 63 6f 6c 6f 72 uttondat 1 color 2b60: 29 0a 09 09 20 20 20 20 20 20 28 76 65 63 74 6f )... (vecto 2b70: 72 2d 73 65 74 21 20 62 75 74 74 6f 6e 64 61 74 r-set! buttondat 2b80: 20 32 20 62 75 74 74 6f 6e 74 78 74 29 0a 09 09 2 buttontxt)... 2b90: 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d 73 65 (vector-se 2ba0: 74 21 20 62 75 74 74 6f 6e 64 61 74 20 33 20 74 t! buttondat 3 t 2bb0: 65 73 74 29 0a 09 09 20 20 20 20 20 20 28 76 65 est)... (ve 2bc0: 63 74 6f 72 2d 73 65 74 21 20 62 75 74 74 6f 6e ctor-set! button 2bd0: 64 61 74 20 34 20 72 75 6e 2d 6b 65 79 29 0a 09 dat 4 run-key).. 2be0: 09 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 . (if (not 2bf0: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f (hash-table-ref/ 2c00: 64 65 66 61 75 6c 74 20 2a 61 6c 6c 74 65 73 74 default *alltest 2c10: 6e 61 6d 65 73 2a 20 74 65 73 74 66 75 6c 6c 6e names* testfulln 2c20: 61 6d 65 20 23 66 29 29 0a 09 09 09 20 20 28 62 ame #f)).... (b 2c30: 65 67 69 6e 0a 09 09 09 20 20 20 20 28 68 61 73 egin.... (has 2c40: 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 2a 61 6c h-table-set! *al 2c50: 6c 74 65 73 74 6e 61 6d 65 73 2a 20 74 65 73 74 ltestnames* test 2c60: 66 75 6c 6c 6e 61 6d 65 20 23 74 29 0a 09 09 09 fullname #t).... 2c70: 20 20 20 20 28 73 65 74 21 20 2a 61 6c 6c 74 65 (set! *allte 2c80: 73 74 6e 61 6d 65 6c 73 74 2a 20 28 61 70 70 65 stnamelst* (appe 2c90: 6e 64 20 2a 61 6c 6c 74 65 73 74 6e 61 6d 65 6c nd *alltestnamel 2ca0: 73 74 2a 20 28 6c 69 73 74 20 74 65 73 74 66 75 st* (list testfu 2cb0: 6c 6c 6e 61 6d 65 29 29 29 29 29 29 0a 09 09 20 llname))))))... 2cc0: 20 20 20 29 0a 09 09 28 73 65 74 21 20 72 6f 77 )...(set! row 2cd0: 6e 20 28 2b 20 72 6f 77 6e 20 31 29 29 29 29 0a n (+ rown 1)))). 2ce0: 09 20 20 20 20 28 64 72 6f 70 20 74 65 73 74 6e . (drop testn 2cf0: 61 6d 65 73 20 2a 73 74 61 72 74 2d 74 65 73 74 ames *start-test 2d00: 2d 6f 66 66 73 65 74 2a 29 29 29 0a 09 20 28 73 -offset*))).. (s 2d10: 65 74 21 20 63 6f 6c 6e 20 28 2b 20 63 6f 6c 6e et! coln (+ coln 2d20: 20 31 29 29 29 29 0a 20 20 20 20 20 72 75 6e 73 1)))). runs 2d30: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 6d 6b )))..(define (mk 2d40: 73 74 72 20 2e 20 78 29 0a 20 20 28 73 74 72 69 str . x). (stri 2d50: 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 ng-intersperse ( 2d60: 6d 61 70 20 63 6f 6e 63 20 78 29 20 22 2c 22 29 map conc x) ",") 2d70: 29 0a 0a 28 64 65 66 69 6e 65 20 28 75 70 64 61 )..(define (upda 2d80: 74 65 2d 73 65 61 72 63 68 20 78 20 76 61 6c 29 te-search x val) 2d90: 0a 20 20 28 70 72 69 6e 74 20 22 53 65 74 74 69 . (print "Setti 2da0: 6e 67 20 73 65 61 72 63 68 20 66 6f 72 20 22 20 ng search for " 2db0: 78 20 22 20 74 6f 20 22 20 76 61 6c 29 0a 20 20 x " to " val). 2dc0: 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 (hash-table-set! 2dd0: 20 2a 73 65 61 72 63 68 70 61 74 74 73 2a 20 78 *searchpatts* x 2de0: 20 76 61 6c 29 29 0a 0a 28 64 65 66 69 6e 65 20 val))..(define 2df0: 28 6d 61 6b 65 2d 64 61 73 68 62 6f 61 72 64 2d (make-dashboard- 2e00: 62 75 74 74 6f 6e 73 20 6e 72 75 6e 73 20 6e 74 buttons nruns nt 2e10: 65 73 74 73 20 6b 65 79 6e 61 6d 65 73 29 0a 20 ests keynames). 2e20: 20 28 6c 65 74 2a 20 28 28 6e 6b 65 79 73 20 20 (let* ((nkeys 2e30: 20 28 6c 65 6e 67 74 68 20 6b 65 79 6e 61 6d 65 (length keyname 2e40: 73 29 29 0a 09 20 28 72 75 6e 73 76 65 63 20 28 s)).. (runsvec ( 2e50: 6d 61 6b 65 2d 76 65 63 74 6f 72 20 6e 72 75 6e make-vector nrun 2e60: 73 29 29 0a 09 20 28 68 65 61 64 65 72 20 20 28 s)).. (header ( 2e70: 6d 61 6b 65 2d 76 65 63 74 6f 72 20 6e 72 75 6e make-vector nrun 2e80: 73 29 29 0a 09 20 28 6c 66 74 63 6f 6c 20 20 28 s)).. (lftcol ( 2e90: 6d 61 6b 65 2d 76 65 63 74 6f 72 20 6e 74 65 73 make-vector ntes 2ea0: 74 73 29 29 0a 09 20 28 63 6f 6e 74 72 6f 6c 73 ts)).. (controls 2eb0: 20 27 28 29 29 0a 09 20 28 6c 66 74 6c 73 74 20 '()).. (lftlst 2ec0: 20 27 28 29 29 0a 09 20 28 68 64 72 6c 73 74 20 '()).. (hdrlst 2ed0: 20 27 28 29 29 0a 09 20 28 62 64 79 6c 73 74 20 '()).. (bdylst 2ee0: 20 27 28 29 29 0a 09 20 28 72 65 73 75 6c 74 20 '()).. (result 2ef0: 20 27 28 29 29 0a 09 20 28 69 20 20 20 20 20 20 '()).. (i 2f00: 20 30 29 29 0a 20 20 20 20 3b 3b 20 63 6f 6e 74 0)). ;; cont 2f10: 72 6f 6c 73 20 28 61 6c 6f 6e 67 20 62 6f 74 74 rols (along bott 2f20: 6f 6d 29 0a 20 20 20 20 28 73 65 74 21 20 63 6f om). (set! co 2f30: 6e 74 72 6f 6c 73 0a 09 20 20 28 69 75 70 3a 68 ntrols.. (iup:h 2f40: 62 6f 78 0a 09 20 20 20 28 69 75 70 3a 62 75 74 box.. (iup:but 2f50: 74 6f 6e 20 22 51 75 69 74 22 20 23 3a 61 63 74 ton "Quit" #:act 2f60: 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a ion (lambda (obj 2f70: 29 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 )(sqlite3:finali 2f80: 7a 65 21 20 2a 64 62 2a 29 28 65 78 69 74 29 29 ze! *db*)(exit)) 2f90: 29 0a 09 20 20 20 28 69 75 70 3a 62 75 74 74 6f ).. (iup:butto 2fa0: 6e 20 22 3c 2d 20 20 4c 65 66 74 22 20 23 3a 61 n "<- Left" #:a 2fb0: 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f ction (lambda (o 2fc0: 62 6a 29 28 73 65 74 21 20 2a 73 74 61 72 74 2d bj)(set! *start- 2fd0: 72 75 6e 2d 6f 66 66 73 65 74 2a 20 20 28 2b 20 run-offset* (+ 2fe0: 2a 73 74 61 72 74 2d 72 75 6e 2d 6f 66 66 73 65 *start-run-offse 2ff0: 74 2a 20 31 29 29 29 29 0a 09 20 20 20 28 69 75 t* 1)))).. (iu 3000: 70 3a 62 75 74 74 6f 6e 20 22 55 70 20 20 20 20 p:button "Up 3010: 20 5e 22 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 ^" #:action (la 3020: 6d 62 64 61 20 28 6f 62 6a 29 28 73 65 74 21 20 mbda (obj)(set! 3030: 2a 73 74 61 72 74 2d 74 65 73 74 2d 6f 66 66 73 *start-test-offs 3040: 65 74 2a 20 28 69 66 20 28 3e 20 2a 73 74 61 72 et* (if (> *star 3050: 74 2d 74 65 73 74 2d 6f 66 66 73 65 74 2a 20 30 t-test-offset* 0 3060: 29 28 2d 20 2a 73 74 61 72 74 2d 74 65 73 74 2d )(- *start-test- 3070: 6f 66 66 73 65 74 2a 20 31 29 20 30 29 29 29 29 offset* 1) 0)))) 3080: 0a 09 20 20 20 28 69 75 70 3a 62 75 74 74 6f 6e .. (iup:button 3090: 20 22 44 6f 77 6e 20 20 20 76 22 20 23 3a 61 63 "Down v" #:ac 30a0: 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 tion (lambda (ob 30b0: 6a 29 28 73 65 74 21 20 2a 73 74 61 72 74 2d 74 j)(set! *start-t 30c0: 65 73 74 2d 6f 66 66 73 65 74 2a 20 28 69 66 20 est-offset* (if 30d0: 28 3e 3d 20 2a 73 74 61 72 74 2d 74 65 73 74 2d (>= *start-test- 30e0: 6f 66 66 73 65 74 2a 20 28 6c 65 6e 67 74 68 20 offset* (length 30f0: 2a 61 6c 6c 74 65 73 74 6e 61 6d 65 6c 73 74 2a *alltestnamelst* 3100: 29 29 28 6c 65 6e 67 74 68 20 2a 61 6c 6c 74 65 ))(length *allte 3110: 73 74 6e 61 6d 65 6c 73 74 2a 29 28 2b 20 2a 73 stnamelst*)(+ *s 3120: 74 61 72 74 2d 74 65 73 74 2d 6f 66 66 73 65 74 tart-test-offset 3130: 2a 20 31 29 29 29 29 29 0a 09 20 20 20 28 69 75 * 1))))).. (iu 3140: 70 3a 62 75 74 74 6f 6e 20 22 52 69 67 68 74 20 p:button "Right 3150: 2d 3e 22 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 ->" #:action (la 3160: 6d 62 64 61 20 28 6f 62 6a 29 28 73 65 74 21 20 mbda (obj)(set! 3170: 2a 73 74 61 72 74 2d 72 75 6e 2d 6f 66 66 73 65 *start-run-offse 3180: 74 2a 20 20 28 69 66 20 28 3e 20 2a 73 74 61 72 t* (if (> *star 3190: 74 2d 72 75 6e 2d 6f 66 66 73 65 74 2a 20 30 29 t-run-offset* 0) 31a0: 28 2d 20 2a 73 74 61 72 74 2d 72 75 6e 2d 6f 66 (- *start-run-of 31b0: 66 73 65 74 2a 20 31 29 20 30 29 29 29 29 29 29 fset* 1) 0)))))) 31c0: 0a 20 20 20 20 0a 20 20 20 20 3b 3b 20 63 72 65 . . ;; cre 31d0: 61 74 65 20 74 68 65 20 6c 65 66 74 20 6d 6f 73 ate the left mos 31e0: 74 20 63 6f 6c 75 6d 6e 20 66 6f 72 20 74 68 65 t column for the 31f0: 20 72 75 6e 20 6b 65 79 20 6e 61 6d 65 73 20 61 run key names a 3200: 6e 64 20 74 68 65 20 74 65 73 74 20 6e 61 6d 65 nd the test name 3210: 73 20 0a 20 20 20 20 28 73 65 74 21 20 6c 66 74 s . (set! lft 3220: 6c 73 74 20 28 6c 69 73 74 20 28 61 70 70 6c 79 lst (list (apply 3230: 20 69 75 70 3a 76 62 6f 78 20 0a 09 09 09 20 20 iup:vbox .... 3240: 20 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 (map (lambda 3250: 20 28 78 29 09 09 0a 09 09 09 09 20 20 20 20 20 (x)....... 3260: 28 6c 65 74 20 28 28 72 65 73 20 28 69 75 70 3a (let ((res (iup: 3270: 68 62 6f 78 0a 09 09 09 09 09 09 20 28 69 75 70 hbox....... (iup 3280: 3a 6c 61 62 65 6c 20 78 20 23 3a 73 69 7a 65 20 :label x #:size 3290: 22 34 30 78 31 35 22 20 23 3a 66 6f 6e 74 73 69 "40x15" #:fontsi 32a0: 7a 65 20 22 31 30 22 29 20 3b 3b 20 20 23 3a 65 ze "10") ;; #:e 32b0: 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 xpand "HORIZONTA 32c0: 4c 22 29 0a 09 09 09 09 09 09 20 28 69 75 70 3a L")....... (iup: 32d0: 74 65 78 74 62 6f 78 20 23 3a 73 69 7a 65 20 22 textbox #:size " 32e0: 36 30 78 31 35 22 20 23 3a 66 6f 6e 74 73 69 7a 60x15" #:fontsiz 32f0: 65 20 22 31 30 22 20 23 3a 76 61 6c 75 65 20 22 e "10" #:value " 3300: 25 22 20 3b 3b 20 23 3a 65 78 70 61 6e 64 20 22 %" ;; #:expand " 3310: 48 4f 52 49 5a 4f 4e 54 41 4c 22 0a 09 09 09 09 HORIZONTAL"..... 3320: 09 09 09 20 20 20 20 20 20 23 3a 61 63 74 69 6f ... #:actio 3330: 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 20 75 n (lambda (obj u 3340: 6e 6b 20 76 61 6c 29 0a 09 09 09 09 09 09 09 09 nk val)......... 3350: 09 20 28 75 70 64 61 74 65 2d 73 65 61 72 63 68 . (update-search 3360: 20 78 20 76 61 6c 29 29 29 29 29 29 0a 09 09 09 x val)))))).... 3370: 09 20 20 20 20 20 20 20 28 73 65 74 21 20 69 20 . (set! i 3380: 28 2b 20 69 20 31 29 29 0a 09 09 09 09 20 20 20 (+ i 1))..... 3390: 20 20 20 20 72 65 73 29 29 0a 09 09 09 09 20 20 res))..... 33a0: 20 6b 65 79 6e 61 6d 65 73 29 29 29 29 0a 20 20 keynames)))). 33b0: 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 74 65 (let loop ((te 33c0: 73 74 6e 75 6d 20 20 30 29 0a 09 20 20 20 20 20 stnum 0).. 33d0: 20 20 28 72 65 73 20 20 20 20 20 20 27 28 29 29 (res '()) 33e0: 29 0a 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 ). (cond. 33f0: 20 20 20 20 20 28 28 3e 3d 20 74 65 73 74 6e 75 ((>= testnu 3400: 6d 20 6e 74 65 73 74 73 29 0a 09 3b 3b 20 6e 6f m ntests)..;; no 3410: 77 20 6c 66 74 6c 73 74 20 77 69 6c 6c 20 62 65 w lftlst will be 3420: 20 61 6e 20 68 62 6f 78 20 77 69 74 68 20 74 68 an hbox with th 3430: 65 20 74 65 73 74 20 6b 65 79 73 20 61 6e 64 20 e test keys and 3440: 74 68 65 20 74 65 73 74 20 6e 61 6d 65 20 6c 61 the test name la 3450: 62 65 6c 73 0a 09 28 73 65 74 21 20 6c 66 74 6c bels..(set! lftl 3460: 73 74 20 28 61 70 70 65 6e 64 20 6c 66 74 6c 73 st (append lftls 3470: 74 20 28 6c 69 73 74 20 28 61 70 70 6c 79 20 69 t (list (apply i 3480: 75 70 3a 76 62 6f 78 20 28 72 65 76 65 72 73 65 up:vbox (reverse 3490: 20 72 65 73 29 29 29 29 29 29 0a 20 20 20 20 20 res)))))). 34a0: 20 20 28 65 6c 73 65 0a 09 28 6c 65 74 20 28 28 (else..(let (( 34b0: 6c 61 62 6c 20 20 28 69 75 70 3a 62 75 74 74 6f labl (iup:butto 34c0: 6e 20 22 22 20 23 3a 66 6c 61 74 20 22 59 45 53 n "" #:flat "YES 34d0: 22 20 23 3a 73 69 7a 65 20 22 31 30 30 78 31 35 " #:size "100x15 34e0: 22 20 23 3a 66 6f 6e 74 73 69 7a 65 20 22 31 30 " #:fontsize "10 34f0: 22 29 29 29 0a 09 20 20 28 76 65 63 74 6f 72 2d "))).. (vector- 3500: 73 65 74 21 20 6c 66 74 63 6f 6c 20 74 65 73 74 set! lftcol test 3510: 6e 75 6d 20 6c 61 62 6c 29 0a 09 20 20 28 6c 6f num labl).. (lo 3520: 6f 70 20 28 2b 20 74 65 73 74 6e 75 6d 20 31 29 op (+ testnum 1) 3530: 28 63 6f 6e 73 20 6c 61 62 6c 20 72 65 73 29 29 (cons labl res)) 3540: 29 29 29 29 0a 20 20 20 20 3b 3b 20 0a 20 20 20 )))). ;; . 3550: 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 72 75 6e (let loop ((run 3560: 6e 75 6d 20 20 30 29 0a 09 20 20 20 20 20 20 20 num 0).. 3570: 28 6b 65 79 6e 75 6d 20 20 30 29 0a 09 20 20 20 (keynum 0).. 3580: 20 20 20 20 28 6b 65 79 76 65 63 20 20 28 6d 61 (keyvec (ma 3590: 6b 65 2d 76 65 63 74 6f 72 20 6e 6b 65 79 73 29 ke-vector nkeys) 35a0: 29 0a 09 20 20 20 20 20 20 20 28 72 65 73 20 20 ).. (res 35b0: 20 20 27 28 29 29 29 0a 20 20 20 20 20 20 28 63 '())). (c 35c0: 6f 6e 64 20 3b 3b 20 6e 62 2f 2f 20 6e 6f 20 65 ond ;; nb// no e 35d0: 6c 73 65 20 66 6f 72 20 74 68 69 73 20 61 70 70 lse for this app 35e0: 72 6f 61 63 68 2e 0a 20 20 20 20 20 20 20 28 28 roach.. (( 35f0: 3e 3d 20 72 75 6e 6e 75 6d 20 6e 72 75 6e 73 29 >= runnum nruns) 3600: 20 23 66 29 0a 20 20 20 20 20 20 20 28 28 3e 3d #f). ((>= 3610: 20 6b 65 79 6e 75 6d 20 6e 6b 65 79 73 29 20 0a keynum nkeys) . 3620: 09 28 76 65 63 74 6f 72 2d 73 65 74 21 20 68 65 .(vector-set! he 3630: 61 64 65 72 20 72 75 6e 6e 75 6d 20 6b 65 79 76 ader runnum keyv 3640: 65 63 29 0a 09 28 73 65 74 21 20 68 64 72 6c 73 ec)..(set! hdrls 3650: 74 20 28 63 6f 6e 73 20 28 61 70 70 6c 79 20 69 t (cons (apply i 3660: 75 70 3a 76 62 6f 78 20 28 72 65 76 65 72 73 65 up:vbox (reverse 3670: 20 72 65 73 29 29 20 68 64 72 6c 73 74 29 29 0a res)) hdrlst)). 3680: 09 28 6c 6f 6f 70 20 28 2b 20 72 75 6e 6e 75 6d .(loop (+ runnum 3690: 20 31 29 20 30 20 28 6d 61 6b 65 2d 76 65 63 74 1) 0 (make-vect 36a0: 6f 72 20 6e 6b 65 79 73 29 20 27 28 29 29 29 0a or nkeys) '())). 36b0: 20 20 20 20 20 20 20 28 65 6c 73 65 0a 09 28 6c (else..(l 36c0: 65 74 20 28 28 6c 61 62 6c 20 20 28 69 75 70 3a et ((labl (iup: 36d0: 6c 61 62 65 6c 20 22 22 20 23 3a 73 69 7a 65 20 label "" #:size 36e0: 22 36 30 78 31 35 22 20 23 3a 66 6f 6e 74 73 69 "60x15" #:fontsi 36f0: 7a 65 20 22 31 30 22 20 3b 3b 20 23 3a 65 78 70 ze "10" ;; #:exp 3700: 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 and "HORIZONTAL" 3710: 0a 09 09 09 09 29 29 29 0a 09 20 20 28 76 65 63 .....))).. (vec 3720: 74 6f 72 2d 73 65 74 21 20 6b 65 79 76 65 63 20 tor-set! keyvec 3730: 6b 65 79 6e 75 6d 20 6c 61 62 6c 29 0a 09 20 20 keynum labl).. 3740: 28 6c 6f 6f 70 20 72 75 6e 6e 75 6d 20 28 2b 20 (loop runnum (+ 3750: 6b 65 79 6e 75 6d 20 31 29 20 6b 65 79 76 65 63 keynum 1) keyvec 3760: 20 28 63 6f 6e 73 20 6c 61 62 6c 20 72 65 73 29 (cons labl res) 3770: 29 29 29 29 29 0a 20 20 20 20 3b 3b 20 42 79 20 ))))). ;; By 3780: 68 65 72 65 20 74 68 65 20 68 64 72 6c 73 74 20 here the hdrlst 3790: 63 6f 6e 74 61 69 6e 73 20 61 20 6c 69 73 74 20 contains a list 37a0: 6f 66 20 76 62 6f 78 65 73 20 63 6f 6e 74 61 69 of vboxes contai 37b0: 6e 69 6e 67 20 6e 6b 65 79 73 20 6c 61 62 65 6c ning nkeys label 37c0: 73 0a 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 s. (let loop 37d0: 28 28 72 75 6e 6e 75 6d 20 20 30 29 0a 09 20 20 ((runnum 0).. 37e0: 20 20 20 20 20 28 74 65 73 74 6e 75 6d 20 30 29 (testnum 0) 37f0: 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 76 65 .. (testve 3800: 63 20 20 28 6d 61 6b 65 2d 76 65 63 74 6f 72 20 c (make-vector 3810: 6e 74 65 73 74 73 29 29 0a 09 20 20 20 20 20 20 ntests)).. 3820: 20 28 72 65 73 20 20 20 20 27 28 29 29 29 0a 20 (res '())). 3830: 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 (cond. 3840: 20 20 28 28 3e 3d 20 72 75 6e 6e 75 6d 20 6e 72 ((>= runnum nr 3850: 75 6e 73 29 20 23 66 29 20 3b 3b 20 20 28 76 65 uns) #f) ;; (ve 3860: 63 74 6f 72 20 74 61 62 6c 65 68 65 61 64 65 72 ctor tableheader 3870: 20 72 75 6e 73 76 65 63 29 29 0a 20 20 20 20 20 runsvec)). 3880: 20 20 28 28 3e 3d 20 74 65 73 74 6e 75 6d 20 6e ((>= testnum n 3890: 74 65 73 74 73 29 20 0a 09 28 76 65 63 74 6f 72 tests) ..(vector 38a0: 2d 73 65 74 21 20 72 75 6e 73 76 65 63 20 72 75 -set! runsvec ru 38b0: 6e 6e 75 6d 20 74 65 73 74 76 65 63 29 0a 09 28 nnum testvec)..( 38c0: 73 65 74 21 20 62 64 79 6c 73 74 20 28 63 6f 6e set! bdylst (con 38d0: 73 20 28 61 70 70 6c 79 20 69 75 70 3a 76 62 6f s (apply iup:vbo 38e0: 78 20 28 72 65 76 65 72 73 65 20 72 65 73 29 29 x (reverse res)) 38f0: 20 62 64 79 6c 73 74 29 29 0a 09 28 6c 6f 6f 70 bdylst))..(loop 3900: 20 28 2b 20 72 75 6e 6e 75 6d 20 31 29 20 30 20 (+ runnum 1) 0 3910: 28 6d 61 6b 65 2d 76 65 63 74 6f 72 20 6e 74 65 (make-vector nte 3920: 73 74 73 29 20 27 28 29 29 29 0a 20 20 20 20 20 sts) '())). 3930: 20 20 28 65 6c 73 65 0a 09 28 6c 65 74 2a 20 28 (else..(let* ( 3940: 28 62 75 74 74 6f 6e 2d 6b 65 79 20 28 6d 6b 73 (button-key (mks 3950: 74 72 20 72 75 6e 6e 75 6d 20 74 65 73 74 6e 75 tr runnum testnu 3960: 6d 29 29 0a 09 20 20 20 20 20 20 20 28 62 75 74 m)).. (but 3970: 6e 20 20 20 20 20 20 20 28 69 75 70 3a 62 75 74 n (iup:but 3980: 74 6f 6e 20 22 22 20 3b 3b 20 62 75 74 74 6f 6e ton "" ;; button 3990: 2d 6b 65 79 20 0a 09 09 09 09 20 20 20 20 20 20 -key ..... 39a0: 20 23 3a 73 69 7a 65 20 22 36 30 78 31 35 22 20 #:size "60x15" 39b0: 0a 09 09 09 09 20 20 20 20 20 20 20 3b 3b 20 23 ..... ;; # 39c0: 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e :expand "HORIZON 39d0: 54 41 4c 22 0a 09 09 09 09 20 20 20 20 20 20 20 TAL"..... 39e0: 23 3a 66 6f 6e 74 73 69 7a 65 20 22 31 30 22 20 #:fontsize "10" 39f0: 0a 09 09 09 09 20 20 20 20 20 20 20 23 3a 61 63 ..... #:ac 3a00: 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 78 29 tion (lambda (x) 3a10: 0a 09 09 09 09 09 09 20 20 28 65 78 61 6d 69 6e ....... (examin 3a20: 65 2d 74 65 73 74 20 62 75 74 74 6f 6e 2d 6b 65 e-test button-ke 3a30: 79 29 29 29 29 29 0a 09 20 20 28 68 61 73 68 2d y))))).. (hash- 3a40: 74 61 62 6c 65 2d 73 65 74 21 20 2a 62 75 74 74 table-set! *butt 3a50: 6f 6e 64 61 74 2a 20 62 75 74 74 6f 6e 2d 6b 65 ondat* button-ke 3a60: 79 20 28 76 65 63 74 6f 72 20 30 20 22 31 30 30 y (vector 0 "100 3a70: 20 31 30 30 20 31 30 30 22 20 62 75 74 74 6f 6e 100 100" button 3a80: 2d 6b 65 79 20 23 66 20 23 66 29 29 20 0a 09 20 -key #f #f)) .. 3a90: 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 74 65 (vector-set! te 3aa0: 73 74 76 65 63 20 74 65 73 74 6e 75 6d 20 62 75 stvec testnum bu 3ab0: 74 6e 29 0a 09 20 20 28 6c 6f 6f 70 20 72 75 6e tn).. (loop run 3ac0: 6e 75 6d 20 28 2b 20 74 65 73 74 6e 75 6d 20 31 num (+ testnum 1 3ad0: 29 20 74 65 73 74 76 65 63 20 28 63 6f 6e 73 20 ) testvec (cons 3ae0: 62 75 74 6e 20 72 65 73 29 29 29 29 29 29 0a 20 butn res)))))). 3af0: 20 20 20 3b 3b 20 6e 6f 77 20 61 73 73 65 6d 62 ;; now assemb 3b00: 6c 65 20 74 68 65 20 68 64 72 6c 73 74 20 61 6e le the hdrlst an 3b10: 64 20 62 64 79 6c 73 74 20 61 6e 64 20 6b 69 63 d bdylst and kic 3b20: 6b 20 6f 66 66 20 74 68 65 20 64 69 61 6c 6f 67 k off the dialog 3b30: 0a 20 20 20 20 28 69 75 70 3a 73 68 6f 77 0a 20 . (iup:show. 3b40: 20 20 20 20 28 69 75 70 3a 64 69 61 6c 6f 67 20 (iup:dialog 3b50: 0a 20 20 20 20 20 20 23 3a 74 69 74 6c 65 20 22 . #:title " 3b60: 4d 65 67 61 74 65 73 74 20 64 61 73 68 62 6f 61 Megatest dashboa 3b70: 72 64 22 0a 20 20 20 20 20 20 28 69 75 70 3a 76 rd". (iup:v 3b80: 62 6f 78 0a 09 28 61 70 70 6c 79 20 69 75 70 3a box..(apply iup: 3b90: 68 62 6f 78 20 0a 09 20 20 20 20 20 20 20 28 63 hbox .. (c 3ba0: 6f 6e 73 20 28 61 70 70 6c 79 20 69 75 70 3a 76 ons (apply iup:v 3bb0: 62 6f 78 20 6c 66 74 6c 73 74 29 0a 09 09 20 20 box lftlst)... 3bc0: 20 20 20 28 6c 69 73 74 20 0a 09 09 20 20 20 20 (list ... 3bd0: 20 20 28 69 75 70 3a 76 62 6f 78 0a 09 09 20 20 (iup:vbox... 3be0: 20 20 20 20 20 3b 3b 20 74 68 65 20 68 65 61 64 ;; the head 3bf0: 65 72 0a 09 09 20 20 20 20 20 20 20 28 61 70 70 er... (app 3c00: 6c 79 20 69 75 70 3a 68 62 6f 78 20 28 72 65 76 ly iup:hbox (rev 3c10: 65 72 73 65 20 68 64 72 6c 73 74 29 29 0a 09 09 erse hdrlst))... 3c20: 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 69 75 (apply iu 3c30: 70 3a 68 62 6f 78 20 28 72 65 76 65 72 73 65 20 p:hbox (reverse 3c40: 62 64 79 6c 73 74 29 29 29 29 29 29 0a 20 20 20 bdylst)))))). 3c50: 20 20 20 20 63 6f 6e 74 72 6f 6c 73 29 29 29 0a controls))). 3c60: 20 20 20 20 28 76 65 63 74 6f 72 20 6c 66 74 63 (vector lftc 3c70: 6f 6c 20 68 65 61 64 65 72 20 72 75 6e 73 76 65 ol header runsve 3c80: 63 29 29 29 0a 0a 28 73 65 74 21 20 2a 6e 75 6d c)))..(set! *num 3c90: 2d 74 65 73 74 73 2a 20 28 6d 61 78 20 28 75 70 -tests* (max (up 3ca0: 64 61 74 65 2d 72 75 6e 64 61 74 20 22 25 22 20 date-rundat "%" 3cb0: 2a 6e 75 6d 2d 72 75 6e 73 2a 29 20 38 29 29 0a *num-runs*) 8)). 3cc0: 0a 28 73 65 74 21 20 75 69 64 61 74 20 28 6d 61 .(set! uidat (ma 3cd0: 6b 65 2d 64 61 73 68 62 6f 61 72 64 2d 62 75 74 ke-dashboard-but 3ce0: 74 6f 6e 73 20 2a 6e 75 6d 2d 72 75 6e 73 2a 20 tons *num-runs* 3cf0: 2a 6e 75 6d 2d 74 65 73 74 73 2a 20 64 62 6b 65 *num-tests* dbke 3d00: 79 73 29 29 0a 3b 3b 20 28 6d 65 67 61 74 65 73 ys)).;; (megates 3d10: 74 2d 64 61 73 68 62 6f 61 72 64 29 0a 0a 28 64 t-dashboard)..(d 3d20: 65 66 69 6e 65 20 28 72 75 6e 2d 75 70 64 61 74 efine (run-updat 3d30: 65 20 6f 74 68 65 72 2d 74 68 72 65 61 64 29 0a e other-thread). 3d40: 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 69 20 (let loop ((i 3d50: 30 29 29 0a 20 20 20 20 28 74 68 72 65 61 64 2d 0)). (thread- 3d60: 73 6c 65 65 70 21 20 30 2e 31 29 0a 20 20 20 20 sleep! 0.1). 3d70: 28 74 68 72 65 61 64 2d 73 75 73 70 65 6e 64 21 (thread-suspend! 3d80: 20 6f 74 68 65 72 2d 74 68 72 65 61 64 29 0a 20 other-thread). 3d90: 20 20 20 28 75 70 64 61 74 65 2d 72 75 6e 64 61 (update-runda 3da0: 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 t (hash-table-re 3db0: 66 2f 64 65 66 61 75 6c 74 20 2a 73 65 61 72 63 f/default *searc 3dc0: 68 70 61 74 74 73 2a 20 22 72 75 6e 6e 61 6d 65 hpatts* "runname 3dd0: 22 20 22 25 22 29 20 2a 6e 75 6d 2d 72 75 6e 73 " "%") *num-runs 3de0: 2a 29 0a 20 20 20 20 28 75 70 64 61 74 65 2d 62 *). (update-b 3df0: 75 74 74 6f 6e 73 20 75 69 64 61 74 20 2a 6e 75 uttons uidat *nu 3e00: 6d 2d 72 75 6e 73 2a 20 2a 6e 75 6d 2d 74 65 73 m-runs* *num-tes 3e10: 74 73 2a 29 0a 20 20 20 20 28 74 68 72 65 61 64 ts*). (thread 3e20: 2d 72 65 73 75 6d 65 21 20 6f 74 68 65 72 2d 74 -resume! other-t 3e30: 68 72 65 61 64 29 0a 20 20 20 20 28 6c 6f 6f 70 hread). (loop 3e40: 20 28 2b 20 69 20 31 29 29 29 29 0a 0a 28 64 65 (+ i 1))))..(de 3e50: 66 69 6e 65 20 74 68 32 20 28 6d 61 6b 65 2d 74 fine th2 (make-t 3e60: 68 72 65 61 64 20 69 75 70 3a 6d 61 69 6e 2d 6c hread iup:main-l 3e70: 6f 6f 70 29 29 0a 28 64 65 66 69 6e 65 20 74 68 oop)).(define th 3e80: 31 20 28 6d 61 6b 65 2d 74 68 72 65 61 64 20 28 1 (make-thread ( 3e90: 72 75 6e 2d 75 70 64 61 74 65 20 74 68 32 29 29 run-update th2)) 3ea0: 29 0a 28 74 68 72 65 61 64 2d 73 74 61 72 74 21 ).(thread-start! 3eb0: 20 74 68 31 29 0a 28 74 68 72 65 61 64 2d 73 74 th1).(thread-st 3ec0: 61 72 74 21 20 74 68 32 29 0a 28 74 68 72 65 61 art! th2).(threa 3ed0: 64 2d 6a 6f 69 6e 21 20 74 68 32 29 0a d-join! th2).