Artifact 58d8d13c30b5e647494de441bfd7d35b418a509d:
- File dashboard.scm — part of check-in [ae6dbecf17] at 2011-05-01 23:05:22 on branch trunk — Importing 1.0.1 version of megatest, (nb// work in progress, please wait for next release) (user: matt size: 15617)
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 2e 2e 2f 6d 61 72 67 73 2f clude "../margs/ 0290: 6d 61 72 67 73 2e 73 63 6d 22 29 0a 28 69 6e 63 margs.scm").(inc 02a0: 6c 75 64 65 20 22 6b 65 79 73 2e 73 63 6d 22 29 lude "keys.scm") 02b0: 0a 28 69 6e 63 6c 75 64 65 20 22 69 74 65 6d 73 .(include "items 02c0: 2e 73 63 6d 22 29 0a 28 69 6e 63 6c 75 64 65 20 .scm").(include 02d0: 22 64 62 2e 73 63 6d 22 29 0a 28 69 6e 63 6c 75 "db.scm").(inclu 02e0: 64 65 20 22 63 6f 6e 66 69 67 66 2e 73 63 6d 22 de "configf.scm" 02f0: 29 0a 28 69 6e 63 6c 75 64 65 20 22 70 72 6f 63 ).(include "proc 0300: 65 73 73 2e 73 63 6d 22 29 0a 28 69 6e 63 6c 75 ess.scm").(inclu 0310: 64 65 20 22 6c 61 75 6e 63 68 2e 73 63 6d 22 29 de "launch.scm") 0320: 0a 28 69 6e 63 6c 75 64 65 20 22 72 75 6e 73 2e .(include "runs. 0330: 73 63 6d 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 scm").(include " 0340: 67 75 69 2e 73 63 6d 22 29 0a 0a 28 69 66 20 28 gui.scm")..(if ( 0350: 6e 6f 74 20 28 73 65 74 75 70 2d 66 6f 72 2d 72 not (setup-for-r 0360: 75 6e 29 29 0a 20 20 20 20 28 62 65 67 69 6e 0a un)). (begin. 0370: 20 20 20 20 20 20 28 70 72 69 6e 74 20 22 46 61 (print "Fa 0380: 69 6c 65 64 20 74 6f 20 66 69 6e 64 20 6d 65 67 iled to find meg 0390: 61 74 65 73 74 2e 63 6f 6e 66 69 67 2c 20 65 78 atest.config, ex 03a0: 69 74 69 6e 67 22 29 20 0a 20 20 20 20 20 20 28 iting") . ( 03b0: 65 78 69 74 20 31 29 29 29 0a 0a 28 64 65 66 69 exit 1)))..(defi 03c0: 6e 65 20 2a 64 62 2a 20 28 6f 70 65 6e 2d 64 62 ne *db* (open-db 03d0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 74 6f 70 6c ))..(define topl 03e0: 65 76 65 6c 20 23 66 29 0a 28 64 65 66 69 6e 65 evel #f).(define 03f0: 20 64 6c 67 20 20 20 20 20 20 23 66 29 0a 28 64 dlg #f).(d 0400: 65 66 69 6e 65 20 6d 61 78 2d 74 65 73 74 2d 6e efine max-test-n 0410: 75 6d 20 30 29 0a 28 64 65 66 69 6e 65 20 2a 6b um 0).(define *k 0420: 65 79 73 2a 20 20 20 28 67 65 74 2d 6b 65 79 73 eys* (get-keys 0430: 20 20 20 2a 64 62 2a 29 29 0a 28 64 65 66 69 6e *db*)).(defin 0440: 65 20 64 62 6b 65 79 73 20 20 20 28 6d 61 70 20 e dbkeys (map 0450: 28 6c 61 6d 62 64 61 20 28 78 29 28 76 65 63 74 (lambda (x)(vect 0460: 6f 72 2d 72 65 66 20 78 20 30 29 29 0a 09 09 20 or-ref x 0))... 0470: 20 20 20 20 20 28 61 70 70 65 6e 64 20 2a 6b 65 (append *ke 0480: 79 73 2a 20 28 6c 69 73 74 20 28 76 65 63 74 6f ys* (list (vecto 0490: 72 20 22 72 75 6e 6e 61 6d 65 22 20 22 62 6c 61 r "runname" "bla 04a0: 68 22 29 29 29 29 29 0a 28 64 65 66 69 6e 65 20 h"))))).(define 04b0: 2a 68 65 61 64 65 72 2a 20 20 20 20 20 20 20 23 *header* # 04c0: 66 29 0a 28 64 65 66 69 6e 65 20 2a 61 6c 6c 72 f).(define *allr 04d0: 75 6e 73 2a 20 20 20 20 20 27 28 29 29 0a 28 64 uns* '()).(d 04e0: 65 66 69 6e 65 20 2a 62 75 74 74 6f 6e 64 61 74 efine *buttondat 04f0: 2a 20 20 20 20 28 6d 61 6b 65 2d 68 61 73 68 2d * (make-hash- 0500: 74 61 62 6c 65 29 29 20 3b 3b 20 3c 72 75 6e 2d table)) ;; <run- 0510: 69 64 20 63 6f 6c 6f 72 20 74 65 78 74 20 74 65 id color text te 0520: 73 74 20 72 75 6e 2d 6b 65 79 3e 0a 28 64 65 66 st run-key>.(def 0530: 69 6e 65 20 2a 61 6c 6c 74 65 73 74 6e 61 6d 65 ine *alltestname 0540: 73 2a 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 s* (make-hash-ta 0550: 62 6c 65 29 29 20 3b 3b 20 62 75 69 6c 64 20 61 ble)) ;; build a 0560: 20 6d 69 6e 69 6d 61 6c 69 7a 65 64 20 6c 69 73 minimalized lis 0570: 74 20 6f 66 20 74 65 73 74 20 6e 61 6d 65 73 0a t of test names. 0580: 28 64 65 66 69 6e 65 20 2a 61 6c 6c 74 65 73 74 (define *alltest 0590: 6e 61 6d 65 6c 73 74 2a 20 27 28 29 29 0a 28 64 namelst* '()).(d 05a0: 65 66 69 6e 65 20 2a 73 65 61 72 63 68 70 61 74 efine *searchpat 05b0: 74 73 2a 20 20 28 6d 61 6b 65 2d 68 61 73 68 2d ts* (make-hash- 05c0: 74 61 62 6c 65 29 29 0a 28 64 65 66 69 6e 65 20 table)).(define 05d0: 2a 6e 75 6d 2d 72 75 6e 73 2a 20 20 20 20 20 20 *num-runs* 05e0: 31 30 29 0a 28 64 65 66 69 6e 65 20 2a 6e 75 6d 10).(define *num 05f0: 2d 74 65 73 74 73 2a 20 20 20 20 20 31 35 29 0a -tests* 15). 0600: 28 64 65 66 69 6e 65 20 2a 73 74 61 72 74 2d 72 (define *start-r 0610: 75 6e 2d 6f 66 66 73 65 74 2a 20 20 30 29 0a 28 un-offset* 0).( 0620: 64 65 66 69 6e 65 20 2a 73 74 61 72 74 2d 74 65 define *start-te 0630: 73 74 2d 6f 66 66 73 65 74 2a 20 30 29 0a 0a 0a st-offset* 0)... 0640: 28 64 65 66 69 6e 65 20 28 6d 65 73 73 61 67 65 (define (message 0650: 2d 77 69 6e 64 6f 77 20 6d 73 67 29 0a 20 20 28 -window msg). ( 0660: 69 75 70 3a 73 68 6f 77 0a 20 20 20 28 69 75 70 iup:show. (iup 0670: 3a 64 69 61 6c 6f 67 0a 20 20 20 20 28 69 75 70 :dialog. (iup 0680: 3a 76 62 6f 78 20 0a 20 20 20 20 20 28 69 75 70 :vbox . (iup 0690: 3a 6c 61 62 65 6c 20 6d 73 67 20 23 3a 6d 61 72 :label msg #:mar 06a0: 67 69 6e 20 22 34 30 78 34 30 22 29 29 29 29 29 gin "40x40"))))) 06b0: 0a 0a 28 64 65 66 69 6e 65 20 28 69 75 70 6c 69 ..(define (iupli 06c0: 73 74 62 6f 78 2d 66 69 6c 6c 2d 6c 69 73 74 20 stbox-fill-list 06d0: 6c 62 20 69 74 65 6d 73 20 2e 20 64 65 66 61 75 lb items . defau 06e0: 6c 74 29 0a 20 20 28 6c 65 74 20 28 28 69 20 31 lt). (let ((i 1 06f0: 29 0a 09 28 73 65 6c 65 63 74 65 64 2d 69 74 65 )..(selected-ite 0700: 6d 20 28 69 66 20 28 6e 75 6c 6c 3f 20 64 65 66 m (if (null? def 0710: 61 75 6c 74 29 20 23 66 20 28 63 61 72 20 64 65 ault) #f (car de 0720: 66 61 75 6c 74 29 29 29 29 0a 20 20 20 20 28 69 fault)))). (i 0730: 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 up:attribute-set 0740: 21 20 6c 62 20 22 56 41 4c 55 45 22 20 28 69 66 ! lb "VALUE" (if 0750: 20 73 65 6c 65 63 74 65 64 2d 69 74 65 6d 20 73 selected-item s 0760: 65 6c 65 63 74 65 64 2d 69 74 65 6d 20 22 22 29 elected-item "") 0770: 29 0a 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 ). (for-each 0780: 28 6c 61 6d 62 64 61 20 28 69 74 65 6d 29 0a 09 (lambda (item).. 0790: 09 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d .(iup:attribute- 07a0: 73 65 74 21 20 6c 62 20 28 6e 75 6d 62 65 72 2d set! lb (number- 07b0: 3e 73 74 72 69 6e 67 20 69 29 20 69 74 65 6d 29 >string i) item) 07c0: 0a 09 09 28 69 66 20 73 65 6c 65 63 74 65 64 2d ...(if selected- 07d0: 69 74 65 6d 0a 09 09 20 20 20 20 28 69 66 20 28 item... (if ( 07e0: 65 71 75 61 6c 3f 20 73 65 6c 65 63 74 65 64 2d equal? selected- 07f0: 69 74 65 6d 20 69 74 65 6d 29 0a 09 09 09 28 69 item item)....(i 0800: 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 up:attribute-set 0810: 21 20 6c 62 20 22 56 41 4c 55 45 22 20 69 74 65 ! lb "VALUE" ite 0820: 6d 29 29 29 20 3b 3b 20 28 6e 75 6d 62 65 72 2d m))) ;; (number- 0830: 3e 73 74 72 69 6e 67 20 69 29 29 29 29 0a 09 09 >string i))))... 0840: 28 73 65 74 21 20 69 20 28 2b 20 69 20 31 29 29 (set! i (+ i 1)) 0850: 29 0a 09 20 20 20 20 20 20 69 74 65 6d 73 29 0a ).. items). 0860: 20 20 20 20 69 29 29 0a 0a 28 64 65 66 69 6e 65 i))..(define 0870: 20 28 70 61 64 2d 6c 69 73 74 20 6c 20 6e 29 28 (pad-list l n)( 0880: 61 70 70 65 6e 64 20 6c 20 28 6d 61 6b 65 2d 6c append l (make-l 0890: 69 73 74 20 28 2d 20 6e 20 28 6c 65 6e 67 74 68 ist (- n (length 08a0: 20 6c 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 l)))))..(define 08b0: 20 28 65 78 61 6d 69 6e 65 2d 74 65 73 74 20 62 (examine-test b 08c0: 75 74 74 6f 6e 2d 6b 65 79 29 20 3b 3b 20 72 75 utton-key) ;; ru 08d0: 6e 2d 69 64 20 72 75 6e 2d 6b 65 79 20 6f 72 69 n-id run-key ori 08e0: 67 74 65 73 74 29 0a 20 20 28 6c 65 74 20 28 28 gtest). (let (( 08f0: 62 75 74 74 6f 6e 64 61 74 20 20 20 20 20 28 68 buttondat (h 0900: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de 0910: 66 61 75 6c 74 20 2a 62 75 74 74 6f 6e 64 61 74 fault *buttondat 0920: 2a 20 62 75 74 74 6f 6e 2d 6b 65 79 20 23 66 29 * button-key #f) 0930: 29 29 0a 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 )). ;; (print 0940: 20 22 62 75 74 74 6f 6e 64 61 74 3a 20 22 20 62 "buttondat: " b 0950: 75 74 74 6f 6e 64 61 74 29 0a 20 20 20 20 28 69 uttondat). (i 0960: 66 20 28 61 6e 64 20 62 75 74 74 6f 6e 64 61 74 f (and buttondat 0970: 0a 09 20 20 20 20 20 28 76 65 63 74 6f 72 20 62 .. (vector b 0980: 75 74 74 6f 6e 64 61 74 29 0a 09 20 20 20 20 20 uttondat).. 0990: 28 76 65 63 74 6f 72 2d 72 65 66 20 62 75 74 74 (vector-ref butt 09a0: 6f 6e 64 61 74 20 30 29 0a 09 20 20 20 20 20 28 ondat 0).. ( 09b0: 3e 20 28 76 65 63 74 6f 72 2d 72 65 66 20 62 75 > (vector-ref bu 09c0: 74 74 6f 6e 64 61 74 20 30 29 20 30 29 0a 09 20 ttondat 0) 0).. 09d0: 20 20 20 20 28 76 65 63 74 6f 72 3f 20 28 76 65 (vector? (ve 09e0: 63 74 6f 72 2d 72 65 66 20 62 75 74 74 6f 6e 64 ctor-ref buttond 09f0: 61 74 20 33 29 29 0a 09 20 20 20 20 20 28 3e 20 at 3)).. (> 0a00: 28 76 65 63 74 6f 72 2d 72 65 66 20 28 76 65 63 (vector-ref (vec 0a10: 74 6f 72 2d 72 65 66 20 62 75 74 74 6f 6e 64 61 tor-ref buttonda 0a20: 74 20 33 29 20 30 29 20 30 29 29 0a 09 28 6c 65 t 3) 0) 0))..(le 0a30: 74 2a 20 28 28 72 75 6e 2d 69 64 20 20 20 20 20 t* ((run-id 0a40: 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 62 75 (vector-ref bu 0a50: 74 74 6f 6e 64 61 74 20 30 29 29 0a 09 20 20 20 ttondat 0)).. 0a60: 20 20 20 20 28 6f 72 69 67 74 65 73 74 20 20 20 (origtest 0a70: 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 62 75 (vector-ref bu 0a80: 74 74 6f 6e 64 61 74 20 33 29 29 0a 09 20 20 20 ttondat 3)).. 0a90: 20 20 20 20 28 72 75 6e 2d 6b 65 79 20 20 20 20 (run-key 0aa0: 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 62 75 (vector-ref bu 0ab0: 74 74 6f 6e 64 61 74 20 34 29 29 0a 09 20 20 20 ttondat 4)).. 0ac0: 20 20 20 20 28 74 65 73 74 20 20 20 20 20 20 20 (test 0ad0: 20 20 28 64 62 3a 67 65 74 2d 74 65 73 74 2d 69 (db:get-test-i 0ae0: 6e 66 6f 20 2a 64 62 2a 0a 09 09 09 09 09 20 20 nfo *db*...... 0af0: 20 20 20 20 20 72 75 6e 2d 69 64 0a 09 09 09 09 run-id..... 0b00: 09 20 20 20 20 20 20 20 28 64 62 3a 74 65 73 74 . (db:test 0b10: 2d 67 65 74 2d 74 65 73 74 6e 61 6d 65 20 20 6f -get-testname o 0b20: 72 69 67 74 65 73 74 29 0a 09 09 09 09 09 20 20 rigtest)...... 0b30: 20 20 20 20 20 28 64 62 3a 74 65 73 74 2d 67 65 (db:test-ge 0b40: 74 2d 69 74 65 6d 2d 70 61 74 68 20 6f 72 69 67 t-item-path orig 0b50: 74 65 73 74 29 29 29 0a 09 20 20 20 20 20 20 20 test))).. 0b60: 28 72 75 6e 64 69 72 20 20 20 20 20 20 20 28 64 (rundir (d 0b70: 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e 64 69 b:test-get-rundi 0b80: 72 20 74 65 73 74 29 29 0a 09 20 20 20 20 20 20 r test)).. 0b90: 20 28 74 65 73 74 6e 61 6d 65 20 20 20 20 20 28 (testname ( 0ba0: 64 62 3a 74 65 73 74 2d 67 65 74 2d 74 65 73 74 db:test-get-test 0bb0: 6e 61 6d 65 20 20 20 74 65 73 74 29 29 0a 09 20 name test)).. 0bc0: 20 20 20 20 20 20 28 69 74 65 6d 70 61 74 68 20 (itempath 0bd0: 20 20 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 (db:test-get 0be0: 2d 69 74 65 6d 2d 70 61 74 68 20 74 65 73 74 29 -item-path test) 0bf0: 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 66 ).. (testf 0c00: 75 6c 6c 6e 61 6d 65 20 28 72 75 6e 73 3a 74 65 ullname (runs:te 0c10: 73 74 2d 67 65 74 2d 66 75 6c 6c 2d 70 61 74 68 st-get-full-path 0c20: 20 74 65 73 74 29 29 0a 09 20 20 20 20 20 20 20 test)).. 0c30: 28 63 75 72 72 73 74 61 74 75 73 20 20 20 28 64 (currstatus (d 0c40: 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 75 b:test-get-statu 0c50: 73 20 74 65 73 74 29 29 0a 09 20 20 20 20 20 20 s test)).. 0c60: 20 28 63 75 72 72 73 74 61 74 65 20 20 20 20 28 (currstate ( 0c70: 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 db:test-get-stat 0c80: 65 20 20 74 65 73 74 29 29 0a 09 20 20 20 20 20 e test)).. 0c90: 20 20 28 63 75 72 72 63 6f 6d 6d 65 6e 74 20 20 (currcomment 0ca0: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 63 6f 6d (db:test-get-com 0cb0: 6d 65 6e 74 20 74 65 73 74 29 29 0a 09 20 20 20 ment test)).. 0cc0: 20 20 20 20 28 6c 6f 67 66 69 6c 65 20 20 20 20 (logfile 0cd0: 20 20 28 63 6f 6e 63 20 28 64 62 3a 74 65 73 74 (conc (db:test 0ce0: 2d 67 65 74 2d 72 75 6e 64 69 72 20 74 65 73 74 -get-rundir test 0cf0: 29 20 22 2f 22 20 28 64 62 3a 74 65 73 74 2d 67 ) "/" (db:test-g 0d00: 65 74 2d 66 69 6e 61 6c 5f 6c 6f 67 66 20 74 65 et-final_logf te 0d10: 73 74 29 29 29 0a 09 20 20 20 20 20 20 20 28 76 st))).. (v 0d20: 69 65 77 6c 6f 67 20 20 20 20 20 20 28 6c 61 6d iewlog (lam 0d30: 62 64 61 20 28 78 29 0a 09 09 09 20 20 20 20 20 bda (x).... 0d40: 20 20 28 69 66 20 28 66 69 6c 65 2d 65 78 69 73 (if (file-exis 0d50: 74 73 3f 20 6c 6f 67 66 69 6c 65 29 0a 09 09 09 ts? logfile).... 0d60: 09 20 20 20 28 73 79 73 74 65 6d 20 28 63 6f 6e . (system (con 0d70: 63 20 22 66 69 72 65 66 6f 78 20 22 20 6c 6f 67 c "firefox " log 0d80: 66 69 6c 65 20 22 26 22 29 29 0a 09 09 09 09 20 file "&"))..... 0d90: 20 20 28 6d 65 73 73 61 67 65 2d 77 69 6e 64 6f (message-windo 0da0: 77 20 28 63 6f 6e 63 20 22 46 69 6c 65 20 22 20 w (conc "File " 0db0: 6c 6f 67 66 69 6c 65 20 22 20 6e 6f 74 20 66 6f logfile " not fo 0dc0: 75 6e 64 22 29 29 29 29 29 0a 09 20 20 20 20 20 und"))))).. 0dd0: 20 20 28 78 74 65 72 6d 20 20 20 20 20 20 20 20 (xterm 0de0: 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 09 20 (lambda (x).... 0df0: 20 20 20 20 20 20 28 69 66 20 28 64 69 72 65 63 (if (direc 0e00: 74 6f 72 79 2d 65 78 69 73 74 73 3f 20 72 75 6e tory-exists? run 0e10: 64 69 72 29 0a 09 09 09 09 20 20 20 28 73 79 73 dir)..... (sys 0e20: 74 65 6d 20 28 63 6f 6e 63 20 22 63 64 20 22 20 tem (conc "cd " 0e30: 72 75 6e 64 69 72 20 22 3b 78 74 65 72 6d 20 2d rundir ";xterm - 0e40: 54 20 22 20 28 73 74 72 69 6e 67 2d 74 72 61 6e T " (string-tran 0e50: 73 6c 61 74 65 20 74 65 73 74 66 75 6c 6c 6e 61 slate testfullna 0e60: 6d 65 20 22 28 29 22 20 22 20 20 22 29 20 22 26 me "()" " ") "& 0e70: 22 29 29 0a 09 09 09 09 20 20 20 28 6d 65 73 73 "))..... (mess 0e80: 61 67 65 2d 77 69 6e 64 6f 77 20 20 28 63 6f 6e age-window (con 0e90: 63 20 22 44 69 72 65 63 74 6f 72 79 20 22 20 72 c "Directory " r 0ea0: 75 6e 64 69 72 20 22 20 6e 6f 74 20 66 6f 75 6e undir " not foun 0eb0: 64 22 29 29 29 29 29 0a 09 20 20 20 20 20 20 20 d"))))).. 0ec0: 28 6e 65 77 73 74 61 74 75 73 20 20 20 20 63 75 (newstatus cu 0ed0: 72 72 73 74 61 74 75 73 29 0a 09 20 20 20 20 20 rrstatus).. 0ee0: 20 20 28 6e 65 77 73 74 61 74 65 20 20 20 20 20 (newstate 0ef0: 63 75 72 72 73 74 61 74 65 29 0a 09 20 20 20 20 currstate).. 0f00: 20 20 20 28 73 65 6c 66 20 20 20 20 20 20 20 20 (self 0f10: 20 23 66 29 29 0a 09 20 20 0a 09 20 20 3b 3b 20 #f)).. .. ;; 0f20: 20 28 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 (test-set-statu 0f30: 73 21 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 s! db run-id tes 0f40: 74 2d 6e 61 6d 65 20 73 74 61 74 65 20 73 74 61 t-name state sta 0f50: 74 75 73 20 69 74 65 6d 64 61 74 29 0a 09 20 20 tus itemdat).. 0f60: 28 73 65 74 21 20 73 65 6c 66 20 0a 09 09 28 69 (set! self ...(i 0f70: 75 70 3a 64 69 61 6c 6f 67 0a 09 09 20 28 69 75 up:dialog... (iu 0f80: 70 3a 76 62 6f 78 0a 09 09 20 20 28 69 75 70 3a p:vbox... (iup: 0f90: 68 62 6f 78 20 0a 09 09 20 20 20 28 69 75 70 3a hbox ... (iup: 0fa0: 66 72 61 6d 65 20 28 69 75 70 3a 6c 61 62 65 6c frame (iup:label 0fb0: 20 72 75 6e 2d 6b 65 79 29 29 0a 09 09 20 20 20 run-key))... 0fc0: 28 69 75 70 3a 66 72 61 6d 65 20 28 69 75 70 3a (iup:frame (iup: 0fd0: 6c 61 62 65 6c 20 28 63 6f 6e 63 20 22 54 45 53 label (conc "TES 0fe0: 54 4e 41 4d 45 3a 5c 6e 22 20 74 65 73 74 66 75 TNAME:\n" testfu 0ff0: 6c 6c 6e 61 6d 65 29 20 23 3a 65 78 70 61 6e 64 llname) #:expand 1000: 20 22 59 45 53 22 29 29 29 0a 09 09 20 20 28 69 "YES")))... (i 1010: 75 70 3a 66 72 61 6d 65 20 23 3a 74 69 74 6c 65 up:frame #:title 1020: 20 22 41 63 74 69 6f 6e 73 22 20 23 3a 65 78 70 "Actions" #:exp 1030: 61 6e 64 20 22 59 45 53 22 0a 09 09 09 20 20 20 and "YES".... 1040: 20 20 28 69 75 70 3a 68 62 6f 78 20 3b 3b 20 74 (iup:hbox ;; t 1050: 68 65 20 61 63 74 69 6f 6e 73 20 62 6f 78 0a 09 he actions box.. 1060: 09 09 20 20 20 20 20 20 28 69 75 70 3a 62 75 74 .. (iup:but 1070: 74 6f 6e 20 22 56 69 65 77 20 4c 6f 67 22 20 20 ton "View Log" 1080: 20 20 23 3a 61 63 74 69 6f 6e 20 76 69 65 77 6c #:action viewl 1090: 6f 67 20 20 23 3a 65 78 70 61 6e 64 20 22 59 45 og #:expand "YE 10a0: 53 22 29 0a 09 09 09 20 20 20 20 20 20 28 69 75 S").... (iu 10b0: 70 3a 62 75 74 74 6f 6e 20 22 53 74 61 72 74 20 p:button "Start 10c0: 58 74 65 72 6d 22 20 23 3a 61 63 74 69 6f 6e 20 Xterm" #:action 10d0: 78 74 65 72 6d 20 20 23 3a 65 78 70 61 6e 64 20 xterm #:expand 10e0: 22 59 45 53 22 29 29 29 0a 09 09 20 20 28 69 75 "YES")))... (iu 10f0: 70 3a 66 72 61 6d 65 20 23 3a 74 69 74 6c 65 20 p:frame #:title 1100: 22 53 65 74 20 66 69 65 6c 64 73 22 0a 09 09 09 "Set fields".... 1110: 20 20 20 20 20 28 69 75 70 3a 76 62 6f 78 0a 09 (iup:vbox.. 1120: 09 09 20 20 20 20 20 20 28 69 75 70 3a 68 62 6f .. (iup:hbo 1130: 78 20 0a 09 09 09 20 20 20 20 20 20 20 28 69 75 x .... (iu 1140: 70 3a 76 62 6f 78 20 3b 3b 20 74 68 65 20 73 74 p:vbox ;; the st 1150: 61 74 65 0a 09 09 09 09 28 69 75 70 3a 6c 61 62 ate.....(iup:lab 1160: 65 6c 20 22 53 54 41 54 45 3a 22 20 23 3a 73 69 el "STATE:" #:si 1170: 7a 65 20 22 33 30 78 22 29 0a 09 09 09 09 28 6c ze "30x").....(l 1180: 65 74 20 28 28 6c 62 20 28 69 75 70 3a 6c 69 73 et ((lb (iup:lis 1190: 74 62 6f 78 20 23 3a 61 63 74 69 6f 6e 20 28 6c tbox #:action (l 11a0: 61 6d 62 64 61 20 28 76 61 6c 20 61 20 62 20 63 ambda (val a b c 11b0: 29 0a 09 09 09 09 09 09 09 09 20 20 3b 3b 20 28 )......... ;; ( 11c0: 70 72 69 6e 74 20 76 61 6c 20 22 20 61 3a 20 22 print val " a: " 11d0: 20 61 20 22 20 62 3a 20 22 20 62 20 22 20 63 3a a " b: " b " c: 11e0: 20 22 20 63 29 0a 09 09 09 09 09 09 09 09 20 20 " c)......... 11f0: 28 73 65 74 21 20 6e 65 77 73 74 61 74 65 20 61 (set! newstate a 1200: 29 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 ))....... 1210: 23 3a 65 64 69 74 62 6f 78 20 22 59 45 53 22 0a #:editbox "YES". 1220: 09 09 09 09 09 09 20 20 20 20 20 20 20 23 3a 65 ...... #:e 1230: 78 70 61 6e 64 20 22 59 45 53 22 29 29 29 0a 09 xpand "YES"))).. 1240: 09 09 09 20 20 28 69 75 70 6c 69 73 74 62 6f 78 ... (iuplistbox 1250: 2d 66 69 6c 6c 2d 6c 69 73 74 20 6c 62 0a 09 09 -fill-list lb... 1260: 09 09 09 09 09 28 6c 69 73 74 20 22 43 4f 4d 50 .....(list "COMP 1270: 4c 45 54 45 44 22 20 22 4e 4f 54 5f 53 54 41 52 LETED" "NOT_STAR 1280: 54 45 44 22 20 22 52 55 4e 4e 49 4e 47 22 20 22 TED" "RUNNING" " 1290: 52 45 4d 4f 54 45 48 4f 53 54 53 54 41 52 54 22 REMOTEHOSTSTART" 12a0: 20 22 4b 49 4c 4c 45 44 22 20 22 4b 49 4c 4c 52 "KILLED" "KILLR 12b0: 45 51 22 29 0a 09 09 09 09 09 09 09 63 75 72 72 EQ")........curr 12c0: 73 74 61 74 65 29 0a 09 09 09 09 20 20 6c 62 29 state)..... lb) 12d0: 29 0a 09 09 09 20 20 20 20 20 20 20 28 69 75 70 ).... (iup 12e0: 3a 76 62 6f 78 20 3b 3b 20 74 68 65 20 73 74 61 :vbox ;; the sta 12f0: 74 75 73 0a 09 09 09 09 28 69 75 70 3a 6c 61 62 tus.....(iup:lab 1300: 65 6c 20 22 53 54 41 54 55 53 3a 22 20 23 3a 73 el "STATUS:" #:s 1310: 69 7a 65 20 22 33 30 78 22 29 0a 09 09 09 09 28 ize "30x").....( 1320: 6c 65 74 20 28 28 6c 62 20 28 69 75 70 3a 6c 69 let ((lb (iup:li 1330: 73 74 62 6f 78 20 23 3a 61 63 74 69 6f 6e 20 28 stbox #:action ( 1340: 6c 61 6d 62 64 61 20 28 76 61 6c 20 61 20 62 20 lambda (val a b 1350: 63 29 0a 09 09 09 09 09 09 09 09 20 20 28 73 65 c)......... (se 1360: 74 21 20 6e 65 77 73 74 61 74 75 73 20 61 29 29 t! newstatus a)) 1370: 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 23 3a ....... #: 1380: 65 64 69 74 62 6f 78 20 22 59 45 53 22 0a 09 09 editbox "YES"... 1390: 09 09 09 09 20 20 20 20 20 20 20 23 3a 76 61 6c .... #:val 13a0: 75 65 20 63 75 72 72 73 74 61 74 75 73 0a 09 09 ue currstatus... 13b0: 09 09 09 09 20 20 20 20 20 20 20 23 3a 65 78 70 .... #:exp 13c0: 61 6e 64 20 22 59 45 53 22 29 29 29 0a 09 09 09 and "YES"))).... 13d0: 09 20 20 28 69 75 70 6c 69 73 74 62 6f 78 2d 66 . (iuplistbox-f 13e0: 69 6c 6c 2d 6c 69 73 74 20 6c 62 0a 09 09 09 09 ill-list lb..... 13f0: 09 09 09 28 6c 69 73 74 20 22 50 41 53 53 22 20 ...(list "PASS" 1400: 22 46 41 49 4c 22 20 22 6e 2f 61 22 29 0a 09 09 "FAIL" "n/a")... 1410: 09 09 09 09 09 63 75 72 72 73 74 61 74 75 73 29 .....currstatus) 1420: 0a 09 09 09 09 20 20 6c 62 29 29 29 0a 09 09 09 ..... lb))).... 1430: 20 20 20 20 20 20 28 69 75 70 3a 68 62 6f 78 20 (iup:hbox 1440: 28 69 75 70 3a 6c 61 62 65 6c 20 22 43 6f 6d 6d (iup:label "Comm 1450: 65 6e 74 3a 22 29 0a 09 09 09 09 09 28 69 75 70 ent:")......(iup 1460: 3a 74 65 78 74 62 6f 78 20 23 3a 61 63 74 69 6f :textbox #:actio 1470: 6e 20 28 6c 61 6d 62 64 61 20 28 76 61 6c 20 61 n (lambda (val a 1480: 20 62 29 0a 09 09 09 09 09 09 09 09 28 73 65 74 b).........(set 1490: 21 20 63 75 72 72 63 6f 6d 6d 65 6e 74 20 62 29 ! currcomment b) 14a0: 29 0a 09 09 09 09 09 09 20 20 20 20 20 23 3a 76 )....... #:v 14b0: 61 6c 75 65 20 63 75 72 72 63 6f 6d 6d 65 6e 74 alue currcomment 14c0: 20 0a 09 09 09 09 09 09 20 20 20 20 20 23 3a 65 ....... #:e 14d0: 78 70 61 6e 64 20 22 59 45 53 22 29 29 0a 09 09 xpand "YES"))... 14e0: 09 20 20 20 20 20 20 28 69 75 70 3a 62 75 74 74 . (iup:butt 14f0: 6f 6e 20 22 41 70 70 6c 79 22 0a 09 09 09 09 09 on "Apply"...... 1500: 20 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53 22 #:expand "YES" 1510: 0a 09 09 09 09 09 20 20 23 3a 61 63 74 69 6f 6e ...... #:action 1520: 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 09 (lambda (x).... 1530: 09 09 09 20 20 20 20 20 28 74 65 73 74 2d 73 65 ... (test-se 1540: 74 2d 73 74 61 74 75 73 21 20 2a 64 62 2a 20 72 t-status! *db* r 1550: 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 20 6e un-id testname n 1560: 65 77 73 74 61 74 65 20 6e 65 77 73 74 61 74 75 ewstate newstatu 1570: 73 20 69 74 65 6d 70 61 74 68 20 63 75 72 72 63 s itempath currc 1580: 6f 6d 6d 65 6e 74 29 29 29 0a 09 09 09 20 20 20 omment))).... 1590: 20 20 20 28 69 75 70 3a 68 62 6f 78 20 28 69 75 (iup:hbox (iu 15a0: 70 3a 62 75 74 74 6f 6e 20 22 41 70 70 6c 79 20 p:button "Apply 15b0: 61 6e 64 20 63 6c 6f 73 65 22 0a 09 09 09 09 09 and close"...... 15c0: 09 20 20 20 20 23 3a 65 78 70 61 6e 64 20 22 59 . #:expand "Y 15d0: 45 53 22 0a 09 09 09 09 09 09 20 20 20 20 23 3a ES"....... #: 15e0: 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 action (lambda ( 15f0: 78 29 0a 09 09 09 09 09 09 09 20 20 20 20 20 20 x)........ 1600: 20 28 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 (test-set-statu 1610: 73 21 20 2a 64 62 2a 20 72 75 6e 2d 69 64 20 74 s! *db* run-id t 1620: 65 73 74 6e 61 6d 65 20 6e 65 77 73 74 61 74 65 estname newstate 1630: 20 6e 65 77 73 74 61 74 75 73 20 69 74 65 6d 70 newstatus itemp 1640: 61 74 68 20 63 75 72 72 63 6f 6d 6d 65 6e 74 29 ath currcomment) 1650: 0a 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 ........ ( 1660: 69 75 70 3a 64 65 73 74 72 6f 79 21 20 73 65 6c iup:destroy! sel 1670: 66 29 29 29 0a 09 09 09 09 09 28 69 75 70 3a 62 f)))......(iup:b 1680: 75 74 74 6f 6e 20 22 43 61 6e 63 65 6c 20 61 6e utton "Cancel an 1690: 64 20 63 6c 6f 73 65 22 0a 09 09 09 09 09 09 20 d close"....... 16a0: 20 20 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53 #:expand "YES 16b0: 22 0a 09 09 09 09 09 09 20 20 20 20 23 3a 61 63 "....... #:ac 16c0: 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 78 29 tion (lambda (x) 16d0: 0a 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 ........ ( 16e0: 69 75 70 3a 64 65 73 74 72 6f 79 21 20 73 65 6c iup:destroy! sel 16f0: 66 29 29 29 29 0a 09 09 09 20 20 20 20 20 20 29 f)))).... ) 1700: 29 29 29 29 0a 09 20 20 28 69 75 70 3a 73 68 6f )))).. (iup:sho 1710: 77 20 73 65 6c 66 29 0a 09 20 20 29 29 29 29 0a w self).. )))). 1720: 0a 28 64 65 66 69 6e 65 20 28 63 6f 6c 6f 72 73 .(define (colors 1730: 2d 73 69 6d 69 6c 61 72 3f 20 63 6f 6c 6f 72 31 -similar? color1 1740: 20 63 6f 6c 6f 72 32 29 0a 20 20 28 6c 65 74 2a color2). (let* 1750: 20 28 28 63 31 20 28 6d 61 70 20 73 74 72 69 6e ((c1 (map strin 1760: 67 2d 3e 6e 75 6d 62 65 72 20 28 73 74 72 69 6e g->number (strin 1770: 67 2d 73 70 6c 69 74 20 63 6f 6c 6f 72 31 29 29 g-split color1)) 1780: 29 0a 09 20 28 63 32 20 28 6d 61 70 20 73 74 72 ).. (c2 (map str 1790: 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 73 74 72 ing->number (str 17a0: 69 6e 67 2d 73 70 6c 69 74 20 63 6f 6c 6f 72 32 ing-split color2 17b0: 29 29 29 0a 09 20 28 64 65 6c 74 61 20 28 6d 61 ))).. (delta (ma 17c0: 70 20 28 6c 61 6d 62 64 61 20 28 61 20 62 29 28 p (lambda (a b)( 17d0: 61 62 73 20 28 2d 20 61 20 62 29 29 29 20 63 31 abs (- a b))) c1 17e0: 20 63 32 29 29 29 0a 20 20 20 20 28 6e 75 6c 6c c2))). (null 17f0: 3f 20 28 66 69 6c 74 65 72 20 28 6c 61 6d 62 64 ? (filter (lambd 1800: 61 20 28 78 29 28 3e 20 78 20 33 29 29 20 64 65 a (x)(> x 3)) de 1810: 6c 74 61 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 lta))))..(define 1820: 20 28 75 70 64 61 74 65 2d 72 75 6e 64 61 74 20 (update-rundat 1830: 70 61 74 74 20 6e 75 6d 72 75 6e 73 29 0a 20 20 patt numruns). 1840: 28 6c 65 74 2a 20 28 28 61 6c 6c 72 75 6e 73 20 (let* ((allruns 1850: 20 20 20 20 28 64 62 2d 67 65 74 2d 72 75 6e 73 (db-get-runs 1860: 20 2a 64 62 2a 20 70 61 74 74 20 6e 75 6d 72 75 *db* patt numru 1870: 6e 73 20 2a 73 74 61 72 74 2d 72 75 6e 2d 6f 66 ns *start-run-of 1880: 66 73 65 74 2a 29 29 0a 09 20 28 68 65 61 64 65 fset*)).. (heade 1890: 72 20 20 20 20 20 20 28 64 62 3a 67 65 74 2d 68 r (db:get-h 18a0: 65 61 64 65 72 20 61 6c 6c 72 75 6e 73 29 29 0a eader allruns)). 18b0: 09 20 28 72 75 6e 73 20 20 20 20 20 20 20 20 28 . (runs ( 18c0: 64 62 3a 67 65 74 2d 72 6f 77 73 20 20 20 61 6c db:get-rows al 18d0: 6c 72 75 6e 73 29 29 0a 09 20 28 72 65 73 75 6c lruns)).. (resul 18e0: 74 20 20 20 20 20 20 27 28 29 29 0a 09 20 28 6d t '()).. (m 18f0: 61 78 74 65 73 74 73 20 20 20 20 30 29 29 0a 20 axtests 0)). 1900: 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 (for-each (la 1910: 6d 62 64 61 20 28 72 75 6e 29 0a 09 09 28 6c 65 mbda (run)...(le 1920: 74 2a 20 28 28 72 75 6e 2d 69 64 20 20 20 28 64 t* ((run-id (d 1930: 62 2d 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 b-get-value-by-h 1940: 65 61 64 65 72 20 72 75 6e 20 68 65 61 64 65 72 eader run header 1950: 20 22 69 64 22 29 29 0a 09 09 20 20 20 20 20 20 "id"))... 1960: 20 28 74 65 73 74 73 20 20 20 20 28 64 62 2d 67 (tests (db-g 1970: 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e et-tests-for-run 1980: 20 2a 64 62 2a 20 72 75 6e 2d 69 64 29 29 0a 09 *db* run-id)).. 1990: 09 20 20 20 20 20 20 20 28 6b 65 79 2d 76 61 6c . (key-val 19a0: 73 20 28 67 65 74 2d 6b 65 79 2d 76 61 6c 73 20 s (get-key-vals 19b0: 2a 64 62 2a 20 72 75 6e 2d 69 64 29 29 29 0a 09 *db* run-id))).. 19c0: 09 20 20 28 69 66 20 28 3e 20 28 6c 65 6e 67 74 . (if (> (lengt 19d0: 68 20 74 65 73 74 73 29 20 6d 61 78 74 65 73 74 h tests) maxtest 19e0: 73 29 0a 09 09 20 20 20 20 20 20 28 73 65 74 21 s)... (set! 19f0: 20 6d 61 78 74 65 73 74 73 20 28 6c 65 6e 67 74 maxtests (lengt 1a00: 68 20 74 65 73 74 73 29 29 29 0a 09 09 20 20 28 h tests)))... ( 1a10: 73 65 74 21 20 72 65 73 75 6c 74 20 28 63 6f 6e set! result (con 1a20: 73 20 28 76 65 63 74 6f 72 20 72 75 6e 20 74 65 s (vector run te 1a30: 73 74 73 20 6b 65 79 2d 76 61 6c 73 29 20 72 65 sts key-vals) re 1a40: 73 75 6c 74 29 29 29 29 0a 09 20 20 20 20 20 20 sult)))).. 1a50: 72 75 6e 73 29 0a 20 20 20 20 28 73 65 74 21 20 runs). (set! 1a60: 2a 68 65 61 64 65 72 2a 20 20 68 65 61 64 65 72 *header* header 1a70: 29 0a 20 20 20 20 28 73 65 74 21 20 2a 61 6c 6c ). (set! *all 1a80: 72 75 6e 73 2a 20 28 72 65 76 65 72 73 65 20 72 runs* (reverse r 1a90: 65 73 75 6c 74 29 29 0a 20 20 20 20 6d 61 78 74 esult)). maxt 1aa0: 65 73 74 73 29 29 0a 0a 28 64 65 66 69 6e 65 20 ests))..(define 1ab0: 28 75 70 64 61 74 65 2d 6c 61 62 65 6c 73 20 75 (update-labels u 1ac0: 69 64 61 74 29 0a 20 20 28 6c 65 74 2a 20 28 28 idat). (let* (( 1ad0: 72 6f 77 6e 20 20 20 20 30 29 0a 09 20 28 6c 66 rown 0).. (lf 1ae0: 74 63 6f 6c 20 28 76 65 63 74 6f 72 2d 72 65 66 tcol (vector-ref 1af0: 20 75 69 64 61 74 20 30 29 29 0a 09 20 28 6d 61 uidat 0)).. (ma 1b00: 78 6e 20 20 20 28 2d 20 28 76 65 63 74 6f 72 2d xn (- (vector- 1b10: 6c 65 6e 67 74 68 20 6c 66 74 63 6f 6c 29 20 31 length lftcol) 1 1b20: 29 29 29 0a 20 20 20 20 28 6c 65 74 20 6c 6f 6f ))). (let loo 1b30: 70 20 28 28 69 20 30 29 29 0a 20 20 20 20 20 20 p ((i 0)). 1b40: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 (iup:attribute-s 1b50: 65 74 21 20 28 76 65 63 74 6f 72 2d 72 65 66 20 et! (vector-ref 1b60: 6c 66 74 63 6f 6c 20 69 29 20 22 54 49 54 4c 45 lftcol i) "TITLE 1b70: 22 20 22 22 29 0a 20 20 20 20 20 20 28 69 66 20 " ""). (if 1b80: 28 3c 3d 20 69 20 72 6f 77 6e 29 0a 09 20 20 28 (<= i rown).. ( 1b90: 6c 6f 6f 70 20 28 2b 20 69 20 31 29 29 29 29 0a loop (+ i 1)))). 1ba0: 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c (for-each (l 1bb0: 61 6d 62 64 61 20 28 6e 61 6d 65 29 0a 09 09 28 ambda (name)...( 1bc0: 69 66 20 28 3c 3d 20 72 6f 77 6e 20 6d 61 78 6e if (<= rown maxn 1bd0: 29 0a 09 09 20 20 20 20 28 6c 65 74 20 28 28 6c )... (let ((l 1be0: 61 62 6c 20 28 76 65 63 74 6f 72 2d 72 65 66 20 abl (vector-ref 1bf0: 6c 66 74 63 6f 6c 20 72 6f 77 6e 29 29 29 0a 09 lftcol rown))).. 1c00: 09 20 20 20 20 20 20 28 69 75 70 3a 61 74 74 72 . (iup:attr 1c10: 69 62 75 74 65 2d 73 65 74 21 20 6c 61 62 6c 20 ibute-set! labl 1c20: 22 54 49 54 4c 45 22 20 6e 61 6d 65 29 29 29 0a "TITLE" name))). 1c30: 09 09 28 73 65 74 21 20 72 6f 77 6e 20 28 2b 20 ..(set! rown (+ 1c40: 31 20 72 6f 77 6e 29 29 29 0a 09 20 20 20 20 20 1 rown))).. 1c50: 20 28 64 72 6f 70 20 2a 61 6c 6c 74 65 73 74 6e (drop *alltestn 1c60: 61 6d 65 6c 73 74 2a 20 2a 73 74 61 72 74 2d 74 amelst* *start-t 1c70: 65 73 74 2d 6f 66 66 73 65 74 2a 29 29 29 29 0a est-offset*)))). 1c80: 0a 28 64 65 66 69 6e 65 20 28 75 70 64 61 74 65 .(define (update 1c90: 2d 62 75 74 74 6f 6e 73 20 75 69 64 61 74 20 6e -buttons uidat n 1ca0: 75 6d 72 75 6e 73 20 6e 75 6d 74 65 73 74 73 29 umruns numtests) 1cb0: 0a 20 20 28 6c 65 74 2a 20 28 28 72 75 6e 73 20 . (let* ((runs 1cc0: 20 20 20 20 20 20 20 28 69 66 20 28 3e 20 28 6c (if (> (l 1cd0: 65 6e 67 74 68 20 2a 61 6c 6c 72 75 6e 73 2a 29 ength *allruns*) 1ce0: 20 6e 75 6d 72 75 6e 73 29 0a 09 09 09 20 20 28 numruns).... ( 1cf0: 74 61 6b 65 2d 72 69 67 68 74 20 2a 61 6c 6c 72 take-right *allr 1d00: 75 6e 73 2a 20 6e 75 6d 72 75 6e 73 29 0a 09 09 uns* numruns)... 1d10: 09 20 20 28 70 61 64 2d 6c 69 73 74 20 2a 61 6c . (pad-list *al 1d20: 6c 72 75 6e 73 2a 20 6e 75 6d 72 75 6e 73 29 29 lruns* numruns)) 1d30: 29 0a 09 20 28 6c 66 74 63 6f 6c 20 20 20 20 20 ).. (lftcol 1d40: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 75 69 64 (vector-ref uid 1d50: 61 74 20 30 29 29 0a 09 20 28 74 61 62 6c 65 68 at 0)).. (tableh 1d60: 65 61 64 65 72 20 28 76 65 63 74 6f 72 2d 72 65 eader (vector-re 1d70: 66 20 75 69 64 61 74 20 31 29 29 0a 09 20 28 74 f uidat 1)).. (t 1d80: 61 62 6c 65 20 20 20 20 20 20 20 28 76 65 63 74 able (vect 1d90: 6f 72 2d 72 65 66 20 75 69 64 61 74 20 32 29 29 or-ref uidat 2)) 1da0: 0a 09 20 28 63 6f 6c 6e 20 20 20 20 20 20 20 20 .. (coln 1db0: 30 29 29 0a 20 20 20 20 28 75 70 64 61 74 65 2d 0)). (update- 1dc0: 6c 61 62 65 6c 73 20 75 69 64 61 74 29 0a 20 20 labels uidat). 1dd0: 20 20 28 66 6f 72 2d 65 61 63 68 0a 20 20 20 20 (for-each. 1de0: 20 28 6c 61 6d 62 64 61 20 28 72 75 6e 64 61 74 (lambda (rundat 1df0: 29 0a 20 20 20 20 20 20 20 28 69 66 20 28 6e 6f ). (if (no 1e00: 74 20 72 75 6e 64 61 74 29 20 3b 3b 20 68 61 6e t rundat) ;; han 1e10: 64 6c 65 20 70 61 64 64 65 64 20 72 75 6e 73 0a dle padded runs. 1e20: 09 20 20 20 3b 3b 20 20 20 20 20 20 20 20 20 20 . ;; 1e30: 20 20 20 20 20 20 3b 3b 20 69 64 20 72 75 6e 2d ;; id run- 1e40: 69 64 20 74 65 73 74 6e 61 6d 65 20 73 74 61 74 id testname stat 1e50: 65 20 73 74 61 74 75 73 20 65 76 65 6e 74 2d 74 e status event-t 1e60: 69 6d 65 20 68 6f 73 74 20 63 70 75 6c 6f 61 64 ime host cpuload 1e70: 20 64 69 73 6b 66 72 65 65 20 75 6e 61 6d 65 20 diskfree uname 1e80: 72 75 6e 64 69 72 20 69 74 65 6d 2d 70 61 74 68 rundir item-path 1e90: 20 72 75 6e 2d 64 75 72 61 74 69 6f 6e 0a 09 20 run-duration.. 1ea0: 20 20 28 73 65 74 21 20 72 75 6e 64 61 74 20 28 (set! rundat ( 1eb0: 76 65 63 74 6f 72 20 28 6d 61 6b 65 2d 76 65 63 vector (make-vec 1ec0: 74 6f 72 20 32 30 20 23 66 29 20 27 28 29 20 28 tor 20 #f) '() ( 1ed0: 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 78 29 20 map (lambda (x) 1ee0: 22 22 29 20 2a 6b 65 79 73 2a 29 29 29 29 3b 3b "") *keys*))));; 1ef0: 20 33 29 29 29 0a 20 20 20 20 20 20 20 28 6c 65 3))). (le 1f00: 74 2a 20 28 28 72 75 6e 20 20 20 20 20 20 28 76 t* ((run (v 1f10: 65 63 74 6f 72 2d 72 65 66 20 72 75 6e 64 61 74 ector-ref rundat 1f20: 20 30 29 29 0a 09 20 20 20 20 20 20 28 74 65 73 0)).. (tes 1f30: 74 73 64 61 74 20 28 76 65 63 74 6f 72 2d 72 65 tsdat (vector-re 1f40: 66 20 72 75 6e 64 61 74 20 31 29 29 0a 09 20 20 f rundat 1)).. 1f50: 20 20 20 20 28 6b 65 79 2d 76 61 6c 2d 64 61 74 (key-val-dat 1f60: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 72 75 6e (vector-ref run 1f70: 64 61 74 20 32 29 29 0a 09 20 20 20 20 20 20 28 dat 2)).. ( 1f80: 72 75 6e 2d 69 64 20 20 20 28 64 62 2d 67 65 74 run-id (db-get 1f90: 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 -value-by-header 1fa0: 20 72 75 6e 20 2a 68 65 61 64 65 72 2a 20 22 69 run *header* "i 1fb0: 64 22 29 29 0a 09 20 20 20 20 20 20 28 74 65 73 d")).. (tes 1fc0: 74 6e 61 6d 65 73 20 28 64 65 6c 65 74 65 2d 64 tnames (delete-d 1fd0: 75 70 6c 69 63 61 74 65 73 20 28 61 70 70 65 6e uplicates (appen 1fe0: 64 20 2a 61 6c 6c 74 65 73 74 6e 61 6d 65 6c 73 d *alltestnamels 1ff0: 74 2a 20 0a 09 09 09 09 09 09 20 20 20 20 28 6d t* ....... (m 2000: 61 70 20 74 65 73 74 3a 74 65 73 74 2d 67 65 74 ap test:test-get 2010: 2d 66 75 6c 6c 6e 61 6d 65 20 74 65 73 74 73 64 -fullname testsd 2020: 61 74 29 29 29 29 20 3b 3b 20 28 74 61 6b 65 20 at)))) ;; (take 2030: 28 70 61 64 2d 6c 69 73 74 20 74 65 73 74 73 64 (pad-list testsd 2040: 61 74 20 6e 75 6d 74 65 73 74 73 29 20 6e 75 6d at numtests) num 2050: 74 65 73 74 73 29 29 0a 09 20 20 20 20 20 20 28 tests)).. ( 2060: 6b 65 79 2d 76 61 6c 73 20 28 61 70 70 65 6e 64 key-vals (append 2070: 20 6b 65 79 2d 76 61 6c 2d 64 61 74 0a 09 09 09 key-val-dat.... 2080: 09 28 6c 69 73 74 20 28 6c 65 74 20 28 28 78 20 .(list (let ((x 2090: 28 64 62 2d 67 65 74 2d 76 61 6c 75 65 2d 62 79 (db-get-value-by 20a0: 2d 68 65 61 64 65 72 20 72 75 6e 20 2a 68 65 61 -header run *hea 20b0: 64 65 72 2a 20 22 72 75 6e 6e 61 6d 65 22 29 29 der* "runname")) 20c0: 29 0a 09 09 09 09 09 28 69 66 20 78 20 78 20 22 )......(if x x " 20d0: 22 29 29 29 29 29 0a 09 20 20 20 20 20 20 28 72 "))))).. (r 20e0: 75 6e 2d 6b 65 79 20 20 28 73 74 72 69 6e 67 2d un-key (string- 20f0: 69 6e 74 65 72 73 70 65 72 73 65 20 6b 65 79 2d intersperse key- 2100: 76 61 6c 73 20 22 5c 6e 22 29 29 29 0a 09 20 3b vals "\n"))).. ; 2110: 3b 20 28 72 75 6e 2d 68 74 20 20 28 68 61 73 68 ; (run-ht (hash 2120: 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 -table-ref/defau 2130: 6c 74 20 61 6c 6c 64 61 74 20 72 75 6e 2d 6b 65 lt alldat run-ke 2140: 79 20 23 66 29 29 29 0a 09 20 3b 3b 20 66 69 6c y #f))).. ;; fil 2150: 6c 20 69 6e 20 74 68 65 20 72 75 6e 20 68 65 61 l in the run hea 2160: 64 65 72 20 6b 65 79 20 76 61 6c 75 65 73 0a 09 der key values.. 2170: 20 28 6c 65 74 20 28 28 72 6f 77 6e 20 20 20 20 (let ((rown 2180: 20 20 30 29 0a 09 20 20 20 20 20 20 20 28 68 65 0).. (he 2190: 61 64 65 72 63 6f 6c 20 28 76 65 63 74 6f 72 2d adercol (vector- 21a0: 72 65 66 20 74 61 62 6c 65 68 65 61 64 65 72 20 ref tableheader 21b0: 63 6f 6c 6e 29 29 29 0a 09 20 20 20 28 66 6f 72 coln))).. (for 21c0: 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 6b -each (lambda (k 21d0: 76 61 6c 29 0a 09 09 20 20 20 20 20 20 20 28 6c val)... (l 21e0: 65 74 2a 20 28 28 6c 61 62 6c 20 20 20 20 20 20 et* ((labl 21f0: 28 76 65 63 74 6f 72 2d 72 65 66 20 68 65 61 64 (vector-ref head 2200: 65 72 63 6f 6c 20 72 6f 77 6e 29 29 29 0a 09 09 ercol rown)))... 2210: 09 20 28 69 66 20 28 6e 6f 74 20 28 65 71 75 61 . (if (not (equa 2220: 6c 3f 20 6b 76 61 6c 20 28 69 75 70 3a 61 74 74 l? kval (iup:att 2230: 72 69 62 75 74 65 20 6c 61 62 6c 20 22 54 49 54 ribute labl "TIT 2240: 4c 45 22 29 29 29 0a 09 09 09 20 20 20 20 20 28 LE"))).... ( 2250: 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 iup:attribute-se 2260: 74 21 20 28 76 65 63 74 6f 72 2d 72 65 66 20 68 t! (vector-ref h 2270: 65 61 64 65 72 63 6f 6c 20 72 6f 77 6e 29 20 22 eadercol rown) " 2280: 54 49 54 4c 45 22 20 6b 76 61 6c 29 29 0a 09 09 TITLE" kval))... 2290: 09 20 28 73 65 74 21 20 72 6f 77 6e 20 28 2b 20 . (set! rown (+ 22a0: 72 6f 77 6e 20 31 29 29 29 29 0a 09 09 20 20 20 rown 1))))... 22b0: 20 20 6b 65 79 2d 76 61 6c 73 29 29 0a 0a 09 20 key-vals))... 22c0: 3b 3b 20 46 6f 72 20 74 68 69 73 20 72 75 6e 20 ;; For this run 22d0: 6e 6f 77 20 66 69 6c 6c 20 69 6e 20 74 68 65 20 now fill in the 22e0: 62 75 74 74 6f 6e 73 20 66 6f 72 20 65 61 63 68 buttons for each 22f0: 20 74 65 73 74 0a 09 20 28 6c 65 74 20 28 28 72 test.. (let ((r 2300: 6f 77 6e 20 30 29 0a 09 20 20 20 20 20 20 20 28 own 0).. ( 2310: 63 6f 6c 75 6d 6e 64 61 74 20 20 28 76 65 63 74 columndat (vect 2320: 6f 72 2d 72 65 66 20 74 61 62 6c 65 20 63 6f 6c or-ref table col 2330: 6e 29 29 29 0a 09 20 20 20 28 66 6f 72 2d 65 61 n))).. (for-ea 2340: 63 68 0a 09 20 20 20 20 28 6c 61 6d 62 64 61 20 ch.. (lambda 2350: 28 74 65 73 74 6e 61 6d 65 29 0a 09 20 20 20 20 (testname).. 2360: 20 20 28 6c 65 74 20 28 28 62 75 74 74 6f 6e 64 (let ((buttond 2370: 61 74 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d at (hash-table- 2380: 72 65 66 2f 64 65 66 61 75 6c 74 20 2a 62 75 74 ref/default *but 2390: 74 6f 6e 64 61 74 2a 20 28 6d 6b 73 74 72 20 63 tondat* (mkstr c 23a0: 6f 6c 6e 20 72 6f 77 6e 29 20 23 66 29 29 29 0a oln rown) #f))). 23b0: 09 09 28 69 66 20 62 75 74 74 6f 6e 64 61 74 0a ..(if buttondat. 23c0: 09 09 20 20 20 20 28 6c 65 74 2a 20 28 28 74 65 .. (let* ((te 23d0: 73 74 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 st (let (( 23e0: 6d 61 74 63 68 69 6e 67 20 28 66 69 6c 74 65 72 matching (filter 23f0: 20 0a 09 09 09 09 09 09 09 28 6c 61 6d 62 64 61 ........(lambda 2400: 20 28 78 29 28 65 71 75 61 6c 3f 20 28 74 65 73 (x)(equal? (tes 2410: 74 3a 74 65 73 74 2d 67 65 74 2d 66 75 6c 6c 6e t:test-get-fulln 2420: 61 6d 65 20 78 29 20 74 65 73 74 6e 61 6d 65 29 ame x) testname) 2430: 29 0a 09 09 09 09 09 09 09 74 65 73 74 73 64 61 )........testsda 2440: 74 29 29 29 0a 09 09 09 09 09 20 28 69 66 20 28 t)))...... (if ( 2450: 6e 75 6c 6c 3f 20 6d 61 74 63 68 69 6e 67 29 0a null? matching). 2460: 09 09 09 09 09 20 20 20 20 20 28 76 65 63 74 6f ..... (vecto 2470: 72 20 2d 31 20 2d 31 20 22 22 20 22 22 20 22 22 r -1 -1 "" "" "" 2480: 20 30 20 22 22 20 22 22 20 30 20 22 22 20 22 22 0 "" "" 0 "" "" 2490: 20 22 22 20 30 20 22 22 20 22 22 29 0a 09 09 09 "" 0 "" "").... 24a0: 09 09 20 20 20 20 20 28 63 61 72 20 6d 61 74 63 .. (car matc 24b0: 68 69 6e 67 29 29 29 29 0a 09 09 09 20 20 20 3b hing)))).... ; 24c0: 3b 20 28 74 65 73 74 20 20 20 20 20 20 20 28 69 ; (test (i 24d0: 66 20 72 65 61 6c 2d 74 65 73 74 20 72 65 61 6c f real-test real 24e0: 2d 74 65 73 74 0a 09 09 09 20 20 20 28 74 65 73 -test.... (tes 24f0: 74 6e 61 6d 65 20 20 20 28 64 62 3a 74 65 73 74 tname (db:test 2500: 2d 67 65 74 2d 74 65 73 74 6e 61 6d 65 20 20 74 -get-testname t 2510: 65 73 74 29 29 0a 09 09 09 20 20 20 28 69 74 65 est)).... (ite 2520: 6d 70 61 74 68 20 20 20 28 64 62 3a 74 65 73 74 mpath (db:test 2530: 2d 67 65 74 2d 69 74 65 6d 2d 70 61 74 68 20 74 -get-item-path t 2540: 65 73 74 29 29 0a 09 09 09 20 20 20 28 74 65 73 est)).... (tes 2550: 74 66 75 6c 6c 6e 61 6d 65 20 28 74 65 73 74 3a tfullname (test: 2560: 74 65 73 74 2d 67 65 74 2d 66 75 6c 6c 6e 61 6d test-get-fullnam 2570: 65 20 74 65 73 74 29 29 0a 09 09 09 20 20 20 28 e test)).... ( 2580: 74 65 73 74 73 74 61 74 75 73 20 28 64 62 3a 74 teststatus (db:t 2590: 65 73 74 2d 67 65 74 2d 73 74 61 74 75 73 20 20 est-get-status 25a0: 20 74 65 73 74 29 29 0a 09 09 09 20 20 20 28 74 test)).... (t 25b0: 65 73 74 73 74 61 74 65 20 20 28 64 62 3a 74 65 eststate (db:te 25c0: 73 74 2d 67 65 74 2d 73 74 61 74 65 20 20 20 20 st-get-state 25d0: 74 65 73 74 29 29 0a 09 09 09 20 20 20 28 62 75 test)).... (bu 25e0: 74 74 6f 6e 74 78 74 20 20 28 69 66 20 28 65 71 ttontxt (if (eq 25f0: 75 61 6c 3f 20 74 65 73 74 73 74 61 74 65 20 22 ual? teststate " 2600: 43 4f 4d 50 4c 45 54 45 44 22 29 20 74 65 73 74 COMPLETED") test 2610: 73 74 61 74 75 73 20 74 65 73 74 73 74 61 74 65 status teststate 2620: 29 29 0a 09 09 09 20 20 20 28 62 75 74 74 6f 6e )).... (button 2630: 20 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 (vector-ref 2640: 20 63 6f 6c 75 6d 6e 64 61 74 20 72 6f 77 6e 29 columndat rown) 2650: 29 0a 09 09 09 20 20 20 28 63 6f 6c 6f 72 20 20 ).... (color 2660: 20 20 20 20 28 63 61 73 65 20 28 73 74 72 69 6e (case (strin 2670: 67 2d 3e 73 79 6d 62 6f 6c 20 74 65 73 74 73 74 g->symbol testst 2680: 61 74 65 29 0a 09 09 09 09 09 20 28 28 43 4f 4d ate)...... ((COM 2690: 50 4c 45 54 45 44 29 0a 09 09 09 09 09 20 20 28 PLETED)...... ( 26a0: 69 66 20 28 65 71 75 61 6c 3f 20 74 65 73 74 73 if (equal? tests 26b0: 74 61 74 75 73 20 22 50 41 53 53 22 29 20 22 37 tatus "PASS") "7 26c0: 30 20 32 34 39 20 37 33 22 20 22 32 32 33 20 33 0 249 73" "223 3 26d0: 33 20 34 39 22 29 29 20 3b 3b 20 67 72 65 65 6e 3 49")) ;; green 26e0: 69 73 68 20 72 65 64 69 73 68 0a 09 09 09 09 09 ish redish...... 26f0: 20 28 28 4c 41 55 4e 43 48 45 44 29 20 20 20 20 ((LAUNCHED) 2700: 20 20 20 20 20 22 31 30 31 20 31 32 33 20 31 34 "101 123 14 2710: 32 22 29 0a 09 09 09 09 09 20 28 28 52 45 4d 4f 2")...... ((REMO 2720: 54 45 48 4f 53 54 53 54 41 52 54 29 20 20 22 35 TEHOSTSTART) "5 2730: 30 20 31 33 30 20 31 39 35 22 29 0a 09 09 09 09 0 130 195")..... 2740: 09 20 28 28 52 55 4e 4e 49 4e 47 29 20 20 20 20 . ((RUNNING) 2750: 20 20 20 20 20 20 22 39 20 31 33 31 20 32 33 32 "9 131 232 2760: 22 29 0a 09 09 09 09 09 20 28 28 4b 49 4c 4c 52 ")...... ((KILLR 2770: 45 51 29 20 20 20 20 20 20 20 20 20 20 22 33 39 EQ) "39 2780: 20 38 32 20 32 30 36 22 29 0a 09 09 09 09 09 20 82 206")...... 2790: 28 28 4b 49 4c 4c 45 44 29 20 20 20 20 20 20 20 ((KILLED) 27a0: 20 20 20 20 22 32 33 34 20 31 30 31 20 31 37 22 "234 101 17" 27b0: 29 0a 09 09 09 09 09 20 28 65 6c 73 65 20 22 31 )...... (else "1 27c0: 39 32 20 31 39 32 20 31 39 32 22 29 29 29 0a 09 92 192 192"))).. 27d0: 09 09 20 20 20 28 63 75 72 72 2d 63 6f 6c 6f 72 .. (curr-color 27e0: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 62 75 74 (vector-ref but 27f0: 74 6f 6e 64 61 74 20 31 29 29 20 3b 3b 20 28 69 tondat 1)) ;; (i 2800: 75 70 3a 61 74 74 72 69 62 75 74 65 20 62 75 74 up:attribute but 2810: 74 6f 6e 20 22 42 47 43 4f 4c 4f 52 22 29 29 0a ton "BGCOLOR")). 2820: 09 09 09 20 20 20 28 63 75 72 72 2d 74 69 74 6c ... (curr-titl 2830: 65 20 28 76 65 63 74 6f 72 2d 72 65 66 20 62 75 e (vector-ref bu 2840: 74 74 6f 6e 64 61 74 20 32 29 29 29 20 3b 3b 20 ttondat 2))) ;; 2850: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 20 62 (iup:attribute b 2860: 75 74 74 6f 6e 20 22 54 49 54 4c 45 22 29 29 29 utton "TITLE"))) 2870: 0a 09 09 20 20 20 20 20 20 28 69 66 20 28 6e 6f ... (if (no 2880: 74 20 28 65 71 75 61 6c 3f 20 63 75 72 72 2d 63 t (equal? curr-c 2890: 6f 6c 6f 72 20 63 6f 6c 6f 72 29 29 0a 09 09 09 olor color)).... 28a0: 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 (iup:attribute 28b0: 2d 73 65 74 21 20 62 75 74 74 6f 6e 20 22 42 47 -set! button "BG 28c0: 43 4f 4c 4f 52 22 20 63 6f 6c 6f 72 29 29 0a 09 COLOR" color)).. 28d0: 09 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 . (if (not 28e0: 28 65 71 75 61 6c 3f 20 63 75 72 72 2d 74 69 74 (equal? curr-tit 28f0: 6c 65 20 62 75 74 74 6f 6e 74 78 74 29 29 0a 09 le buttontxt)).. 2900: 09 09 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 .. (iup:attribu 2910: 74 65 2d 73 65 74 21 20 62 75 74 74 6f 6e 20 22 te-set! button " 2920: 54 49 54 4c 45 22 20 20 20 62 75 74 74 6f 6e 74 TITLE" buttont 2930: 78 74 29 29 0a 09 09 20 20 20 20 20 20 28 76 65 xt))... (ve 2940: 63 74 6f 72 2d 73 65 74 21 20 62 75 74 74 6f 6e ctor-set! button 2950: 64 61 74 20 30 20 72 75 6e 2d 69 64 29 0a 09 09 dat 0 run-id)... 2960: 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d 73 65 (vector-se 2970: 74 21 20 62 75 74 74 6f 6e 64 61 74 20 31 20 63 t! buttondat 1 c 2980: 6f 6c 6f 72 29 0a 09 09 20 20 20 20 20 20 28 76 olor)... (v 2990: 65 63 74 6f 72 2d 73 65 74 21 20 62 75 74 74 6f ector-set! butto 29a0: 6e 64 61 74 20 32 20 62 75 74 74 6f 6e 74 78 74 ndat 2 buttontxt 29b0: 29 0a 09 09 20 20 20 20 20 20 28 76 65 63 74 6f )... (vecto 29c0: 72 2d 73 65 74 21 20 62 75 74 74 6f 6e 64 61 74 r-set! buttondat 29d0: 20 33 20 74 65 73 74 29 0a 09 09 20 20 20 20 20 3 test)... 29e0: 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 62 75 (vector-set! bu 29f0: 74 74 6f 6e 64 61 74 20 34 20 72 75 6e 2d 6b 65 ttondat 4 run-ke 2a00: 79 29 0a 09 09 20 20 20 20 20 20 28 69 66 20 28 y)... (if ( 2a10: 6e 6f 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d not (hash-table- 2a20: 72 65 66 2f 64 65 66 61 75 6c 74 20 2a 61 6c 6c ref/default *all 2a30: 74 65 73 74 6e 61 6d 65 73 2a 20 74 65 73 74 66 testnames* testf 2a40: 75 6c 6c 6e 61 6d 65 20 23 66 29 29 0a 09 09 09 ullname #f)).... 2a50: 20 20 28 62 65 67 69 6e 0a 09 09 09 20 20 20 20 (begin.... 2a60: 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 (hash-table-set! 2a70: 20 2a 61 6c 6c 74 65 73 74 6e 61 6d 65 73 2a 20 *alltestnames* 2a80: 74 65 73 74 66 75 6c 6c 6e 61 6d 65 20 23 74 29 testfullname #t) 2a90: 0a 09 09 09 20 20 20 20 28 73 65 74 21 20 2a 61 .... (set! *a 2aa0: 6c 6c 74 65 73 74 6e 61 6d 65 6c 73 74 2a 20 28 lltestnamelst* ( 2ab0: 61 70 70 65 6e 64 20 2a 61 6c 6c 74 65 73 74 6e append *alltestn 2ac0: 61 6d 65 6c 73 74 2a 20 28 6c 69 73 74 20 74 65 amelst* (list te 2ad0: 73 74 66 75 6c 6c 6e 61 6d 65 29 29 29 29 29 29 stfullname)))))) 2ae0: 0a 09 09 20 20 20 20 29 0a 09 09 28 73 65 74 21 ... )...(set! 2af0: 20 72 6f 77 6e 20 28 2b 20 72 6f 77 6e 20 31 29 rown (+ rown 1) 2b00: 29 29 29 0a 09 20 20 20 20 28 64 72 6f 70 20 74 ))).. (drop t 2b10: 65 73 74 6e 61 6d 65 73 20 2a 73 74 61 72 74 2d estnames *start- 2b20: 74 65 73 74 2d 6f 66 66 73 65 74 2a 29 29 29 0a test-offset*))). 2b30: 09 20 28 73 65 74 21 20 63 6f 6c 6e 20 28 2b 20 . (set! coln (+ 2b40: 63 6f 6c 6e 20 31 29 29 29 29 0a 20 20 20 20 20 coln 1)))). 2b50: 72 75 6e 73 29 29 29 0a 0a 28 64 65 66 69 6e 65 runs)))..(define 2b60: 20 28 6d 6b 73 74 72 20 2e 20 78 29 0a 20 20 28 (mkstr . x). ( 2b70: 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 string-intersper 2b80: 73 65 20 28 6d 61 70 20 63 6f 6e 63 20 78 29 20 se (map conc x) 2b90: 22 2c 22 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 ","))..(define ( 2ba0: 75 70 64 61 74 65 2d 73 65 61 72 63 68 20 78 20 update-search x 2bb0: 76 61 6c 29 0a 20 20 28 70 72 69 6e 74 20 22 53 val). (print "S 2bc0: 65 74 74 69 6e 67 20 73 65 61 72 63 68 20 66 6f etting search fo 2bd0: 72 20 22 20 78 20 22 20 74 6f 20 22 20 76 61 6c r " x " to " val 2be0: 29 0a 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d ). (hash-table- 2bf0: 73 65 74 21 20 2a 73 65 61 72 63 68 70 61 74 74 set! *searchpatt 2c00: 73 2a 20 78 20 76 61 6c 29 29 0a 0a 28 64 65 66 s* x val))..(def 2c10: 69 6e 65 20 28 6d 61 6b 65 2d 64 61 73 68 62 6f ine (make-dashbo 2c20: 61 72 64 2d 62 75 74 74 6f 6e 73 20 6e 72 75 6e ard-buttons nrun 2c30: 73 20 6e 74 65 73 74 73 20 6b 65 79 6e 61 6d 65 s ntests keyname 2c40: 73 29 0a 20 20 28 6c 65 74 2a 20 28 28 6e 6b 65 s). (let* ((nke 2c50: 79 73 20 20 20 28 6c 65 6e 67 74 68 20 6b 65 79 ys (length key 2c60: 6e 61 6d 65 73 29 29 0a 09 20 28 72 75 6e 73 76 names)).. (runsv 2c70: 65 63 20 28 6d 61 6b 65 2d 76 65 63 74 6f 72 20 ec (make-vector 2c80: 6e 72 75 6e 73 29 29 0a 09 20 28 68 65 61 64 65 nruns)).. (heade 2c90: 72 20 20 28 6d 61 6b 65 2d 76 65 63 74 6f 72 20 r (make-vector 2ca0: 6e 72 75 6e 73 29 29 0a 09 20 28 6c 66 74 63 6f nruns)).. (lftco 2cb0: 6c 20 20 28 6d 61 6b 65 2d 76 65 63 74 6f 72 20 l (make-vector 2cc0: 6e 74 65 73 74 73 29 29 0a 09 20 28 63 6f 6e 74 ntests)).. (cont 2cd0: 72 6f 6c 73 20 27 28 29 29 0a 09 20 28 6c 66 74 rols '()).. (lft 2ce0: 6c 73 74 20 20 27 28 29 29 0a 09 20 28 68 64 72 lst '()).. (hdr 2cf0: 6c 73 74 20 20 27 28 29 29 0a 09 20 28 62 64 79 lst '()).. (bdy 2d00: 6c 73 74 20 20 27 28 29 29 0a 09 20 28 72 65 73 lst '()).. (res 2d10: 75 6c 74 20 20 27 28 29 29 0a 09 20 28 69 20 20 ult '()).. (i 2d20: 20 20 20 20 20 30 29 29 0a 20 20 20 20 3b 3b 20 0)). ;; 2d30: 63 6f 6e 74 72 6f 6c 73 20 28 61 6c 6f 6e 67 20 controls (along 2d40: 62 6f 74 74 6f 6d 29 0a 20 20 20 20 28 73 65 74 bottom). (set 2d50: 21 20 63 6f 6e 74 72 6f 6c 73 0a 09 20 20 28 69 ! controls.. (i 2d60: 75 70 3a 68 62 6f 78 0a 09 20 20 20 28 69 75 70 up:hbox.. (iup 2d70: 3a 62 75 74 74 6f 6e 20 22 51 75 69 74 22 20 23 :button "Quit" # 2d80: 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 :action (lambda 2d90: 28 6f 62 6a 29 28 73 71 6c 69 74 65 33 3a 66 69 (obj)(sqlite3:fi 2da0: 6e 61 6c 69 7a 65 21 20 2a 64 62 2a 29 28 65 78 nalize! *db*)(ex 2db0: 69 74 29 29 29 0a 09 20 20 20 28 69 75 70 3a 62 it))).. (iup:b 2dc0: 75 74 74 6f 6e 20 22 3c 2d 20 20 4c 65 66 74 22 utton "<- Left" 2dd0: 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 #:action (lambd 2de0: 61 20 28 6f 62 6a 29 28 73 65 74 21 20 2a 73 74 a (obj)(set! *st 2df0: 61 72 74 2d 72 75 6e 2d 6f 66 66 73 65 74 2a 20 art-run-offset* 2e00: 20 28 2b 20 2a 73 74 61 72 74 2d 72 75 6e 2d 6f (+ *start-run-o 2e10: 66 66 73 65 74 2a 20 31 29 29 29 29 0a 09 20 20 ffset* 1)))).. 2e20: 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 55 70 (iup:button "Up 2e30: 20 20 20 20 20 5e 22 20 23 3a 61 63 74 69 6f 6e ^" #:action 2e40: 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 29 28 73 (lambda (obj)(s 2e50: 65 74 21 20 2a 73 74 61 72 74 2d 74 65 73 74 2d et! *start-test- 2e60: 6f 66 66 73 65 74 2a 20 28 69 66 20 28 3e 20 2a offset* (if (> * 2e70: 73 74 61 72 74 2d 74 65 73 74 2d 6f 66 66 73 65 start-test-offse 2e80: 74 2a 20 30 29 28 2d 20 2a 73 74 61 72 74 2d 74 t* 0)(- *start-t 2e90: 65 73 74 2d 6f 66 66 73 65 74 2a 20 31 29 20 30 est-offset* 1) 0 2ea0: 29 29 29 29 0a 09 20 20 20 28 69 75 70 3a 62 75 )))).. (iup:bu 2eb0: 74 74 6f 6e 20 22 44 6f 77 6e 20 20 20 76 22 20 tton "Down v" 2ec0: 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 #:action (lambda 2ed0: 20 28 6f 62 6a 29 28 73 65 74 21 20 2a 73 74 61 (obj)(set! *sta 2ee0: 72 74 2d 74 65 73 74 2d 6f 66 66 73 65 74 2a 20 rt-test-offset* 2ef0: 28 69 66 20 28 3e 3d 20 2a 73 74 61 72 74 2d 74 (if (>= *start-t 2f00: 65 73 74 2d 6f 66 66 73 65 74 2a 20 28 6c 65 6e est-offset* (len 2f10: 67 74 68 20 2a 61 6c 6c 74 65 73 74 6e 61 6d 65 gth *alltestname 2f20: 6c 73 74 2a 29 29 28 6c 65 6e 67 74 68 20 2a 61 lst*))(length *a 2f30: 6c 6c 74 65 73 74 6e 61 6d 65 6c 73 74 2a 29 28 lltestnamelst*)( 2f40: 2b 20 2a 73 74 61 72 74 2d 74 65 73 74 2d 6f 66 + *start-test-of 2f50: 66 73 65 74 2a 20 31 29 29 29 29 29 0a 09 20 20 fset* 1))))).. 2f60: 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 52 69 (iup:button "Ri 2f70: 67 68 74 20 2d 3e 22 20 23 3a 61 63 74 69 6f 6e ght ->" #:action 2f80: 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 29 28 73 (lambda (obj)(s 2f90: 65 74 21 20 2a 73 74 61 72 74 2d 72 75 6e 2d 6f et! *start-run-o 2fa0: 66 66 73 65 74 2a 20 20 28 69 66 20 28 3e 20 2a ffset* (if (> * 2fb0: 73 74 61 72 74 2d 72 75 6e 2d 6f 66 66 73 65 74 start-run-offset 2fc0: 2a 20 30 29 28 2d 20 2a 73 74 61 72 74 2d 72 75 * 0)(- *start-ru 2fd0: 6e 2d 6f 66 66 73 65 74 2a 20 31 29 20 30 29 29 n-offset* 1) 0)) 2fe0: 29 29 29 29 0a 20 20 20 20 0a 20 20 20 20 3b 3b )))). . ;; 2ff0: 20 63 72 65 61 74 65 20 74 68 65 20 6c 65 66 74 create the left 3000: 20 6d 6f 73 74 20 63 6f 6c 75 6d 6e 20 66 6f 72 most column for 3010: 20 74 68 65 20 72 75 6e 20 6b 65 79 20 6e 61 6d the run key nam 3020: 65 73 20 61 6e 64 20 74 68 65 20 74 65 73 74 20 es and the test 3030: 6e 61 6d 65 73 20 0a 20 20 20 20 28 73 65 74 21 names . (set! 3040: 20 6c 66 74 6c 73 74 20 28 6c 69 73 74 20 28 61 lftlst (list (a 3050: 70 70 6c 79 20 69 75 70 3a 76 62 6f 78 20 0a 09 pply iup:vbox .. 3060: 09 09 20 20 20 20 20 20 28 6d 61 70 20 28 6c 61 .. (map (la 3070: 6d 62 64 61 20 28 78 29 09 09 0a 09 09 09 09 20 mbda (x)....... 3080: 20 20 20 20 28 6c 65 74 20 28 28 72 65 73 20 28 (let ((res ( 3090: 69 75 70 3a 68 62 6f 78 0a 09 09 09 09 09 09 20 iup:hbox....... 30a0: 28 69 75 70 3a 6c 61 62 65 6c 20 78 20 23 3a 73 (iup:label x #:s 30b0: 69 7a 65 20 22 34 30 78 31 35 22 20 23 3a 66 6f ize "40x15" #:fo 30c0: 6e 74 73 69 7a 65 20 22 31 30 22 29 20 3b 3b 20 ntsize "10") ;; 30d0: 20 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a #:expand "HORIZ 30e0: 4f 4e 54 41 4c 22 29 0a 09 09 09 09 09 09 20 28 ONTAL")....... ( 30f0: 69 75 70 3a 74 65 78 74 62 6f 78 20 23 3a 73 69 iup:textbox #:si 3100: 7a 65 20 22 36 30 78 31 35 22 20 23 3a 66 6f 6e ze "60x15" #:fon 3110: 74 73 69 7a 65 20 22 31 30 22 20 23 3a 76 61 6c tsize "10" #:val 3120: 75 65 20 22 25 22 20 3b 3b 20 23 3a 65 78 70 61 ue "%" ;; #:expa 3130: 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 0a nd "HORIZONTAL". 3140: 09 09 09 09 09 09 09 20 20 20 20 20 20 23 3a 61 ....... #:a 3150: 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f ction (lambda (o 3160: 62 6a 20 75 6e 6b 20 76 61 6c 29 0a 09 09 09 09 bj unk val)..... 3170: 09 09 09 09 09 20 28 75 70 64 61 74 65 2d 73 65 ..... (update-se 3180: 61 72 63 68 20 78 20 76 61 6c 29 29 29 29 29 29 arch x val)))))) 3190: 0a 09 09 09 09 20 20 20 20 20 20 20 28 73 65 74 ..... (set 31a0: 21 20 69 20 28 2b 20 69 20 31 29 29 0a 09 09 09 ! i (+ i 1)).... 31b0: 09 20 20 20 20 20 20 20 72 65 73 29 29 0a 09 09 . res))... 31c0: 09 09 20 20 20 6b 65 79 6e 61 6d 65 73 29 29 29 .. keynames))) 31d0: 29 0a 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 ). (let loop 31e0: 28 28 74 65 73 74 6e 75 6d 20 20 30 29 0a 09 20 ((testnum 0).. 31f0: 20 20 20 20 20 20 28 72 65 73 20 20 20 20 20 20 (res 3200: 27 28 29 29 29 0a 20 20 20 20 20 20 28 63 6f 6e '())). (con 3210: 64 0a 20 20 20 20 20 20 20 28 28 3e 3d 20 74 65 d. ((>= te 3220: 73 74 6e 75 6d 20 6e 74 65 73 74 73 29 0a 09 3b stnum ntests)..; 3230: 3b 20 6e 6f 77 20 6c 66 74 6c 73 74 20 77 69 6c ; now lftlst wil 3240: 6c 20 62 65 20 61 6e 20 68 62 6f 78 20 77 69 74 l be an hbox wit 3250: 68 20 74 68 65 20 74 65 73 74 20 6b 65 79 73 20 h the test keys 3260: 61 6e 64 20 74 68 65 20 74 65 73 74 20 6e 61 6d and the test nam 3270: 65 20 6c 61 62 65 6c 73 0a 09 28 73 65 74 21 20 e labels..(set! 3280: 6c 66 74 6c 73 74 20 28 61 70 70 65 6e 64 20 6c lftlst (append l 3290: 66 74 6c 73 74 20 28 6c 69 73 74 20 28 61 70 70 ftlst (list (app 32a0: 6c 79 20 69 75 70 3a 76 62 6f 78 20 28 72 65 76 ly iup:vbox (rev 32b0: 65 72 73 65 20 72 65 73 29 29 29 29 29 29 0a 20 erse res)))))). 32c0: 20 20 20 20 20 20 28 65 6c 73 65 0a 09 28 6c 65 (else..(le 32d0: 74 20 28 28 6c 61 62 6c 20 20 28 69 75 70 3a 62 t ((labl (iup:b 32e0: 75 74 74 6f 6e 20 22 22 20 23 3a 66 6c 61 74 20 utton "" #:flat 32f0: 22 59 45 53 22 20 23 3a 73 69 7a 65 20 22 31 30 "YES" #:size "10 3300: 30 78 31 35 22 20 23 3a 66 6f 6e 74 73 69 7a 65 0x15" #:fontsize 3310: 20 22 31 30 22 29 29 29 0a 09 20 20 28 76 65 63 "10"))).. (vec 3320: 74 6f 72 2d 73 65 74 21 20 6c 66 74 63 6f 6c 20 tor-set! lftcol 3330: 74 65 73 74 6e 75 6d 20 6c 61 62 6c 29 0a 09 20 testnum labl).. 3340: 20 28 6c 6f 6f 70 20 28 2b 20 74 65 73 74 6e 75 (loop (+ testnu 3350: 6d 20 31 29 28 63 6f 6e 73 20 6c 61 62 6c 20 72 m 1)(cons labl r 3360: 65 73 29 29 29 29 29 29 0a 20 20 20 20 3b 3b 20 es)))))). ;; 3370: 0a 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 . (let loop ( 3380: 28 72 75 6e 6e 75 6d 20 20 30 29 0a 09 20 20 20 (runnum 0).. 3390: 20 20 20 20 28 6b 65 79 6e 75 6d 20 20 30 29 0a (keynum 0). 33a0: 09 20 20 20 20 20 20 20 28 6b 65 79 76 65 63 20 . (keyvec 33b0: 20 28 6d 61 6b 65 2d 76 65 63 74 6f 72 20 6e 6b (make-vector nk 33c0: 65 79 73 29 29 0a 09 20 20 20 20 20 20 20 28 72 eys)).. (r 33d0: 65 73 20 20 20 20 27 28 29 29 29 0a 20 20 20 20 es '())). 33e0: 20 20 28 63 6f 6e 64 20 3b 3b 20 6e 62 2f 2f 20 (cond ;; nb// 33f0: 6e 6f 20 65 6c 73 65 20 66 6f 72 20 74 68 69 73 no else for this 3400: 20 61 70 70 72 6f 61 63 68 2e 0a 20 20 20 20 20 approach.. 3410: 20 20 28 28 3e 3d 20 72 75 6e 6e 75 6d 20 6e 72 ((>= runnum nr 3420: 75 6e 73 29 20 23 66 29 0a 20 20 20 20 20 20 20 uns) #f). 3430: 28 28 3e 3d 20 6b 65 79 6e 75 6d 20 6e 6b 65 79 ((>= keynum nkey 3440: 73 29 20 0a 09 28 76 65 63 74 6f 72 2d 73 65 74 s) ..(vector-set 3450: 21 20 68 65 61 64 65 72 20 72 75 6e 6e 75 6d 20 ! header runnum 3460: 6b 65 79 76 65 63 29 0a 09 28 73 65 74 21 20 68 keyvec)..(set! h 3470: 64 72 6c 73 74 20 28 63 6f 6e 73 20 28 61 70 70 drlst (cons (app 3480: 6c 79 20 69 75 70 3a 76 62 6f 78 20 28 72 65 76 ly iup:vbox (rev 3490: 65 72 73 65 20 72 65 73 29 29 20 68 64 72 6c 73 erse res)) hdrls 34a0: 74 29 29 0a 09 28 6c 6f 6f 70 20 28 2b 20 72 75 t))..(loop (+ ru 34b0: 6e 6e 75 6d 20 31 29 20 30 20 28 6d 61 6b 65 2d nnum 1) 0 (make- 34c0: 76 65 63 74 6f 72 20 6e 6b 65 79 73 29 20 27 28 vector nkeys) '( 34d0: 29 29 29 0a 20 20 20 20 20 20 20 28 65 6c 73 65 ))). (else 34e0: 0a 09 28 6c 65 74 20 28 28 6c 61 62 6c 20 20 28 ..(let ((labl ( 34f0: 69 75 70 3a 6c 61 62 65 6c 20 22 22 20 23 3a 73 iup:label "" #:s 3500: 69 7a 65 20 22 36 30 78 31 35 22 20 23 3a 66 6f ize "60x15" #:fo 3510: 6e 74 73 69 7a 65 20 22 31 30 22 20 3b 3b 20 23 ntsize "10" ;; # 3520: 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e :expand "HORIZON 3530: 54 41 4c 22 0a 09 09 09 09 29 29 29 0a 09 20 20 TAL".....))).. 3540: 28 76 65 63 74 6f 72 2d 73 65 74 21 20 6b 65 79 (vector-set! key 3550: 76 65 63 20 6b 65 79 6e 75 6d 20 6c 61 62 6c 29 vec keynum labl) 3560: 0a 09 20 20 28 6c 6f 6f 70 20 72 75 6e 6e 75 6d .. (loop runnum 3570: 20 28 2b 20 6b 65 79 6e 75 6d 20 31 29 20 6b 65 (+ keynum 1) ke 3580: 79 76 65 63 20 28 63 6f 6e 73 20 6c 61 62 6c 20 yvec (cons labl 3590: 72 65 73 29 29 29 29 29 29 0a 20 20 20 20 3b 3b res)))))). ;; 35a0: 20 42 79 20 68 65 72 65 20 74 68 65 20 68 64 72 By here the hdr 35b0: 6c 73 74 20 63 6f 6e 74 61 69 6e 73 20 61 20 6c lst contains a l 35c0: 69 73 74 20 6f 66 20 76 62 6f 78 65 73 20 63 6f ist of vboxes co 35d0: 6e 74 61 69 6e 69 6e 67 20 6e 6b 65 79 73 20 6c ntaining nkeys l 35e0: 61 62 65 6c 73 0a 20 20 20 20 28 6c 65 74 20 6c abels. (let l 35f0: 6f 6f 70 20 28 28 72 75 6e 6e 75 6d 20 20 30 29 oop ((runnum 0) 3600: 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 6e 75 .. (testnu 3610: 6d 20 30 29 0a 09 20 20 20 20 20 20 20 28 74 65 m 0).. (te 3620: 73 74 76 65 63 20 20 28 6d 61 6b 65 2d 76 65 63 stvec (make-vec 3630: 74 6f 72 20 6e 74 65 73 74 73 29 29 0a 09 20 20 tor ntests)).. 3640: 20 20 20 20 20 28 72 65 73 20 20 20 20 27 28 29 (res '() 3650: 29 29 0a 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 )). (cond. 3660: 20 20 20 20 20 20 28 28 3e 3d 20 72 75 6e 6e 75 ((>= runnu 3670: 6d 20 6e 72 75 6e 73 29 20 23 66 29 20 3b 3b 20 m nruns) #f) ;; 3680: 20 28 76 65 63 74 6f 72 20 74 61 62 6c 65 68 65 (vector tablehe 3690: 61 64 65 72 20 72 75 6e 73 76 65 63 29 29 0a 20 ader runsvec)). 36a0: 20 20 20 20 20 20 28 28 3e 3d 20 74 65 73 74 6e ((>= testn 36b0: 75 6d 20 6e 74 65 73 74 73 29 20 0a 09 28 76 65 um ntests) ..(ve 36c0: 63 74 6f 72 2d 73 65 74 21 20 72 75 6e 73 76 65 ctor-set! runsve 36d0: 63 20 72 75 6e 6e 75 6d 20 74 65 73 74 76 65 63 c runnum testvec 36e0: 29 0a 09 28 73 65 74 21 20 62 64 79 6c 73 74 20 )..(set! bdylst 36f0: 28 63 6f 6e 73 20 28 61 70 70 6c 79 20 69 75 70 (cons (apply iup 3700: 3a 76 62 6f 78 20 28 72 65 76 65 72 73 65 20 72 :vbox (reverse r 3710: 65 73 29 29 20 62 64 79 6c 73 74 29 29 0a 09 28 es)) bdylst))..( 3720: 6c 6f 6f 70 20 28 2b 20 72 75 6e 6e 75 6d 20 31 loop (+ runnum 1 3730: 29 20 30 20 28 6d 61 6b 65 2d 76 65 63 74 6f 72 ) 0 (make-vector 3740: 20 6e 74 65 73 74 73 29 20 27 28 29 29 29 0a 20 ntests) '())). 3750: 20 20 20 20 20 20 28 65 6c 73 65 0a 09 28 6c 65 (else..(le 3760: 74 2a 20 28 28 62 75 74 74 6f 6e 2d 6b 65 79 20 t* ((button-key 3770: 28 6d 6b 73 74 72 20 72 75 6e 6e 75 6d 20 74 65 (mkstr runnum te 3780: 73 74 6e 75 6d 29 29 0a 09 20 20 20 20 20 20 20 stnum)).. 3790: 28 62 75 74 6e 20 20 20 20 20 20 20 28 69 75 70 (butn (iup 37a0: 3a 62 75 74 74 6f 6e 20 22 22 20 3b 3b 20 62 75 :button "" ;; bu 37b0: 74 74 6f 6e 2d 6b 65 79 20 0a 09 09 09 09 20 20 tton-key ..... 37c0: 20 20 20 20 20 23 3a 73 69 7a 65 20 22 36 30 78 #:size "60x 37d0: 31 35 22 20 0a 09 09 09 09 20 20 20 20 20 20 20 15" ..... 37e0: 3b 3b 20 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 ;; #:expand "HOR 37f0: 49 5a 4f 4e 54 41 4c 22 0a 09 09 09 09 20 20 20 IZONTAL"..... 3800: 20 20 20 20 23 3a 66 6f 6e 74 73 69 7a 65 20 22 #:fontsize " 3810: 31 30 22 20 0a 09 09 09 09 20 20 20 20 20 20 20 10" ..... 3820: 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 #:action (lambda 3830: 20 28 78 29 0a 09 09 09 09 09 09 20 20 28 65 78 (x)....... (ex 3840: 61 6d 69 6e 65 2d 74 65 73 74 20 62 75 74 74 6f amine-test butto 3850: 6e 2d 6b 65 79 29 29 29 29 29 0a 09 20 20 28 68 n-key))))).. (h 3860: 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 2a ash-table-set! * 3870: 62 75 74 74 6f 6e 64 61 74 2a 20 62 75 74 74 6f buttondat* butto 3880: 6e 2d 6b 65 79 20 28 76 65 63 74 6f 72 20 30 20 n-key (vector 0 3890: 22 31 30 30 20 31 30 30 20 31 30 30 22 20 62 75 "100 100 100" bu 38a0: 74 74 6f 6e 2d 6b 65 79 20 23 66 20 23 66 29 29 tton-key #f #f)) 38b0: 20 0a 09 20 20 28 76 65 63 74 6f 72 2d 73 65 74 .. (vector-set 38c0: 21 20 74 65 73 74 76 65 63 20 74 65 73 74 6e 75 ! testvec testnu 38d0: 6d 20 62 75 74 6e 29 0a 09 20 20 28 6c 6f 6f 70 m butn).. (loop 38e0: 20 72 75 6e 6e 75 6d 20 28 2b 20 74 65 73 74 6e runnum (+ testn 38f0: 75 6d 20 31 29 20 74 65 73 74 76 65 63 20 28 63 um 1) testvec (c 3900: 6f 6e 73 20 62 75 74 6e 20 72 65 73 29 29 29 29 ons butn res)))) 3910: 29 29 0a 20 20 20 20 3b 3b 20 6e 6f 77 20 61 73 )). ;; now as 3920: 73 65 6d 62 6c 65 20 74 68 65 20 68 64 72 6c 73 semble the hdrls 3930: 74 20 61 6e 64 20 62 64 79 6c 73 74 20 61 6e 64 t and bdylst and 3940: 20 6b 69 63 6b 20 6f 66 66 20 74 68 65 20 64 69 kick off the di 3950: 61 6c 6f 67 0a 20 20 20 20 28 69 75 70 3a 73 68 alog. (iup:sh 3960: 6f 77 0a 20 20 20 20 20 28 69 75 70 3a 64 69 61 ow. (iup:dia 3970: 6c 6f 67 20 0a 20 20 20 20 20 20 23 3a 74 69 74 log . #:tit 3980: 6c 65 20 22 4d 65 67 61 74 65 73 74 20 64 61 73 le "Megatest das 3990: 68 62 6f 61 72 64 22 0a 20 20 20 20 20 20 28 69 hboard". (i 39a0: 75 70 3a 76 62 6f 78 0a 09 28 61 70 70 6c 79 20 up:vbox..(apply 39b0: 69 75 70 3a 68 62 6f 78 20 0a 09 20 20 20 20 20 iup:hbox .. 39c0: 20 20 28 63 6f 6e 73 20 28 61 70 70 6c 79 20 69 (cons (apply i 39d0: 75 70 3a 76 62 6f 78 20 6c 66 74 6c 73 74 29 0a up:vbox lftlst). 39e0: 09 09 20 20 20 20 20 28 6c 69 73 74 20 0a 09 09 .. (list ... 39f0: 20 20 20 20 20 20 28 69 75 70 3a 76 62 6f 78 0a (iup:vbox. 3a00: 09 09 20 20 20 20 20 20 20 3b 3b 20 74 68 65 20 .. ;; the 3a10: 68 65 61 64 65 72 0a 09 09 20 20 20 20 20 20 20 header... 3a20: 28 61 70 70 6c 79 20 69 75 70 3a 68 62 6f 78 20 (apply iup:hbox 3a30: 28 72 65 76 65 72 73 65 20 68 64 72 6c 73 74 29 (reverse hdrlst) 3a40: 29 0a 09 09 20 20 20 20 20 20 20 28 61 70 70 6c )... (appl 3a50: 79 20 69 75 70 3a 68 62 6f 78 20 28 72 65 76 65 y iup:hbox (reve 3a60: 72 73 65 20 62 64 79 6c 73 74 29 29 29 29 29 29 rse bdylst)))))) 3a70: 0a 20 20 20 20 20 20 20 63 6f 6e 74 72 6f 6c 73 . controls 3a80: 29 29 29 0a 20 20 20 20 28 76 65 63 74 6f 72 20 ))). (vector 3a90: 6c 66 74 63 6f 6c 20 68 65 61 64 65 72 20 72 75 lftcol header ru 3aa0: 6e 73 76 65 63 29 29 29 0a 0a 28 73 65 74 21 20 nsvec)))..(set! 3ab0: 2a 6e 75 6d 2d 74 65 73 74 73 2a 20 28 6d 61 78 *num-tests* (max 3ac0: 20 28 75 70 64 61 74 65 2d 72 75 6e 64 61 74 20 (update-rundat 3ad0: 22 25 22 20 2a 6e 75 6d 2d 72 75 6e 73 2a 29 20 "%" *num-runs*) 3ae0: 38 29 29 0a 0a 28 73 65 74 21 20 75 69 64 61 74 8))..(set! uidat 3af0: 20 28 6d 61 6b 65 2d 64 61 73 68 62 6f 61 72 64 (make-dashboard 3b00: 2d 62 75 74 74 6f 6e 73 20 2a 6e 75 6d 2d 72 75 -buttons *num-ru 3b10: 6e 73 2a 20 2a 6e 75 6d 2d 74 65 73 74 73 2a 20 ns* *num-tests* 3b20: 64 62 6b 65 79 73 29 29 0a 3b 3b 20 28 6d 65 67 dbkeys)).;; (meg 3b30: 61 74 65 73 74 2d 64 61 73 68 62 6f 61 72 64 29 atest-dashboard) 3b40: 0a 0a 28 64 65 66 69 6e 65 20 28 72 75 6e 2d 75 ..(define (run-u 3b50: 70 64 61 74 65 20 6f 74 68 65 72 2d 74 68 72 65 pdate other-thre 3b60: 61 64 29 0a 20 20 28 6c 65 74 20 6c 6f 6f 70 20 ad). (let loop 3b70: 28 28 69 20 30 29 29 0a 20 20 20 20 28 74 68 72 ((i 0)). (thr 3b80: 65 61 64 2d 73 6c 65 65 70 21 20 30 2e 31 29 0a ead-sleep! 0.1). 3b90: 20 20 20 20 28 74 68 72 65 61 64 2d 73 75 73 70 (thread-susp 3ba0: 65 6e 64 21 20 6f 74 68 65 72 2d 74 68 72 65 61 end! other-threa 3bb0: 64 29 0a 20 20 20 20 28 75 70 64 61 74 65 2d 72 d). (update-r 3bc0: 75 6e 64 61 74 20 28 68 61 73 68 2d 74 61 62 6c undat (hash-tabl 3bd0: 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 2a 73 e-ref/default *s 3be0: 65 61 72 63 68 70 61 74 74 73 2a 20 22 72 75 6e earchpatts* "run 3bf0: 6e 61 6d 65 22 20 22 25 22 29 20 2a 6e 75 6d 2d name" "%") *num- 3c00: 72 75 6e 73 2a 29 0a 20 20 20 20 28 75 70 64 61 runs*). (upda 3c10: 74 65 2d 62 75 74 74 6f 6e 73 20 75 69 64 61 74 te-buttons uidat 3c20: 20 2a 6e 75 6d 2d 72 75 6e 73 2a 20 2a 6e 75 6d *num-runs* *num 3c30: 2d 74 65 73 74 73 2a 29 0a 20 20 20 20 28 74 68 -tests*). (th 3c40: 72 65 61 64 2d 72 65 73 75 6d 65 21 20 6f 74 68 read-resume! oth 3c50: 65 72 2d 74 68 72 65 61 64 29 0a 20 20 20 20 28 er-thread). ( 3c60: 6c 6f 6f 70 20 28 2b 20 69 20 31 29 29 29 29 0a loop (+ i 1)))). 3c70: 0a 28 64 65 66 69 6e 65 20 74 68 32 20 28 6d 61 .(define th2 (ma 3c80: 6b 65 2d 74 68 72 65 61 64 20 69 75 70 3a 6d 61 ke-thread iup:ma 3c90: 69 6e 2d 6c 6f 6f 70 29 29 0a 28 64 65 66 69 6e in-loop)).(defin 3ca0: 65 20 74 68 31 20 28 6d 61 6b 65 2d 74 68 72 65 e th1 (make-thre 3cb0: 61 64 20 28 72 75 6e 2d 75 70 64 61 74 65 20 74 ad (run-update t 3cc0: 68 32 29 29 29 0a 28 74 68 72 65 61 64 2d 73 74 h2))).(thread-st 3cd0: 61 72 74 21 20 74 68 31 29 0a 28 74 68 72 65 61 art! th1).(threa 3ce0: 64 2d 73 74 61 72 74 21 20 74 68 32 29 0a 28 74 d-start! th2).(t 3cf0: 68 72 65 61 64 2d 6a 6f 69 6e 21 20 74 68 32 29 hread-join! th2) 3d00: 0a .