Artifact 43e9dd636ea63c878b33798df9fec448ee1f29ae:
- File dashboard.scm — part of check-in [e38c4a9bdd] at 2011-05-03 02:30:39 on branch trunk — Fixed and or implemented; concurrent running tasks limit, derive megatest executable path and add to PATH, add MT_TEST_RUN_DIR (user: matt size: 15608)
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 6c 6f 67 66 )).. (logf 0cc0: 69 6c 65 20 20 20 20 20 20 28 63 6f 6e 63 20 28 ile (conc ( 0cd0: 64 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e 64 db:test-get-rund 0ce0: 69 72 20 74 65 73 74 29 20 22 2f 22 20 28 64 62 ir test) "/" (db 0cf0: 3a 74 65 73 74 2d 67 65 74 2d 66 69 6e 61 6c 5f :test-get-final_ 0d00: 6c 6f 67 66 20 74 65 73 74 29 29 29 0a 09 20 20 logf test))).. 0d10: 20 20 20 20 20 28 76 69 65 77 6c 6f 67 20 20 20 (viewlog 0d20: 20 20 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 (lambda (x).. 0d30: 09 09 20 20 20 20 20 20 20 28 69 66 20 28 66 69 .. (if (fi 0d40: 6c 65 2d 65 78 69 73 74 73 3f 20 6c 6f 67 66 69 le-exists? logfi 0d50: 6c 65 29 0a 09 09 09 09 20 20 20 28 73 79 73 74 le)..... (syst 0d60: 65 6d 20 28 63 6f 6e 63 20 22 66 69 72 65 66 6f em (conc "firefo 0d70: 78 20 22 20 6c 6f 67 66 69 6c 65 20 22 26 22 29 x " logfile "&") 0d80: 29 0a 09 09 09 09 20 20 20 28 6d 65 73 73 61 67 )..... (messag 0d90: 65 2d 77 69 6e 64 6f 77 20 28 63 6f 6e 63 20 22 e-window (conc " 0da0: 46 69 6c 65 20 22 20 6c 6f 67 66 69 6c 65 20 22 File " logfile " 0db0: 20 6e 6f 74 20 66 6f 75 6e 64 22 29 29 29 29 29 not found"))))) 0dc0: 0a 09 20 20 20 20 20 20 20 28 78 74 65 72 6d 20 .. (xterm 0dd0: 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 (lambda ( 0de0: 78 29 0a 09 09 09 20 20 20 20 20 20 20 28 69 66 x).... (if 0df0: 20 28 64 69 72 65 63 74 6f 72 79 2d 65 78 69 73 (directory-exis 0e00: 74 73 3f 20 72 75 6e 64 69 72 29 0a 09 09 09 09 ts? rundir)..... 0e10: 20 20 20 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 (system (conc 0e20: 20 22 63 64 20 22 20 72 75 6e 64 69 72 20 22 3b "cd " rundir "; 0e30: 78 74 65 72 6d 20 2d 54 20 22 20 28 73 74 72 69 xterm -T " (stri 0e40: 6e 67 2d 74 72 61 6e 73 6c 61 74 65 20 74 65 73 ng-translate tes 0e50: 74 66 75 6c 6c 6e 61 6d 65 20 22 28 29 22 20 22 tfullname "()" " 0e60: 20 20 22 29 20 22 26 22 29 29 0a 09 09 09 09 20 ") "&"))..... 0e70: 20 20 28 6d 65 73 73 61 67 65 2d 77 69 6e 64 6f (message-windo 0e80: 77 20 20 28 63 6f 6e 63 20 22 44 69 72 65 63 74 w (conc "Direct 0e90: 6f 72 79 20 22 20 72 75 6e 64 69 72 20 22 20 6e ory " rundir " n 0ea0: 6f 74 20 66 6f 75 6e 64 22 29 29 29 29 29 0a 09 ot found"))))).. 0eb0: 20 20 20 20 20 20 20 28 6e 65 77 73 74 61 74 75 (newstatu 0ec0: 73 20 20 20 20 63 75 72 72 73 74 61 74 75 73 29 s currstatus) 0ed0: 0a 09 20 20 20 20 20 20 20 28 6e 65 77 73 74 61 .. (newsta 0ee0: 74 65 20 20 20 20 20 63 75 72 72 73 74 61 74 65 te currstate 0ef0: 29 0a 09 20 20 20 20 20 20 20 28 73 65 6c 66 20 ).. (self 0f00: 20 20 20 20 20 20 20 20 23 66 29 29 0a 09 20 20 #f)).. 0f10: 0a 09 20 20 3b 3b 20 20 28 74 65 73 74 2d 73 65 .. ;; (test-se 0f20: 74 2d 73 74 61 74 75 73 21 20 64 62 20 72 75 6e t-status! db run 0f30: 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 73 74 -id test-name st 0f40: 61 74 65 20 73 74 61 74 75 73 20 69 74 65 6d 64 ate status itemd 0f50: 61 74 29 0a 09 20 20 28 73 65 74 21 20 73 65 6c at).. (set! sel 0f60: 66 20 0a 09 09 28 69 75 70 3a 64 69 61 6c 6f 67 f ...(iup:dialog 0f70: 0a 09 09 20 28 69 75 70 3a 76 62 6f 78 0a 09 09 ... (iup:vbox... 0f80: 20 20 28 69 75 70 3a 68 62 6f 78 20 0a 09 09 20 (iup:hbox ... 0f90: 20 20 28 69 75 70 3a 66 72 61 6d 65 20 28 69 75 (iup:frame (iu 0fa0: 70 3a 6c 61 62 65 6c 20 72 75 6e 2d 6b 65 79 29 p:label run-key) 0fb0: 29 0a 09 09 20 20 20 28 69 75 70 3a 66 72 61 6d )... (iup:fram 0fc0: 65 20 28 69 75 70 3a 6c 61 62 65 6c 20 28 63 6f e (iup:label (co 0fd0: 6e 63 20 22 54 45 53 54 4e 41 4d 45 3a 5c 6e 22 nc "TESTNAME:\n" 0fe0: 20 74 65 73 74 66 75 6c 6c 6e 61 6d 65 29 20 23 testfullname) # 0ff0: 3a 65 78 70 61 6e 64 20 22 59 45 53 22 29 29 29 :expand "YES"))) 1000: 0a 09 09 20 20 28 69 75 70 3a 66 72 61 6d 65 20 ... (iup:frame 1010: 23 3a 74 69 74 6c 65 20 22 41 63 74 69 6f 6e 73 #:title "Actions 1020: 22 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53 22 " #:expand "YES" 1030: 0a 09 09 09 20 20 20 20 20 28 69 75 70 3a 68 62 .... (iup:hb 1040: 6f 78 20 3b 3b 20 74 68 65 20 61 63 74 69 6f 6e ox ;; the action 1050: 73 20 62 6f 78 0a 09 09 09 20 20 20 20 20 20 28 s box.... ( 1060: 69 75 70 3a 62 75 74 74 6f 6e 20 22 56 69 65 77 iup:button "View 1070: 20 4c 6f 67 22 20 20 20 20 23 3a 61 63 74 69 6f Log" #:actio 1080: 6e 20 76 69 65 77 6c 6f 67 20 20 23 3a 65 78 70 n viewlog #:exp 1090: 61 6e 64 20 22 59 45 53 22 29 0a 09 09 09 20 20 and "YES").... 10a0: 20 20 20 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 (iup:button 10b0: 22 53 74 61 72 74 20 58 74 65 72 6d 22 20 23 3a "Start Xterm" #: 10c0: 61 63 74 69 6f 6e 20 78 74 65 72 6d 20 20 23 3a action xterm #: 10d0: 65 78 70 61 6e 64 20 22 59 45 53 22 29 29 29 0a expand "YES"))). 10e0: 09 09 20 20 28 69 75 70 3a 66 72 61 6d 65 20 23 .. (iup:frame # 10f0: 3a 74 69 74 6c 65 20 22 53 65 74 20 66 69 65 6c :title "Set fiel 1100: 64 73 22 0a 09 09 09 20 20 20 20 20 28 69 75 70 ds".... (iup 1110: 3a 76 62 6f 78 0a 09 09 09 20 20 20 20 20 20 28 :vbox.... ( 1120: 69 75 70 3a 68 62 6f 78 20 0a 09 09 09 20 20 20 iup:hbox .... 1130: 20 20 20 20 28 69 75 70 3a 76 62 6f 78 20 3b 3b (iup:vbox ;; 1140: 20 74 68 65 20 73 74 61 74 65 0a 09 09 09 09 28 the state.....( 1150: 69 75 70 3a 6c 61 62 65 6c 20 22 53 54 41 54 45 iup:label "STATE 1160: 3a 22 20 23 3a 73 69 7a 65 20 22 33 30 78 22 29 :" #:size "30x") 1170: 0a 09 09 09 09 28 6c 65 74 20 28 28 6c 62 20 28 .....(let ((lb ( 1180: 69 75 70 3a 6c 69 73 74 62 6f 78 20 23 3a 61 63 iup:listbox #:ac 1190: 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 76 61 tion (lambda (va 11a0: 6c 20 61 20 62 20 63 29 0a 09 09 09 09 09 09 09 l a b c)........ 11b0: 09 20 20 3b 3b 20 28 70 72 69 6e 74 20 76 61 6c . ;; (print val 11c0: 20 22 20 61 3a 20 22 20 61 20 22 20 62 3a 20 22 " a: " a " b: " 11d0: 20 62 20 22 20 63 3a 20 22 20 63 29 0a 09 09 09 b " c: " c).... 11e0: 09 09 09 09 09 20 20 28 73 65 74 21 20 6e 65 77 ..... (set! new 11f0: 73 74 61 74 65 20 61 29 29 0a 09 09 09 09 09 09 state a))....... 1200: 20 20 20 20 20 20 20 23 3a 65 64 69 74 62 6f 78 #:editbox 1210: 20 22 59 45 53 22 0a 09 09 09 09 09 09 20 20 20 "YES"....... 1220: 20 20 20 20 23 3a 65 78 70 61 6e 64 20 22 59 45 #:expand "YE 1230: 53 22 29 29 29 0a 09 09 09 09 20 20 28 69 75 70 S")))..... (iup 1240: 6c 69 73 74 62 6f 78 2d 66 69 6c 6c 2d 6c 69 73 listbox-fill-lis 1250: 74 20 6c 62 0a 09 09 09 09 09 09 09 28 6c 69 73 t lb........(lis 1260: 74 20 22 43 4f 4d 50 4c 45 54 45 44 22 20 22 4e t "COMPLETED" "N 1270: 4f 54 5f 53 54 41 52 54 45 44 22 20 22 52 55 4e OT_STARTED" "RUN 1280: 4e 49 4e 47 22 20 22 52 45 4d 4f 54 45 48 4f 53 NING" "REMOTEHOS 1290: 54 53 54 41 52 54 22 20 22 4b 49 4c 4c 45 44 22 TSTART" "KILLED" 12a0: 20 22 4b 49 4c 4c 52 45 51 22 29 0a 09 09 09 09 "KILLREQ")..... 12b0: 09 09 09 63 75 72 72 73 74 61 74 65 29 0a 09 09 ...currstate)... 12c0: 09 09 20 20 6c 62 29 29 0a 09 09 09 20 20 20 20 .. lb)).... 12d0: 20 20 20 28 69 75 70 3a 76 62 6f 78 20 3b 3b 20 (iup:vbox ;; 12e0: 74 68 65 20 73 74 61 74 75 73 0a 09 09 09 09 28 the status.....( 12f0: 69 75 70 3a 6c 61 62 65 6c 20 22 53 54 41 54 55 iup:label "STATU 1300: 53 3a 22 20 23 3a 73 69 7a 65 20 22 33 30 78 22 S:" #:size "30x" 1310: 29 0a 09 09 09 09 28 6c 65 74 20 28 28 6c 62 20 ).....(let ((lb 1320: 28 69 75 70 3a 6c 69 73 74 62 6f 78 20 23 3a 61 (iup:listbox #:a 1330: 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 76 ction (lambda (v 1340: 61 6c 20 61 20 62 20 63 29 0a 09 09 09 09 09 09 al a b c)....... 1350: 09 09 20 20 28 73 65 74 21 20 6e 65 77 73 74 61 .. (set! newsta 1360: 74 75 73 20 61 29 29 0a 09 09 09 09 09 09 20 20 tus a))....... 1370: 20 20 20 20 20 23 3a 65 64 69 74 62 6f 78 20 22 #:editbox " 1380: 59 45 53 22 0a 09 09 09 09 09 09 20 20 20 20 20 YES"....... 1390: 20 20 23 3a 76 61 6c 75 65 20 63 75 72 72 73 74 #:value currst 13a0: 61 74 75 73 0a 09 09 09 09 09 09 20 20 20 20 20 atus....... 13b0: 20 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53 22 #:expand "YES" 13c0: 29 29 29 0a 09 09 09 09 20 20 28 69 75 70 6c 69 )))..... (iupli 13d0: 73 74 62 6f 78 2d 66 69 6c 6c 2d 6c 69 73 74 20 stbox-fill-list 13e0: 6c 62 0a 09 09 09 09 09 09 09 28 6c 69 73 74 20 lb........(list 13f0: 22 50 41 53 53 22 20 22 46 41 49 4c 22 20 22 6e "PASS" "FAIL" "n 1400: 2f 61 22 29 0a 09 09 09 09 09 09 09 63 75 72 72 /a")........curr 1410: 73 74 61 74 75 73 29 0a 09 09 09 09 20 20 6c 62 status)..... lb 1420: 29 29 29 0a 09 09 09 20 20 20 20 20 20 28 69 75 ))).... (iu 1430: 70 3a 68 62 6f 78 20 28 69 75 70 3a 6c 61 62 65 p:hbox (iup:labe 1440: 6c 20 22 43 6f 6d 6d 65 6e 74 3a 22 29 0a 09 09 l "Comment:")... 1450: 09 09 09 28 69 75 70 3a 74 65 78 74 62 6f 78 20 ...(iup:textbox 1460: 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 #:action (lambda 1470: 20 28 76 61 6c 20 61 20 62 29 0a 09 09 09 09 09 (val a b)...... 1480: 09 09 09 28 73 65 74 21 20 63 75 72 72 63 6f 6d ...(set! currcom 1490: 6d 65 6e 74 20 62 29 29 0a 09 09 09 09 09 09 20 ment b))....... 14a0: 20 20 20 20 23 3a 76 61 6c 75 65 20 63 75 72 72 #:value curr 14b0: 63 6f 6d 6d 65 6e 74 20 0a 09 09 09 09 09 09 20 comment ....... 14c0: 20 20 20 20 23 3a 65 78 70 61 6e 64 20 22 59 45 #:expand "YE 14d0: 53 22 29 29 0a 09 09 09 20 20 20 20 20 20 28 69 S")).... (i 14e0: 75 70 3a 62 75 74 74 6f 6e 20 22 41 70 70 6c 79 up:button "Apply 14f0: 22 0a 09 09 09 09 09 20 20 23 3a 65 78 70 61 6e "...... #:expan 1500: 64 20 22 59 45 53 22 0a 09 09 09 09 09 20 20 23 d "YES"...... # 1510: 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 :action (lambda 1520: 28 78 29 0a 09 09 09 09 09 09 20 20 20 20 20 28 (x)....... ( 1530: 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 test-set-status! 1540: 20 2a 64 62 2a 20 72 75 6e 2d 69 64 20 74 65 73 *db* run-id tes 1550: 74 6e 61 6d 65 20 6e 65 77 73 74 61 74 65 20 6e tname newstate n 1560: 65 77 73 74 61 74 75 73 20 69 74 65 6d 70 61 74 ewstatus itempat 1570: 68 20 63 75 72 72 63 6f 6d 6d 65 6e 74 29 29 29 h currcomment))) 1580: 0a 09 09 09 20 20 20 20 20 20 28 69 75 70 3a 68 .... (iup:h 1590: 62 6f 78 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 box (iup:button 15a0: 22 41 70 70 6c 79 20 61 6e 64 20 63 6c 6f 73 65 "Apply and close 15b0: 22 0a 09 09 09 09 09 09 20 20 20 20 23 3a 65 78 "....... #:ex 15c0: 70 61 6e 64 20 22 59 45 53 22 0a 09 09 09 09 09 pand "YES"...... 15d0: 09 20 20 20 20 23 3a 61 63 74 69 6f 6e 20 28 6c . #:action (l 15e0: 61 6d 62 64 61 20 28 78 29 0a 09 09 09 09 09 09 ambda (x)....... 15f0: 09 20 20 20 20 20 20 20 28 74 65 73 74 2d 73 65 . (test-se 1600: 74 2d 73 74 61 74 75 73 21 20 2a 64 62 2a 20 72 t-status! *db* r 1610: 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 20 6e un-id testname n 1620: 65 77 73 74 61 74 65 20 6e 65 77 73 74 61 74 75 ewstate newstatu 1630: 73 20 69 74 65 6d 70 61 74 68 20 63 75 72 72 63 s itempath currc 1640: 6f 6d 6d 65 6e 74 29 0a 09 09 09 09 09 09 09 20 omment)........ 1650: 20 20 20 20 20 20 28 69 75 70 3a 64 65 73 74 72 (iup:destr 1660: 6f 79 21 20 73 65 6c 66 29 29 29 0a 09 09 09 09 oy! self)))..... 1670: 09 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 43 61 .(iup:button "Ca 1680: 6e 63 65 6c 20 61 6e 64 20 63 6c 6f 73 65 22 0a ncel and close". 1690: 09 09 09 09 09 09 20 20 20 20 23 3a 65 78 70 61 ...... #:expa 16a0: 6e 64 20 22 59 45 53 22 0a 09 09 09 09 09 09 20 nd "YES"....... 16b0: 20 20 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d #:action (lam 16c0: 62 64 61 20 28 78 29 0a 09 09 09 09 09 09 09 20 bda (x)........ 16d0: 20 20 20 20 20 20 28 69 75 70 3a 64 65 73 74 72 (iup:destr 16e0: 6f 79 21 20 73 65 6c 66 29 29 29 29 0a 09 09 09 oy! self)))).... 16f0: 20 20 20 20 20 20 29 29 29 29 29 0a 09 20 20 28 ))))).. ( 1700: 69 75 70 3a 73 68 6f 77 20 73 65 6c 66 29 0a 09 iup:show self).. 1710: 20 20 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 ))))..(define 1720: 28 63 6f 6c 6f 72 73 2d 73 69 6d 69 6c 61 72 3f (colors-similar? 1730: 20 63 6f 6c 6f 72 31 20 63 6f 6c 6f 72 32 29 0a color1 color2). 1740: 20 20 28 6c 65 74 2a 20 28 28 63 31 20 28 6d 61 (let* ((c1 (ma 1750: 70 20 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 p string->number 1760: 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 63 (string-split c 1770: 6f 6c 6f 72 31 29 29 29 0a 09 20 28 63 32 20 28 olor1))).. (c2 ( 1780: 6d 61 70 20 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 map string->numb 1790: 65 72 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 er (string-split 17a0: 20 63 6f 6c 6f 72 32 29 29 29 0a 09 20 28 64 65 color2))).. (de 17b0: 6c 74 61 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 lta (map (lambda 17c0: 20 28 61 20 62 29 28 61 62 73 20 28 2d 20 61 20 (a b)(abs (- a 17d0: 62 29 29 29 20 63 31 20 63 32 29 29 29 0a 20 20 b))) c1 c2))). 17e0: 20 20 28 6e 75 6c 6c 3f 20 28 66 69 6c 74 65 72 (null? (filter 17f0: 20 28 6c 61 6d 62 64 61 20 28 78 29 28 3e 20 78 (lambda (x)(> x 1800: 20 33 29 29 20 64 65 6c 74 61 29 29 29 29 0a 0a 3)) delta)))).. 1810: 28 64 65 66 69 6e 65 20 28 75 70 64 61 74 65 2d (define (update- 1820: 72 75 6e 64 61 74 20 70 61 74 74 20 6e 75 6d 72 rundat patt numr 1830: 75 6e 73 29 0a 20 20 28 6c 65 74 2a 20 28 28 61 uns). (let* ((a 1840: 6c 6c 72 75 6e 73 20 20 20 20 20 28 64 62 2d 67 llruns (db-g 1850: 65 74 2d 72 75 6e 73 20 2a 64 62 2a 20 70 61 74 et-runs *db* pat 1860: 74 20 6e 75 6d 72 75 6e 73 20 2a 73 74 61 72 74 t numruns *start 1870: 2d 72 75 6e 2d 6f 66 66 73 65 74 2a 29 29 0a 09 -run-offset*)).. 1880: 20 28 68 65 61 64 65 72 20 20 20 20 20 20 28 64 (header (d 1890: 62 3a 67 65 74 2d 68 65 61 64 65 72 20 61 6c 6c b:get-header all 18a0: 72 75 6e 73 29 29 0a 09 20 28 72 75 6e 73 20 20 runs)).. (runs 18b0: 20 20 20 20 20 20 28 64 62 3a 67 65 74 2d 72 6f (db:get-ro 18c0: 77 73 20 20 20 61 6c 6c 72 75 6e 73 29 29 0a 09 ws allruns)).. 18d0: 20 28 72 65 73 75 6c 74 20 20 20 20 20 20 27 28 (result '( 18e0: 29 29 0a 09 20 28 6d 61 78 74 65 73 74 73 20 20 )).. (maxtests 18f0: 20 20 30 29 29 0a 20 20 20 20 28 66 6f 72 2d 65 0)). (for-e 1900: 61 63 68 20 28 6c 61 6d 62 64 61 20 28 72 75 6e ach (lambda (run 1910: 29 0a 09 09 28 6c 65 74 2a 20 28 28 72 75 6e 2d )...(let* ((run- 1920: 69 64 20 20 20 28 64 62 2d 67 65 74 2d 76 61 6c id (db-get-val 1930: 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 6e ue-by-header run 1940: 20 68 65 61 64 65 72 20 22 69 64 22 29 29 0a 09 header "id")).. 1950: 09 20 20 20 20 20 20 20 28 74 65 73 74 73 20 20 . (tests 1960: 20 20 28 64 62 2d 67 65 74 2d 74 65 73 74 73 2d (db-get-tests- 1970: 66 6f 72 2d 72 75 6e 20 2a 64 62 2a 20 72 75 6e for-run *db* run 1980: 2d 69 64 29 29 0a 09 09 20 20 20 20 20 20 20 28 -id))... ( 1990: 6b 65 79 2d 76 61 6c 73 20 28 67 65 74 2d 6b 65 key-vals (get-ke 19a0: 79 2d 76 61 6c 73 20 2a 64 62 2a 20 72 75 6e 2d y-vals *db* run- 19b0: 69 64 29 29 29 0a 09 09 20 20 28 69 66 20 28 3e id)))... (if (> 19c0: 20 28 6c 65 6e 67 74 68 20 74 65 73 74 73 29 20 (length tests) 19d0: 6d 61 78 74 65 73 74 73 29 0a 09 09 20 20 20 20 maxtests)... 19e0: 20 20 28 73 65 74 21 20 6d 61 78 74 65 73 74 73 (set! maxtests 19f0: 20 28 6c 65 6e 67 74 68 20 74 65 73 74 73 29 29 (length tests)) 1a00: 29 0a 09 09 20 20 28 73 65 74 21 20 72 65 73 75 )... (set! resu 1a10: 6c 74 20 28 63 6f 6e 73 20 28 76 65 63 74 6f 72 lt (cons (vector 1a20: 20 72 75 6e 20 74 65 73 74 73 20 6b 65 79 2d 76 run tests key-v 1a30: 61 6c 73 29 20 72 65 73 75 6c 74 29 29 29 29 0a als) result)))). 1a40: 09 20 20 20 20 20 20 72 75 6e 73 29 0a 20 20 20 . runs). 1a50: 20 28 73 65 74 21 20 2a 68 65 61 64 65 72 2a 20 (set! *header* 1a60: 20 68 65 61 64 65 72 29 0a 20 20 20 20 28 73 65 header). (se 1a70: 74 21 20 2a 61 6c 6c 72 75 6e 73 2a 20 28 72 65 t! *allruns* (re 1a80: 76 65 72 73 65 20 72 65 73 75 6c 74 29 29 0a 20 verse result)). 1a90: 20 20 20 6d 61 78 74 65 73 74 73 29 29 0a 0a 28 maxtests))..( 1aa0: 64 65 66 69 6e 65 20 28 75 70 64 61 74 65 2d 6c define (update-l 1ab0: 61 62 65 6c 73 20 75 69 64 61 74 29 0a 20 20 28 abels uidat). ( 1ac0: 6c 65 74 2a 20 28 28 72 6f 77 6e 20 20 20 20 30 let* ((rown 0 1ad0: 29 0a 09 20 28 6c 66 74 63 6f 6c 20 28 76 65 63 ).. (lftcol (vec 1ae0: 74 6f 72 2d 72 65 66 20 75 69 64 61 74 20 30 29 tor-ref uidat 0) 1af0: 29 0a 09 20 28 6d 61 78 6e 20 20 20 28 2d 20 28 ).. (maxn (- ( 1b00: 76 65 63 74 6f 72 2d 6c 65 6e 67 74 68 20 6c 66 vector-length lf 1b10: 74 63 6f 6c 29 20 31 29 29 29 0a 20 20 20 20 28 tcol) 1))). ( 1b20: 6c 65 74 20 6c 6f 6f 70 20 28 28 69 20 30 29 29 let loop ((i 0)) 1b30: 0a 20 20 20 20 20 20 28 69 75 70 3a 61 74 74 72 . (iup:attr 1b40: 69 62 75 74 65 2d 73 65 74 21 20 28 76 65 63 74 ibute-set! (vect 1b50: 6f 72 2d 72 65 66 20 6c 66 74 63 6f 6c 20 69 29 or-ref lftcol i) 1b60: 20 22 54 49 54 4c 45 22 20 22 22 29 0a 20 20 20 "TITLE" ""). 1b70: 20 20 20 28 69 66 20 28 3c 3d 20 69 20 72 6f 77 (if (<= i row 1b80: 6e 29 0a 09 20 20 28 6c 6f 6f 70 20 28 2b 20 69 n).. (loop (+ i 1b90: 20 31 29 29 29 29 0a 20 20 20 20 28 66 6f 72 2d 1)))). (for- 1ba0: 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 6e 61 each (lambda (na 1bb0: 6d 65 29 0a 09 09 28 69 66 20 28 3c 3d 20 72 6f me)...(if (<= ro 1bc0: 77 6e 20 6d 61 78 6e 29 0a 09 09 20 20 20 20 28 wn maxn)... ( 1bd0: 6c 65 74 20 28 28 6c 61 62 6c 20 28 76 65 63 74 let ((labl (vect 1be0: 6f 72 2d 72 65 66 20 6c 66 74 63 6f 6c 20 72 6f or-ref lftcol ro 1bf0: 77 6e 29 29 29 0a 09 09 20 20 20 20 20 20 28 69 wn)))... (i 1c00: 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 up:attribute-set 1c10: 21 20 6c 61 62 6c 20 22 54 49 54 4c 45 22 20 6e ! labl "TITLE" n 1c20: 61 6d 65 29 29 29 0a 09 09 28 73 65 74 21 20 72 ame)))...(set! r 1c30: 6f 77 6e 20 28 2b 20 31 20 72 6f 77 6e 29 29 29 own (+ 1 rown))) 1c40: 0a 09 20 20 20 20 20 20 28 64 72 6f 70 20 2a 61 .. (drop *a 1c50: 6c 6c 74 65 73 74 6e 61 6d 65 6c 73 74 2a 20 2a lltestnamelst* * 1c60: 73 74 61 72 74 2d 74 65 73 74 2d 6f 66 66 73 65 start-test-offse 1c70: 74 2a 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 t*))))..(define 1c80: 28 75 70 64 61 74 65 2d 62 75 74 74 6f 6e 73 20 (update-buttons 1c90: 75 69 64 61 74 20 6e 75 6d 72 75 6e 73 20 6e 75 uidat numruns nu 1ca0: 6d 74 65 73 74 73 29 0a 20 20 28 6c 65 74 2a 20 mtests). (let* 1cb0: 28 28 72 75 6e 73 20 20 20 20 20 20 20 20 28 69 ((runs (i 1cc0: 66 20 28 3e 20 28 6c 65 6e 67 74 68 20 2a 61 6c f (> (length *al 1cd0: 6c 72 75 6e 73 2a 29 20 6e 75 6d 72 75 6e 73 29 lruns*) numruns) 1ce0: 0a 09 09 09 20 20 28 74 61 6b 65 2d 72 69 67 68 .... (take-righ 1cf0: 74 20 2a 61 6c 6c 72 75 6e 73 2a 20 6e 75 6d 72 t *allruns* numr 1d00: 75 6e 73 29 0a 09 09 09 20 20 28 70 61 64 2d 6c uns).... (pad-l 1d10: 69 73 74 20 2a 61 6c 6c 72 75 6e 73 2a 20 6e 75 ist *allruns* nu 1d20: 6d 72 75 6e 73 29 29 29 0a 09 20 28 6c 66 74 63 mruns))).. (lftc 1d30: 6f 6c 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d ol (vector- 1d40: 72 65 66 20 75 69 64 61 74 20 30 29 29 0a 09 20 ref uidat 0)).. 1d50: 28 74 61 62 6c 65 68 65 61 64 65 72 20 28 76 65 (tableheader (ve 1d60: 63 74 6f 72 2d 72 65 66 20 75 69 64 61 74 20 31 ctor-ref uidat 1 1d70: 29 29 0a 09 20 28 74 61 62 6c 65 20 20 20 20 20 )).. (table 1d80: 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 75 69 (vector-ref ui 1d90: 64 61 74 20 32 29 29 0a 09 20 28 63 6f 6c 6e 20 dat 2)).. (coln 1da0: 20 20 20 20 20 20 20 30 29 29 0a 20 20 20 20 28 0)). ( 1db0: 75 70 64 61 74 65 2d 6c 61 62 65 6c 73 20 75 69 update-labels ui 1dc0: 64 61 74 29 0a 20 20 20 20 28 66 6f 72 2d 65 61 dat). (for-ea 1dd0: 63 68 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 ch. (lambda 1de0: 28 72 75 6e 64 61 74 29 0a 20 20 20 20 20 20 20 (rundat). 1df0: 28 69 66 20 28 6e 6f 74 20 72 75 6e 64 61 74 29 (if (not rundat) 1e00: 20 3b 3b 20 68 61 6e 64 6c 65 20 70 61 64 64 65 ;; handle padde 1e10: 64 20 72 75 6e 73 0a 09 20 20 20 3b 3b 20 20 20 d runs.. ;; 1e20: 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 ;; 1e30: 69 64 20 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 id run-id testna 1e40: 6d 65 20 73 74 61 74 65 20 73 74 61 74 75 73 20 me state status 1e50: 65 76 65 6e 74 2d 74 69 6d 65 20 68 6f 73 74 20 event-time host 1e60: 63 70 75 6c 6f 61 64 20 64 69 73 6b 66 72 65 65 cpuload diskfree 1e70: 20 75 6e 61 6d 65 20 72 75 6e 64 69 72 20 69 74 uname rundir it 1e80: 65 6d 2d 70 61 74 68 20 72 75 6e 2d 64 75 72 61 em-path run-dura 1e90: 74 69 6f 6e 0a 09 20 20 20 28 73 65 74 21 20 72 tion.. (set! r 1ea0: 75 6e 64 61 74 20 28 76 65 63 74 6f 72 20 28 6d undat (vector (m 1eb0: 61 6b 65 2d 76 65 63 74 6f 72 20 32 30 20 23 66 ake-vector 20 #f 1ec0: 29 20 27 28 29 20 28 6d 61 70 20 28 6c 61 6d 62 ) '() (map (lamb 1ed0: 64 61 20 28 78 29 20 22 22 29 20 2a 6b 65 79 73 da (x) "") *keys 1ee0: 2a 29 29 29 29 3b 3b 20 33 29 29 29 0a 20 20 20 *))));; 3))). 1ef0: 20 20 20 20 28 6c 65 74 2a 20 28 28 72 75 6e 20 (let* ((run 1f00: 20 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 (vector-ref 1f10: 20 72 75 6e 64 61 74 20 30 29 29 0a 09 20 20 20 rundat 0)).. 1f20: 20 20 20 28 74 65 73 74 73 64 61 74 20 28 76 65 (testsdat (ve 1f30: 63 74 6f 72 2d 72 65 66 20 72 75 6e 64 61 74 20 ctor-ref rundat 1f40: 31 29 29 0a 09 20 20 20 20 20 20 28 6b 65 79 2d 1)).. (key- 1f50: 76 61 6c 2d 64 61 74 20 28 76 65 63 74 6f 72 2d val-dat (vector- 1f60: 72 65 66 20 72 75 6e 64 61 74 20 32 29 29 0a 09 ref rundat 2)).. 1f70: 20 20 20 20 20 20 28 72 75 6e 2d 69 64 20 20 20 (run-id 1f80: 28 64 62 2d 67 65 74 2d 76 61 6c 75 65 2d 62 79 (db-get-value-by 1f90: 2d 68 65 61 64 65 72 20 72 75 6e 20 2a 68 65 61 -header run *hea 1fa0: 64 65 72 2a 20 22 69 64 22 29 29 0a 09 20 20 20 der* "id")).. 1fb0: 20 20 20 28 74 65 73 74 6e 61 6d 65 73 20 28 64 (testnames (d 1fc0: 65 6c 65 74 65 2d 64 75 70 6c 69 63 61 74 65 73 elete-duplicates 1fd0: 20 28 61 70 70 65 6e 64 20 2a 61 6c 6c 74 65 73 (append *alltes 1fe0: 74 6e 61 6d 65 6c 73 74 2a 20 0a 09 09 09 09 09 tnamelst* ...... 1ff0: 09 20 20 20 20 28 6d 61 70 20 74 65 73 74 3a 74 . (map test:t 2000: 65 73 74 2d 67 65 74 2d 66 75 6c 6c 6e 61 6d 65 est-get-fullname 2010: 20 74 65 73 74 73 64 61 74 29 29 29 29 20 3b 3b testsdat)))) ;; 2020: 20 28 74 61 6b 65 20 28 70 61 64 2d 6c 69 73 74 (take (pad-list 2030: 20 74 65 73 74 73 64 61 74 20 6e 75 6d 74 65 73 testsdat numtes 2040: 74 73 29 20 6e 75 6d 74 65 73 74 73 29 29 0a 09 ts) numtests)).. 2050: 20 20 20 20 20 20 28 6b 65 79 2d 76 61 6c 73 20 (key-vals 2060: 28 61 70 70 65 6e 64 20 6b 65 79 2d 76 61 6c 2d (append key-val- 2070: 64 61 74 0a 09 09 09 09 28 6c 69 73 74 20 28 6c dat.....(list (l 2080: 65 74 20 28 28 78 20 28 64 62 2d 67 65 74 2d 76 et ((x (db-get-v 2090: 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 alue-by-header r 20a0: 75 6e 20 2a 68 65 61 64 65 72 2a 20 22 72 75 6e un *header* "run 20b0: 6e 61 6d 65 22 29 29 29 0a 09 09 09 09 09 28 69 name")))......(i 20c0: 66 20 78 20 78 20 22 22 29 29 29 29 29 0a 09 20 f x x ""))))).. 20d0: 20 20 20 20 20 28 72 75 6e 2d 6b 65 79 20 20 28 (run-key ( 20e0: 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 string-intersper 20f0: 73 65 20 6b 65 79 2d 76 61 6c 73 20 22 5c 6e 22 se key-vals "\n" 2100: 29 29 29 0a 09 20 3b 3b 20 28 72 75 6e 2d 68 74 ))).. ;; (run-ht 2110: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 (hash-table-re 2120: 66 2f 64 65 66 61 75 6c 74 20 61 6c 6c 64 61 74 f/default alldat 2130: 20 72 75 6e 2d 6b 65 79 20 23 66 29 29 29 0a 09 run-key #f))).. 2140: 20 3b 3b 20 66 69 6c 6c 20 69 6e 20 74 68 65 20 ;; fill in the 2150: 72 75 6e 20 68 65 61 64 65 72 20 6b 65 79 20 76 run header key v 2160: 61 6c 75 65 73 0a 09 20 28 6c 65 74 20 28 28 72 alues.. (let ((r 2170: 6f 77 6e 20 20 20 20 20 20 30 29 0a 09 20 20 20 own 0).. 2180: 20 20 20 20 28 68 65 61 64 65 72 63 6f 6c 20 28 (headercol ( 2190: 76 65 63 74 6f 72 2d 72 65 66 20 74 61 62 6c 65 vector-ref table 21a0: 68 65 61 64 65 72 20 63 6f 6c 6e 29 29 29 0a 09 header coln))).. 21b0: 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 (for-each (la 21c0: 6d 62 64 61 20 28 6b 76 61 6c 29 0a 09 09 20 20 mbda (kval)... 21d0: 20 20 20 20 20 28 6c 65 74 2a 20 28 28 6c 61 62 (let* ((lab 21e0: 6c 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d 72 l (vector-r 21f0: 65 66 20 68 65 61 64 65 72 63 6f 6c 20 72 6f 77 ef headercol row 2200: 6e 29 29 29 0a 09 09 09 20 28 69 66 20 28 6e 6f n))).... (if (no 2210: 74 20 28 65 71 75 61 6c 3f 20 6b 76 61 6c 20 28 t (equal? kval ( 2220: 69 75 70 3a 61 74 74 72 69 62 75 74 65 20 6c 61 iup:attribute la 2230: 62 6c 20 22 54 49 54 4c 45 22 29 29 29 0a 09 09 bl "TITLE")))... 2240: 09 20 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 . (iup:attri 2250: 62 75 74 65 2d 73 65 74 21 20 28 76 65 63 74 6f bute-set! (vecto 2260: 72 2d 72 65 66 20 68 65 61 64 65 72 63 6f 6c 20 r-ref headercol 2270: 72 6f 77 6e 29 20 22 54 49 54 4c 45 22 20 6b 76 rown) "TITLE" kv 2280: 61 6c 29 29 0a 09 09 09 20 28 73 65 74 21 20 72 al)).... (set! r 2290: 6f 77 6e 20 28 2b 20 72 6f 77 6e 20 31 29 29 29 own (+ rown 1))) 22a0: 29 0a 09 09 20 20 20 20 20 6b 65 79 2d 76 61 6c )... key-val 22b0: 73 29 29 0a 0a 09 20 3b 3b 20 46 6f 72 20 74 68 s))... ;; For th 22c0: 69 73 20 72 75 6e 20 6e 6f 77 20 66 69 6c 6c 20 is run now fill 22d0: 69 6e 20 74 68 65 20 62 75 74 74 6f 6e 73 20 66 in the buttons f 22e0: 6f 72 20 65 61 63 68 20 74 65 73 74 0a 09 20 28 or each test.. ( 22f0: 6c 65 74 20 28 28 72 6f 77 6e 20 30 29 0a 09 20 let ((rown 0).. 2300: 20 20 20 20 20 20 28 63 6f 6c 75 6d 6e 64 61 74 (columndat 2310: 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 74 61 (vector-ref ta 2320: 62 6c 65 20 63 6f 6c 6e 29 29 29 0a 09 20 20 20 ble coln))).. 2330: 28 66 6f 72 2d 65 61 63 68 0a 09 20 20 20 20 28 (for-each.. ( 2340: 6c 61 6d 62 64 61 20 28 74 65 73 74 6e 61 6d 65 lambda (testname 2350: 29 0a 09 20 20 20 20 20 20 28 6c 65 74 20 28 28 ).. (let (( 2360: 62 75 74 74 6f 6e 64 61 74 20 20 28 68 61 73 68 buttondat (hash 2370: 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 -table-ref/defau 2380: 6c 74 20 2a 62 75 74 74 6f 6e 64 61 74 2a 20 28 lt *buttondat* ( 2390: 6d 6b 73 74 72 20 63 6f 6c 6e 20 72 6f 77 6e 29 mkstr coln rown) 23a0: 20 23 66 29 29 29 0a 09 09 28 69 66 20 62 75 74 #f)))...(if but 23b0: 74 6f 6e 64 61 74 0a 09 09 20 20 20 20 28 6c 65 tondat... (le 23c0: 74 2a 20 28 28 74 65 73 74 20 20 20 20 20 20 20 t* ((test 23d0: 28 6c 65 74 20 28 28 6d 61 74 63 68 69 6e 67 20 (let ((matching 23e0: 28 66 69 6c 74 65 72 20 0a 09 09 09 09 09 09 09 (filter ........ 23f0: 28 6c 61 6d 62 64 61 20 28 78 29 28 65 71 75 61 (lambda (x)(equa 2400: 6c 3f 20 28 74 65 73 74 3a 74 65 73 74 2d 67 65 l? (test:test-ge 2410: 74 2d 66 75 6c 6c 6e 61 6d 65 20 78 29 20 74 65 t-fullname x) te 2420: 73 74 6e 61 6d 65 29 29 0a 09 09 09 09 09 09 09 stname))........ 2430: 74 65 73 74 73 64 61 74 29 29 29 0a 09 09 09 09 testsdat)))..... 2440: 09 20 28 69 66 20 28 6e 75 6c 6c 3f 20 6d 61 74 . (if (null? mat 2450: 63 68 69 6e 67 29 0a 09 09 09 09 09 20 20 20 20 ching)...... 2460: 20 28 76 65 63 74 6f 72 20 2d 31 20 2d 31 20 22 (vector -1 -1 " 2470: 22 20 22 22 20 22 22 20 30 20 22 22 20 22 22 20 " "" "" 0 "" "" 2480: 30 20 22 22 20 22 22 20 22 22 20 30 20 22 22 20 0 "" "" "" 0 "" 2490: 22 22 29 0a 09 09 09 09 09 20 20 20 20 20 28 63 "")...... (c 24a0: 61 72 20 6d 61 74 63 68 69 6e 67 29 29 29 29 0a ar matching)))). 24b0: 09 09 09 20 20 20 3b 3b 20 28 74 65 73 74 20 20 ... ;; (test 24c0: 20 20 20 20 20 28 69 66 20 72 65 61 6c 2d 74 65 (if real-te 24d0: 73 74 20 72 65 61 6c 2d 74 65 73 74 0a 09 09 09 st real-test.... 24e0: 20 20 20 28 74 65 73 74 6e 61 6d 65 20 20 20 28 (testname ( 24f0: 64 62 3a 74 65 73 74 2d 67 65 74 2d 74 65 73 74 db:test-get-test 2500: 6e 61 6d 65 20 20 74 65 73 74 29 29 0a 09 09 09 name test)).... 2510: 20 20 20 28 69 74 65 6d 70 61 74 68 20 20 20 28 (itempath ( 2520: 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 74 65 6d db:test-get-item 2530: 2d 70 61 74 68 20 74 65 73 74 29 29 0a 09 09 09 -path test)).... 2540: 20 20 20 28 74 65 73 74 66 75 6c 6c 6e 61 6d 65 (testfullname 2550: 20 28 74 65 73 74 3a 74 65 73 74 2d 67 65 74 2d (test:test-get- 2560: 66 75 6c 6c 6e 61 6d 65 20 74 65 73 74 29 29 0a fullname test)). 2570: 09 09 09 20 20 20 28 74 65 73 74 73 74 61 74 75 ... (teststatu 2580: 73 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 s (db:test-get-s 2590: 74 61 74 75 73 20 20 20 74 65 73 74 29 29 0a 09 tatus test)).. 25a0: 09 09 20 20 20 28 74 65 73 74 73 74 61 74 65 20 .. (teststate 25b0: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 (db:test-get-st 25c0: 61 74 65 20 20 20 20 74 65 73 74 29 29 0a 09 09 ate test))... 25d0: 09 20 20 20 28 62 75 74 74 6f 6e 74 78 74 20 20 . (buttontxt 25e0: 28 69 66 20 28 65 71 75 61 6c 3f 20 74 65 73 74 (if (equal? test 25f0: 73 74 61 74 65 20 22 43 4f 4d 50 4c 45 54 45 44 state "COMPLETED 2600: 22 29 20 74 65 73 74 73 74 61 74 75 73 20 74 65 ") teststatus te 2610: 73 74 73 74 61 74 65 29 29 0a 09 09 09 20 20 20 ststate)).... 2620: 28 62 75 74 74 6f 6e 20 20 20 20 20 28 76 65 63 (button (vec 2630: 74 6f 72 2d 72 65 66 20 63 6f 6c 75 6d 6e 64 61 tor-ref columnda 2640: 74 20 72 6f 77 6e 29 29 0a 09 09 09 20 20 20 28 t rown)).... ( 2650: 63 6f 6c 6f 72 20 20 20 20 20 20 28 63 61 73 65 color (case 2660: 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c (string->symbol 2670: 20 74 65 73 74 73 74 61 74 65 29 0a 09 09 09 09 teststate)..... 2680: 09 20 28 28 43 4f 4d 50 4c 45 54 45 44 29 0a 09 . ((COMPLETED).. 2690: 09 09 09 09 20 20 28 69 66 20 28 65 71 75 61 6c .... (if (equal 26a0: 3f 20 74 65 73 74 73 74 61 74 75 73 20 22 50 41 ? teststatus "PA 26b0: 53 53 22 29 20 22 37 30 20 32 34 39 20 37 33 22 SS") "70 249 73" 26c0: 20 22 32 32 33 20 33 33 20 34 39 22 29 29 20 3b "223 33 49")) ; 26d0: 3b 20 67 72 65 65 6e 69 73 68 20 72 65 64 69 73 ; greenish redis 26e0: 68 0a 09 09 09 09 09 20 28 28 4c 41 55 4e 43 48 h...... ((LAUNCH 26f0: 45 44 29 20 20 20 20 20 20 20 20 20 22 31 30 31 ED) "101 2700: 20 31 32 33 20 31 34 32 22 29 0a 09 09 09 09 09 123 142")...... 2710: 20 28 28 52 45 4d 4f 54 45 48 4f 53 54 53 54 41 ((REMOTEHOSTSTA 2720: 52 54 29 20 20 22 35 30 20 31 33 30 20 31 39 35 RT) "50 130 195 2730: 22 29 0a 09 09 09 09 09 20 28 28 52 55 4e 4e 49 ")...... ((RUNNI 2740: 4e 47 29 20 20 20 20 20 20 20 20 20 20 22 39 20 NG) "9 2750: 31 33 31 20 32 33 32 22 29 0a 09 09 09 09 09 20 131 232")...... 2760: 28 28 4b 49 4c 4c 52 45 51 29 20 20 20 20 20 20 ((KILLREQ) 2770: 20 20 20 20 22 33 39 20 38 32 20 32 30 36 22 29 "39 82 206") 2780: 0a 09 09 09 09 09 20 28 28 4b 49 4c 4c 45 44 29 ...... ((KILLED) 2790: 20 20 20 20 20 20 20 20 20 20 20 22 32 33 34 20 "234 27a0: 31 30 31 20 31 37 22 29 0a 09 09 09 09 09 20 28 101 17")...... ( 27b0: 65 6c 73 65 20 22 31 39 32 20 31 39 32 20 31 39 else "192 192 19 27c0: 32 22 29 29 29 0a 09 09 09 20 20 20 28 63 75 72 2"))).... (cur 27d0: 72 2d 63 6f 6c 6f 72 20 28 76 65 63 74 6f 72 2d r-color (vector- 27e0: 72 65 66 20 62 75 74 74 6f 6e 64 61 74 20 31 29 ref buttondat 1) 27f0: 29 20 3b 3b 20 28 69 75 70 3a 61 74 74 72 69 62 ) ;; (iup:attrib 2800: 75 74 65 20 62 75 74 74 6f 6e 20 22 42 47 43 4f ute button "BGCO 2810: 4c 4f 52 22 29 29 0a 09 09 09 20 20 20 28 63 75 LOR")).... (cu 2820: 72 72 2d 74 69 74 6c 65 20 28 76 65 63 74 6f 72 rr-title (vector 2830: 2d 72 65 66 20 62 75 74 74 6f 6e 64 61 74 20 32 -ref buttondat 2 2840: 29 29 29 20 3b 3b 20 28 69 75 70 3a 61 74 74 72 ))) ;; (iup:attr 2850: 69 62 75 74 65 20 62 75 74 74 6f 6e 20 22 54 49 ibute button "TI 2860: 54 4c 45 22 29 29 29 0a 09 09 20 20 20 20 20 20 TLE")))... 2870: 28 69 66 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f (if (not (equal? 2880: 20 63 75 72 72 2d 63 6f 6c 6f 72 20 63 6f 6c 6f curr-color colo 2890: 72 29 29 0a 09 09 09 20 20 28 69 75 70 3a 61 74 r)).... (iup:at 28a0: 74 72 69 62 75 74 65 2d 73 65 74 21 20 62 75 74 tribute-set! but 28b0: 74 6f 6e 20 22 42 47 43 4f 4c 4f 52 22 20 63 6f ton "BGCOLOR" co 28c0: 6c 6f 72 29 29 0a 09 09 20 20 20 20 20 20 28 69 lor))... (i 28d0: 66 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 63 f (not (equal? c 28e0: 75 72 72 2d 74 69 74 6c 65 20 62 75 74 74 6f 6e urr-title button 28f0: 74 78 74 29 29 0a 09 09 09 20 20 28 69 75 70 3a txt)).... (iup: 2900: 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 62 attribute-set! b 2910: 75 74 74 6f 6e 20 22 54 49 54 4c 45 22 20 20 20 utton "TITLE" 2920: 62 75 74 74 6f 6e 74 78 74 29 29 0a 09 09 20 20 buttontxt))... 2930: 20 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 (vector-set! 2940: 20 62 75 74 74 6f 6e 64 61 74 20 30 20 72 75 6e buttondat 0 run 2950: 2d 69 64 29 0a 09 09 20 20 20 20 20 20 28 76 65 -id)... (ve 2960: 63 74 6f 72 2d 73 65 74 21 20 62 75 74 74 6f 6e ctor-set! button 2970: 64 61 74 20 31 20 63 6f 6c 6f 72 29 0a 09 09 20 dat 1 color)... 2980: 20 20 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 (vector-set 2990: 21 20 62 75 74 74 6f 6e 64 61 74 20 32 20 62 75 ! buttondat 2 bu 29a0: 74 74 6f 6e 74 78 74 29 0a 09 09 20 20 20 20 20 ttontxt)... 29b0: 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 62 75 (vector-set! bu 29c0: 74 74 6f 6e 64 61 74 20 33 20 74 65 73 74 29 0a ttondat 3 test). 29d0: 09 09 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d .. (vector- 29e0: 73 65 74 21 20 62 75 74 74 6f 6e 64 61 74 20 34 set! buttondat 4 29f0: 20 72 75 6e 2d 6b 65 79 29 0a 09 09 20 20 20 20 run-key)... 2a00: 20 20 28 69 66 20 28 6e 6f 74 20 28 68 61 73 68 (if (not (hash 2a10: 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 -table-ref/defau 2a20: 6c 74 20 2a 61 6c 6c 74 65 73 74 6e 61 6d 65 73 lt *alltestnames 2a30: 2a 20 74 65 73 74 66 75 6c 6c 6e 61 6d 65 20 23 * testfullname # 2a40: 66 29 29 0a 09 09 09 20 20 28 62 65 67 69 6e 0a f)).... (begin. 2a50: 09 09 09 20 20 20 20 28 68 61 73 68 2d 74 61 62 ... (hash-tab 2a60: 6c 65 2d 73 65 74 21 20 2a 61 6c 6c 74 65 73 74 le-set! *alltest 2a70: 6e 61 6d 65 73 2a 20 74 65 73 74 66 75 6c 6c 6e names* testfulln 2a80: 61 6d 65 20 23 74 29 0a 09 09 09 20 20 20 20 28 ame #t).... ( 2a90: 73 65 74 21 20 2a 61 6c 6c 74 65 73 74 6e 61 6d set! *alltestnam 2aa0: 65 6c 73 74 2a 20 28 61 70 70 65 6e 64 20 2a 61 elst* (append *a 2ab0: 6c 6c 74 65 73 74 6e 61 6d 65 6c 73 74 2a 20 28 lltestnamelst* ( 2ac0: 6c 69 73 74 20 74 65 73 74 66 75 6c 6c 6e 61 6d list testfullnam 2ad0: 65 29 29 29 29 29 29 0a 09 09 20 20 20 20 29 0a e))))))... ). 2ae0: 09 09 28 73 65 74 21 20 72 6f 77 6e 20 28 2b 20 ..(set! rown (+ 2af0: 72 6f 77 6e 20 31 29 29 29 29 0a 09 20 20 20 20 rown 1)))).. 2b00: 28 64 72 6f 70 20 74 65 73 74 6e 61 6d 65 73 20 (drop testnames 2b10: 2a 73 74 61 72 74 2d 74 65 73 74 2d 6f 66 66 73 *start-test-offs 2b20: 65 74 2a 29 29 29 0a 09 20 28 73 65 74 21 20 63 et*))).. (set! c 2b30: 6f 6c 6e 20 28 2b 20 63 6f 6c 6e 20 31 29 29 29 oln (+ coln 1))) 2b40: 29 0a 20 20 20 20 20 72 75 6e 73 29 29 29 0a 0a ). runs))).. 2b50: 28 64 65 66 69 6e 65 20 28 6d 6b 73 74 72 20 2e (define (mkstr . 2b60: 20 78 29 0a 20 20 28 73 74 72 69 6e 67 2d 69 6e x). (string-in 2b70: 74 65 72 73 70 65 72 73 65 20 28 6d 61 70 20 63 tersperse (map c 2b80: 6f 6e 63 20 78 29 20 22 2c 22 29 29 0a 0a 28 64 onc x) ","))..(d 2b90: 65 66 69 6e 65 20 28 75 70 64 61 74 65 2d 73 65 efine (update-se 2ba0: 61 72 63 68 20 78 20 76 61 6c 29 0a 20 20 28 70 arch x val). (p 2bb0: 72 69 6e 74 20 22 53 65 74 74 69 6e 67 20 73 65 rint "Setting se 2bc0: 61 72 63 68 20 66 6f 72 20 22 20 78 20 22 20 74 arch for " x " t 2bd0: 6f 20 22 20 76 61 6c 29 0a 20 20 28 68 61 73 68 o " val). (hash 2be0: 2d 74 61 62 6c 65 2d 73 65 74 21 20 2a 73 65 61 -table-set! *sea 2bf0: 72 63 68 70 61 74 74 73 2a 20 78 20 76 61 6c 29 rchpatts* x val) 2c00: 29 0a 0a 28 64 65 66 69 6e 65 20 28 6d 61 6b 65 )..(define (make 2c10: 2d 64 61 73 68 62 6f 61 72 64 2d 62 75 74 74 6f -dashboard-butto 2c20: 6e 73 20 6e 72 75 6e 73 20 6e 74 65 73 74 73 20 ns nruns ntests 2c30: 6b 65 79 6e 61 6d 65 73 29 0a 20 20 28 6c 65 74 keynames). (let 2c40: 2a 20 28 28 6e 6b 65 79 73 20 20 20 28 6c 65 6e * ((nkeys (len 2c50: 67 74 68 20 6b 65 79 6e 61 6d 65 73 29 29 0a 09 gth keynames)).. 2c60: 20 28 72 75 6e 73 76 65 63 20 28 6d 61 6b 65 2d (runsvec (make- 2c70: 76 65 63 74 6f 72 20 6e 72 75 6e 73 29 29 0a 09 vector nruns)).. 2c80: 20 28 68 65 61 64 65 72 20 20 28 6d 61 6b 65 2d (header (make- 2c90: 76 65 63 74 6f 72 20 6e 72 75 6e 73 29 29 0a 09 vector nruns)).. 2ca0: 20 28 6c 66 74 63 6f 6c 20 20 28 6d 61 6b 65 2d (lftcol (make- 2cb0: 76 65 63 74 6f 72 20 6e 74 65 73 74 73 29 29 0a vector ntests)). 2cc0: 09 20 28 63 6f 6e 74 72 6f 6c 73 20 27 28 29 29 . (controls '()) 2cd0: 0a 09 20 28 6c 66 74 6c 73 74 20 20 27 28 29 29 .. (lftlst '()) 2ce0: 0a 09 20 28 68 64 72 6c 73 74 20 20 27 28 29 29 .. (hdrlst '()) 2cf0: 0a 09 20 28 62 64 79 6c 73 74 20 20 27 28 29 29 .. (bdylst '()) 2d00: 0a 09 20 28 72 65 73 75 6c 74 20 20 27 28 29 29 .. (result '()) 2d10: 0a 09 20 28 69 20 20 20 20 20 20 20 30 29 29 0a .. (i 0)). 2d20: 20 20 20 20 3b 3b 20 63 6f 6e 74 72 6f 6c 73 20 ;; controls 2d30: 28 61 6c 6f 6e 67 20 62 6f 74 74 6f 6d 29 0a 20 (along bottom). 2d40: 20 20 20 28 73 65 74 21 20 63 6f 6e 74 72 6f 6c (set! control 2d50: 73 0a 09 20 20 28 69 75 70 3a 68 62 6f 78 0a 09 s.. (iup:hbox.. 2d60: 20 20 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 (iup:button " 2d70: 51 75 69 74 22 20 23 3a 61 63 74 69 6f 6e 20 28 Quit" #:action ( 2d80: 6c 61 6d 62 64 61 20 28 6f 62 6a 29 28 73 71 6c lambda (obj)(sql 2d90: 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 2a ite3:finalize! * 2da0: 64 62 2a 29 28 65 78 69 74 29 29 29 0a 09 20 20 db*)(exit))).. 2db0: 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 3c 2d (iup:button "<- 2dc0: 20 20 4c 65 66 74 22 20 23 3a 61 63 74 69 6f 6e Left" #:action 2dd0: 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 29 28 73 (lambda (obj)(s 2de0: 65 74 21 20 2a 73 74 61 72 74 2d 72 75 6e 2d 6f et! *start-run-o 2df0: 66 66 73 65 74 2a 20 20 28 2b 20 2a 73 74 61 72 ffset* (+ *star 2e00: 74 2d 72 75 6e 2d 6f 66 66 73 65 74 2a 20 31 29 t-run-offset* 1) 2e10: 29 29 29 0a 09 20 20 20 28 69 75 70 3a 62 75 74 ))).. (iup:but 2e20: 74 6f 6e 20 22 55 70 20 20 20 20 20 5e 22 20 23 ton "Up ^" # 2e30: 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 :action (lambda 2e40: 28 6f 62 6a 29 28 73 65 74 21 20 2a 73 74 61 72 (obj)(set! *star 2e50: 74 2d 74 65 73 74 2d 6f 66 66 73 65 74 2a 20 28 t-test-offset* ( 2e60: 69 66 20 28 3e 20 2a 73 74 61 72 74 2d 74 65 73 if (> *start-tes 2e70: 74 2d 6f 66 66 73 65 74 2a 20 30 29 28 2d 20 2a t-offset* 0)(- * 2e80: 73 74 61 72 74 2d 74 65 73 74 2d 6f 66 66 73 65 start-test-offse 2e90: 74 2a 20 31 29 20 30 29 29 29 29 0a 09 20 20 20 t* 1) 0)))).. 2ea0: 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 44 6f 77 (iup:button "Dow 2eb0: 6e 20 20 20 76 22 20 23 3a 61 63 74 69 6f 6e 20 n v" #:action 2ec0: 28 6c 61 6d 62 64 61 20 28 6f 62 6a 29 28 73 65 (lambda (obj)(se 2ed0: 74 21 20 2a 73 74 61 72 74 2d 74 65 73 74 2d 6f t! *start-test-o 2ee0: 66 66 73 65 74 2a 20 28 69 66 20 28 3e 3d 20 2a ffset* (if (>= * 2ef0: 73 74 61 72 74 2d 74 65 73 74 2d 6f 66 66 73 65 start-test-offse 2f00: 74 2a 20 28 6c 65 6e 67 74 68 20 2a 61 6c 6c 74 t* (length *allt 2f10: 65 73 74 6e 61 6d 65 6c 73 74 2a 29 29 28 6c 65 estnamelst*))(le 2f20: 6e 67 74 68 20 2a 61 6c 6c 74 65 73 74 6e 61 6d ngth *alltestnam 2f30: 65 6c 73 74 2a 29 28 2b 20 2a 73 74 61 72 74 2d elst*)(+ *start- 2f40: 74 65 73 74 2d 6f 66 66 73 65 74 2a 20 31 29 29 test-offset* 1)) 2f50: 29 29 29 0a 09 20 20 20 28 69 75 70 3a 62 75 74 ))).. (iup:but 2f60: 74 6f 6e 20 22 52 69 67 68 74 20 2d 3e 22 20 23 ton "Right ->" # 2f70: 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 :action (lambda 2f80: 28 6f 62 6a 29 28 73 65 74 21 20 2a 73 74 61 72 (obj)(set! *star 2f90: 74 2d 72 75 6e 2d 6f 66 66 73 65 74 2a 20 20 28 t-run-offset* ( 2fa0: 69 66 20 28 3e 20 2a 73 74 61 72 74 2d 72 75 6e if (> *start-run 2fb0: 2d 6f 66 66 73 65 74 2a 20 30 29 28 2d 20 2a 73 -offset* 0)(- *s 2fc0: 74 61 72 74 2d 72 75 6e 2d 6f 66 66 73 65 74 2a tart-run-offset* 2fd0: 20 31 29 20 30 29 29 29 29 29 29 0a 20 20 20 20 1) 0)))))). 2fe0: 0a 20 20 20 20 3b 3b 20 63 72 65 61 74 65 20 74 . ;; create t 2ff0: 68 65 20 6c 65 66 74 20 6d 6f 73 74 20 63 6f 6c he left most col 3000: 75 6d 6e 20 66 6f 72 20 74 68 65 20 72 75 6e 20 umn for the run 3010: 6b 65 79 20 6e 61 6d 65 73 20 61 6e 64 20 74 68 key names and th 3020: 65 20 74 65 73 74 20 6e 61 6d 65 73 20 0a 20 20 e test names . 3030: 20 20 28 73 65 74 21 20 6c 66 74 6c 73 74 20 28 (set! lftlst ( 3040: 6c 69 73 74 20 28 61 70 70 6c 79 20 69 75 70 3a list (apply iup: 3050: 76 62 6f 78 20 0a 09 09 09 20 20 20 20 20 20 28 vbox .... ( 3060: 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 78 29 09 map (lambda (x). 3070: 09 0a 09 09 09 09 20 20 20 20 20 28 6c 65 74 20 ...... (let 3080: 28 28 72 65 73 20 28 69 75 70 3a 68 62 6f 78 0a ((res (iup:hbox. 3090: 09 09 09 09 09 09 20 28 69 75 70 3a 6c 61 62 65 ...... (iup:labe 30a0: 6c 20 78 20 23 3a 73 69 7a 65 20 22 34 30 78 31 l x #:size "40x1 30b0: 35 22 20 23 3a 66 6f 6e 74 73 69 7a 65 20 22 31 5" #:fontsize "1 30c0: 30 22 29 20 3b 3b 20 20 23 3a 65 78 70 61 6e 64 0") ;; #:expand 30d0: 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 29 0a 09 "HORIZONTAL").. 30e0: 09 09 09 09 09 20 28 69 75 70 3a 74 65 78 74 62 ..... (iup:textb 30f0: 6f 78 20 23 3a 73 69 7a 65 20 22 36 30 78 31 35 ox #:size "60x15 3100: 22 20 23 3a 66 6f 6e 74 73 69 7a 65 20 22 31 30 " #:fontsize "10 3110: 22 20 23 3a 76 61 6c 75 65 20 22 25 22 20 3b 3b " #:value "%" ;; 3120: 20 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a #:expand "HORIZ 3130: 4f 4e 54 41 4c 22 0a 09 09 09 09 09 09 09 20 20 ONTAL"........ 3140: 20 20 20 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 #:action (la 3150: 6d 62 64 61 20 28 6f 62 6a 20 75 6e 6b 20 76 61 mbda (obj unk va 3160: 6c 29 0a 09 09 09 09 09 09 09 09 09 20 28 75 70 l).......... (up 3170: 64 61 74 65 2d 73 65 61 72 63 68 20 78 20 76 61 date-search x va 3180: 6c 29 29 29 29 29 29 0a 09 09 09 09 20 20 20 20 l))))))..... 3190: 20 20 20 28 73 65 74 21 20 69 20 28 2b 20 69 20 (set! i (+ i 31a0: 31 29 29 0a 09 09 09 09 20 20 20 20 20 20 20 72 1))..... r 31b0: 65 73 29 29 0a 09 09 09 09 20 20 20 6b 65 79 6e es))..... keyn 31c0: 61 6d 65 73 29 29 29 29 0a 20 20 20 20 28 6c 65 ames)))). (le 31d0: 74 20 6c 6f 6f 70 20 28 28 74 65 73 74 6e 75 6d t loop ((testnum 31e0: 20 20 30 29 0a 09 20 20 20 20 20 20 20 28 72 65 0).. (re 31f0: 73 20 20 20 20 20 20 27 28 29 29 29 0a 20 20 20 s '())). 3200: 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 (cond. 3210: 28 28 3e 3d 20 74 65 73 74 6e 75 6d 20 6e 74 65 ((>= testnum nte 3220: 73 74 73 29 0a 09 3b 3b 20 6e 6f 77 20 6c 66 74 sts)..;; now lft 3230: 6c 73 74 20 77 69 6c 6c 20 62 65 20 61 6e 20 68 lst will be an h 3240: 62 6f 78 20 77 69 74 68 20 74 68 65 20 74 65 73 box with the tes 3250: 74 20 6b 65 79 73 20 61 6e 64 20 74 68 65 20 74 t keys and the t 3260: 65 73 74 20 6e 61 6d 65 20 6c 61 62 65 6c 73 0a est name labels. 3270: 09 28 73 65 74 21 20 6c 66 74 6c 73 74 20 28 61 .(set! lftlst (a 3280: 70 70 65 6e 64 20 6c 66 74 6c 73 74 20 28 6c 69 ppend lftlst (li 3290: 73 74 20 28 61 70 70 6c 79 20 69 75 70 3a 76 62 st (apply iup:vb 32a0: 6f 78 20 28 72 65 76 65 72 73 65 20 72 65 73 29 ox (reverse res) 32b0: 29 29 29 29 29 0a 20 20 20 20 20 20 20 28 65 6c ))))). (el 32c0: 73 65 0a 09 28 6c 65 74 20 28 28 6c 61 62 6c 20 se..(let ((labl 32d0: 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 22 20 (iup:button "" 32e0: 23 3a 66 6c 61 74 20 22 59 45 53 22 20 23 3a 73 #:flat "YES" #:s 32f0: 69 7a 65 20 22 31 30 30 78 31 35 22 20 23 3a 66 ize "100x15" #:f 3300: 6f 6e 74 73 69 7a 65 20 22 31 30 22 29 29 29 0a ontsize "10"))). 3310: 09 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 . (vector-set! 3320: 6c 66 74 63 6f 6c 20 74 65 73 74 6e 75 6d 20 6c lftcol testnum l 3330: 61 62 6c 29 0a 09 20 20 28 6c 6f 6f 70 20 28 2b abl).. (loop (+ 3340: 20 74 65 73 74 6e 75 6d 20 31 29 28 63 6f 6e 73 testnum 1)(cons 3350: 20 6c 61 62 6c 20 72 65 73 29 29 29 29 29 29 0a labl res)))))). 3360: 20 20 20 20 3b 3b 20 0a 20 20 20 20 28 6c 65 74 ;; . (let 3370: 20 6c 6f 6f 70 20 28 28 72 75 6e 6e 75 6d 20 20 loop ((runnum 3380: 30 29 0a 09 20 20 20 20 20 20 20 28 6b 65 79 6e 0).. (keyn 3390: 75 6d 20 20 30 29 0a 09 20 20 20 20 20 20 20 28 um 0).. ( 33a0: 6b 65 79 76 65 63 20 20 28 6d 61 6b 65 2d 76 65 keyvec (make-ve 33b0: 63 74 6f 72 20 6e 6b 65 79 73 29 29 0a 09 20 20 ctor nkeys)).. 33c0: 20 20 20 20 20 28 72 65 73 20 20 20 20 27 28 29 (res '() 33d0: 29 29 0a 20 20 20 20 20 20 28 63 6f 6e 64 20 3b )). (cond ; 33e0: 3b 20 6e 62 2f 2f 20 6e 6f 20 65 6c 73 65 20 66 ; nb// no else f 33f0: 6f 72 20 74 68 69 73 20 61 70 70 72 6f 61 63 68 or this approach 3400: 2e 0a 20 20 20 20 20 20 20 28 28 3e 3d 20 72 75 .. ((>= ru 3410: 6e 6e 75 6d 20 6e 72 75 6e 73 29 20 23 66 29 0a nnum nruns) #f). 3420: 20 20 20 20 20 20 20 28 28 3e 3d 20 6b 65 79 6e ((>= keyn 3430: 75 6d 20 6e 6b 65 79 73 29 20 0a 09 28 76 65 63 um nkeys) ..(vec 3440: 74 6f 72 2d 73 65 74 21 20 68 65 61 64 65 72 20 tor-set! header 3450: 72 75 6e 6e 75 6d 20 6b 65 79 76 65 63 29 0a 09 runnum keyvec).. 3460: 28 73 65 74 21 20 68 64 72 6c 73 74 20 28 63 6f (set! hdrlst (co 3470: 6e 73 20 28 61 70 70 6c 79 20 69 75 70 3a 76 62 ns (apply iup:vb 3480: 6f 78 20 28 72 65 76 65 72 73 65 20 72 65 73 29 ox (reverse res) 3490: 29 20 68 64 72 6c 73 74 29 29 0a 09 28 6c 6f 6f ) hdrlst))..(loo 34a0: 70 20 28 2b 20 72 75 6e 6e 75 6d 20 31 29 20 30 p (+ runnum 1) 0 34b0: 20 28 6d 61 6b 65 2d 76 65 63 74 6f 72 20 6e 6b (make-vector nk 34c0: 65 79 73 29 20 27 28 29 29 29 0a 20 20 20 20 20 eys) '())). 34d0: 20 20 28 65 6c 73 65 0a 09 28 6c 65 74 20 28 28 (else..(let (( 34e0: 6c 61 62 6c 20 20 28 69 75 70 3a 6c 61 62 65 6c labl (iup:label 34f0: 20 22 22 20 23 3a 73 69 7a 65 20 22 36 30 78 31 "" #:size "60x1 3500: 35 22 20 23 3a 66 6f 6e 74 73 69 7a 65 20 22 31 5" #:fontsize "1 3510: 30 22 20 3b 3b 20 23 3a 65 78 70 61 6e 64 20 22 0" ;; #:expand " 3520: 48 4f 52 49 5a 4f 4e 54 41 4c 22 0a 09 09 09 09 HORIZONTAL"..... 3530: 29 29 29 0a 09 20 20 28 76 65 63 74 6f 72 2d 73 ))).. (vector-s 3540: 65 74 21 20 6b 65 79 76 65 63 20 6b 65 79 6e 75 et! keyvec keynu 3550: 6d 20 6c 61 62 6c 29 0a 09 20 20 28 6c 6f 6f 70 m labl).. (loop 3560: 20 72 75 6e 6e 75 6d 20 28 2b 20 6b 65 79 6e 75 runnum (+ keynu 3570: 6d 20 31 29 20 6b 65 79 76 65 63 20 28 63 6f 6e m 1) keyvec (con 3580: 73 20 6c 61 62 6c 20 72 65 73 29 29 29 29 29 29 s labl res)))))) 3590: 0a 20 20 20 20 3b 3b 20 42 79 20 68 65 72 65 20 . ;; By here 35a0: 74 68 65 20 68 64 72 6c 73 74 20 63 6f 6e 74 61 the hdrlst conta 35b0: 69 6e 73 20 61 20 6c 69 73 74 20 6f 66 20 76 62 ins a list of vb 35c0: 6f 78 65 73 20 63 6f 6e 74 61 69 6e 69 6e 67 20 oxes containing 35d0: 6e 6b 65 79 73 20 6c 61 62 65 6c 73 0a 20 20 20 nkeys labels. 35e0: 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 72 75 6e (let loop ((run 35f0: 6e 75 6d 20 20 30 29 0a 09 20 20 20 20 20 20 20 num 0).. 3600: 28 74 65 73 74 6e 75 6d 20 30 29 0a 09 20 20 20 (testnum 0).. 3610: 20 20 20 20 28 74 65 73 74 76 65 63 20 20 28 6d (testvec (m 3620: 61 6b 65 2d 76 65 63 74 6f 72 20 6e 74 65 73 74 ake-vector ntest 3630: 73 29 29 0a 09 20 20 20 20 20 20 20 28 72 65 73 s)).. (res 3640: 20 20 20 20 27 28 29 29 29 0a 20 20 20 20 20 20 '())). 3650: 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 28 28 3e (cond. ((> 3660: 3d 20 72 75 6e 6e 75 6d 20 6e 72 75 6e 73 29 20 = runnum nruns) 3670: 23 66 29 20 3b 3b 20 20 28 76 65 63 74 6f 72 20 #f) ;; (vector 3680: 74 61 62 6c 65 68 65 61 64 65 72 20 72 75 6e 73 tableheader runs 3690: 76 65 63 29 29 0a 20 20 20 20 20 20 20 28 28 3e vec)). ((> 36a0: 3d 20 74 65 73 74 6e 75 6d 20 6e 74 65 73 74 73 = testnum ntests 36b0: 29 20 0a 09 28 76 65 63 74 6f 72 2d 73 65 74 21 ) ..(vector-set! 36c0: 20 72 75 6e 73 76 65 63 20 72 75 6e 6e 75 6d 20 runsvec runnum 36d0: 74 65 73 74 76 65 63 29 0a 09 28 73 65 74 21 20 testvec)..(set! 36e0: 62 64 79 6c 73 74 20 28 63 6f 6e 73 20 28 61 70 bdylst (cons (ap 36f0: 70 6c 79 20 69 75 70 3a 76 62 6f 78 20 28 72 65 ply iup:vbox (re 3700: 76 65 72 73 65 20 72 65 73 29 29 20 62 64 79 6c verse res)) bdyl 3710: 73 74 29 29 0a 09 28 6c 6f 6f 70 20 28 2b 20 72 st))..(loop (+ r 3720: 75 6e 6e 75 6d 20 31 29 20 30 20 28 6d 61 6b 65 unnum 1) 0 (make 3730: 2d 76 65 63 74 6f 72 20 6e 74 65 73 74 73 29 20 -vector ntests) 3740: 27 28 29 29 29 0a 20 20 20 20 20 20 20 28 65 6c '())). (el 3750: 73 65 0a 09 28 6c 65 74 2a 20 28 28 62 75 74 74 se..(let* ((butt 3760: 6f 6e 2d 6b 65 79 20 28 6d 6b 73 74 72 20 72 75 on-key (mkstr ru 3770: 6e 6e 75 6d 20 74 65 73 74 6e 75 6d 29 29 0a 09 nnum testnum)).. 3780: 20 20 20 20 20 20 20 28 62 75 74 6e 20 20 20 20 (butn 3790: 20 20 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 (iup:button " 37a0: 22 20 3b 3b 20 62 75 74 74 6f 6e 2d 6b 65 79 20 " ;; button-key 37b0: 0a 09 09 09 09 20 20 20 20 20 20 20 23 3a 73 69 ..... #:si 37c0: 7a 65 20 22 36 30 78 31 35 22 20 0a 09 09 09 09 ze "60x15" ..... 37d0: 20 20 20 20 20 20 20 3b 3b 20 23 3a 65 78 70 61 ;; #:expa 37e0: 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 0a nd "HORIZONTAL". 37f0: 09 09 09 09 20 20 20 20 20 20 20 23 3a 66 6f 6e .... #:fon 3800: 74 73 69 7a 65 20 22 31 30 22 20 0a 09 09 09 09 tsize "10" ..... 3810: 20 20 20 20 20 20 20 23 3a 61 63 74 69 6f 6e 20 #:action 3820: 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 09 09 (lambda (x)..... 3830: 09 09 20 20 28 65 78 61 6d 69 6e 65 2d 74 65 73 .. (examine-tes 3840: 74 20 62 75 74 74 6f 6e 2d 6b 65 79 29 29 29 29 t button-key)))) 3850: 29 0a 09 20 20 28 68 61 73 68 2d 74 61 62 6c 65 ).. (hash-table 3860: 2d 73 65 74 21 20 2a 62 75 74 74 6f 6e 64 61 74 -set! *buttondat 3870: 2a 20 62 75 74 74 6f 6e 2d 6b 65 79 20 28 76 65 * button-key (ve 3880: 63 74 6f 72 20 30 20 22 31 30 30 20 31 30 30 20 ctor 0 "100 100 3890: 31 30 30 22 20 62 75 74 74 6f 6e 2d 6b 65 79 20 100" button-key 38a0: 23 66 20 23 66 29 29 20 0a 09 20 20 28 76 65 63 #f #f)) .. (vec 38b0: 74 6f 72 2d 73 65 74 21 20 74 65 73 74 76 65 63 tor-set! testvec 38c0: 20 74 65 73 74 6e 75 6d 20 62 75 74 6e 29 0a 09 testnum butn).. 38d0: 20 20 28 6c 6f 6f 70 20 72 75 6e 6e 75 6d 20 28 (loop runnum ( 38e0: 2b 20 74 65 73 74 6e 75 6d 20 31 29 20 74 65 73 + testnum 1) tes 38f0: 74 76 65 63 20 28 63 6f 6e 73 20 62 75 74 6e 20 tvec (cons butn 3900: 72 65 73 29 29 29 29 29 29 0a 20 20 20 20 3b 3b res)))))). ;; 3910: 20 6e 6f 77 20 61 73 73 65 6d 62 6c 65 20 74 68 now assemble th 3920: 65 20 68 64 72 6c 73 74 20 61 6e 64 20 62 64 79 e hdrlst and bdy 3930: 6c 73 74 20 61 6e 64 20 6b 69 63 6b 20 6f 66 66 lst and kick off 3940: 20 74 68 65 20 64 69 61 6c 6f 67 0a 20 20 20 20 the dialog. 3950: 28 69 75 70 3a 73 68 6f 77 0a 20 20 20 20 20 28 (iup:show. ( 3960: 69 75 70 3a 64 69 61 6c 6f 67 20 0a 20 20 20 20 iup:dialog . 3970: 20 20 23 3a 74 69 74 6c 65 20 22 4d 65 67 61 74 #:title "Megat 3980: 65 73 74 20 64 61 73 68 62 6f 61 72 64 22 0a 20 est dashboard". 3990: 20 20 20 20 20 28 69 75 70 3a 76 62 6f 78 0a 09 (iup:vbox.. 39a0: 28 61 70 70 6c 79 20 69 75 70 3a 68 62 6f 78 20 (apply iup:hbox 39b0: 0a 09 20 20 20 20 20 20 20 28 63 6f 6e 73 20 28 .. (cons ( 39c0: 61 70 70 6c 79 20 69 75 70 3a 76 62 6f 78 20 6c apply iup:vbox l 39d0: 66 74 6c 73 74 29 0a 09 09 20 20 20 20 20 28 6c ftlst)... (l 39e0: 69 73 74 20 0a 09 09 20 20 20 20 20 20 28 69 75 ist ... (iu 39f0: 70 3a 76 62 6f 78 0a 09 09 20 20 20 20 20 20 20 p:vbox... 3a00: 3b 3b 20 74 68 65 20 68 65 61 64 65 72 0a 09 09 ;; the header... 3a10: 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 69 75 (apply iu 3a20: 70 3a 68 62 6f 78 20 28 72 65 76 65 72 73 65 20 p:hbox (reverse 3a30: 68 64 72 6c 73 74 29 29 0a 09 09 20 20 20 20 20 hdrlst))... 3a40: 20 20 28 61 70 70 6c 79 20 69 75 70 3a 68 62 6f (apply iup:hbo 3a50: 78 20 28 72 65 76 65 72 73 65 20 62 64 79 6c 73 x (reverse bdyls 3a60: 74 29 29 29 29 29 29 0a 20 20 20 20 20 20 20 63 t)))))). c 3a70: 6f 6e 74 72 6f 6c 73 29 29 29 0a 20 20 20 20 28 ontrols))). ( 3a80: 76 65 63 74 6f 72 20 6c 66 74 63 6f 6c 20 68 65 vector lftcol he 3a90: 61 64 65 72 20 72 75 6e 73 76 65 63 29 29 29 0a ader runsvec))). 3aa0: 0a 28 73 65 74 21 20 2a 6e 75 6d 2d 74 65 73 74 .(set! *num-test 3ab0: 73 2a 20 28 6d 61 78 20 28 75 70 64 61 74 65 2d s* (max (update- 3ac0: 72 75 6e 64 61 74 20 22 25 22 20 2a 6e 75 6d 2d rundat "%" *num- 3ad0: 72 75 6e 73 2a 29 20 38 29 29 0a 0a 28 73 65 74 runs*) 8))..(set 3ae0: 21 20 75 69 64 61 74 20 28 6d 61 6b 65 2d 64 61 ! uidat (make-da 3af0: 73 68 62 6f 61 72 64 2d 62 75 74 74 6f 6e 73 20 shboard-buttons 3b00: 2a 6e 75 6d 2d 72 75 6e 73 2a 20 2a 6e 75 6d 2d *num-runs* *num- 3b10: 74 65 73 74 73 2a 20 64 62 6b 65 79 73 29 29 0a tests* dbkeys)). 3b20: 3b 3b 20 28 6d 65 67 61 74 65 73 74 2d 64 61 73 ;; (megatest-das 3b30: 68 62 6f 61 72 64 29 0a 0a 28 64 65 66 69 6e 65 hboard)..(define 3b40: 20 28 72 75 6e 2d 75 70 64 61 74 65 20 6f 74 68 (run-update oth 3b50: 65 72 2d 74 68 72 65 61 64 29 0a 20 20 28 6c 65 er-thread). (le 3b60: 74 20 6c 6f 6f 70 20 28 28 69 20 30 29 29 0a 20 t loop ((i 0)). 3b70: 20 20 20 28 74 68 72 65 61 64 2d 73 6c 65 65 70 (thread-sleep 3b80: 21 20 30 2e 31 29 0a 20 20 20 20 28 74 68 72 65 ! 0.1). (thre 3b90: 61 64 2d 73 75 73 70 65 6e 64 21 20 6f 74 68 65 ad-suspend! othe 3ba0: 72 2d 74 68 72 65 61 64 29 0a 20 20 20 20 28 75 r-thread). (u 3bb0: 70 64 61 74 65 2d 72 75 6e 64 61 74 20 28 68 61 pdate-rundat (ha 3bc0: 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 sh-table-ref/def 3bd0: 61 75 6c 74 20 2a 73 65 61 72 63 68 70 61 74 74 ault *searchpatt 3be0: 73 2a 20 22 72 75 6e 6e 61 6d 65 22 20 22 25 22 s* "runname" "%" 3bf0: 29 20 2a 6e 75 6d 2d 72 75 6e 73 2a 29 0a 20 20 ) *num-runs*). 3c00: 20 20 28 75 70 64 61 74 65 2d 62 75 74 74 6f 6e (update-button 3c10: 73 20 75 69 64 61 74 20 2a 6e 75 6d 2d 72 75 6e s uidat *num-run 3c20: 73 2a 20 2a 6e 75 6d 2d 74 65 73 74 73 2a 29 0a s* *num-tests*). 3c30: 20 20 20 20 28 74 68 72 65 61 64 2d 72 65 73 75 (thread-resu 3c40: 6d 65 21 20 6f 74 68 65 72 2d 74 68 72 65 61 64 me! other-thread 3c50: 29 0a 20 20 20 20 28 6c 6f 6f 70 20 28 2b 20 69 ). (loop (+ i 3c60: 20 31 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 1))))..(define 3c70: 74 68 32 20 28 6d 61 6b 65 2d 74 68 72 65 61 64 th2 (make-thread 3c80: 20 69 75 70 3a 6d 61 69 6e 2d 6c 6f 6f 70 29 29 iup:main-loop)) 3c90: 0a 28 64 65 66 69 6e 65 20 74 68 31 20 28 6d 61 .(define th1 (ma 3ca0: 6b 65 2d 74 68 72 65 61 64 20 28 72 75 6e 2d 75 ke-thread (run-u 3cb0: 70 64 61 74 65 20 74 68 32 29 29 29 0a 28 74 68 pdate th2))).(th 3cc0: 72 65 61 64 2d 73 74 61 72 74 21 20 74 68 31 29 read-start! th1) 3cd0: 0a 28 74 68 72 65 61 64 2d 73 74 61 72 74 21 20 .(thread-start! 3ce0: 74 68 32 29 0a 28 74 68 72 65 61 64 2d 6a 6f 69 th2).(thread-joi 3cf0: 6e 21 20 74 68 32 29 0a n! th2).