Artifact 8443e49efc55455b8ec0f314e7943948e97aa70b:
- File dashboard.scm — part of check-in [874a4143eb] at 2011-05-05 22:50:57 on branch trunk — Typo in dashboard (user: matt size: 16094)
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 5f 64 75 72 61 74 st-get-run_durat 0d40: 69 6f 6e 20 74 65 73 74 29 29 0a 09 20 20 20 20 ion test)).. 0d50: 20 20 20 28 6c 6f 67 66 69 6c 65 20 20 20 20 20 (logfile 0d60: 20 28 63 6f 6e 63 20 28 64 62 3a 74 65 73 74 2d (conc (db:test- 0d70: 67 65 74 2d 72 75 6e 64 69 72 20 74 65 73 74 29 get-rundir test) 0d80: 20 22 2f 22 20 28 64 62 3a 74 65 73 74 2d 67 65 "/" (db:test-ge 0d90: 74 2d 66 69 6e 61 6c 5f 6c 6f 67 66 20 74 65 73 t-final_logf tes 0da0: 74 29 29 29 0a 09 20 20 20 20 20 20 20 28 76 69 t))).. (vi 0db0: 65 77 6c 6f 67 20 20 20 20 20 20 28 6c 61 6d 62 ewlog (lamb 0dc0: 64 61 20 28 78 29 0a 09 09 09 20 20 20 20 20 20 da (x).... 0dd0: 20 28 69 66 20 28 66 69 6c 65 2d 65 78 69 73 74 (if (file-exist 0de0: 73 3f 20 6c 6f 67 66 69 6c 65 29 0a 09 09 09 09 s? logfile)..... 0df0: 20 20 20 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 (system (conc 0e00: 20 22 66 69 72 65 66 6f 78 20 22 20 6c 6f 67 66 "firefox " logf 0e10: 69 6c 65 20 22 26 22 29 29 0a 09 09 09 09 20 20 ile "&"))..... 0e20: 20 28 6d 65 73 73 61 67 65 2d 77 69 6e 64 6f 77 (message-window 0e30: 20 28 63 6f 6e 63 20 22 46 69 6c 65 20 22 20 6c (conc "File " l 0e40: 6f 67 66 69 6c 65 20 22 20 6e 6f 74 20 66 6f 75 ogfile " not fou 0e50: 6e 64 22 29 29 29 29 29 0a 09 20 20 20 20 20 20 nd"))))).. 0e60: 20 28 78 74 65 72 6d 20 20 20 20 20 20 20 20 28 (xterm ( 0e70: 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 09 20 20 lambda (x).... 0e80: 20 20 20 20 20 28 69 66 20 28 64 69 72 65 63 74 (if (direct 0e90: 6f 72 79 2d 65 78 69 73 74 73 3f 20 72 75 6e 64 ory-exists? rund 0ea0: 69 72 29 0a 09 09 09 09 20 20 20 28 73 79 73 74 ir)..... (syst 0eb0: 65 6d 20 28 63 6f 6e 63 20 22 63 64 20 22 20 72 em (conc "cd " r 0ec0: 75 6e 64 69 72 20 22 3b 78 74 65 72 6d 20 2d 54 undir ";xterm -T 0ed0: 20 22 20 28 73 74 72 69 6e 67 2d 74 72 61 6e 73 " (string-trans 0ee0: 6c 61 74 65 20 74 65 73 74 66 75 6c 6c 6e 61 6d late testfullnam 0ef0: 65 20 22 28 29 22 20 22 20 20 22 29 20 22 26 22 e "()" " ") "&" 0f00: 29 29 0a 09 09 09 09 20 20 20 28 6d 65 73 73 61 ))..... (messa 0f10: 67 65 2d 77 69 6e 64 6f 77 20 20 28 63 6f 6e 63 ge-window (conc 0f20: 20 22 44 69 72 65 63 74 6f 72 79 20 22 20 72 75 "Directory " ru 0f30: 6e 64 69 72 20 22 20 6e 6f 74 20 66 6f 75 6e 64 ndir " not found 0f40: 22 29 29 29 29 29 0a 09 20 20 20 20 20 20 20 28 "))))).. ( 0f50: 6e 65 77 73 74 61 74 75 73 20 20 20 20 63 75 72 newstatus cur 0f60: 72 73 74 61 74 75 73 29 0a 09 20 20 20 20 20 20 rstatus).. 0f70: 20 28 6e 65 77 73 74 61 74 65 20 20 20 20 20 63 (newstate c 0f80: 75 72 72 73 74 61 74 65 29 0a 09 20 20 20 20 20 urrstate).. 0f90: 20 20 28 73 65 6c 66 20 20 20 20 20 20 20 20 20 (self 0fa0: 23 66 29 29 0a 09 20 20 0a 09 20 20 3b 3b 20 20 #f)).. .. ;; 0fb0: 28 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 (test-set-status 0fc0: 21 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 ! db run-id test 0fd0: 2d 6e 61 6d 65 20 73 74 61 74 65 20 73 74 61 74 -name state stat 0fe0: 75 73 20 69 74 65 6d 64 61 74 29 0a 09 20 20 28 us itemdat).. ( 0ff0: 73 65 74 21 20 73 65 6c 66 20 0a 09 09 28 69 75 set! self ...(iu 1000: 70 3a 64 69 61 6c 6f 67 0a 09 09 20 28 69 75 70 p:dialog... (iup 1010: 3a 76 62 6f 78 0a 09 09 20 20 28 69 75 70 3a 68 :vbox... (iup:h 1020: 62 6f 78 20 0a 09 09 20 20 20 28 69 75 70 3a 66 box ... (iup:f 1030: 72 61 6d 65 20 28 69 75 70 3a 6c 61 62 65 6c 20 rame (iup:label 1040: 72 75 6e 2d 6b 65 79 29 29 0a 09 09 20 20 20 28 run-key))... ( 1050: 69 75 70 3a 66 72 61 6d 65 20 28 69 75 70 3a 6c iup:frame (iup:l 1060: 61 62 65 6c 20 28 63 6f 6e 63 20 22 54 45 53 54 abel (conc "TEST 1070: 4e 41 4d 45 3a 5c 6e 22 20 74 65 73 74 66 75 6c NAME:\n" testful 1080: 6c 6e 61 6d 65 29 20 23 3a 65 78 70 61 6e 64 20 lname) #:expand 1090: 22 59 45 53 22 29 29 29 0a 09 09 20 20 28 69 75 "YES")))... (iu 10a0: 70 3a 66 72 61 6d 65 20 23 3a 74 69 74 6c 65 20 p:frame #:title 10b0: 22 41 63 74 69 6f 6e 73 22 20 23 3a 65 78 70 61 "Actions" #:expa 10c0: 6e 64 20 22 59 45 53 22 0a 09 09 09 20 20 20 20 nd "YES".... 10d0: 20 28 69 75 70 3a 68 62 6f 78 20 3b 3b 20 74 68 (iup:hbox ;; th 10e0: 65 20 61 63 74 69 6f 6e 73 20 62 6f 78 0a 09 09 e actions box... 10f0: 09 20 20 20 20 20 20 28 69 75 70 3a 62 75 74 74 . (iup:butt 1100: 6f 6e 20 22 56 69 65 77 20 4c 6f 67 22 20 20 20 on "View Log" 1110: 20 23 3a 61 63 74 69 6f 6e 20 76 69 65 77 6c 6f #:action viewlo 1120: 67 20 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53 g #:expand "YES 1130: 22 29 0a 09 09 09 20 20 20 20 20 20 28 69 75 70 ").... (iup 1140: 3a 62 75 74 74 6f 6e 20 22 53 74 61 72 74 20 58 :button "Start X 1150: 74 65 72 6d 22 20 23 3a 61 63 74 69 6f 6e 20 78 term" #:action x 1160: 74 65 72 6d 20 20 23 3a 65 78 70 61 6e 64 20 22 term #:expand " 1170: 59 45 53 22 29 29 29 0a 09 09 20 20 28 69 75 70 YES")))... (iup 1180: 3a 66 72 61 6d 65 20 23 3a 74 69 74 6c 65 20 22 :frame #:title " 1190: 53 65 74 20 66 69 65 6c 64 73 22 0a 09 09 09 20 Set fields".... 11a0: 20 20 20 20 28 69 75 70 3a 76 62 6f 78 0a 09 09 (iup:vbox... 11b0: 09 20 20 20 20 20 20 28 69 75 70 3a 68 62 6f 78 . (iup:hbox 11c0: 20 0a 09 09 09 20 20 20 20 20 20 20 28 69 75 70 .... (iup 11d0: 3a 76 62 6f 78 20 3b 3b 20 74 68 65 20 73 74 61 :vbox ;; the sta 11e0: 74 65 0a 09 09 09 09 28 69 75 70 3a 6c 61 62 65 te.....(iup:labe 11f0: 6c 20 22 53 54 41 54 45 3a 22 20 23 3a 73 69 7a l "STATE:" #:siz 1200: 65 20 22 33 30 78 22 29 0a 09 09 09 09 28 6c 65 e "30x").....(le 1210: 74 20 28 28 6c 62 20 28 69 75 70 3a 6c 69 73 74 t ((lb (iup:list 1220: 62 6f 78 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 box #:action (la 1230: 6d 62 64 61 20 28 76 61 6c 20 61 20 62 20 63 29 mbda (val a b c) 1240: 0a 09 09 09 09 09 09 09 09 20 20 3b 3b 20 28 70 ......... ;; (p 1250: 72 69 6e 74 20 76 61 6c 20 22 20 61 3a 20 22 20 rint val " a: " 1260: 61 20 22 20 62 3a 20 22 20 62 20 22 20 63 3a 20 a " b: " b " c: 1270: 22 20 63 29 0a 09 09 09 09 09 09 09 09 20 20 28 " c)......... ( 1280: 73 65 74 21 20 6e 65 77 73 74 61 74 65 20 61 29 set! newstate a) 1290: 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 23 )....... # 12a0: 3a 65 64 69 74 62 6f 78 20 22 59 45 53 22 0a 09 :editbox "YES".. 12b0: 09 09 09 09 09 20 20 20 20 20 20 20 23 3a 65 78 ..... #:ex 12c0: 70 61 6e 64 20 22 59 45 53 22 29 29 29 0a 09 09 pand "YES")))... 12d0: 09 09 20 20 28 69 75 70 6c 69 73 74 62 6f 78 2d .. (iuplistbox- 12e0: 66 69 6c 6c 2d 6c 69 73 74 20 6c 62 0a 09 09 09 fill-list lb.... 12f0: 09 09 09 09 28 6c 69 73 74 20 22 43 4f 4d 50 4c ....(list "COMPL 1300: 45 54 45 44 22 20 22 4e 4f 54 5f 53 54 41 52 54 ETED" "NOT_START 1310: 45 44 22 20 22 52 55 4e 4e 49 4e 47 22 20 22 52 ED" "RUNNING" "R 1320: 45 4d 4f 54 45 48 4f 53 54 53 54 41 52 54 22 20 EMOTEHOSTSTART" 1330: 22 4b 49 4c 4c 45 44 22 20 22 4b 49 4c 4c 52 45 "KILLED" "KILLRE 1340: 51 22 20 22 43 48 45 43 4b 22 29 0a 09 09 09 09 Q" "CHECK")..... 1350: 09 09 09 63 75 72 72 73 74 61 74 65 29 0a 09 09 ...currstate)... 1360: 09 09 20 20 6c 62 29 29 0a 09 09 09 20 20 20 20 .. lb)).... 1370: 20 20 20 28 69 75 70 3a 76 62 6f 78 20 3b 3b 20 (iup:vbox ;; 1380: 74 68 65 20 73 74 61 74 75 73 0a 09 09 09 09 28 the status.....( 1390: 69 75 70 3a 6c 61 62 65 6c 20 22 53 54 41 54 55 iup:label "STATU 13a0: 53 3a 22 20 23 3a 73 69 7a 65 20 22 33 30 78 22 S:" #:size "30x" 13b0: 29 0a 09 09 09 09 28 6c 65 74 20 28 28 6c 62 20 ).....(let ((lb 13c0: 28 69 75 70 3a 6c 69 73 74 62 6f 78 20 23 3a 61 (iup:listbox #:a 13d0: 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 76 ction (lambda (v 13e0: 61 6c 20 61 20 62 20 63 29 0a 09 09 09 09 09 09 al a b c)....... 13f0: 09 09 20 20 28 73 65 74 21 20 6e 65 77 73 74 61 .. (set! newsta 1400: 74 75 73 20 61 29 29 0a 09 09 09 09 09 09 20 20 tus a))....... 1410: 20 20 20 20 20 23 3a 65 64 69 74 62 6f 78 20 22 #:editbox " 1420: 59 45 53 22 0a 09 09 09 09 09 09 20 20 20 20 20 YES"....... 1430: 20 20 23 3a 76 61 6c 75 65 20 63 75 72 72 73 74 #:value currst 1440: 61 74 75 73 0a 09 09 09 09 09 09 20 20 20 20 20 atus....... 1450: 20 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53 22 #:expand "YES" 1460: 29 29 29 0a 09 09 09 09 20 20 28 69 75 70 6c 69 )))..... (iupli 1470: 73 74 62 6f 78 2d 66 69 6c 6c 2d 6c 69 73 74 20 stbox-fill-list 1480: 6c 62 0a 09 09 09 09 09 09 09 28 6c 69 73 74 20 lb........(list 1490: 22 50 41 53 53 22 20 22 46 41 49 4c 22 20 22 6e "PASS" "FAIL" "n 14a0: 2f 61 22 29 0a 09 09 09 09 09 09 09 63 75 72 72 /a")........curr 14b0: 73 74 61 74 75 73 29 0a 09 09 09 09 20 20 6c 62 status)..... lb 14c0: 29 29 29 0a 09 09 09 20 20 20 20 20 20 28 69 75 ))).... (iu 14d0: 70 3a 68 62 6f 78 20 28 69 75 70 3a 6c 61 62 65 p:hbox (iup:labe 14e0: 6c 20 22 43 6f 6d 6d 65 6e 74 3a 22 29 0a 09 09 l "Comment:")... 14f0: 09 09 09 28 69 75 70 3a 74 65 78 74 62 6f 78 20 ...(iup:textbox 1500: 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 #:action (lambda 1510: 20 28 76 61 6c 20 61 20 62 29 0a 09 09 09 09 09 (val a b)...... 1520: 09 09 09 28 73 65 74 21 20 63 75 72 72 63 6f 6d ...(set! currcom 1530: 6d 65 6e 74 20 62 29 29 0a 09 09 09 09 09 09 20 ment b))....... 1540: 20 20 20 20 23 3a 76 61 6c 75 65 20 63 75 72 72 #:value curr 1550: 63 6f 6d 6d 65 6e 74 20 0a 09 09 09 09 09 09 20 comment ....... 1560: 20 20 20 20 23 3a 65 78 70 61 6e 64 20 22 59 45 #:expand "YE 1570: 53 22 29 29 0a 09 09 09 20 20 20 20 20 20 28 69 S")).... (i 1580: 75 70 3a 62 75 74 74 6f 6e 20 22 41 70 70 6c 79 up:button "Apply 1590: 22 0a 09 09 09 09 09 20 20 23 3a 65 78 70 61 6e "...... #:expan 15a0: 64 20 22 59 45 53 22 0a 09 09 09 09 09 20 20 23 d "YES"...... # 15b0: 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 :action (lambda 15c0: 28 78 29 0a 09 09 09 09 09 09 20 20 20 20 20 28 (x)....... ( 15d0: 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 test-set-status! 15e0: 20 2a 64 62 2a 20 72 75 6e 2d 69 64 20 74 65 73 *db* run-id tes 15f0: 74 6e 61 6d 65 20 6e 65 77 73 74 61 74 65 20 6e tname newstate n 1600: 65 77 73 74 61 74 75 73 20 69 74 65 6d 70 61 74 ewstatus itempat 1610: 68 20 63 75 72 72 63 6f 6d 6d 65 6e 74 29 29 29 h currcomment))) 1620: 0a 09 09 09 20 20 20 20 20 20 28 69 75 70 3a 68 .... (iup:h 1630: 62 6f 78 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 box (iup:button 1640: 22 41 70 70 6c 79 20 61 6e 64 20 63 6c 6f 73 65 "Apply and close 1650: 22 0a 09 09 09 09 09 09 20 20 20 20 23 3a 65 78 "....... #:ex 1660: 70 61 6e 64 20 22 59 45 53 22 0a 09 09 09 09 09 pand "YES"...... 1670: 09 20 20 20 20 23 3a 61 63 74 69 6f 6e 20 28 6c . #:action (l 1680: 61 6d 62 64 61 20 28 78 29 0a 09 09 09 09 09 09 ambda (x)....... 1690: 09 20 20 20 20 20 20 20 28 74 65 73 74 2d 73 65 . (test-se 16a0: 74 2d 73 74 61 74 75 73 21 20 2a 64 62 2a 20 72 t-status! *db* r 16b0: 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 20 6e un-id testname n 16c0: 65 77 73 74 61 74 65 20 6e 65 77 73 74 61 74 75 ewstate newstatu 16d0: 73 20 69 74 65 6d 70 61 74 68 20 63 75 72 72 63 s itempath currc 16e0: 6f 6d 6d 65 6e 74 29 0a 09 09 09 09 09 09 09 20 omment)........ 16f0: 20 20 20 20 20 20 28 69 75 70 3a 64 65 73 74 72 (iup:destr 1700: 6f 79 21 20 73 65 6c 66 29 29 29 0a 09 09 09 09 oy! self)))..... 1710: 09 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 43 61 .(iup:button "Ca 1720: 6e 63 65 6c 20 61 6e 64 20 63 6c 6f 73 65 22 0a ncel and close". 1730: 09 09 09 09 09 09 20 20 20 20 23 3a 65 78 70 61 ...... #:expa 1740: 6e 64 20 22 59 45 53 22 0a 09 09 09 09 09 09 20 nd "YES"....... 1750: 20 20 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d #:action (lam 1760: 62 64 61 20 28 78 29 0a 09 09 09 09 09 09 09 20 bda (x)........ 1770: 20 20 20 20 20 20 28 69 75 70 3a 64 65 73 74 72 (iup:destr 1780: 6f 79 21 20 73 65 6c 66 29 29 29 29 0a 09 09 09 oy! self)))).... 1790: 20 20 20 20 20 20 29 29 29 29 29 0a 09 20 20 28 ))))).. ( 17a0: 69 75 70 3a 73 68 6f 77 20 73 65 6c 66 29 0a 09 iup:show self).. 17b0: 20 20 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 ))))..(define 17c0: 28 63 6f 6c 6f 72 73 2d 73 69 6d 69 6c 61 72 3f (colors-similar? 17d0: 20 63 6f 6c 6f 72 31 20 63 6f 6c 6f 72 32 29 0a color1 color2). 17e0: 20 20 28 6c 65 74 2a 20 28 28 63 31 20 28 6d 61 (let* ((c1 (ma 17f0: 70 20 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 p string->number 1800: 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 63 (string-split c 1810: 6f 6c 6f 72 31 29 29 29 0a 09 20 28 63 32 20 28 olor1))).. (c2 ( 1820: 6d 61 70 20 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 map string->numb 1830: 65 72 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 er (string-split 1840: 20 63 6f 6c 6f 72 32 29 29 29 0a 09 20 28 64 65 color2))).. (de 1850: 6c 74 61 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 lta (map (lambda 1860: 20 28 61 20 62 29 28 61 62 73 20 28 2d 20 61 20 (a b)(abs (- a 1870: 62 29 29 29 20 63 31 20 63 32 29 29 29 0a 20 20 b))) c1 c2))). 1880: 20 20 28 6e 75 6c 6c 3f 20 28 66 69 6c 74 65 72 (null? (filter 1890: 20 28 6c 61 6d 62 64 61 20 28 78 29 28 3e 20 78 (lambda (x)(> x 18a0: 20 33 29 29 20 64 65 6c 74 61 29 29 29 29 0a 0a 3)) delta)))).. 18b0: 28 64 65 66 69 6e 65 20 28 75 70 64 61 74 65 2d (define (update- 18c0: 72 75 6e 64 61 74 20 70 61 74 74 20 6e 75 6d 72 rundat patt numr 18d0: 75 6e 73 29 0a 20 20 28 6c 65 74 2a 20 28 28 61 uns). (let* ((a 18e0: 6c 6c 72 75 6e 73 20 20 20 20 20 28 64 62 2d 67 llruns (db-g 18f0: 65 74 2d 72 75 6e 73 20 2a 64 62 2a 20 70 61 74 et-runs *db* pat 1900: 74 20 6e 75 6d 72 75 6e 73 20 2a 73 74 61 72 74 t numruns *start 1910: 2d 72 75 6e 2d 6f 66 66 73 65 74 2a 29 29 0a 09 -run-offset*)).. 1920: 20 28 68 65 61 64 65 72 20 20 20 20 20 20 28 64 (header (d 1930: 62 3a 67 65 74 2d 68 65 61 64 65 72 20 61 6c 6c b:get-header all 1940: 72 75 6e 73 29 29 0a 09 20 28 72 75 6e 73 20 20 runs)).. (runs 1950: 20 20 20 20 20 20 28 64 62 3a 67 65 74 2d 72 6f (db:get-ro 1960: 77 73 20 20 20 61 6c 6c 72 75 6e 73 29 29 0a 09 ws allruns)).. 1970: 20 28 72 65 73 75 6c 74 20 20 20 20 20 20 27 28 (result '( 1980: 29 29 0a 09 20 28 6d 61 78 74 65 73 74 73 20 20 )).. (maxtests 1990: 20 20 30 29 29 0a 20 20 20 20 28 66 6f 72 2d 65 0)). (for-e 19a0: 61 63 68 20 28 6c 61 6d 62 64 61 20 28 72 75 6e ach (lambda (run 19b0: 29 0a 09 09 28 6c 65 74 2a 20 28 28 72 75 6e 2d )...(let* ((run- 19c0: 69 64 20 20 20 28 64 62 2d 67 65 74 2d 76 61 6c id (db-get-val 19d0: 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 6e ue-by-header run 19e0: 20 68 65 61 64 65 72 20 22 69 64 22 29 29 0a 09 header "id")).. 19f0: 09 20 20 20 20 20 20 20 28 74 65 73 74 73 20 20 . (tests 1a00: 20 20 28 64 62 2d 67 65 74 2d 74 65 73 74 73 2d (db-get-tests- 1a10: 66 6f 72 2d 72 75 6e 20 2a 64 62 2a 20 72 75 6e for-run *db* run 1a20: 2d 69 64 29 29 0a 09 09 20 20 20 20 20 20 20 28 -id))... ( 1a30: 6b 65 79 2d 76 61 6c 73 20 28 67 65 74 2d 6b 65 key-vals (get-ke 1a40: 79 2d 76 61 6c 73 20 2a 64 62 2a 20 72 75 6e 2d y-vals *db* run- 1a50: 69 64 29 29 29 0a 09 09 20 20 28 69 66 20 28 3e id)))... (if (> 1a60: 20 28 6c 65 6e 67 74 68 20 74 65 73 74 73 29 20 (length tests) 1a70: 6d 61 78 74 65 73 74 73 29 0a 09 09 20 20 20 20 maxtests)... 1a80: 20 20 28 73 65 74 21 20 6d 61 78 74 65 73 74 73 (set! maxtests 1a90: 20 28 6c 65 6e 67 74 68 20 74 65 73 74 73 29 29 (length tests)) 1aa0: 29 0a 09 09 20 20 28 73 65 74 21 20 72 65 73 75 )... (set! resu 1ab0: 6c 74 20 28 63 6f 6e 73 20 28 76 65 63 74 6f 72 lt (cons (vector 1ac0: 20 72 75 6e 20 74 65 73 74 73 20 6b 65 79 2d 76 run tests key-v 1ad0: 61 6c 73 29 20 72 65 73 75 6c 74 29 29 29 29 0a als) result)))). 1ae0: 09 20 20 20 20 20 20 72 75 6e 73 29 0a 20 20 20 . runs). 1af0: 20 28 73 65 74 21 20 2a 68 65 61 64 65 72 2a 20 (set! *header* 1b00: 20 68 65 61 64 65 72 29 0a 20 20 20 20 28 73 65 header). (se 1b10: 74 21 20 2a 61 6c 6c 72 75 6e 73 2a 20 28 72 65 t! *allruns* (re 1b20: 76 65 72 73 65 20 72 65 73 75 6c 74 29 29 0a 20 verse result)). 1b30: 20 20 20 6d 61 78 74 65 73 74 73 29 29 0a 0a 28 maxtests))..( 1b40: 64 65 66 69 6e 65 20 28 75 70 64 61 74 65 2d 6c define (update-l 1b50: 61 62 65 6c 73 20 75 69 64 61 74 29 0a 20 20 28 abels uidat). ( 1b60: 6c 65 74 2a 20 28 28 72 6f 77 6e 20 20 20 20 30 let* ((rown 0 1b70: 29 0a 09 20 28 6c 66 74 63 6f 6c 20 28 76 65 63 ).. (lftcol (vec 1b80: 74 6f 72 2d 72 65 66 20 75 69 64 61 74 20 30 29 tor-ref uidat 0) 1b90: 29 0a 09 20 28 6d 61 78 6e 20 20 20 28 2d 20 28 ).. (maxn (- ( 1ba0: 76 65 63 74 6f 72 2d 6c 65 6e 67 74 68 20 6c 66 vector-length lf 1bb0: 74 63 6f 6c 29 20 31 29 29 29 0a 20 20 20 20 28 tcol) 1))). ( 1bc0: 6c 65 74 20 6c 6f 6f 70 20 28 28 69 20 30 29 29 let loop ((i 0)) 1bd0: 0a 20 20 20 20 20 20 28 69 75 70 3a 61 74 74 72 . (iup:attr 1be0: 69 62 75 74 65 2d 73 65 74 21 20 28 76 65 63 74 ibute-set! (vect 1bf0: 6f 72 2d 72 65 66 20 6c 66 74 63 6f 6c 20 69 29 or-ref lftcol i) 1c00: 20 22 54 49 54 4c 45 22 20 22 22 29 0a 20 20 20 "TITLE" ""). 1c10: 20 20 20 28 69 66 20 28 3c 3d 20 69 20 72 6f 77 (if (<= i row 1c20: 6e 29 0a 09 20 20 28 6c 6f 6f 70 20 28 2b 20 69 n).. (loop (+ i 1c30: 20 31 29 29 29 29 0a 20 20 20 20 28 66 6f 72 2d 1)))). (for- 1c40: 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 6e 61 each (lambda (na 1c50: 6d 65 29 0a 09 09 28 69 66 20 28 3c 3d 20 72 6f me)...(if (<= ro 1c60: 77 6e 20 6d 61 78 6e 29 0a 09 09 20 20 20 20 28 wn maxn)... ( 1c70: 6c 65 74 20 28 28 6c 61 62 6c 20 28 76 65 63 74 let ((labl (vect 1c80: 6f 72 2d 72 65 66 20 6c 66 74 63 6f 6c 20 72 6f or-ref lftcol ro 1c90: 77 6e 29 29 29 0a 09 09 20 20 20 20 20 20 28 69 wn)))... (i 1ca0: 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 up:attribute-set 1cb0: 21 20 6c 61 62 6c 20 22 54 49 54 4c 45 22 20 6e ! labl "TITLE" n 1cc0: 61 6d 65 29 29 29 0a 09 09 28 73 65 74 21 20 72 ame)))...(set! r 1cd0: 6f 77 6e 20 28 2b 20 31 20 72 6f 77 6e 29 29 29 own (+ 1 rown))) 1ce0: 0a 09 20 20 20 20 20 20 28 64 72 6f 70 20 2a 61 .. (drop *a 1cf0: 6c 6c 74 65 73 74 6e 61 6d 65 6c 73 74 2a 20 2a lltestnamelst* * 1d00: 73 74 61 72 74 2d 74 65 73 74 2d 6f 66 66 73 65 start-test-offse 1d10: 74 2a 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 t*))))..(define 1d20: 28 75 70 64 61 74 65 2d 62 75 74 74 6f 6e 73 20 (update-buttons 1d30: 75 69 64 61 74 20 6e 75 6d 72 75 6e 73 20 6e 75 uidat numruns nu 1d40: 6d 74 65 73 74 73 29 0a 20 20 28 6c 65 74 2a 20 mtests). (let* 1d50: 28 28 72 75 6e 73 20 20 20 20 20 20 20 20 28 69 ((runs (i 1d60: 66 20 28 3e 20 28 6c 65 6e 67 74 68 20 2a 61 6c f (> (length *al 1d70: 6c 72 75 6e 73 2a 29 20 6e 75 6d 72 75 6e 73 29 lruns*) numruns) 1d80: 0a 09 09 09 20 20 28 74 61 6b 65 2d 72 69 67 68 .... (take-righ 1d90: 74 20 2a 61 6c 6c 72 75 6e 73 2a 20 6e 75 6d 72 t *allruns* numr 1da0: 75 6e 73 29 0a 09 09 09 20 20 28 70 61 64 2d 6c uns).... (pad-l 1db0: 69 73 74 20 2a 61 6c 6c 72 75 6e 73 2a 20 6e 75 ist *allruns* nu 1dc0: 6d 72 75 6e 73 29 29 29 0a 09 20 28 6c 66 74 63 mruns))).. (lftc 1dd0: 6f 6c 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d ol (vector- 1de0: 72 65 66 20 75 69 64 61 74 20 30 29 29 0a 09 20 ref uidat 0)).. 1df0: 28 74 61 62 6c 65 68 65 61 64 65 72 20 28 76 65 (tableheader (ve 1e00: 63 74 6f 72 2d 72 65 66 20 75 69 64 61 74 20 31 ctor-ref uidat 1 1e10: 29 29 0a 09 20 28 74 61 62 6c 65 20 20 20 20 20 )).. (table 1e20: 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 75 69 (vector-ref ui 1e30: 64 61 74 20 32 29 29 0a 09 20 28 63 6f 6c 6e 20 dat 2)).. (coln 1e40: 20 20 20 20 20 20 20 30 29 29 0a 20 20 20 20 28 0)). ( 1e50: 75 70 64 61 74 65 2d 6c 61 62 65 6c 73 20 75 69 update-labels ui 1e60: 64 61 74 29 0a 20 20 20 20 28 66 6f 72 2d 65 61 dat). (for-ea 1e70: 63 68 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 ch. (lambda 1e80: 28 72 75 6e 64 61 74 29 0a 20 20 20 20 20 20 20 (rundat). 1e90: 28 69 66 20 28 6e 6f 74 20 72 75 6e 64 61 74 29 (if (not rundat) 1ea0: 20 3b 3b 20 68 61 6e 64 6c 65 20 70 61 64 64 65 ;; handle padde 1eb0: 64 20 72 75 6e 73 0a 09 20 20 20 3b 3b 20 20 20 d runs.. ;; 1ec0: 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 ;; 1ed0: 69 64 20 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 id run-id testna 1ee0: 6d 65 20 73 74 61 74 65 20 73 74 61 74 75 73 20 me state status 1ef0: 65 76 65 6e 74 2d 74 69 6d 65 20 68 6f 73 74 20 event-time host 1f00: 63 70 75 6c 6f 61 64 20 64 69 73 6b 66 72 65 65 cpuload diskfree 1f10: 20 75 6e 61 6d 65 20 72 75 6e 64 69 72 20 69 74 uname rundir it 1f20: 65 6d 2d 70 61 74 68 20 72 75 6e 2d 64 75 72 61 em-path run-dura 1f30: 74 69 6f 6e 0a 09 20 20 20 28 73 65 74 21 20 72 tion.. (set! r 1f40: 75 6e 64 61 74 20 28 76 65 63 74 6f 72 20 28 6d undat (vector (m 1f50: 61 6b 65 2d 76 65 63 74 6f 72 20 32 30 20 23 66 ake-vector 20 #f 1f60: 29 20 27 28 29 20 28 6d 61 70 20 28 6c 61 6d 62 ) '() (map (lamb 1f70: 64 61 20 28 78 29 20 22 22 29 20 2a 6b 65 79 73 da (x) "") *keys 1f80: 2a 29 29 29 29 3b 3b 20 33 29 29 29 0a 20 20 20 *))));; 3))). 1f90: 20 20 20 20 28 6c 65 74 2a 20 28 28 72 75 6e 20 (let* ((run 1fa0: 20 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 (vector-ref 1fb0: 20 72 75 6e 64 61 74 20 30 29 29 0a 09 20 20 20 rundat 0)).. 1fc0: 20 20 20 28 74 65 73 74 73 64 61 74 20 28 76 65 (testsdat (ve 1fd0: 63 74 6f 72 2d 72 65 66 20 72 75 6e 64 61 74 20 ctor-ref rundat 1fe0: 31 29 29 0a 09 20 20 20 20 20 20 28 6b 65 79 2d 1)).. (key- 1ff0: 76 61 6c 2d 64 61 74 20 28 76 65 63 74 6f 72 2d val-dat (vector- 2000: 72 65 66 20 72 75 6e 64 61 74 20 32 29 29 0a 09 ref rundat 2)).. 2010: 20 20 20 20 20 20 28 72 75 6e 2d 69 64 20 20 20 (run-id 2020: 28 64 62 2d 67 65 74 2d 76 61 6c 75 65 2d 62 79 (db-get-value-by 2030: 2d 68 65 61 64 65 72 20 72 75 6e 20 2a 68 65 61 -header run *hea 2040: 64 65 72 2a 20 22 69 64 22 29 29 0a 09 20 20 20 der* "id")).. 2050: 20 20 20 28 74 65 73 74 6e 61 6d 65 73 20 28 64 (testnames (d 2060: 65 6c 65 74 65 2d 64 75 70 6c 69 63 61 74 65 73 elete-duplicates 2070: 20 28 61 70 70 65 6e 64 20 2a 61 6c 6c 74 65 73 (append *alltes 2080: 74 6e 61 6d 65 6c 73 74 2a 20 0a 09 09 09 09 09 tnamelst* ...... 2090: 09 20 20 20 20 28 6d 61 70 20 74 65 73 74 3a 74 . (map test:t 20a0: 65 73 74 2d 67 65 74 2d 66 75 6c 6c 6e 61 6d 65 est-get-fullname 20b0: 20 74 65 73 74 73 64 61 74 29 29 29 29 20 3b 3b testsdat)))) ;; 20c0: 20 28 74 61 6b 65 20 28 70 61 64 2d 6c 69 73 74 (take (pad-list 20d0: 20 74 65 73 74 73 64 61 74 20 6e 75 6d 74 65 73 testsdat numtes 20e0: 74 73 29 20 6e 75 6d 74 65 73 74 73 29 29 0a 09 ts) numtests)).. 20f0: 20 20 20 20 20 20 28 6b 65 79 2d 76 61 6c 73 20 (key-vals 2100: 28 61 70 70 65 6e 64 20 6b 65 79 2d 76 61 6c 2d (append key-val- 2110: 64 61 74 0a 09 09 09 09 28 6c 69 73 74 20 28 6c dat.....(list (l 2120: 65 74 20 28 28 78 20 28 64 62 2d 67 65 74 2d 76 et ((x (db-get-v 2130: 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 alue-by-header r 2140: 75 6e 20 2a 68 65 61 64 65 72 2a 20 22 72 75 6e un *header* "run 2150: 6e 61 6d 65 22 29 29 29 0a 09 09 09 09 09 28 69 name")))......(i 2160: 66 20 78 20 78 20 22 22 29 29 29 29 29 0a 09 20 f x x ""))))).. 2170: 20 20 20 20 20 28 72 75 6e 2d 6b 65 79 20 20 28 (run-key ( 2180: 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 string-intersper 2190: 73 65 20 6b 65 79 2d 76 61 6c 73 20 22 5c 6e 22 se key-vals "\n" 21a0: 29 29 29 0a 09 20 3b 3b 20 28 72 75 6e 2d 68 74 ))).. ;; (run-ht 21b0: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 (hash-table-re 21c0: 66 2f 64 65 66 61 75 6c 74 20 61 6c 6c 64 61 74 f/default alldat 21d0: 20 72 75 6e 2d 6b 65 79 20 23 66 29 29 29 0a 09 run-key #f))).. 21e0: 20 3b 3b 20 66 69 6c 6c 20 69 6e 20 74 68 65 20 ;; fill in the 21f0: 72 75 6e 20 68 65 61 64 65 72 20 6b 65 79 20 76 run header key v 2200: 61 6c 75 65 73 0a 09 20 28 6c 65 74 20 28 28 72 alues.. (let ((r 2210: 6f 77 6e 20 20 20 20 20 20 30 29 0a 09 20 20 20 own 0).. 2220: 20 20 20 20 28 68 65 61 64 65 72 63 6f 6c 20 28 (headercol ( 2230: 76 65 63 74 6f 72 2d 72 65 66 20 74 61 62 6c 65 vector-ref table 2240: 68 65 61 64 65 72 20 63 6f 6c 6e 29 29 29 0a 09 header coln))).. 2250: 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 (for-each (la 2260: 6d 62 64 61 20 28 6b 76 61 6c 29 0a 09 09 20 20 mbda (kval)... 2270: 20 20 20 20 20 28 6c 65 74 2a 20 28 28 6c 61 62 (let* ((lab 2280: 6c 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d 72 l (vector-r 2290: 65 66 20 68 65 61 64 65 72 63 6f 6c 20 72 6f 77 ef headercol row 22a0: 6e 29 29 29 0a 09 09 09 20 28 69 66 20 28 6e 6f n))).... (if (no 22b0: 74 20 28 65 71 75 61 6c 3f 20 6b 76 61 6c 20 28 t (equal? kval ( 22c0: 69 75 70 3a 61 74 74 72 69 62 75 74 65 20 6c 61 iup:attribute la 22d0: 62 6c 20 22 54 49 54 4c 45 22 29 29 29 0a 09 09 bl "TITLE")))... 22e0: 09 20 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 . (iup:attri 22f0: 62 75 74 65 2d 73 65 74 21 20 28 76 65 63 74 6f bute-set! (vecto 2300: 72 2d 72 65 66 20 68 65 61 64 65 72 63 6f 6c 20 r-ref headercol 2310: 72 6f 77 6e 29 20 22 54 49 54 4c 45 22 20 6b 76 rown) "TITLE" kv 2320: 61 6c 29 29 0a 09 09 09 20 28 73 65 74 21 20 72 al)).... (set! r 2330: 6f 77 6e 20 28 2b 20 72 6f 77 6e 20 31 29 29 29 own (+ rown 1))) 2340: 29 0a 09 09 20 20 20 20 20 6b 65 79 2d 76 61 6c )... key-val 2350: 73 29 29 0a 0a 09 20 3b 3b 20 46 6f 72 20 74 68 s))... ;; For th 2360: 69 73 20 72 75 6e 20 6e 6f 77 20 66 69 6c 6c 20 is run now fill 2370: 69 6e 20 74 68 65 20 62 75 74 74 6f 6e 73 20 66 in the buttons f 2380: 6f 72 20 65 61 63 68 20 74 65 73 74 0a 09 20 28 or each test.. ( 2390: 6c 65 74 20 28 28 72 6f 77 6e 20 30 29 0a 09 20 let ((rown 0).. 23a0: 20 20 20 20 20 20 28 63 6f 6c 75 6d 6e 64 61 74 (columndat 23b0: 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 74 61 (vector-ref ta 23c0: 62 6c 65 20 63 6f 6c 6e 29 29 29 0a 09 20 20 20 ble coln))).. 23d0: 28 66 6f 72 2d 65 61 63 68 0a 09 20 20 20 20 28 (for-each.. ( 23e0: 6c 61 6d 62 64 61 20 28 74 65 73 74 6e 61 6d 65 lambda (testname 23f0: 29 0a 09 20 20 20 20 20 20 28 6c 65 74 20 28 28 ).. (let (( 2400: 62 75 74 74 6f 6e 64 61 74 20 20 28 68 61 73 68 buttondat (hash 2410: 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 -table-ref/defau 2420: 6c 74 20 2a 62 75 74 74 6f 6e 64 61 74 2a 20 28 lt *buttondat* ( 2430: 6d 6b 73 74 72 20 63 6f 6c 6e 20 72 6f 77 6e 29 mkstr coln rown) 2440: 20 23 66 29 29 29 0a 09 09 28 69 66 20 62 75 74 #f)))...(if but 2450: 74 6f 6e 64 61 74 0a 09 09 20 20 20 20 28 6c 65 tondat... (le 2460: 74 2a 20 28 28 74 65 73 74 20 20 20 20 20 20 20 t* ((test 2470: 28 6c 65 74 20 28 28 6d 61 74 63 68 69 6e 67 20 (let ((matching 2480: 28 66 69 6c 74 65 72 20 0a 09 09 09 09 09 09 09 (filter ........ 2490: 28 6c 61 6d 62 64 61 20 28 78 29 28 65 71 75 61 (lambda (x)(equa 24a0: 6c 3f 20 28 74 65 73 74 3a 74 65 73 74 2d 67 65 l? (test:test-ge 24b0: 74 2d 66 75 6c 6c 6e 61 6d 65 20 78 29 20 74 65 t-fullname x) te 24c0: 73 74 6e 61 6d 65 29 29 0a 09 09 09 09 09 09 09 stname))........ 24d0: 74 65 73 74 73 64 61 74 29 29 29 0a 09 09 09 09 testsdat)))..... 24e0: 09 20 28 69 66 20 28 6e 75 6c 6c 3f 20 6d 61 74 . (if (null? mat 24f0: 63 68 69 6e 67 29 0a 09 09 09 09 09 20 20 20 20 ching)...... 2500: 20 28 76 65 63 74 6f 72 20 2d 31 20 2d 31 20 22 (vector -1 -1 " 2510: 22 20 22 22 20 22 22 20 30 20 22 22 20 22 22 20 " "" "" 0 "" "" 2520: 30 20 22 22 20 22 22 20 22 22 20 30 20 22 22 20 0 "" "" "" 0 "" 2530: 22 22 29 0a 09 09 09 09 09 20 20 20 20 20 28 63 "")...... (c 2540: 61 72 20 6d 61 74 63 68 69 6e 67 29 29 29 29 0a ar matching)))). 2550: 09 09 09 20 20 20 3b 3b 20 28 74 65 73 74 20 20 ... ;; (test 2560: 20 20 20 20 20 28 69 66 20 72 65 61 6c 2d 74 65 (if real-te 2570: 73 74 20 72 65 61 6c 2d 74 65 73 74 0a 09 09 09 st real-test.... 2580: 20 20 20 28 74 65 73 74 6e 61 6d 65 20 20 20 28 (testname ( 2590: 64 62 3a 74 65 73 74 2d 67 65 74 2d 74 65 73 74 db:test-get-test 25a0: 6e 61 6d 65 20 20 74 65 73 74 29 29 0a 09 09 09 name test)).... 25b0: 20 20 20 28 69 74 65 6d 70 61 74 68 20 20 20 28 (itempath ( 25c0: 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 74 65 6d db:test-get-item 25d0: 2d 70 61 74 68 20 74 65 73 74 29 29 0a 09 09 09 -path test)).... 25e0: 20 20 20 28 74 65 73 74 66 75 6c 6c 6e 61 6d 65 (testfullname 25f0: 20 28 74 65 73 74 3a 74 65 73 74 2d 67 65 74 2d (test:test-get- 2600: 66 75 6c 6c 6e 61 6d 65 20 74 65 73 74 29 29 0a fullname test)). 2610: 09 09 09 20 20 20 28 74 65 73 74 73 74 61 74 75 ... (teststatu 2620: 73 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 s (db:test-get-s 2630: 74 61 74 75 73 20 20 20 74 65 73 74 29 29 0a 09 tatus test)).. 2640: 09 09 20 20 20 28 74 65 73 74 73 74 61 74 65 20 .. (teststate 2650: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 (db:test-get-st 2660: 61 74 65 20 20 20 20 74 65 73 74 29 29 0a 09 09 ate test))... 2670: 09 20 20 20 28 74 65 73 74 73 74 61 72 74 20 20 . (teststart 2680: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 65 76 65 (db:test-get-eve 2690: 6e 74 5f 74 69 6d 65 20 74 65 73 74 29 29 0a 09 nt_time test)).. 26a0: 09 09 20 20 20 28 72 75 6e 74 69 6d 65 20 20 20 .. (runtime 26b0: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 (db:test-get-ru 26c0: 6e 5f 64 75 72 61 74 69 6f 6e 20 74 65 73 74 29 n_duration test) 26d0: 29 0a 09 09 09 20 20 20 28 62 75 74 74 6f 6e 74 ).... (buttont 26e0: 78 74 20 20 28 69 66 20 28 65 71 75 61 6c 3f 20 xt (if (equal? 26f0: 74 65 73 74 73 74 61 74 65 20 22 43 4f 4d 50 4c teststate "COMPL 2700: 45 54 45 44 22 29 20 74 65 73 74 73 74 61 74 75 ETED") teststatu 2710: 73 20 74 65 73 74 73 74 61 74 65 29 29 0a 09 09 s teststate))... 2720: 09 20 20 20 28 62 75 74 74 6f 6e 20 20 20 20 20 . (button 2730: 28 76 65 63 74 6f 72 2d 72 65 66 20 63 6f 6c 75 (vector-ref colu 2740: 6d 6e 64 61 74 20 72 6f 77 6e 29 29 0a 09 09 09 mndat rown)).... 2750: 20 20 20 28 63 6f 6c 6f 72 20 20 20 20 20 20 28 (color ( 2760: 63 61 73 65 20 28 73 74 72 69 6e 67 2d 3e 73 79 case (string->sy 2770: 6d 62 6f 6c 20 74 65 73 74 73 74 61 74 65 29 0a mbol teststate). 2780: 09 09 09 09 09 20 28 28 43 4f 4d 50 4c 45 54 45 ..... ((COMPLETE 2790: 44 29 0a 09 09 09 09 09 20 20 28 69 66 20 28 65 D)...... (if (e 27a0: 71 75 61 6c 3f 20 74 65 73 74 73 74 61 74 75 73 qual? teststatus 27b0: 20 22 50 41 53 53 22 29 20 22 37 30 20 32 34 39 "PASS") "70 249 27c0: 20 37 33 22 20 22 32 32 33 20 33 33 20 34 39 22 73" "223 33 49" 27d0: 29 29 20 3b 3b 20 67 72 65 65 6e 69 73 68 20 72 )) ;; greenish r 27e0: 65 64 69 73 68 0a 09 09 09 09 09 20 28 28 4c 41 edish...... ((LA 27f0: 55 4e 43 48 45 44 29 20 20 20 20 20 20 20 20 20 UNCHED) 2800: 22 31 30 31 20 31 32 33 20 31 34 32 22 29 0a 09 "101 123 142").. 2810: 09 09 09 09 20 28 28 43 48 45 43 4b 29 20 20 20 .... ((CHECK) 2820: 20 20 20 20 20 20 20 20 20 22 32 35 35 20 31 30 "255 10 2830: 30 20 35 30 22 29 0a 09 09 09 09 09 20 28 28 52 0 50")...... ((R 2840: 45 4d 4f 54 45 48 4f 53 54 53 54 41 52 54 29 20 EMOTEHOSTSTART) 2850: 20 22 35 30 20 31 33 30 20 31 39 35 22 29 0a 09 "50 130 195").. 2860: 09 09 09 09 20 28 28 52 55 4e 4e 49 4e 47 29 20 .... ((RUNNING) 2870: 20 20 20 20 20 20 20 20 20 22 39 20 31 33 31 20 "9 131 2880: 32 33 32 22 29 0a 09 09 09 09 09 20 28 28 4b 49 232")...... ((KI 2890: 4c 4c 52 45 51 29 20 20 20 20 20 20 20 20 20 20 LLREQ) 28a0: 22 33 39 20 38 32 20 32 30 36 22 29 0a 09 09 09 "39 82 206").... 28b0: 09 09 20 28 28 4b 49 4c 4c 45 44 29 20 20 20 20 .. ((KILLED) 28c0: 20 20 20 20 20 20 20 22 32 33 34 20 31 30 31 20 "234 101 28d0: 31 37 22 29 0a 09 09 09 09 09 20 28 65 6c 73 65 17")...... (else 28e0: 20 22 31 39 32 20 31 39 32 20 31 39 32 22 29 29 "192 192 192")) 28f0: 29 0a 09 09 09 20 20 20 28 63 75 72 72 2d 63 6f ).... (curr-co 2900: 6c 6f 72 20 28 76 65 63 74 6f 72 2d 72 65 66 20 lor (vector-ref 2910: 62 75 74 74 6f 6e 64 61 74 20 31 29 29 20 3b 3b buttondat 1)) ;; 2920: 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 20 (iup:attribute 2930: 62 75 74 74 6f 6e 20 22 42 47 43 4f 4c 4f 52 22 button "BGCOLOR" 2940: 29 29 0a 09 09 09 20 20 20 28 63 75 72 72 2d 74 )).... (curr-t 2950: 69 74 6c 65 20 28 76 65 63 74 6f 72 2d 72 65 66 itle (vector-ref 2960: 20 62 75 74 74 6f 6e 64 61 74 20 32 29 29 29 20 buttondat 2))) 2970: 3b 3b 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 ;; (iup:attribut 2980: 65 20 62 75 74 74 6f 6e 20 22 54 49 54 4c 45 22 e button "TITLE" 2990: 29 29 29 0a 09 09 3b 3b 20 20 20 20 20 20 20 28 )))...;; ( 29a0: 69 66 20 28 61 6e 64 20 28 65 71 75 61 6c 3f 20 if (and (equal? 29b0: 74 65 73 74 73 74 61 74 65 20 22 52 55 4e 4e 49 teststate "RUNNI 29c0: 4e 47 22 29 0a 09 09 3b 3b 20 09 20 20 20 20 20 NG")...;; . 29d0: 20 20 28 3e 20 28 2d 20 28 63 75 72 72 65 6e 74 (> (- (current 29e0: 2d 73 65 63 6f 6e 64 73 29 20 28 2b 20 74 65 73 -seconds) (+ tes 29f0: 74 73 74 61 72 74 20 72 75 6e 74 69 6d 65 29 29 tstart runtime)) 2a00: 20 31 30 30 29 29 20 3b 3b 20 69 66 20 74 65 73 100)) ;; if tes 2a10: 74 20 68 61 73 20 62 65 65 6e 20 64 65 61 64 20 t has been dead 2a20: 66 6f 72 20 6d 6f 72 65 20 74 68 61 6e 20 31 30 for more than 10 2a30: 30 20 73 65 63 6f 6e 64 73 2c 20 63 61 6c 6c 20 0 seconds, call 2a40: 69 74 20 64 65 61 64 0a 09 09 09 20 20 0a 09 09 it dead.... ... 2a50: 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 (if (not ( 2a60: 65 71 75 61 6c 3f 20 63 75 72 72 2d 63 6f 6c 6f equal? curr-colo 2a70: 72 20 63 6f 6c 6f 72 29 29 0a 09 09 09 20 20 28 r color)).... ( 2a80: 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 iup:attribute-se 2a90: 74 21 20 62 75 74 74 6f 6e 20 22 42 47 43 4f 4c t! button "BGCOL 2aa0: 4f 52 22 20 63 6f 6c 6f 72 29 29 0a 09 09 20 20 OR" color))... 2ab0: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 65 71 (if (not (eq 2ac0: 75 61 6c 3f 20 63 75 72 72 2d 74 69 74 6c 65 20 ual? curr-title 2ad0: 62 75 74 74 6f 6e 74 78 74 29 29 0a 09 09 09 20 buttontxt)).... 2ae0: 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d (iup:attribute- 2af0: 73 65 74 21 20 62 75 74 74 6f 6e 20 22 54 49 54 set! button "TIT 2b00: 4c 45 22 20 20 20 62 75 74 74 6f 6e 74 78 74 29 LE" buttontxt) 2b10: 29 0a 09 09 20 20 20 20 20 20 28 76 65 63 74 6f )... (vecto 2b20: 72 2d 73 65 74 21 20 62 75 74 74 6f 6e 64 61 74 r-set! buttondat 2b30: 20 30 20 72 75 6e 2d 69 64 29 0a 09 09 20 20 20 0 run-id)... 2b40: 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 (vector-set! 2b50: 62 75 74 74 6f 6e 64 61 74 20 31 20 63 6f 6c 6f buttondat 1 colo 2b60: 72 29 0a 09 09 20 20 20 20 20 20 28 76 65 63 74 r)... (vect 2b70: 6f 72 2d 73 65 74 21 20 62 75 74 74 6f 6e 64 61 or-set! buttonda 2b80: 74 20 32 20 62 75 74 74 6f 6e 74 78 74 29 0a 09 t 2 buttontxt).. 2b90: 09 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d 73 . (vector-s 2ba0: 65 74 21 20 62 75 74 74 6f 6e 64 61 74 20 33 20 et! buttondat 3 2bb0: 74 65 73 74 29 0a 09 09 20 20 20 20 20 20 28 76 test)... (v 2bc0: 65 63 74 6f 72 2d 73 65 74 21 20 62 75 74 74 6f ector-set! butto 2bd0: 6e 64 61 74 20 34 20 72 75 6e 2d 6b 65 79 29 0a ndat 4 run-key). 2be0: 09 09 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 .. (if (not 2bf0: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref 2c00: 2f 64 65 66 61 75 6c 74 20 2a 61 6c 6c 74 65 73 /default *alltes 2c10: 74 6e 61 6d 65 73 2a 20 74 65 73 74 66 75 6c 6c tnames* testfull 2c20: 6e 61 6d 65 20 23 66 29 29 0a 09 09 09 20 20 28 name #f)).... ( 2c30: 62 65 67 69 6e 0a 09 09 09 20 20 20 20 28 68 61 begin.... (ha 2c40: 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 2a 61 sh-table-set! *a 2c50: 6c 6c 74 65 73 74 6e 61 6d 65 73 2a 20 74 65 73 lltestnames* tes 2c60: 74 66 75 6c 6c 6e 61 6d 65 20 23 74 29 0a 09 09 tfullname #t)... 2c70: 09 20 20 20 20 28 73 65 74 21 20 2a 61 6c 6c 74 . (set! *allt 2c80: 65 73 74 6e 61 6d 65 6c 73 74 2a 20 28 61 70 70 estnamelst* (app 2c90: 65 6e 64 20 2a 61 6c 6c 74 65 73 74 6e 61 6d 65 end *alltestname 2ca0: 6c 73 74 2a 20 28 6c 69 73 74 20 74 65 73 74 66 lst* (list testf 2cb0: 75 6c 6c 6e 61 6d 65 29 29 29 29 29 29 0a 09 09 ullname))))))... 2cc0: 20 20 20 20 29 0a 09 09 28 73 65 74 21 20 72 6f )...(set! ro 2cd0: 77 6e 20 28 2b 20 72 6f 77 6e 20 31 29 29 29 29 wn (+ rown 1)))) 2ce0: 0a 09 20 20 20 20 28 64 72 6f 70 20 74 65 73 74 .. (drop test 2cf0: 6e 61 6d 65 73 20 2a 73 74 61 72 74 2d 74 65 73 names *start-tes 2d00: 74 2d 6f 66 66 73 65 74 2a 29 29 29 0a 09 20 28 t-offset*))).. ( 2d10: 73 65 74 21 20 63 6f 6c 6e 20 28 2b 20 63 6f 6c set! coln (+ col 2d20: 6e 20 31 29 29 29 29 0a 20 20 20 20 20 72 75 6e n 1)))). run 2d30: 73 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 6d s)))..(define (m 2d40: 6b 73 74 72 20 2e 20 78 29 0a 20 20 28 73 74 72 kstr . x). (str 2d50: 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 ing-intersperse 2d60: 28 6d 61 70 20 63 6f 6e 63 20 78 29 20 22 2c 22 (map conc x) "," 2d70: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 75 70 64 ))..(define (upd 2d80: 61 74 65 2d 73 65 61 72 63 68 20 78 20 76 61 6c ate-search x val 2d90: 29 0a 20 20 28 70 72 69 6e 74 20 22 53 65 74 74 ). (print "Sett 2da0: 69 6e 67 20 73 65 61 72 63 68 20 66 6f 72 20 22 ing search for " 2db0: 20 78 20 22 20 74 6f 20 22 20 76 61 6c 29 0a 20 x " to " val). 2dc0: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 (hash-table-set 2dd0: 21 20 2a 73 65 61 72 63 68 70 61 74 74 73 2a 20 ! *searchpatts* 2de0: 78 20 76 61 6c 29 29 0a 0a 28 64 65 66 69 6e 65 x val))..(define 2df0: 20 28 6d 61 6b 65 2d 64 61 73 68 62 6f 61 72 64 (make-dashboard 2e00: 2d 62 75 74 74 6f 6e 73 20 6e 72 75 6e 73 20 6e -buttons nruns n 2e10: 74 65 73 74 73 20 6b 65 79 6e 61 6d 65 73 29 0a tests keynames). 2e20: 20 20 28 6c 65 74 2a 20 28 28 6e 6b 65 79 73 20 (let* ((nkeys 2e30: 20 20 28 6c 65 6e 67 74 68 20 6b 65 79 6e 61 6d (length keynam 2e40: 65 73 29 29 0a 09 20 28 72 75 6e 73 76 65 63 20 es)).. (runsvec 2e50: 28 6d 61 6b 65 2d 76 65 63 74 6f 72 20 6e 72 75 (make-vector nru 2e60: 6e 73 29 29 0a 09 20 28 68 65 61 64 65 72 20 20 ns)).. (header 2e70: 28 6d 61 6b 65 2d 76 65 63 74 6f 72 20 6e 72 75 (make-vector nru 2e80: 6e 73 29 29 0a 09 20 28 6c 66 74 63 6f 6c 20 20 ns)).. (lftcol 2e90: 28 6d 61 6b 65 2d 76 65 63 74 6f 72 20 6e 74 65 (make-vector nte 2ea0: 73 74 73 29 29 0a 09 20 28 63 6f 6e 74 72 6f 6c sts)).. (control 2eb0: 73 20 27 28 29 29 0a 09 20 28 6c 66 74 6c 73 74 s '()).. (lftlst 2ec0: 20 20 27 28 29 29 0a 09 20 28 68 64 72 6c 73 74 '()).. (hdrlst 2ed0: 20 20 27 28 29 29 0a 09 20 28 62 64 79 6c 73 74 '()).. (bdylst 2ee0: 20 20 27 28 29 29 0a 09 20 28 72 65 73 75 6c 74 '()).. (result 2ef0: 20 20 27 28 29 29 0a 09 20 28 69 20 20 20 20 20 '()).. (i 2f00: 20 20 30 29 29 0a 20 20 20 20 3b 3b 20 63 6f 6e 0)). ;; con 2f10: 74 72 6f 6c 73 20 28 61 6c 6f 6e 67 20 62 6f 74 trols (along bot 2f20: 74 6f 6d 29 0a 20 20 20 20 28 73 65 74 21 20 63 tom). (set! c 2f30: 6f 6e 74 72 6f 6c 73 0a 09 20 20 28 69 75 70 3a ontrols.. (iup: 2f40: 68 62 6f 78 0a 09 20 20 20 28 69 75 70 3a 62 75 hbox.. (iup:bu 2f50: 74 74 6f 6e 20 22 51 75 69 74 22 20 23 3a 61 63 tton "Quit" #:ac 2f60: 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 tion (lambda (ob 2f70: 6a 29 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c j)(sqlite3:final 2f80: 69 7a 65 21 20 2a 64 62 2a 29 28 65 78 69 74 29 ize! *db*)(exit) 2f90: 29 29 0a 09 20 20 20 28 69 75 70 3a 62 75 74 74 )).. (iup:butt 2fa0: 6f 6e 20 22 3c 2d 20 20 4c 65 66 74 22 20 23 3a on "<- Left" #: 2fb0: 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 action (lambda ( 2fc0: 6f 62 6a 29 28 73 65 74 21 20 2a 73 74 61 72 74 obj)(set! *start 2fd0: 2d 72 75 6e 2d 6f 66 66 73 65 74 2a 20 20 28 2b -run-offset* (+ 2fe0: 20 2a 73 74 61 72 74 2d 72 75 6e 2d 6f 66 66 73 *start-run-offs 2ff0: 65 74 2a 20 31 29 29 29 29 0a 09 20 20 20 28 69 et* 1)))).. (i 3000: 75 70 3a 62 75 74 74 6f 6e 20 22 55 70 20 20 20 up:button "Up 3010: 20 20 5e 22 20 23 3a 61 63 74 69 6f 6e 20 28 6c ^" #:action (l 3020: 61 6d 62 64 61 20 28 6f 62 6a 29 28 73 65 74 21 ambda (obj)(set! 3030: 20 2a 73 74 61 72 74 2d 74 65 73 74 2d 6f 66 66 *start-test-off 3040: 73 65 74 2a 20 28 69 66 20 28 3e 20 2a 73 74 61 set* (if (> *sta 3050: 72 74 2d 74 65 73 74 2d 6f 66 66 73 65 74 2a 20 rt-test-offset* 3060: 30 29 28 2d 20 2a 73 74 61 72 74 2d 74 65 73 74 0)(- *start-test 3070: 2d 6f 66 66 73 65 74 2a 20 31 29 20 30 29 29 29 -offset* 1) 0))) 3080: 29 0a 09 20 20 20 28 69 75 70 3a 62 75 74 74 6f ).. (iup:butto 3090: 6e 20 22 44 6f 77 6e 20 20 20 76 22 20 23 3a 61 n "Down v" #:a 30a0: 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f ction (lambda (o 30b0: 62 6a 29 28 73 65 74 21 20 2a 73 74 61 72 74 2d bj)(set! *start- 30c0: 74 65 73 74 2d 6f 66 66 73 65 74 2a 20 28 69 66 test-offset* (if 30d0: 20 28 3e 3d 20 2a 73 74 61 72 74 2d 74 65 73 74 (>= *start-test 30e0: 2d 6f 66 66 73 65 74 2a 20 28 6c 65 6e 67 74 68 -offset* (length 30f0: 20 2a 61 6c 6c 74 65 73 74 6e 61 6d 65 6c 73 74 *alltestnamelst 3100: 2a 29 29 28 6c 65 6e 67 74 68 20 2a 61 6c 6c 74 *))(length *allt 3110: 65 73 74 6e 61 6d 65 6c 73 74 2a 29 28 2b 20 2a estnamelst*)(+ * 3120: 73 74 61 72 74 2d 74 65 73 74 2d 6f 66 66 73 65 start-test-offse 3130: 74 2a 20 31 29 29 29 29 29 0a 09 20 20 20 28 69 t* 1))))).. (i 3140: 75 70 3a 62 75 74 74 6f 6e 20 22 52 69 67 68 74 up:button "Right 3150: 20 2d 3e 22 20 23 3a 61 63 74 69 6f 6e 20 28 6c ->" #:action (l 3160: 61 6d 62 64 61 20 28 6f 62 6a 29 28 73 65 74 21 ambda (obj)(set! 3170: 20 2a 73 74 61 72 74 2d 72 75 6e 2d 6f 66 66 73 *start-run-offs 3180: 65 74 2a 20 20 28 69 66 20 28 3e 20 2a 73 74 61 et* (if (> *sta 3190: 72 74 2d 72 75 6e 2d 6f 66 66 73 65 74 2a 20 30 rt-run-offset* 0 31a0: 29 28 2d 20 2a 73 74 61 72 74 2d 72 75 6e 2d 6f )(- *start-run-o 31b0: 66 66 73 65 74 2a 20 31 29 20 30 29 29 29 29 29 ffset* 1) 0))))) 31c0: 29 0a 20 20 20 20 0a 20 20 20 20 3b 3b 20 63 72 ). . ;; cr 31d0: 65 61 74 65 20 74 68 65 20 6c 65 66 74 20 6d 6f eate the left mo 31e0: 73 74 20 63 6f 6c 75 6d 6e 20 66 6f 72 20 74 68 st column for th 31f0: 65 20 72 75 6e 20 6b 65 79 20 6e 61 6d 65 73 20 e run key names 3200: 61 6e 64 20 74 68 65 20 74 65 73 74 20 6e 61 6d and the test nam 3210: 65 73 20 0a 20 20 20 20 28 73 65 74 21 20 6c 66 es . (set! lf 3220: 74 6c 73 74 20 28 6c 69 73 74 20 28 61 70 70 6c tlst (list (appl 3230: 79 20 69 75 70 3a 76 62 6f 78 20 0a 09 09 09 20 y iup:vbox .... 3240: 20 20 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 (map (lambd 3250: 61 20 28 78 29 09 09 0a 09 09 09 09 20 20 20 20 a (x)....... 3260: 20 28 6c 65 74 20 28 28 72 65 73 20 28 69 75 70 (let ((res (iup 3270: 3a 68 62 6f 78 0a 09 09 09 09 09 09 20 28 69 75 :hbox....... (iu 3280: 70 3a 6c 61 62 65 6c 20 78 20 23 3a 73 69 7a 65 p:label x #:size 3290: 20 22 34 30 78 31 35 22 20 23 3a 66 6f 6e 74 73 "40x15" #:fonts 32a0: 69 7a 65 20 22 31 30 22 29 20 3b 3b 20 20 23 3a ize "10") ;; #: 32b0: 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 expand "HORIZONT 32c0: 41 4c 22 29 0a 09 09 09 09 09 09 20 28 69 75 70 AL")....... (iup 32d0: 3a 74 65 78 74 62 6f 78 20 23 3a 73 69 7a 65 20 :textbox #:size 32e0: 22 36 30 78 31 35 22 20 23 3a 66 6f 6e 74 73 69 "60x15" #:fontsi 32f0: 7a 65 20 22 31 30 22 20 23 3a 76 61 6c 75 65 20 ze "10" #:value 3300: 22 25 22 20 3b 3b 20 23 3a 65 78 70 61 6e 64 20 "%" ;; #:expand 3310: 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 0a 09 09 09 "HORIZONTAL".... 3320: 09 09 09 09 20 20 20 20 20 20 23 3a 61 63 74 69 .... #:acti 3330: 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 20 on (lambda (obj 3340: 75 6e 6b 20 76 61 6c 29 0a 09 09 09 09 09 09 09 unk val)........ 3350: 09 09 20 28 75 70 64 61 74 65 2d 73 65 61 72 63 .. (update-searc 3360: 68 20 78 20 76 61 6c 29 29 29 29 29 29 0a 09 09 h x val))))))... 3370: 09 09 20 20 20 20 20 20 20 28 73 65 74 21 20 69 .. (set! i 3380: 20 28 2b 20 69 20 31 29 29 0a 09 09 09 09 20 20 (+ i 1))..... 3390: 20 20 20 20 20 72 65 73 29 29 0a 09 09 09 09 20 res))..... 33a0: 20 20 6b 65 79 6e 61 6d 65 73 29 29 29 29 0a 20 keynames)))). 33b0: 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 74 (let loop ((t 33c0: 65 73 74 6e 75 6d 20 20 30 29 0a 09 20 20 20 20 estnum 0).. 33d0: 20 20 20 28 72 65 73 20 20 20 20 20 20 27 28 29 (res '() 33e0: 29 29 0a 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 )). (cond. 33f0: 20 20 20 20 20 20 28 28 3e 3d 20 74 65 73 74 6e ((>= testn 3400: 75 6d 20 6e 74 65 73 74 73 29 0a 09 3b 3b 20 6e um ntests)..;; n 3410: 6f 77 20 6c 66 74 6c 73 74 20 77 69 6c 6c 20 62 ow lftlst will b 3420: 65 20 61 6e 20 68 62 6f 78 20 77 69 74 68 20 74 e an hbox with t 3430: 68 65 20 74 65 73 74 20 6b 65 79 73 20 61 6e 64 he test keys and 3440: 20 74 68 65 20 74 65 73 74 20 6e 61 6d 65 20 6c the test name l 3450: 61 62 65 6c 73 0a 09 28 73 65 74 21 20 6c 66 74 abels..(set! lft 3460: 6c 73 74 20 28 61 70 70 65 6e 64 20 6c 66 74 6c lst (append lftl 3470: 73 74 20 28 6c 69 73 74 20 28 61 70 70 6c 79 20 st (list (apply 3480: 69 75 70 3a 76 62 6f 78 20 28 72 65 76 65 72 73 iup:vbox (revers 3490: 65 20 72 65 73 29 29 29 29 29 29 0a 20 20 20 20 e res)))))). 34a0: 20 20 20 28 65 6c 73 65 0a 09 28 6c 65 74 20 28 (else..(let ( 34b0: 28 6c 61 62 6c 20 20 28 69 75 70 3a 62 75 74 74 (labl (iup:butt 34c0: 6f 6e 20 22 22 20 23 3a 66 6c 61 74 20 22 59 45 on "" #:flat "YE 34d0: 53 22 20 23 3a 73 69 7a 65 20 22 31 30 30 78 31 S" #:size "100x1 34e0: 35 22 20 23 3a 66 6f 6e 74 73 69 7a 65 20 22 31 5" #:fontsize "1 34f0: 30 22 29 29 29 0a 09 20 20 28 76 65 63 74 6f 72 0"))).. (vector 3500: 2d 73 65 74 21 20 6c 66 74 63 6f 6c 20 74 65 73 -set! lftcol tes 3510: 74 6e 75 6d 20 6c 61 62 6c 29 0a 09 20 20 28 6c tnum labl).. (l 3520: 6f 6f 70 20 28 2b 20 74 65 73 74 6e 75 6d 20 31 oop (+ testnum 1 3530: 29 28 63 6f 6e 73 20 6c 61 62 6c 20 72 65 73 29 )(cons labl res) 3540: 29 29 29 29 29 0a 20 20 20 20 3b 3b 20 0a 20 20 ))))). ;; . 3550: 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 72 75 (let loop ((ru 3560: 6e 6e 75 6d 20 20 30 29 0a 09 20 20 20 20 20 20 nnum 0).. 3570: 20 28 6b 65 79 6e 75 6d 20 20 30 29 0a 09 20 20 (keynum 0).. 3580: 20 20 20 20 20 28 6b 65 79 76 65 63 20 20 28 6d (keyvec (m 3590: 61 6b 65 2d 76 65 63 74 6f 72 20 6e 6b 65 79 73 ake-vector nkeys 35a0: 29 29 0a 09 20 20 20 20 20 20 20 28 72 65 73 20 )).. (res 35b0: 20 20 20 27 28 29 29 29 0a 20 20 20 20 20 20 28 '())). ( 35c0: 63 6f 6e 64 20 3b 3b 20 6e 62 2f 2f 20 6e 6f 20 cond ;; nb// no 35d0: 65 6c 73 65 20 66 6f 72 20 74 68 69 73 20 61 70 else for this ap 35e0: 70 72 6f 61 63 68 2e 0a 20 20 20 20 20 20 20 28 proach.. ( 35f0: 28 3e 3d 20 72 75 6e 6e 75 6d 20 6e 72 75 6e 73 (>= runnum nruns 3600: 29 20 23 66 29 0a 20 20 20 20 20 20 20 28 28 3e ) #f). ((> 3610: 3d 20 6b 65 79 6e 75 6d 20 6e 6b 65 79 73 29 20 = keynum nkeys) 3620: 0a 09 28 76 65 63 74 6f 72 2d 73 65 74 21 20 68 ..(vector-set! h 3630: 65 61 64 65 72 20 72 75 6e 6e 75 6d 20 6b 65 79 eader runnum key 3640: 76 65 63 29 0a 09 28 73 65 74 21 20 68 64 72 6c vec)..(set! hdrl 3650: 73 74 20 28 63 6f 6e 73 20 28 61 70 70 6c 79 20 st (cons (apply 3660: 69 75 70 3a 76 62 6f 78 20 28 72 65 76 65 72 73 iup:vbox (revers 3670: 65 20 72 65 73 29 29 20 68 64 72 6c 73 74 29 29 e res)) hdrlst)) 3680: 0a 09 28 6c 6f 6f 70 20 28 2b 20 72 75 6e 6e 75 ..(loop (+ runnu 3690: 6d 20 31 29 20 30 20 28 6d 61 6b 65 2d 76 65 63 m 1) 0 (make-vec 36a0: 74 6f 72 20 6e 6b 65 79 73 29 20 27 28 29 29 29 tor nkeys) '())) 36b0: 0a 20 20 20 20 20 20 20 28 65 6c 73 65 0a 09 28 . (else..( 36c0: 6c 65 74 20 28 28 6c 61 62 6c 20 20 28 69 75 70 let ((labl (iup 36d0: 3a 6c 61 62 65 6c 20 22 22 20 23 3a 73 69 7a 65 :label "" #:size 36e0: 20 22 36 30 78 31 35 22 20 23 3a 66 6f 6e 74 73 "60x15" #:fonts 36f0: 69 7a 65 20 22 31 30 22 20 3b 3b 20 23 3a 65 78 ize "10" ;; #:ex 3700: 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c pand "HORIZONTAL 3710: 22 0a 09 09 09 09 29 29 29 0a 09 20 20 28 76 65 ".....))).. (ve 3720: 63 74 6f 72 2d 73 65 74 21 20 6b 65 79 76 65 63 ctor-set! keyvec 3730: 20 6b 65 79 6e 75 6d 20 6c 61 62 6c 29 0a 09 20 keynum labl).. 3740: 20 28 6c 6f 6f 70 20 72 75 6e 6e 75 6d 20 28 2b (loop runnum (+ 3750: 20 6b 65 79 6e 75 6d 20 31 29 20 6b 65 79 76 65 keynum 1) keyve 3760: 63 20 28 63 6f 6e 73 20 6c 61 62 6c 20 72 65 73 c (cons labl res 3770: 29 29 29 29 29 29 0a 20 20 20 20 3b 3b 20 42 79 )))))). ;; By 3780: 20 68 65 72 65 20 74 68 65 20 68 64 72 6c 73 74 here the hdrlst 3790: 20 63 6f 6e 74 61 69 6e 73 20 61 20 6c 69 73 74 contains a list 37a0: 20 6f 66 20 76 62 6f 78 65 73 20 63 6f 6e 74 61 of vboxes conta 37b0: 69 6e 69 6e 67 20 6e 6b 65 79 73 20 6c 61 62 65 ining nkeys labe 37c0: 6c 73 0a 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 ls. (let loop 37d0: 20 28 28 72 75 6e 6e 75 6d 20 20 30 29 0a 09 20 ((runnum 0).. 37e0: 20 20 20 20 20 20 28 74 65 73 74 6e 75 6d 20 30 (testnum 0 37f0: 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 76 ).. (testv 3800: 65 63 20 20 28 6d 61 6b 65 2d 76 65 63 74 6f 72 ec (make-vector 3810: 20 6e 74 65 73 74 73 29 29 0a 09 20 20 20 20 20 ntests)).. 3820: 20 20 28 72 65 73 20 20 20 20 27 28 29 29 29 0a (res '())). 3830: 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 (cond. 3840: 20 20 20 28 28 3e 3d 20 72 75 6e 6e 75 6d 20 6e ((>= runnum n 3850: 72 75 6e 73 29 20 23 66 29 20 3b 3b 20 20 28 76 runs) #f) ;; (v 3860: 65 63 74 6f 72 20 74 61 62 6c 65 68 65 61 64 65 ector tableheade 3870: 72 20 72 75 6e 73 76 65 63 29 29 0a 20 20 20 20 r runsvec)). 3880: 20 20 20 28 28 3e 3d 20 74 65 73 74 6e 75 6d 20 ((>= testnum 3890: 6e 74 65 73 74 73 29 20 0a 09 28 76 65 63 74 6f ntests) ..(vecto 38a0: 72 2d 73 65 74 21 20 72 75 6e 73 76 65 63 20 72 r-set! runsvec r 38b0: 75 6e 6e 75 6d 20 74 65 73 74 76 65 63 29 0a 09 unnum testvec).. 38c0: 28 73 65 74 21 20 62 64 79 6c 73 74 20 28 63 6f (set! bdylst (co 38d0: 6e 73 20 28 61 70 70 6c 79 20 69 75 70 3a 76 62 ns (apply iup:vb 38e0: 6f 78 20 28 72 65 76 65 72 73 65 20 72 65 73 29 ox (reverse res) 38f0: 29 20 62 64 79 6c 73 74 29 29 0a 09 28 6c 6f 6f ) bdylst))..(loo 3900: 70 20 28 2b 20 72 75 6e 6e 75 6d 20 31 29 20 30 p (+ runnum 1) 0 3910: 20 28 6d 61 6b 65 2d 76 65 63 74 6f 72 20 6e 74 (make-vector nt 3920: 65 73 74 73 29 20 27 28 29 29 29 0a 20 20 20 20 ests) '())). 3930: 20 20 20 28 65 6c 73 65 0a 09 28 6c 65 74 2a 20 (else..(let* 3940: 28 28 62 75 74 74 6f 6e 2d 6b 65 79 20 28 6d 6b ((button-key (mk 3950: 73 74 72 20 72 75 6e 6e 75 6d 20 74 65 73 74 6e str runnum testn 3960: 75 6d 29 29 0a 09 20 20 20 20 20 20 20 28 62 75 um)).. (bu 3970: 74 6e 20 20 20 20 20 20 20 28 69 75 70 3a 62 75 tn (iup:bu 3980: 74 74 6f 6e 20 22 22 20 3b 3b 20 62 75 74 74 6f tton "" ;; butto 3990: 6e 2d 6b 65 79 20 0a 09 09 09 09 20 20 20 20 20 n-key ..... 39a0: 20 20 23 3a 73 69 7a 65 20 22 36 30 78 31 35 22 #:size "60x15" 39b0: 20 0a 09 09 09 09 20 20 20 20 20 20 20 3b 3b 20 ..... ;; 39c0: 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f #:expand "HORIZO 39d0: 4e 54 41 4c 22 0a 09 09 09 09 20 20 20 20 20 20 NTAL"..... 39e0: 20 23 3a 66 6f 6e 74 73 69 7a 65 20 22 31 30 22 #:fontsize "10" 39f0: 20 0a 09 09 09 09 20 20 20 20 20 20 20 23 3a 61 ..... #:a 3a00: 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 78 ction (lambda (x 3a10: 29 0a 09 09 09 09 09 09 20 20 28 65 78 61 6d 69 )....... (exami 3a20: 6e 65 2d 74 65 73 74 20 62 75 74 74 6f 6e 2d 6b ne-test button-k 3a30: 65 79 29 29 29 29 29 0a 09 20 20 28 68 61 73 68 ey))))).. (hash 3a40: 2d 74 61 62 6c 65 2d 73 65 74 21 20 2a 62 75 74 -table-set! *but 3a50: 74 6f 6e 64 61 74 2a 20 62 75 74 74 6f 6e 2d 6b tondat* button-k 3a60: 65 79 20 28 76 65 63 74 6f 72 20 30 20 22 31 30 ey (vector 0 "10 3a70: 30 20 31 30 30 20 31 30 30 22 20 62 75 74 74 6f 0 100 100" butto 3a80: 6e 2d 6b 65 79 20 23 66 20 23 66 29 29 20 0a 09 n-key #f #f)) .. 3a90: 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 74 (vector-set! t 3aa0: 65 73 74 76 65 63 20 74 65 73 74 6e 75 6d 20 62 estvec testnum b 3ab0: 75 74 6e 29 0a 09 20 20 28 6c 6f 6f 70 20 72 75 utn).. (loop ru 3ac0: 6e 6e 75 6d 20 28 2b 20 74 65 73 74 6e 75 6d 20 nnum (+ testnum 3ad0: 31 29 20 74 65 73 74 76 65 63 20 28 63 6f 6e 73 1) testvec (cons 3ae0: 20 62 75 74 6e 20 72 65 73 29 29 29 29 29 29 0a butn res)))))). 3af0: 20 20 20 20 3b 3b 20 6e 6f 77 20 61 73 73 65 6d ;; now assem 3b00: 62 6c 65 20 74 68 65 20 68 64 72 6c 73 74 20 61 ble the hdrlst a 3b10: 6e 64 20 62 64 79 6c 73 74 20 61 6e 64 20 6b 69 nd bdylst and ki 3b20: 63 6b 20 6f 66 66 20 74 68 65 20 64 69 61 6c 6f ck off the dialo 3b30: 67 0a 20 20 20 20 28 69 75 70 3a 73 68 6f 77 0a g. (iup:show. 3b40: 20 20 20 20 20 28 69 75 70 3a 64 69 61 6c 6f 67 (iup:dialog 3b50: 20 0a 20 20 20 20 20 20 23 3a 74 69 74 6c 65 20 . #:title 3b60: 22 4d 65 67 61 74 65 73 74 20 64 61 73 68 62 6f "Megatest dashbo 3b70: 61 72 64 22 0a 20 20 20 20 20 20 28 69 75 70 3a ard". (iup: 3b80: 76 62 6f 78 0a 09 28 61 70 70 6c 79 20 69 75 70 vbox..(apply iup 3b90: 3a 68 62 6f 78 20 0a 09 20 20 20 20 20 20 20 28 :hbox .. ( 3ba0: 63 6f 6e 73 20 28 61 70 70 6c 79 20 69 75 70 3a cons (apply iup: 3bb0: 76 62 6f 78 20 6c 66 74 6c 73 74 29 0a 09 09 20 vbox lftlst)... 3bc0: 20 20 20 20 28 6c 69 73 74 20 0a 09 09 20 20 20 (list ... 3bd0: 20 20 20 28 69 75 70 3a 76 62 6f 78 0a 09 09 20 (iup:vbox... 3be0: 20 20 20 20 20 20 3b 3b 20 74 68 65 20 68 65 61 ;; the hea 3bf0: 64 65 72 0a 09 09 20 20 20 20 20 20 20 28 61 70 der... (ap 3c00: 70 6c 79 20 69 75 70 3a 68 62 6f 78 20 28 72 65 ply iup:hbox (re 3c10: 76 65 72 73 65 20 68 64 72 6c 73 74 29 29 0a 09 verse hdrlst)).. 3c20: 09 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 69 . (apply i 3c30: 75 70 3a 68 62 6f 78 20 28 72 65 76 65 72 73 65 up:hbox (reverse 3c40: 20 62 64 79 6c 73 74 29 29 29 29 29 29 0a 20 20 bdylst)))))). 3c50: 20 20 20 20 20 63 6f 6e 74 72 6f 6c 73 29 29 29 controls))) 3c60: 0a 20 20 20 20 28 76 65 63 74 6f 72 20 6c 66 74 . (vector lft 3c70: 63 6f 6c 20 68 65 61 64 65 72 20 72 75 6e 73 76 col header runsv 3c80: 65 63 29 29 29 0a 0a 28 73 65 74 21 20 2a 6e 75 ec)))..(set! *nu 3c90: 6d 2d 74 65 73 74 73 2a 20 28 6d 61 78 20 28 75 m-tests* (max (u 3ca0: 70 64 61 74 65 2d 72 75 6e 64 61 74 20 22 25 22 pdate-rundat "%" 3cb0: 20 2a 6e 75 6d 2d 72 75 6e 73 2a 29 20 38 29 29 *num-runs*) 8)) 3cc0: 0a 0a 28 73 65 74 21 20 75 69 64 61 74 20 28 6d ..(set! uidat (m 3cd0: 61 6b 65 2d 64 61 73 68 62 6f 61 72 64 2d 62 75 ake-dashboard-bu 3ce0: 74 74 6f 6e 73 20 2a 6e 75 6d 2d 72 75 6e 73 2a ttons *num-runs* 3cf0: 20 2a 6e 75 6d 2d 74 65 73 74 73 2a 20 64 62 6b *num-tests* dbk 3d00: 65 79 73 29 29 0a 3b 3b 20 28 6d 65 67 61 74 65 eys)).;; (megate 3d10: 73 74 2d 64 61 73 68 62 6f 61 72 64 29 0a 0a 28 st-dashboard)..( 3d20: 64 65 66 69 6e 65 20 28 72 75 6e 2d 75 70 64 61 define (run-upda 3d30: 74 65 20 6f 74 68 65 72 2d 74 68 72 65 61 64 29 te other-thread) 3d40: 0a 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 69 . (let loop ((i 3d50: 20 30 29 29 0a 20 20 20 20 28 74 68 72 65 61 64 0)). (thread 3d60: 2d 73 6c 65 65 70 21 20 30 2e 31 29 0a 20 20 20 -sleep! 0.1). 3d70: 20 28 74 68 72 65 61 64 2d 73 75 73 70 65 6e 64 (thread-suspend 3d80: 21 20 6f 74 68 65 72 2d 74 68 72 65 61 64 29 0a ! other-thread). 3d90: 20 20 20 20 28 75 70 64 61 74 65 2d 72 75 6e 64 (update-rund 3da0: 61 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 at (hash-table-r 3db0: 65 66 2f 64 65 66 61 75 6c 74 20 2a 73 65 61 72 ef/default *sear 3dc0: 63 68 70 61 74 74 73 2a 20 22 72 75 6e 6e 61 6d chpatts* "runnam 3dd0: 65 22 20 22 25 22 29 20 2a 6e 75 6d 2d 72 75 6e e" "%") *num-run 3de0: 73 2a 29 0a 20 20 20 20 28 75 70 64 61 74 65 2d s*). (update- 3df0: 62 75 74 74 6f 6e 73 20 75 69 64 61 74 20 2a 6e buttons uidat *n 3e00: 75 6d 2d 72 75 6e 73 2a 20 2a 6e 75 6d 2d 74 65 um-runs* *num-te 3e10: 73 74 73 2a 29 0a 20 20 20 20 28 74 68 72 65 61 sts*). (threa 3e20: 64 2d 72 65 73 75 6d 65 21 20 6f 74 68 65 72 2d d-resume! other- 3e30: 74 68 72 65 61 64 29 0a 20 20 20 20 28 6c 6f 6f thread). (loo 3e40: 70 20 28 2b 20 69 20 31 29 29 29 29 0a 0a 28 64 p (+ i 1))))..(d 3e50: 65 66 69 6e 65 20 74 68 32 20 28 6d 61 6b 65 2d efine th2 (make- 3e60: 74 68 72 65 61 64 20 69 75 70 3a 6d 61 69 6e 2d thread iup:main- 3e70: 6c 6f 6f 70 29 29 0a 28 64 65 66 69 6e 65 20 74 loop)).(define t 3e80: 68 31 20 28 6d 61 6b 65 2d 74 68 72 65 61 64 20 h1 (make-thread 3e90: 28 72 75 6e 2d 75 70 64 61 74 65 20 74 68 32 29 (run-update th2) 3ea0: 29 29 0a 28 74 68 72 65 61 64 2d 73 74 61 72 74 )).(thread-start 3eb0: 21 20 74 68 31 29 0a 28 74 68 72 65 61 64 2d 73 ! th1).(thread-s 3ec0: 74 61 72 74 21 20 74 68 32 29 0a 28 74 68 72 65 tart! th2).(thre 3ed0: 61 64 2d 6a 6f 69 6e 21 20 74 68 32 29 0a ad-join! th2).