Artifact 78e2859a5dd5f60bd4de3fcccf55262168bfda23:
- File dashboard.scm — part of check-in [a76b6398d6] at 2011-06-14 23:04:55 on branch trunk — Added filters on test and items to dashboard. Not even close to having real scrolling but it'll have to do for now (user: mrwellan size: 18712)
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 75 73 65 ==========..(use 01e0: 20 66 6f 72 6d 61 74 29 0a 28 72 65 71 75 69 72 format).(requir 01f0: 65 2d 6c 69 62 72 61 72 79 20 69 75 70 29 0a 28 e-library iup).( 0200: 69 6d 70 6f 72 74 20 28 70 72 65 66 69 78 20 69 import (prefix i 0210: 75 70 20 69 75 70 3a 29 29 0a 0a 3b 3b 20 28 75 up iup:))..;; (u 0220: 73 65 20 63 61 6e 76 61 73 2d 64 72 61 77 29 0a se canvas-draw). 0230: 0a 28 75 73 65 20 73 71 6c 69 74 65 33 20 73 72 .(use sqlite3 sr 0240: 66 69 2d 31 20 70 6f 73 69 78 20 72 65 67 65 78 fi-1 posix regex 0250: 20 72 65 67 65 78 2d 63 61 73 65 20 73 72 66 69 regex-case srfi 0260: 2d 36 39 29 0a 0a 28 69 6d 70 6f 72 74 20 28 70 -69)..(import (p 0270: 72 65 66 69 78 20 73 71 6c 69 74 65 33 20 73 71 refix sqlite3 sq 0280: 6c 69 74 65 33 3a 29 29 0a 0a 28 69 6e 63 6c 75 lite3:))..(inclu 0290: 64 65 20 22 6d 61 72 67 73 2e 73 63 6d 22 29 0a de "margs.scm"). 02a0: 28 69 6e 63 6c 75 64 65 20 22 6b 65 79 73 2e 73 (include "keys.s 02b0: 63 6d 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 69 cm").(include "i 02c0: 74 65 6d 73 2e 73 63 6d 22 29 0a 28 69 6e 63 6c tems.scm").(incl 02d0: 75 64 65 20 22 64 62 2e 73 63 6d 22 29 0a 28 69 ude "db.scm").(i 02e0: 6e 63 6c 75 64 65 20 22 63 6f 6e 66 69 67 66 2e nclude "configf. 02f0: 73 63 6d 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 scm").(include " 0300: 70 72 6f 63 65 73 73 2e 73 63 6d 22 29 0a 28 69 process.scm").(i 0310: 6e 63 6c 75 64 65 20 22 6c 61 75 6e 63 68 2e 73 nclude "launch.s 0320: 63 6d 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 72 cm").(include "r 0330: 75 6e 73 2e 73 63 6d 22 29 0a 28 69 6e 63 6c 75 uns.scm").(inclu 0340: 64 65 20 22 67 75 69 2e 73 63 6d 22 29 0a 0a 28 de "gui.scm")..( 0350: 69 66 20 28 6e 6f 74 20 28 73 65 74 75 70 2d 66 if (not (setup-f 0360: 6f 72 2d 72 75 6e 29 29 0a 20 20 20 20 28 62 65 or-run)). (be 0370: 67 69 6e 0a 20 20 20 20 20 20 28 70 72 69 6e 74 gin. (print 0380: 20 22 46 61 69 6c 65 64 20 74 6f 20 66 69 6e 64 "Failed to find 0390: 20 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 megatest.config 03a0: 2c 20 65 78 69 74 69 6e 67 22 29 20 0a 20 20 20 , exiting") . 03b0: 20 20 20 28 65 78 69 74 20 31 29 29 29 0a 0a 28 (exit 1)))..( 03c0: 64 65 66 69 6e 65 20 2a 64 62 2a 20 28 6f 70 65 define *db* (ope 03d0: 6e 2d 64 62 29 29 0a 0a 28 64 65 66 69 6e 65 20 n-db))..(define 03e0: 74 6f 70 6c 65 76 65 6c 20 23 66 29 0a 28 64 65 toplevel #f).(de 03f0: 66 69 6e 65 20 64 6c 67 20 20 20 20 20 20 23 66 fine dlg #f 0400: 29 0a 28 64 65 66 69 6e 65 20 6d 61 78 2d 74 65 ).(define max-te 0410: 73 74 2d 6e 75 6d 20 30 29 0a 28 64 65 66 69 6e st-num 0).(defin 0420: 65 20 2a 6b 65 79 73 2a 20 20 20 28 67 65 74 2d e *keys* (get- 0430: 6b 65 79 73 20 20 20 2a 64 62 2a 29 29 0a 28 64 keys *db*)).(d 0440: 65 66 69 6e 65 20 64 62 6b 65 79 73 20 20 20 28 efine dbkeys ( 0450: 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 78 29 28 map (lambda (x)( 0460: 76 65 63 74 6f 72 2d 72 65 66 20 78 20 30 29 29 vector-ref x 0)) 0470: 0a 09 09 20 20 20 20 20 20 28 61 70 70 65 6e 64 ... (append 0480: 20 2a 6b 65 79 73 2a 20 28 6c 69 73 74 20 28 76 *keys* (list (v 0490: 65 63 74 6f 72 20 22 72 75 6e 6e 61 6d 65 22 20 ector "runname" 04a0: 22 62 6c 61 68 22 29 29 29 29 29 0a 28 64 65 66 "blah"))))).(def 04b0: 69 6e 65 20 2a 68 65 61 64 65 72 2a 20 20 20 20 ine *header* 04c0: 20 20 20 23 66 29 0a 28 64 65 66 69 6e 65 20 2a #f).(define * 04d0: 61 6c 6c 72 75 6e 73 2a 20 20 20 20 20 27 28 29 allruns* '() 04e0: 29 0a 28 64 65 66 69 6e 65 20 2a 62 75 74 74 6f ).(define *butto 04f0: 6e 64 61 74 2a 20 20 20 20 28 6d 61 6b 65 2d 68 ndat* (make-h 0500: 61 73 68 2d 74 61 62 6c 65 29 29 20 3b 3b 20 3c ash-table)) ;; < 0510: 72 75 6e 2d 69 64 20 63 6f 6c 6f 72 20 74 65 78 run-id color tex 0520: 74 20 74 65 73 74 20 72 75 6e 2d 6b 65 79 3e 0a t test run-key>. 0530: 28 64 65 66 69 6e 65 20 2a 61 6c 6c 74 65 73 74 (define *alltest 0540: 6e 61 6d 65 73 2a 20 28 6d 61 6b 65 2d 68 61 73 names* (make-has 0550: 68 2d 74 61 62 6c 65 29 29 20 3b 3b 20 62 75 69 h-table)) ;; bui 0560: 6c 64 20 61 20 6d 69 6e 69 6d 61 6c 69 7a 65 64 ld a minimalized 0570: 20 6c 69 73 74 20 6f 66 20 74 65 73 74 20 6e 61 list of test na 0580: 6d 65 73 0a 28 64 65 66 69 6e 65 20 2a 61 6c 6c mes.(define *all 0590: 74 65 73 74 6e 61 6d 65 6c 73 74 2a 20 27 28 29 testnamelst* '() 05a0: 29 0a 28 64 65 66 69 6e 65 20 2a 73 65 61 72 63 ).(define *searc 05b0: 68 70 61 74 74 73 2a 20 20 28 6d 61 6b 65 2d 68 hpatts* (make-h 05c0: 61 73 68 2d 74 61 62 6c 65 29 29 0a 28 64 65 66 ash-table)).(def 05d0: 69 6e 65 20 2a 6e 75 6d 2d 72 75 6e 73 2a 20 20 ine *num-runs* 05e0: 20 20 20 20 31 30 29 0a 28 64 65 66 69 6e 65 20 10).(define 05f0: 2a 6e 75 6d 2d 74 65 73 74 73 2a 20 20 20 20 20 *num-tests* 0600: 31 35 29 0a 28 64 65 66 69 6e 65 20 2a 73 74 61 15).(define *sta 0610: 72 74 2d 72 75 6e 2d 6f 66 66 73 65 74 2a 20 20 rt-run-offset* 0620: 30 29 0a 28 64 65 66 69 6e 65 20 2a 73 74 61 72 0).(define *star 0630: 74 2d 74 65 73 74 2d 6f 66 66 73 65 74 2a 20 30 t-test-offset* 0 0640: 29 0a 28 64 65 66 69 6e 65 20 2a 65 78 61 6d 69 ).(define *exami 0650: 6e 65 2d 74 65 73 74 2d 64 61 74 2a 20 28 6d 61 ne-test-dat* (ma 0660: 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 0a ke-hash-table)). 0670: 0a 28 64 65 66 69 6e 65 20 28 6d 65 73 73 61 67 .(define (messag 0680: 65 2d 77 69 6e 64 6f 77 20 6d 73 67 29 0a 20 20 e-window msg). 0690: 28 69 75 70 3a 73 68 6f 77 0a 20 20 20 28 69 75 (iup:show. (iu 06a0: 70 3a 64 69 61 6c 6f 67 0a 20 20 20 20 28 69 75 p:dialog. (iu 06b0: 70 3a 76 62 6f 78 20 0a 20 20 20 20 20 28 69 75 p:vbox . (iu 06c0: 70 3a 6c 61 62 65 6c 20 6d 73 67 20 23 3a 6d 61 p:label msg #:ma 06d0: 72 67 69 6e 20 22 34 30 78 34 30 22 29 29 29 29 rgin "40x40")))) 06e0: 29 0a 0a 28 64 65 66 69 6e 65 20 28 69 75 70 6c )..(define (iupl 06f0: 69 73 74 62 6f 78 2d 66 69 6c 6c 2d 6c 69 73 74 istbox-fill-list 0700: 20 6c 62 20 69 74 65 6d 73 20 2e 20 64 65 66 61 lb items . defa 0710: 75 6c 74 29 0a 20 20 28 6c 65 74 20 28 28 69 20 ult). (let ((i 0720: 31 29 0a 09 28 73 65 6c 65 63 74 65 64 2d 69 74 1)..(selected-it 0730: 65 6d 20 28 69 66 20 28 6e 75 6c 6c 3f 20 64 65 em (if (null? de 0740: 66 61 75 6c 74 29 20 23 66 20 28 63 61 72 20 64 fault) #f (car d 0750: 65 66 61 75 6c 74 29 29 29 29 0a 20 20 20 20 28 efault)))). ( 0760: 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 iup:attribute-se 0770: 74 21 20 6c 62 20 22 56 41 4c 55 45 22 20 28 69 t! lb "VALUE" (i 0780: 66 20 73 65 6c 65 63 74 65 64 2d 69 74 65 6d 20 f selected-item 0790: 73 65 6c 65 63 74 65 64 2d 69 74 65 6d 20 22 22 selected-item "" 07a0: 29 29 0a 20 20 20 20 28 66 6f 72 2d 65 61 63 68 )). (for-each 07b0: 20 28 6c 61 6d 62 64 61 20 28 69 74 65 6d 29 0a (lambda (item). 07c0: 09 09 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 ..(iup:attribute 07d0: 2d 73 65 74 21 20 6c 62 20 28 6e 75 6d 62 65 72 -set! lb (number 07e0: 2d 3e 73 74 72 69 6e 67 20 69 29 20 69 74 65 6d ->string i) item 07f0: 29 0a 09 09 28 69 66 20 73 65 6c 65 63 74 65 64 )...(if selected 0800: 2d 69 74 65 6d 0a 09 09 20 20 20 20 28 69 66 20 -item... (if 0810: 28 65 71 75 61 6c 3f 20 73 65 6c 65 63 74 65 64 (equal? selected 0820: 2d 69 74 65 6d 20 69 74 65 6d 29 0a 09 09 09 28 -item item)....( 0830: 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 iup:attribute-se 0840: 74 21 20 6c 62 20 22 56 41 4c 55 45 22 20 69 74 t! lb "VALUE" it 0850: 65 6d 29 29 29 20 3b 3b 20 28 6e 75 6d 62 65 72 em))) ;; (number 0860: 2d 3e 73 74 72 69 6e 67 20 69 29 29 29 29 0a 09 ->string i)))).. 0870: 09 28 73 65 74 21 20 69 20 28 2b 20 69 20 31 29 .(set! i (+ i 1) 0880: 29 29 0a 09 20 20 20 20 20 20 69 74 65 6d 73 29 )).. items) 0890: 0a 20 20 20 20 69 29 29 0a 0a 28 64 65 66 69 6e . i))..(defin 08a0: 65 20 28 70 61 64 2d 6c 69 73 74 20 6c 20 6e 29 e (pad-list l n) 08b0: 28 61 70 70 65 6e 64 20 6c 20 28 6d 61 6b 65 2d (append l (make- 08c0: 6c 69 73 74 20 28 2d 20 6e 20 28 6c 65 6e 67 74 list (- n (lengt 08d0: 68 20 6c 29 29 29 29 29 0a 0a 28 64 65 66 69 6e h l)))))..(defin 08e0: 65 20 28 65 78 61 6d 69 6e 65 2d 74 65 73 74 20 e (examine-test 08f0: 62 75 74 74 6f 6e 2d 6b 65 79 29 20 3b 3b 20 72 button-key) ;; r 0900: 75 6e 2d 69 64 20 72 75 6e 2d 6b 65 79 20 6f 72 un-id run-key or 0910: 69 67 74 65 73 74 29 0a 20 20 28 6c 65 74 20 28 igtest). (let ( 0920: 28 62 75 74 74 6f 6e 64 61 74 20 20 20 20 20 28 (buttondat ( 0930: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 hash-table-ref/d 0940: 65 66 61 75 6c 74 20 2a 62 75 74 74 6f 6e 64 61 efault *buttonda 0950: 74 2a 20 62 75 74 74 6f 6e 2d 6b 65 79 20 23 66 t* button-key #f 0960: 29 29 29 0a 20 20 20 20 3b 3b 20 28 70 72 69 6e ))). ;; (prin 0970: 74 20 22 62 75 74 74 6f 6e 64 61 74 3a 20 22 20 t "buttondat: " 0980: 62 75 74 74 6f 6e 64 61 74 29 0a 20 20 20 20 28 buttondat). ( 0990: 69 66 20 28 61 6e 64 20 62 75 74 74 6f 6e 64 61 if (and buttonda 09a0: 74 0a 09 20 20 20 20 20 28 76 65 63 74 6f 72 20 t.. (vector 09b0: 62 75 74 74 6f 6e 64 61 74 29 0a 09 20 20 20 20 buttondat).. 09c0: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 62 75 74 (vector-ref but 09d0: 74 6f 6e 64 61 74 20 30 29 0a 09 20 20 20 20 20 tondat 0).. 09e0: 28 3e 20 28 76 65 63 74 6f 72 2d 72 65 66 20 62 (> (vector-ref b 09f0: 75 74 74 6f 6e 64 61 74 20 30 29 20 30 29 0a 09 uttondat 0) 0).. 0a00: 20 20 20 20 20 28 76 65 63 74 6f 72 3f 20 28 76 (vector? (v 0a10: 65 63 74 6f 72 2d 72 65 66 20 62 75 74 74 6f 6e ector-ref button 0a20: 64 61 74 20 33 29 29 0a 09 20 20 20 20 20 28 3e dat 3)).. (> 0a30: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 28 76 65 (vector-ref (ve 0a40: 63 74 6f 72 2d 72 65 66 20 62 75 74 74 6f 6e 64 ctor-ref buttond 0a50: 61 74 20 33 29 20 30 29 20 30 29 29 0a 09 28 6c at 3) 0) 0))..(l 0a60: 65 74 2a 20 28 28 72 75 6e 2d 69 64 20 20 20 20 et* ((run-id 0a70: 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 62 (vector-ref b 0a80: 75 74 74 6f 6e 64 61 74 20 30 29 29 0a 09 20 20 uttondat 0)).. 0a90: 20 20 20 20 20 28 6f 72 69 67 74 65 73 74 20 20 (origtest 0aa0: 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 62 (vector-ref b 0ab0: 75 74 74 6f 6e 64 61 74 20 33 29 29 0a 09 20 20 uttondat 3)).. 0ac0: 20 20 20 20 20 28 72 75 6e 2d 6b 65 79 20 20 20 (run-key 0ad0: 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 62 (vector-ref b 0ae0: 75 74 74 6f 6e 64 61 74 20 34 29 29 0a 09 20 20 uttondat 4)).. 0af0: 20 20 20 20 20 28 74 65 73 74 20 20 20 20 20 20 (test 0b00: 20 20 20 28 64 62 3a 67 65 74 2d 74 65 73 74 2d (db:get-test- 0b10: 69 6e 66 6f 20 2a 64 62 2a 0a 09 09 09 09 09 20 info *db*...... 0b20: 20 20 20 20 20 20 72 75 6e 2d 69 64 0a 09 09 09 run-id.... 0b30: 09 09 20 20 20 20 20 20 20 28 64 62 3a 74 65 73 .. (db:tes 0b40: 74 2d 67 65 74 2d 74 65 73 74 6e 61 6d 65 20 20 t-get-testname 0b50: 6f 72 69 67 74 65 73 74 29 0a 09 09 09 09 09 20 origtest)...... 0b60: 20 20 20 20 20 20 28 64 62 3a 74 65 73 74 2d 67 (db:test-g 0b70: 65 74 2d 69 74 65 6d 2d 70 61 74 68 20 6f 72 69 et-item-path ori 0b80: 67 74 65 73 74 29 29 29 0a 09 20 20 20 20 20 20 gtest))).. 0b90: 20 28 72 75 6e 64 69 72 20 20 20 20 20 20 20 28 (rundir ( 0ba0: 64 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e 64 db:test-get-rund 0bb0: 69 72 20 74 65 73 74 29 29 0a 09 20 20 20 20 20 ir test)).. 0bc0: 20 20 28 74 65 73 74 2d 69 64 20 20 20 20 20 20 (test-id 0bd0: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 64 20 (db:test-get-id 0be0: 20 20 20 20 74 65 73 74 29 29 0a 09 20 20 20 20 test)).. 0bf0: 20 20 20 28 74 65 73 74 6e 61 6d 65 20 20 20 20 (testname 0c00: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 74 65 (db:test-get-te 0c10: 73 74 6e 61 6d 65 20 20 20 74 65 73 74 29 29 0a stname test)). 0c20: 09 20 20 20 20 20 20 20 28 69 74 65 6d 70 61 74 . (itempat 0c30: 68 20 20 20 20 20 28 64 62 3a 74 65 73 74 2d 67 h (db:test-g 0c40: 65 74 2d 69 74 65 6d 2d 70 61 74 68 20 74 65 73 et-item-path tes 0c50: 74 29 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 t)).. (tes 0c60: 74 66 75 6c 6c 6e 61 6d 65 20 28 72 75 6e 73 3a tfullname (runs: 0c70: 74 65 73 74 2d 67 65 74 2d 66 75 6c 6c 2d 70 61 test-get-full-pa 0c80: 74 68 20 74 65 73 74 29 29 0a 09 20 20 20 20 20 th test)).. 0c90: 20 20 28 74 65 73 74 6b 65 79 20 20 20 20 20 20 (testkey 0ca0: 28 6c 69 73 74 20 74 65 73 74 2d 69 64 20 74 65 (list test-id te 0cb0: 73 74 6e 61 6d 65 20 69 74 65 6d 70 61 74 68 20 stname itempath 0cc0: 74 65 73 74 66 75 6c 6c 6e 61 6d 65 29 29 0a 09 testfullname)).. 0cd0: 20 20 20 20 20 20 20 28 77 69 64 67 65 74 73 20 (widgets 0ce0: 20 20 20 20 20 28 6d 61 6b 65 2d 68 61 73 68 2d (make-hash- 0cf0: 74 61 62 6c 65 29 29 20 3b 3b 20 70 75 74 20 74 table)) ;; put t 0d00: 68 65 20 77 69 64 67 65 74 73 20 74 6f 20 75 70 he widgets to up 0d10: 64 61 74 65 20 69 6e 20 74 68 69 73 20 68 61 73 date in this has 0d20: 68 74 61 62 6c 65 0a 09 20 20 20 20 20 20 20 28 htable.. ( 0d30: 63 75 72 72 73 74 61 74 75 73 20 20 20 28 64 62 currstatus (db 0d40: 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 75 73 :test-get-status 0d50: 20 74 65 73 74 29 29 0a 09 20 20 20 20 20 20 20 test)).. 0d60: 28 63 75 72 72 73 74 61 74 65 20 20 20 20 28 64 (currstate (d 0d70: 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 65 b:test-get-state 0d80: 20 20 74 65 73 74 29 29 0a 09 20 20 20 20 20 20 test)).. 0d90: 20 28 63 75 72 72 63 6f 6d 6d 65 6e 74 20 20 28 (currcomment ( 0da0: 64 62 3a 74 65 73 74 2d 67 65 74 2d 63 6f 6d 6d db:test-get-comm 0db0: 65 6e 74 20 74 65 73 74 29 29 0a 09 20 20 20 20 ent test)).. 0dc0: 20 20 20 28 68 6f 73 74 20 20 20 20 20 20 20 20 (host 0dd0: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 68 6f (db:test-get-ho 0de0: 73 74 20 74 65 73 74 29 29 0a 09 20 20 20 20 20 st test)).. 0df0: 20 20 28 63 70 75 6c 6f 61 64 20 20 20 20 20 20 (cpuload 0e00: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 63 70 75 (db:test-get-cpu 0e10: 6c 6f 61 64 20 74 65 73 74 29 29 0a 09 20 20 20 load test)).. 0e20: 20 20 20 20 28 72 75 6e 74 69 6d 65 20 20 20 20 (runtime 0e30: 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 72 (db:test-get-r 0e40: 75 6e 5f 64 75 72 61 74 69 6f 6e 20 74 65 73 74 un_duration test 0e50: 29 29 0a 09 20 20 20 20 20 20 20 28 6c 6f 67 66 )).. (logf 0e60: 69 6c 65 20 20 20 20 20 20 28 63 6f 6e 63 20 28 ile (conc ( 0e70: 64 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e 64 db:test-get-rund 0e80: 69 72 20 74 65 73 74 29 20 22 2f 22 20 28 64 62 ir test) "/" (db 0e90: 3a 74 65 73 74 2d 67 65 74 2d 66 69 6e 61 6c 5f :test-get-final_ 0ea0: 6c 6f 67 66 20 74 65 73 74 29 29 29 0a 09 20 20 logf test))).. 0eb0: 20 20 20 20 20 28 76 69 65 77 6c 6f 67 20 20 20 (viewlog 0ec0: 20 20 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 (lambda (x).. 0ed0: 09 09 20 20 20 20 20 20 20 28 69 66 20 28 66 69 .. (if (fi 0ee0: 6c 65 2d 65 78 69 73 74 73 3f 20 6c 6f 67 66 69 le-exists? logfi 0ef0: 6c 65 29 0a 09 09 09 09 20 20 20 28 73 79 73 74 le)..... (syst 0f00: 65 6d 20 28 63 6f 6e 63 20 22 66 69 72 65 66 6f em (conc "firefo 0f10: 78 20 22 20 6c 6f 67 66 69 6c 65 20 22 26 22 29 x " logfile "&") 0f20: 29 0a 09 09 09 09 20 20 20 28 6d 65 73 73 61 67 )..... (messag 0f30: 65 2d 77 69 6e 64 6f 77 20 28 63 6f 6e 63 20 22 e-window (conc " 0f40: 46 69 6c 65 20 22 20 6c 6f 67 66 69 6c 65 20 22 File " logfile " 0f50: 20 6e 6f 74 20 66 6f 75 6e 64 22 29 29 29 29 29 not found"))))) 0f60: 0a 09 20 20 20 20 20 20 20 28 78 74 65 72 6d 20 .. (xterm 0f70: 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 (lambda ( 0f80: 78 29 0a 09 09 09 20 20 20 20 20 20 20 28 69 66 x).... (if 0f90: 20 28 64 69 72 65 63 74 6f 72 79 2d 65 78 69 73 (directory-exis 0fa0: 74 73 3f 20 72 75 6e 64 69 72 29 0a 09 09 09 09 ts? rundir)..... 0fb0: 20 20 20 28 6c 65 74 20 28 28 73 68 65 6c 6c 20 (let ((shell 0fc0: 28 69 66 20 28 67 65 74 2d 65 6e 76 69 72 6f 6e (if (get-environ 0fd0: 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 22 53 ment-variable "S 0fe0: 48 45 4c 4c 22 29 20 0a 09 09 09 09 09 09 20 20 HELL") ....... 0ff0: 20 20 28 63 6f 6e 63 20 22 2d 65 20 22 20 28 67 (conc "-e " (g 1000: 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 et-environment-v 1010: 61 72 69 61 62 6c 65 20 22 53 48 45 4c 4c 22 29 ariable "SHELL") 1020: 29 0a 09 09 09 09 09 09 20 20 20 20 22 22 29 29 )....... "")) 1030: 29 0a 09 09 09 09 20 20 20 20 20 28 73 79 73 74 )..... (syst 1040: 65 6d 20 28 63 6f 6e 63 20 22 63 64 20 22 20 72 em (conc "cd " r 1050: 75 6e 64 69 72 20 0a 09 09 09 09 09 09 20 20 20 undir ....... 1060: 22 3b 78 74 65 72 6d 20 2d 54 20 5c 22 22 20 28 ";xterm -T \"" ( 1070: 73 74 72 69 6e 67 2d 74 72 61 6e 73 6c 61 74 65 string-translate 1080: 20 74 65 73 74 66 75 6c 6c 6e 61 6d 65 20 22 28 testfullname "( 1090: 29 22 20 22 20 20 22 29 20 22 5c 22 20 22 20 73 )" " ") "\" " s 10a0: 68 65 6c 6c 20 22 26 22 29 29 29 0a 09 09 09 09 hell "&")))..... 10b0: 20 20 20 28 6d 65 73 73 61 67 65 2d 77 69 6e 64 (message-wind 10c0: 6f 77 20 20 28 63 6f 6e 63 20 22 44 69 72 65 63 ow (conc "Direc 10d0: 74 6f 72 79 20 22 20 72 75 6e 64 69 72 20 22 20 tory " rundir " 10e0: 6e 6f 74 20 66 6f 75 6e 64 22 29 29 29 29 29 0a not found"))))). 10f0: 09 20 20 20 20 20 20 20 28 6e 65 77 73 74 61 74 . (newstat 1100: 75 73 20 20 20 20 63 75 72 72 73 74 61 74 75 73 us currstatus 1110: 29 0a 09 20 20 20 20 20 20 20 28 6e 65 77 73 74 ).. (newst 1120: 61 74 65 20 20 20 20 20 63 75 72 72 73 74 61 74 ate currstat 1130: 65 29 0a 09 20 20 20 20 20 20 20 28 73 65 6c 66 e).. (self 1140: 20 20 20 20 20 20 20 20 20 23 66 29 29 0a 0a 09 #f))... 1150: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 (hash-table-se 1160: 74 21 20 2a 65 78 61 6d 69 6e 65 2d 74 65 73 74 t! *examine-test 1170: 2d 64 61 74 2a 20 74 65 73 74 6b 65 79 20 77 69 -dat* testkey wi 1180: 64 67 65 74 73 29 0a 09 20 20 0a 09 20 20 3b 3b dgets).. .. ;; 1190: 20 20 28 74 65 73 74 2d 73 65 74 2d 73 74 61 74 (test-set-stat 11a0: 75 73 21 20 64 62 20 72 75 6e 2d 69 64 20 74 65 us! db run-id te 11b0: 73 74 2d 6e 61 6d 65 20 73 74 61 74 65 20 73 74 st-name state st 11c0: 61 74 75 73 20 69 74 65 6d 64 61 74 29 0a 09 20 atus itemdat).. 11d0: 20 28 73 65 74 21 20 73 65 6c 66 20 0a 09 09 28 (set! self ...( 11e0: 69 75 70 3a 64 69 61 6c 6f 67 0a 09 09 20 23 3a iup:dialog... #: 11f0: 74 69 74 6c 65 20 74 65 73 74 66 75 6c 6c 6e 61 title testfullna 1200: 6d 65 0a 09 09 20 28 69 75 70 3a 68 62 6f 78 20 me... (iup:hbox 1210: 3b 3b 20 4e 65 65 64 20 61 20 66 75 6c 6c 20 68 ;; Need a full h 1220: 65 69 67 68 74 20 62 6f 78 20 66 6f 72 20 61 6c eight box for al 1230: 6c 20 74 68 65 20 74 65 73 74 20 73 74 65 70 73 l the test steps 1240: 0a 09 09 20 20 28 69 75 70 3a 76 62 6f 78 0a 09 ... (iup:vbox.. 1250: 09 20 20 20 28 69 75 70 3a 68 62 6f 78 20 0a 09 . (iup:hbox .. 1260: 09 20 20 20 20 28 69 75 70 3a 66 72 61 6d 65 20 . (iup:frame 1270: 28 69 75 70 3a 6c 61 62 65 6c 20 72 75 6e 2d 6b (iup:label run-k 1280: 65 79 29 29 0a 09 09 20 20 20 20 28 69 75 70 3a ey))... (iup: 1290: 66 72 61 6d 65 20 28 69 75 70 3a 6c 61 62 65 6c frame (iup:label 12a0: 20 28 63 6f 6e 63 20 22 54 45 53 54 4e 41 4d 45 (conc "TESTNAME 12b0: 3a 5c 6e 22 20 74 65 73 74 66 75 6c 6c 6e 61 6d :\n" testfullnam 12c0: 65 29 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53 e) #:expand "YES 12d0: 22 29 29 29 0a 09 09 20 20 20 28 69 75 70 3a 66 ")))... (iup:f 12e0: 72 61 6d 65 20 23 3a 74 69 74 6c 65 20 22 41 63 rame #:title "Ac 12f0: 74 69 6f 6e 73 22 20 23 3a 65 78 70 61 6e 64 20 tions" #:expand 1300: 22 59 45 53 22 0a 09 09 09 20 20 20 20 20 20 28 "YES".... ( 1310: 69 75 70 3a 68 62 6f 78 20 3b 3b 20 74 68 65 20 iup:hbox ;; the 1320: 61 63 74 69 6f 6e 73 20 62 6f 78 0a 09 09 09 20 actions box.... 1330: 20 20 20 20 20 20 28 69 75 70 3a 62 75 74 74 6f (iup:butto 1340: 6e 20 22 56 69 65 77 20 4c 6f 67 22 20 20 20 20 n "View Log" 1350: 23 3a 61 63 74 69 6f 6e 20 76 69 65 77 6c 6f 67 #:action viewlog 1360: 20 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53 22 #:expand "YES" 1370: 29 0a 09 09 09 20 20 20 20 20 20 20 28 69 75 70 ).... (iup 1380: 3a 62 75 74 74 6f 6e 20 22 53 74 61 72 74 20 58 :button "Start X 1390: 74 65 72 6d 22 20 23 3a 61 63 74 69 6f 6e 20 78 term" #:action x 13a0: 74 65 72 6d 20 20 23 3a 65 78 70 61 6e 64 20 22 term #:expand " 13b0: 59 45 53 22 29 29 29 0a 09 09 20 20 20 28 69 75 YES")))... (iu 13c0: 70 3a 66 72 61 6d 65 20 23 3a 74 69 74 6c 65 20 p:frame #:title 13d0: 22 53 65 74 20 66 69 65 6c 64 73 22 0a 09 09 09 "Set fields".... 13e0: 20 20 20 20 20 20 28 69 75 70 3a 76 62 6f 78 0a (iup:vbox. 13f0: 09 09 09 20 20 20 20 20 20 20 28 69 75 70 3a 68 ... (iup:h 1400: 62 6f 78 20 0a 09 09 09 09 28 69 75 70 3a 76 62 box .....(iup:vb 1410: 6f 78 20 3b 3b 20 74 68 65 20 73 74 61 74 65 0a ox ;; the state. 1420: 09 09 09 09 20 28 69 75 70 3a 6c 61 62 65 6c 20 .... (iup:label 1430: 22 53 54 41 54 45 3a 22 20 23 3a 73 69 7a 65 20 "STATE:" #:size 1440: 22 33 30 78 22 29 0a 09 09 09 09 20 28 6c 65 74 "30x")..... (let 1450: 20 28 28 6c 62 20 28 69 75 70 3a 6c 69 73 74 62 ((lb (iup:listb 1460: 6f 78 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d ox #:action (lam 1470: 62 64 61 20 28 76 61 6c 20 61 20 62 20 63 29 0a bda (val a b c). 1480: 09 09 09 09 09 09 09 09 20 20 20 3b 3b 20 28 70 ........ ;; (p 1490: 72 69 6e 74 20 76 61 6c 20 22 20 61 3a 20 22 20 rint val " a: " 14a0: 61 20 22 20 62 3a 20 22 20 62 20 22 20 63 3a 20 a " b: " b " c: 14b0: 22 20 63 29 0a 09 09 09 09 09 09 09 09 20 20 20 " c)......... 14c0: 28 73 65 74 21 20 6e 65 77 73 74 61 74 65 20 61 (set! newstate a 14d0: 29 29 0a 09 09 09 09 09 09 09 23 3a 65 64 69 74 ))........#:edit 14e0: 62 6f 78 20 22 59 45 53 22 0a 09 09 09 09 09 09 box "YES"....... 14f0: 09 23 3a 65 78 70 61 6e 64 20 22 59 45 53 22 29 .#:expand "YES") 1500: 29 29 0a 09 09 09 09 20 20 20 28 69 75 70 6c 69 ))..... (iupli 1510: 73 74 62 6f 78 2d 66 69 6c 6c 2d 6c 69 73 74 20 stbox-fill-list 1520: 6c 62 0a 09 09 09 09 09 09 09 20 28 6c 69 73 74 lb........ (list 1530: 20 22 43 4f 4d 50 4c 45 54 45 44 22 20 22 4e 4f "COMPLETED" "NO 1540: 54 5f 53 54 41 52 54 45 44 22 20 22 52 55 4e 4e T_STARTED" "RUNN 1550: 49 4e 47 22 20 22 52 45 4d 4f 54 45 48 4f 53 54 ING" "REMOTEHOST 1560: 53 54 41 52 54 22 20 22 4b 49 4c 4c 45 44 22 20 START" "KILLED" 1570: 22 4b 49 4c 4c 52 45 51 22 20 22 43 48 45 43 4b "KILLREQ" "CHECK 1580: 22 29 0a 09 09 09 09 09 09 09 20 63 75 72 72 73 ")........ currs 1590: 74 61 74 65 29 0a 09 09 09 09 20 20 20 6c 62 29 tate)..... lb) 15a0: 29 0a 09 09 09 09 28 69 75 70 3a 76 62 6f 78 20 ).....(iup:vbox 15b0: 3b 3b 20 74 68 65 20 73 74 61 74 75 73 0a 09 09 ;; the status... 15c0: 09 09 20 28 69 75 70 3a 6c 61 62 65 6c 20 22 53 .. (iup:label "S 15d0: 54 41 54 55 53 3a 22 20 23 3a 73 69 7a 65 20 22 TATUS:" #:size " 15e0: 33 30 78 22 29 0a 09 09 09 09 20 28 6c 65 74 20 30x")..... (let 15f0: 28 28 6c 62 20 28 69 75 70 3a 6c 69 73 74 62 6f ((lb (iup:listbo 1600: 78 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 x #:action (lamb 1610: 64 61 20 28 76 61 6c 20 61 20 62 20 63 29 0a 09 da (val a b c).. 1620: 09 09 09 09 09 09 09 20 20 20 28 73 65 74 21 20 ....... (set! 1630: 6e 65 77 73 74 61 74 75 73 20 61 29 29 0a 09 09 newstatus a))... 1640: 09 09 09 09 09 23 3a 65 64 69 74 62 6f 78 20 22 .....#:editbox " 1650: 59 45 53 22 0a 09 09 09 09 09 09 09 23 3a 76 61 YES"........#:va 1660: 6c 75 65 20 63 75 72 72 73 74 61 74 75 73 0a 09 lue currstatus.. 1670: 09 09 09 09 09 09 23 3a 65 78 70 61 6e 64 20 22 ......#:expand " 1680: 59 45 53 22 29 29 29 0a 09 09 09 09 20 20 20 28 YES")))..... ( 1690: 69 75 70 6c 69 73 74 62 6f 78 2d 66 69 6c 6c 2d iuplistbox-fill- 16a0: 6c 69 73 74 20 6c 62 0a 09 09 09 09 09 09 09 20 list lb........ 16b0: 28 6c 69 73 74 20 22 50 41 53 53 22 20 22 57 41 (list "PASS" "WA 16c0: 52 4e 22 20 22 46 41 49 4c 22 20 22 43 48 45 43 RN" "FAIL" "CHEC 16d0: 4b 22 20 22 6e 2f 61 22 29 0a 09 09 09 09 09 09 K" "n/a")....... 16e0: 09 20 63 75 72 72 73 74 61 74 75 73 29 0a 09 09 . currstatus)... 16f0: 09 09 20 20 20 6c 62 29 29 29 0a 09 09 09 20 20 .. lb))).... 1700: 20 20 20 20 20 28 69 75 70 3a 68 62 6f 78 20 28 (iup:hbox ( 1710: 69 75 70 3a 6c 61 62 65 6c 20 22 43 6f 6d 6d 65 iup:label "Comme 1720: 6e 74 3a 22 29 0a 09 09 09 09 09 20 28 69 75 70 nt:")...... (iup 1730: 3a 74 65 78 74 62 6f 78 20 23 3a 61 63 74 69 6f :textbox #:actio 1740: 6e 20 28 6c 61 6d 62 64 61 20 28 76 61 6c 20 61 n (lambda (val a 1750: 20 62 29 0a 09 09 09 09 09 09 09 09 20 28 73 65 b)......... (se 1760: 74 21 20 63 75 72 72 63 6f 6d 6d 65 6e 74 20 62 t! currcomment b 1770: 29 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 23 ))....... # 1780: 3a 76 61 6c 75 65 20 63 75 72 72 63 6f 6d 6d 65 :value currcomme 1790: 6e 74 20 0a 09 09 09 09 09 09 20 20 20 20 20 20 nt ....... 17a0: 23 3a 65 78 70 61 6e 64 20 22 59 45 53 22 29 29 #:expand "YES")) 17b0: 0a 09 09 09 20 20 20 20 20 20 20 28 69 75 70 3a .... (iup: 17c0: 62 75 74 74 6f 6e 20 22 41 70 70 6c 79 22 0a 09 button "Apply".. 17d0: 09 09 09 09 20 20 20 23 3a 65 78 70 61 6e 64 20 .... #:expand 17e0: 22 59 45 53 22 0a 09 09 09 09 09 20 20 20 23 3a "YES"...... #: 17f0: 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 action (lambda ( 1800: 78 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 28 x)....... ( 1810: 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 test-set-status! 1820: 20 2a 64 62 2a 20 72 75 6e 2d 69 64 20 74 65 73 *db* run-id tes 1830: 74 6e 61 6d 65 20 6e 65 77 73 74 61 74 65 20 6e tname newstate n 1840: 65 77 73 74 61 74 75 73 20 69 74 65 6d 70 61 74 ewstatus itempat 1850: 68 20 63 75 72 72 63 6f 6d 6d 65 6e 74 29 29 29 h currcomment))) 1860: 0a 09 09 09 20 20 20 20 20 20 20 28 69 75 70 3a .... (iup: 1870: 68 62 6f 78 20 28 69 75 70 3a 62 75 74 74 6f 6e hbox (iup:button 1880: 20 22 41 70 70 6c 79 20 61 6e 64 20 63 6c 6f 73 "Apply and clos 1890: 65 22 0a 09 09 09 09 09 09 20 20 20 20 20 23 3a e"....... #: 18a0: 65 78 70 61 6e 64 20 22 59 45 53 22 0a 09 09 09 expand "YES".... 18b0: 09 09 09 20 20 20 20 20 23 3a 61 63 74 69 6f 6e ... #:action 18c0: 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 09 (lambda (x).... 18d0: 09 09 09 09 09 28 68 61 73 68 2d 74 61 62 6c 65 .....(hash-table 18e0: 2d 64 65 6c 65 74 65 21 20 2a 65 78 61 6d 69 6e -delete! *examin 18f0: 65 2d 74 65 73 74 2d 64 61 74 2a 20 74 65 73 74 e-test-dat* test 1900: 6b 65 79 29 0a 09 09 09 09 09 09 09 09 28 74 65 key).........(te 1910: 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 2a st-set-status! * 1920: 64 62 2a 20 72 75 6e 2d 69 64 20 74 65 73 74 6e db* run-id testn 1930: 61 6d 65 20 6e 65 77 73 74 61 74 65 20 6e 65 77 ame newstate new 1940: 73 74 61 74 75 73 20 69 74 65 6d 70 61 74 68 20 status itempath 1950: 63 75 72 72 63 6f 6d 6d 65 6e 74 29 0a 09 09 09 currcomment).... 1960: 09 09 09 09 09 28 69 75 70 3a 64 65 73 74 72 6f .....(iup:destro 1970: 79 21 20 73 65 6c 66 29 29 29 0a 09 09 09 09 09 y! self)))...... 1980: 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 43 61 (iup:button "Ca 1990: 6e 63 65 6c 20 61 6e 64 20 63 6c 6f 73 65 22 0a ncel and close". 19a0: 09 09 09 09 09 09 20 20 20 20 20 23 3a 65 78 70 ...... #:exp 19b0: 61 6e 64 20 22 59 45 53 22 0a 09 09 09 09 09 09 and "YES"....... 19c0: 20 20 20 20 20 23 3a 61 63 74 69 6f 6e 20 28 6c #:action (l 19d0: 61 6d 62 64 61 20 28 78 29 0a 09 09 09 09 09 09 ambda (x)....... 19e0: 09 09 28 68 61 73 68 2d 74 61 62 6c 65 2d 64 65 ..(hash-table-de 19f0: 6c 65 74 65 21 20 2a 65 78 61 6d 69 6e 65 2d 74 lete! *examine-t 1a00: 65 73 74 2d 64 61 74 2a 20 74 65 73 74 6b 65 79 est-dat* testkey 1a10: 29 0a 09 09 09 09 09 09 09 09 28 69 75 70 3a 64 ).........(iup:d 1a20: 65 73 74 72 6f 79 21 20 73 65 6c 66 29 29 29 29 estroy! self)))) 1a30: 0a 09 09 09 20 20 20 20 20 20 20 29 29 29 0a 09 .... ))).. 1a40: 09 20 20 28 69 75 70 3a 68 62 6f 78 20 3b 3b 20 . (iup:hbox ;; 1a50: 74 68 65 20 74 65 73 74 20 73 74 65 70 73 20 61 the test steps a 1a60: 72 65 20 74 72 61 63 6b 65 64 20 68 65 72 65 0a re tracked here. 1a70: 09 09 20 20 20 28 6c 65 74 20 28 28 73 74 65 70 .. (let ((step 1a80: 73 64 61 74 20 28 69 75 70 3a 6c 61 62 65 6c 20 sdat (iup:label 1a90: 22 54 65 73 74 20 73 74 65 70 73 20 2e 2e 2e 2e "Test steps .... 1aa0: 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e ................ 1ab0: 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e ................ 1ac0: 2e 2e 22 20 23 3a 65 78 70 61 6e 64 20 22 59 45 .." #:expand "YE 1ad0: 53 22 29 29 29 0a 09 09 20 20 20 20 20 28 68 61 S")))... (ha 1ae0: 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 77 69 sh-table-set! wi 1af0: 64 67 65 74 73 20 22 54 65 73 74 20 53 74 65 70 dgets "Test Step 1b00: 73 22 20 73 74 65 70 73 64 61 74 29 0a 09 09 20 s" stepsdat)... 1b10: 20 20 20 20 73 74 65 70 73 64 61 74 29 0a 09 09 stepsdat)... 1b20: 20 20 20 29 29 29 29 0a 09 20 20 28 69 75 70 3a )))).. (iup: 1b30: 73 68 6f 77 20 73 65 6c 66 29 0a 09 20 20 29 29 show self).. )) 1b40: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 6f 6c ))..(define (col 1b50: 6f 72 73 2d 73 69 6d 69 6c 61 72 3f 20 63 6f 6c ors-similar? col 1b60: 6f 72 31 20 63 6f 6c 6f 72 32 29 0a 20 20 28 6c or1 color2). (l 1b70: 65 74 2a 20 28 28 63 31 20 28 6d 61 70 20 73 74 et* ((c1 (map st 1b80: 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 73 74 ring->number (st 1b90: 72 69 6e 67 2d 73 70 6c 69 74 20 63 6f 6c 6f 72 ring-split color 1ba0: 31 29 29 29 0a 09 20 28 63 32 20 28 6d 61 70 20 1))).. (c2 (map 1bb0: 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 string->number ( 1bc0: 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 63 6f 6c string-split col 1bd0: 6f 72 32 29 29 29 0a 09 20 28 64 65 6c 74 61 20 or2))).. (delta 1be0: 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 61 20 (map (lambda (a 1bf0: 62 29 28 61 62 73 20 28 2d 20 61 20 62 29 29 29 b)(abs (- a b))) 1c00: 20 63 31 20 63 32 29 29 29 0a 20 20 20 20 28 6e c1 c2))). (n 1c10: 75 6c 6c 3f 20 28 66 69 6c 74 65 72 20 28 6c 61 ull? (filter (la 1c20: 6d 62 64 61 20 28 78 29 28 3e 20 78 20 33 29 29 mbda (x)(> x 3)) 1c30: 20 64 65 6c 74 61 29 29 29 29 0a 0a 28 64 65 66 delta))))..(def 1c40: 69 6e 65 20 28 75 70 64 61 74 65 2d 72 75 6e 64 ine (update-rund 1c50: 61 74 20 72 75 6e 6e 61 6d 65 70 61 74 74 20 6e at runnamepatt n 1c60: 75 6d 72 75 6e 73 20 74 65 73 74 6e 61 6d 65 70 umruns testnamep 1c70: 61 74 74 20 69 74 65 6d 6e 61 6d 65 70 61 74 74 att itemnamepatt 1c80: 29 0a 20 20 28 6c 65 74 2a 20 28 28 61 6c 6c 72 ). (let* ((allr 1c90: 75 6e 73 20 20 20 20 20 28 64 62 2d 67 65 74 2d uns (db-get- 1ca0: 72 75 6e 73 20 2a 64 62 2a 20 72 75 6e 6e 61 6d runs *db* runnam 1cb0: 65 70 61 74 74 20 6e 75 6d 72 75 6e 73 20 2a 73 epatt numruns *s 1cc0: 74 61 72 74 2d 72 75 6e 2d 6f 66 66 73 65 74 2a tart-run-offset* 1cd0: 29 29 0a 09 20 28 68 65 61 64 65 72 20 20 20 20 )).. (header 1ce0: 20 20 28 64 62 3a 67 65 74 2d 68 65 61 64 65 72 (db:get-header 1cf0: 20 61 6c 6c 72 75 6e 73 29 29 0a 09 20 28 72 75 allruns)).. (ru 1d00: 6e 73 20 20 20 20 20 20 20 20 28 64 62 3a 67 65 ns (db:ge 1d10: 74 2d 72 6f 77 73 20 20 20 61 6c 6c 72 75 6e 73 t-rows allruns 1d20: 29 29 0a 09 20 28 72 65 73 75 6c 74 20 20 20 20 )).. (result 1d30: 20 20 27 28 29 29 0a 09 20 28 6d 61 78 74 65 73 '()).. (maxtes 1d40: 74 73 20 20 20 20 30 29 29 0a 20 20 20 20 28 66 ts 0)). (f 1d50: 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 or-each (lambda 1d60: 28 72 75 6e 29 0a 09 09 28 6c 65 74 2a 20 28 28 (run)...(let* (( 1d70: 72 75 6e 2d 69 64 20 20 20 28 64 62 2d 67 65 74 run-id (db-get 1d80: 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 -value-by-header 1d90: 20 72 75 6e 20 68 65 61 64 65 72 20 22 69 64 22 run header "id" 1da0: 29 29 0a 09 09 20 20 20 20 20 20 20 28 74 65 73 ))... (tes 1db0: 74 73 20 20 20 20 28 64 62 2d 67 65 74 2d 74 65 ts (db-get-te 1dc0: 73 74 73 2d 66 6f 72 2d 72 75 6e 20 2a 64 62 2a sts-for-run *db* 1dd0: 20 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 run-id testname 1de0: 70 61 74 74 20 69 74 65 6d 6e 61 6d 65 70 61 74 patt itemnamepat 1df0: 74 29 29 0a 09 09 20 20 20 20 20 20 20 28 6b 65 t))... (ke 1e00: 79 2d 76 61 6c 73 20 28 67 65 74 2d 6b 65 79 2d y-vals (get-key- 1e10: 76 61 6c 73 20 2a 64 62 2a 20 72 75 6e 2d 69 64 vals *db* run-id 1e20: 29 29 29 0a 09 09 20 20 28 69 66 20 28 3e 20 28 )))... (if (> ( 1e30: 6c 65 6e 67 74 68 20 74 65 73 74 73 29 20 6d 61 length tests) ma 1e40: 78 74 65 73 74 73 29 0a 09 09 20 20 20 20 20 20 xtests)... 1e50: 28 73 65 74 21 20 6d 61 78 74 65 73 74 73 20 28 (set! maxtests ( 1e60: 6c 65 6e 67 74 68 20 74 65 73 74 73 29 29 29 0a length tests))). 1e70: 09 09 20 20 28 73 65 74 21 20 72 65 73 75 6c 74 .. (set! result 1e80: 20 28 63 6f 6e 73 20 28 76 65 63 74 6f 72 20 72 (cons (vector r 1e90: 75 6e 20 74 65 73 74 73 20 6b 65 79 2d 76 61 6c un tests key-val 1ea0: 73 29 20 72 65 73 75 6c 74 29 29 29 29 0a 09 20 s) result)))).. 1eb0: 20 20 20 20 20 72 75 6e 73 29 0a 20 20 20 20 28 runs). ( 1ec0: 73 65 74 21 20 2a 68 65 61 64 65 72 2a 20 20 68 set! *header* h 1ed0: 65 61 64 65 72 29 0a 20 20 20 20 28 73 65 74 21 eader). (set! 1ee0: 20 2a 61 6c 6c 72 75 6e 73 2a 20 28 72 65 76 65 *allruns* (reve 1ef0: 72 73 65 20 72 65 73 75 6c 74 29 29 0a 20 20 20 rse result)). 1f00: 20 6d 61 78 74 65 73 74 73 29 29 0a 0a 28 64 65 maxtests))..(de 1f10: 66 69 6e 65 20 28 75 70 64 61 74 65 2d 6c 61 62 fine (update-lab 1f20: 65 6c 73 20 75 69 64 61 74 29 0a 20 20 28 6c 65 els uidat). (le 1f30: 74 2a 20 28 28 72 6f 77 6e 20 20 20 20 30 29 0a t* ((rown 0). 1f40: 09 20 28 6c 66 74 63 6f 6c 20 28 76 65 63 74 6f . (lftcol (vecto 1f50: 72 2d 72 65 66 20 75 69 64 61 74 20 30 29 29 0a r-ref uidat 0)). 1f60: 09 20 28 6d 61 78 6e 20 20 20 28 2d 20 28 76 65 . (maxn (- (ve 1f70: 63 74 6f 72 2d 6c 65 6e 67 74 68 20 6c 66 74 63 ctor-length lftc 1f80: 6f 6c 29 20 31 29 29 29 0a 20 20 20 20 28 6c 65 ol) 1))). (le 1f90: 74 20 6c 6f 6f 70 20 28 28 69 20 30 29 29 0a 20 t loop ((i 0)). 1fa0: 20 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 (iup:attrib 1fb0: 75 74 65 2d 73 65 74 21 20 28 76 65 63 74 6f 72 ute-set! (vector 1fc0: 2d 72 65 66 20 6c 66 74 63 6f 6c 20 69 29 20 22 -ref lftcol i) " 1fd0: 54 49 54 4c 45 22 20 22 22 29 0a 20 20 20 20 20 TITLE" ""). 1fe0: 20 28 69 66 20 28 3c 20 69 20 6d 61 78 6e 29 0a (if (< i maxn). 1ff0: 09 20 20 28 6c 6f 6f 70 20 28 2b 20 69 20 31 29 . (loop (+ i 1) 2000: 29 29 29 0a 20 20 20 20 28 66 6f 72 2d 65 61 63 ))). (for-eac 2010: 68 20 28 6c 61 6d 62 64 61 20 28 6e 61 6d 65 29 h (lambda (name) 2020: 0a 09 09 28 69 66 20 28 3c 3d 20 72 6f 77 6e 20 ...(if (<= rown 2030: 6d 61 78 6e 29 0a 09 09 20 20 20 20 28 6c 65 74 maxn)... (let 2040: 20 28 28 6c 61 62 6c 20 28 76 65 63 74 6f 72 2d ((labl (vector- 2050: 72 65 66 20 6c 66 74 63 6f 6c 20 72 6f 77 6e 29 ref lftcol rown) 2060: 29 29 0a 09 09 20 20 20 20 20 20 28 69 75 70 3a ))... (iup: 2070: 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 6c attribute-set! l 2080: 61 62 6c 20 22 54 49 54 4c 45 22 20 6e 61 6d 65 abl "TITLE" name 2090: 29 29 29 0a 09 09 28 73 65 74 21 20 72 6f 77 6e )))...(set! rown 20a0: 20 28 2b 20 31 20 72 6f 77 6e 29 29 29 0a 09 20 (+ 1 rown))).. 20b0: 20 20 20 20 20 28 64 72 6f 70 20 2a 61 6c 6c 74 (drop *allt 20c0: 65 73 74 6e 61 6d 65 6c 73 74 2a 20 2a 73 74 61 estnamelst* *sta 20d0: 72 74 2d 74 65 73 74 2d 6f 66 66 73 65 74 2a 29 rt-test-offset*) 20e0: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 75 70 )))..(define (up 20f0: 64 61 74 65 2d 62 75 74 74 6f 6e 73 20 75 69 64 date-buttons uid 2100: 61 74 20 6e 75 6d 72 75 6e 73 20 6e 75 6d 74 65 at numruns numte 2110: 73 74 73 29 0a 20 20 28 6c 65 74 2a 20 28 28 72 sts). (let* ((r 2120: 75 6e 73 20 20 20 20 20 20 20 20 28 69 66 20 28 uns (if ( 2130: 3e 20 28 6c 65 6e 67 74 68 20 2a 61 6c 6c 72 75 > (length *allru 2140: 6e 73 2a 29 20 6e 75 6d 72 75 6e 73 29 0a 09 09 ns*) numruns)... 2150: 09 20 20 28 74 61 6b 65 2d 72 69 67 68 74 20 2a . (take-right * 2160: 61 6c 6c 72 75 6e 73 2a 20 6e 75 6d 72 75 6e 73 allruns* numruns 2170: 29 0a 09 09 09 20 20 28 70 61 64 2d 6c 69 73 74 ).... (pad-list 2180: 20 2a 61 6c 6c 72 75 6e 73 2a 20 6e 75 6d 72 75 *allruns* numru 2190: 6e 73 29 29 29 0a 09 20 28 6c 66 74 63 6f 6c 20 ns))).. (lftcol 21a0: 20 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 (vector-ref 21b0: 20 75 69 64 61 74 20 30 29 29 0a 09 20 28 74 61 uidat 0)).. (ta 21c0: 62 6c 65 68 65 61 64 65 72 20 28 76 65 63 74 6f bleheader (vecto 21d0: 72 2d 72 65 66 20 75 69 64 61 74 20 31 29 29 0a r-ref uidat 1)). 21e0: 09 20 28 74 61 62 6c 65 20 20 20 20 20 20 20 28 . (table ( 21f0: 76 65 63 74 6f 72 2d 72 65 66 20 75 69 64 61 74 vector-ref uidat 2200: 20 32 29 29 0a 09 20 28 63 6f 6c 6e 20 20 20 20 2)).. (coln 2210: 20 20 20 20 30 29 29 0a 20 20 20 20 28 75 70 64 0)). (upd 2220: 61 74 65 2d 6c 61 62 65 6c 73 20 75 69 64 61 74 ate-labels uidat 2230: 29 0a 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 ). (for-each 2240: 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 70 . (lambda (p 2250: 6f 70 75 70 29 0a 20 20 20 20 20 20 20 28 6c 65 opup). (le 2260: 74 2a 20 28 28 74 65 73 74 2d 69 64 20 20 28 63 t* ((test-id (c 2270: 61 72 20 70 6f 70 75 70 29 29 0a 09 20 20 20 20 ar popup)).. 2280: 20 20 28 77 69 64 67 65 74 73 20 20 28 68 61 73 (widgets (has 2290: 68 2d 74 61 62 6c 65 2d 72 65 66 20 2a 65 78 61 h-table-ref *exa 22a0: 6d 69 6e 65 2d 74 65 73 74 2d 64 61 74 2a 20 70 mine-test-dat* p 22b0: 6f 70 75 70 29 29 0a 09 20 20 20 20 20 20 28 73 opup)).. (s 22c0: 74 65 70 73 6c 62 6c 20 28 68 61 73 68 2d 74 61 tepslbl (hash-ta 22d0: 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 ble-ref/default 22e0: 77 69 64 67 65 74 73 20 22 54 65 73 74 20 53 74 widgets "Test St 22f0: 65 70 73 22 20 23 66 29 29 29 0a 09 20 28 69 66 eps" #f))).. (if 2300: 20 73 74 65 70 73 6c 62 6c 0a 09 20 20 20 20 20 stepslbl.. 2310: 28 6c 65 74 2a 20 28 28 66 6d 74 73 74 72 20 20 (let* ((fmtstr 2320: 22 7e 31 35 61 7e 38 61 7e 38 61 7e 31 37 61 22 "~15a~8a~8a~17a" 2330: 29 0a 09 09 20 20 20 20 28 6e 65 77 74 78 74 20 )... (newtxt 2340: 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 (string-intersp 2350: 65 72 73 65 20 0a 09 09 09 20 20 20 20 20 20 28 erse .... ( 2360: 61 70 70 65 6e 64 0a 09 09 09 20 20 20 20 20 20 append.... 2370: 20 28 6c 69 73 74 20 0a 09 09 09 09 28 66 6f 72 (list .....(for 2380: 6d 61 74 20 23 66 20 66 6d 74 73 74 72 20 22 53 mat #f fmtstr "S 2390: 74 65 70 6e 61 6d 65 22 20 22 53 74 61 74 65 22 tepname" "State" 23a0: 20 22 53 74 61 74 75 73 22 20 22 45 76 65 6e 74 "Status" "Event 23b0: 20 54 69 6d 65 22 29 0a 09 09 09 09 28 66 6f 72 Time").....(for 23c0: 6d 61 74 20 23 66 20 66 6d 74 73 74 72 20 22 3d mat #f fmtstr "= 23d0: 3d 3d 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d 3d 22 =======" "=====" 23e0: 20 22 3d 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d 3d "======" "===== 23f0: 3d 3d 3d 3d 3d 22 29 29 0a 09 09 09 20 20 20 20 =====")).... 2400: 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 (map (lambda 2410: 28 78 29 0a 09 09 09 09 20 20 20 20 20 20 3b 3b (x)..... ;; 2420: 20 74 61 6b 65 20 61 64 76 61 6e 74 61 67 65 20 take advantage 2430: 6f 66 20 74 68 65 20 5c 6e 20 6f 6e 20 74 69 6d of the \n on tim 2440: 65 2d 3e 73 74 72 69 6e 67 0a 09 09 09 09 20 20 e->string..... 2450: 20 20 20 20 28 66 6f 72 6d 61 74 20 23 66 20 66 (format #f f 2460: 6d 74 73 74 72 0a 09 09 09 09 09 20 20 20 20 20 mtstr...... 2470: 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 73 74 (db:step-get-st 2480: 65 70 6e 61 6d 65 20 78 29 0a 09 09 09 09 09 20 epname x)...... 2490: 20 20 20 20 20 28 64 62 3a 73 74 65 70 2d 67 65 (db:step-ge 24a0: 74 2d 73 74 61 74 65 20 20 20 20 78 29 0a 09 09 t-state x)... 24b0: 09 09 09 20 20 20 20 20 20 28 64 62 3a 73 74 65 ... (db:ste 24c0: 70 2d 67 65 74 2d 73 74 61 74 75 73 20 20 20 78 p-get-status x 24d0: 29 0a 09 09 09 09 09 20 20 20 20 20 20 28 74 69 )...... (ti 24e0: 6d 65 2d 3e 73 74 72 69 6e 67 20 0a 09 09 09 09 me->string ..... 24f0: 09 20 20 20 20 20 20 20 28 73 65 63 6f 6e 64 73 . (seconds 2500: 2d 3e 6c 6f 63 61 6c 2d 74 69 6d 65 20 0a 09 09 ->local-time ... 2510: 09 09 09 09 28 64 62 3a 73 74 65 70 2d 67 65 74 ....(db:step-get 2520: 2d 65 76 65 6e 74 5f 74 69 6d 65 20 78 29 29 29 -event_time x))) 2530: 29 29 0a 09 09 09 09 20 20 20 20 28 64 62 2d 67 ))..... (db-g 2540: 65 74 2d 74 65 73 74 2d 73 74 65 70 73 2d 66 6f et-test-steps-fo 2550: 72 2d 72 75 6e 20 2a 64 62 2a 20 74 65 73 74 2d r-run *db* test- 2560: 69 64 29 29 29 0a 09 09 09 20 20 20 20 20 22 5c id))).... "\ 2570: 6e 22 29 29 29 0a 09 20 20 20 20 20 20 20 28 69 n"))).. (i 2580: 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 up:attribute-set 2590: 21 20 73 74 65 70 73 6c 62 6c 20 22 54 49 54 4c ! stepslbl "TITL 25a0: 45 22 20 6e 65 77 74 78 74 29 29 29 29 29 0a 20 E" newtxt))))). 25b0: 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d (hash-table- 25c0: 6b 65 79 73 20 2a 65 78 61 6d 69 6e 65 2d 74 65 keys *examine-te 25d0: 73 74 2d 64 61 74 2a 29 29 0a 20 20 20 20 28 73 st-dat*)). (s 25e0: 65 74 21 20 2a 61 6c 6c 74 65 73 74 6e 61 6d 65 et! *alltestname 25f0: 6c 73 74 2a 20 27 28 29 29 0a 20 20 20 20 28 66 lst* '()). (f 2600: 6f 72 2d 65 61 63 68 0a 20 20 20 20 20 28 6c 61 or-each. (la 2610: 6d 62 64 61 20 28 72 75 6e 64 61 74 29 0a 20 20 mbda (rundat). 2620: 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 72 75 (if (not ru 2630: 6e 64 61 74 29 20 3b 3b 20 68 61 6e 64 6c 65 20 ndat) ;; handle 2640: 70 61 64 64 65 64 20 72 75 6e 73 0a 09 20 20 20 padded runs.. 2650: 3b 3b 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 ;; ;; 2660: 69 64 20 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 id run-id testna 2670: 6d 65 20 73 74 61 74 65 20 73 74 61 74 75 73 20 me state status 2680: 65 76 65 6e 74 2d 74 69 6d 65 20 68 6f 73 74 20 event-time host 2690: 63 70 75 6c 6f 61 64 20 64 69 73 6b 66 72 65 65 cpuload diskfree 26a0: 20 75 6e 61 6d 65 20 72 75 6e 64 69 72 20 69 74 uname rundir it 26b0: 65 6d 2d 70 61 74 68 20 72 75 6e 2d 64 75 72 61 em-path run-dura 26c0: 74 69 6f 6e 0a 09 20 20 20 28 73 65 74 21 20 72 tion.. (set! r 26d0: 75 6e 64 61 74 20 28 76 65 63 74 6f 72 20 28 6d undat (vector (m 26e0: 61 6b 65 2d 76 65 63 74 6f 72 20 32 30 20 23 66 ake-vector 20 #f 26f0: 29 20 27 28 29 20 28 6d 61 70 20 28 6c 61 6d 62 ) '() (map (lamb 2700: 64 61 20 28 78 29 20 22 22 29 20 2a 6b 65 79 73 da (x) "") *keys 2710: 2a 29 29 29 29 3b 3b 20 33 29 29 29 0a 20 20 20 *))));; 3))). 2720: 20 20 20 20 28 6c 65 74 2a 20 28 28 72 75 6e 20 (let* ((run 2730: 20 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 (vector-ref 2740: 20 72 75 6e 64 61 74 20 30 29 29 0a 09 20 20 20 rundat 0)).. 2750: 20 20 20 28 74 65 73 74 73 64 61 74 20 28 76 65 (testsdat (ve 2760: 63 74 6f 72 2d 72 65 66 20 72 75 6e 64 61 74 20 ctor-ref rundat 2770: 31 29 29 0a 09 20 20 20 20 20 20 28 6b 65 79 2d 1)).. (key- 2780: 76 61 6c 2d 64 61 74 20 28 76 65 63 74 6f 72 2d val-dat (vector- 2790: 72 65 66 20 72 75 6e 64 61 74 20 32 29 29 0a 09 ref rundat 2)).. 27a0: 20 20 20 20 20 20 28 72 75 6e 2d 69 64 20 20 20 (run-id 27b0: 28 64 62 2d 67 65 74 2d 76 61 6c 75 65 2d 62 79 (db-get-value-by 27c0: 2d 68 65 61 64 65 72 20 72 75 6e 20 2a 68 65 61 -header run *hea 27d0: 64 65 72 2a 20 22 69 64 22 29 29 0a 09 20 20 20 der* "id")).. 27e0: 20 20 20 28 74 65 73 74 6e 61 6d 65 73 20 28 64 (testnames (d 27f0: 65 6c 65 74 65 2d 64 75 70 6c 69 63 61 74 65 73 elete-duplicates 2800: 20 28 61 70 70 65 6e 64 20 2a 61 6c 6c 74 65 73 (append *alltes 2810: 74 6e 61 6d 65 6c 73 74 2a 20 0a 09 09 09 09 09 tnamelst* ...... 2820: 09 20 20 20 20 28 6d 61 70 20 74 65 73 74 3a 74 . (map test:t 2830: 65 73 74 2d 67 65 74 2d 66 75 6c 6c 6e 61 6d 65 est-get-fullname 2840: 20 74 65 73 74 73 64 61 74 29 29 29 29 20 3b 3b testsdat)))) ;; 2850: 20 28 74 61 6b 65 20 28 70 61 64 2d 6c 69 73 74 (take (pad-list 2860: 20 74 65 73 74 73 64 61 74 20 6e 75 6d 74 65 73 testsdat numtes 2870: 74 73 29 20 6e 75 6d 74 65 73 74 73 29 29 0a 09 ts) numtests)).. 2880: 20 20 20 20 20 20 28 6b 65 79 2d 76 61 6c 73 20 (key-vals 2890: 28 61 70 70 65 6e 64 20 6b 65 79 2d 76 61 6c 2d (append key-val- 28a0: 64 61 74 0a 09 09 09 09 28 6c 69 73 74 20 28 6c dat.....(list (l 28b0: 65 74 20 28 28 78 20 28 64 62 2d 67 65 74 2d 76 et ((x (db-get-v 28c0: 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 alue-by-header r 28d0: 75 6e 20 2a 68 65 61 64 65 72 2a 20 22 72 75 6e un *header* "run 28e0: 6e 61 6d 65 22 29 29 29 0a 09 09 09 09 09 28 69 name")))......(i 28f0: 66 20 78 20 78 20 22 22 29 29 29 29 29 0a 09 20 f x x ""))))).. 2900: 20 20 20 20 20 28 72 75 6e 2d 6b 65 79 20 20 28 (run-key ( 2910: 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 string-intersper 2920: 73 65 20 6b 65 79 2d 76 61 6c 73 20 22 5c 6e 22 se key-vals "\n" 2930: 29 29 29 0a 09 20 3b 3b 20 28 72 75 6e 2d 68 74 ))).. ;; (run-ht 2940: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 (hash-table-re 2950: 66 2f 64 65 66 61 75 6c 74 20 61 6c 6c 64 61 74 f/default alldat 2960: 20 72 75 6e 2d 6b 65 79 20 23 66 29 29 29 0a 09 run-key #f))).. 2970: 20 3b 3b 20 66 69 6c 6c 20 69 6e 20 74 68 65 20 ;; fill in the 2980: 72 75 6e 20 68 65 61 64 65 72 20 6b 65 79 20 76 run header key v 2990: 61 6c 75 65 73 0a 09 20 28 73 65 74 21 20 2a 61 alues.. (set! *a 29a0: 6c 6c 74 65 73 74 6e 61 6d 65 6c 73 74 2a 20 74 lltestnamelst* t 29b0: 65 73 74 6e 61 6d 65 73 29 0a 09 20 28 6c 65 74 estnames).. (let 29c0: 20 28 28 72 6f 77 6e 20 20 20 20 20 20 30 29 0a ((rown 0). 29d0: 09 20 20 20 20 20 20 20 28 68 65 61 64 65 72 63 . (headerc 29e0: 6f 6c 20 28 76 65 63 74 6f 72 2d 72 65 66 20 74 ol (vector-ref t 29f0: 61 62 6c 65 68 65 61 64 65 72 20 63 6f 6c 6e 29 ableheader coln) 2a00: 29 29 0a 09 20 20 20 28 66 6f 72 2d 65 61 63 68 )).. (for-each 2a10: 20 28 6c 61 6d 62 64 61 20 28 6b 76 61 6c 29 0a (lambda (kval). 2a20: 09 09 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 .. (let* ( 2a30: 28 6c 61 62 6c 20 20 20 20 20 20 28 76 65 63 74 (labl (vect 2a40: 6f 72 2d 72 65 66 20 68 65 61 64 65 72 63 6f 6c or-ref headercol 2a50: 20 72 6f 77 6e 29 29 29 0a 09 09 09 20 28 69 66 rown))).... (if 2a60: 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 6b 76 (not (equal? kv 2a70: 61 6c 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 al (iup:attribut 2a80: 65 20 6c 61 62 6c 20 22 54 49 54 4c 45 22 29 29 e labl "TITLE")) 2a90: 29 0a 09 09 09 20 20 20 20 20 28 69 75 70 3a 61 ).... (iup:a 2aa0: 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 28 76 ttribute-set! (v 2ab0: 65 63 74 6f 72 2d 72 65 66 20 68 65 61 64 65 72 ector-ref header 2ac0: 63 6f 6c 20 72 6f 77 6e 29 20 22 54 49 54 4c 45 col rown) "TITLE 2ad0: 22 20 6b 76 61 6c 29 29 0a 09 09 09 20 28 73 65 " kval)).... (se 2ae0: 74 21 20 72 6f 77 6e 20 28 2b 20 72 6f 77 6e 20 t! rown (+ rown 2af0: 31 29 29 29 29 0a 09 09 20 20 20 20 20 6b 65 79 1))))... key 2b00: 2d 76 61 6c 73 29 29 0a 0a 09 20 3b 3b 20 46 6f -vals))... ;; Fo 2b10: 72 20 74 68 69 73 20 72 75 6e 20 6e 6f 77 20 66 r this run now f 2b20: 69 6c 6c 20 69 6e 20 74 68 65 20 62 75 74 74 6f ill in the butto 2b30: 6e 73 20 66 6f 72 20 65 61 63 68 20 74 65 73 74 ns for each test 2b40: 0a 09 20 28 6c 65 74 20 28 28 72 6f 77 6e 20 30 .. (let ((rown 0 2b50: 29 0a 09 20 20 20 20 20 20 20 28 63 6f 6c 75 6d ).. (colum 2b60: 6e 64 61 74 20 20 28 76 65 63 74 6f 72 2d 72 65 ndat (vector-re 2b70: 66 20 74 61 62 6c 65 20 63 6f 6c 6e 29 29 29 0a f table coln))). 2b80: 09 20 20 20 28 66 6f 72 2d 65 61 63 68 0a 09 20 . (for-each.. 2b90: 20 20 20 28 6c 61 6d 62 64 61 20 28 74 65 73 74 (lambda (test 2ba0: 6e 61 6d 65 29 0a 09 20 20 20 20 20 20 28 6c 65 name).. (le 2bb0: 74 20 28 28 62 75 74 74 6f 6e 64 61 74 20 20 28 t ((buttondat ( 2bc0: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 hash-table-ref/d 2bd0: 65 66 61 75 6c 74 20 2a 62 75 74 74 6f 6e 64 61 efault *buttonda 2be0: 74 2a 20 28 6d 6b 73 74 72 20 63 6f 6c 6e 20 72 t* (mkstr coln r 2bf0: 6f 77 6e 29 20 23 66 29 29 29 0a 09 09 28 69 66 own) #f)))...(if 2c00: 20 62 75 74 74 6f 6e 64 61 74 0a 09 09 20 20 20 buttondat... 2c10: 20 28 6c 65 74 2a 20 28 28 74 65 73 74 20 20 20 (let* ((test 2c20: 20 20 20 20 28 6c 65 74 20 28 28 6d 61 74 63 68 (let ((match 2c30: 69 6e 67 20 28 66 69 6c 74 65 72 20 0a 09 09 09 ing (filter .... 2c40: 09 09 09 09 28 6c 61 6d 62 64 61 20 28 78 29 28 ....(lambda (x)( 2c50: 65 71 75 61 6c 3f 20 28 74 65 73 74 3a 74 65 73 equal? (test:tes 2c60: 74 2d 67 65 74 2d 66 75 6c 6c 6e 61 6d 65 20 78 t-get-fullname x 2c70: 29 20 74 65 73 74 6e 61 6d 65 29 29 0a 09 09 09 ) testname)).... 2c80: 09 09 09 09 74 65 73 74 73 64 61 74 29 29 29 0a ....testsdat))). 2c90: 09 09 09 09 09 20 28 69 66 20 28 6e 75 6c 6c 3f ..... (if (null? 2ca0: 20 6d 61 74 63 68 69 6e 67 29 0a 09 09 09 09 09 matching)...... 2cb0: 20 20 20 20 20 28 76 65 63 74 6f 72 20 2d 31 20 (vector -1 2cc0: 2d 31 20 22 22 20 22 22 20 22 22 20 30 20 22 22 -1 "" "" "" 0 "" 2cd0: 20 22 22 20 30 20 22 22 20 22 22 20 22 22 20 30 "" 0 "" "" "" 0 2ce0: 20 22 22 20 22 22 29 0a 09 09 09 09 09 20 20 20 "" "")...... 2cf0: 20 20 28 63 61 72 20 6d 61 74 63 68 69 6e 67 29 (car matching) 2d00: 29 29 29 0a 09 09 09 20 20 20 3b 3b 20 28 74 65 ))).... ;; (te 2d10: 73 74 20 20 20 20 20 20 20 28 69 66 20 72 65 61 st (if rea 2d20: 6c 2d 74 65 73 74 20 72 65 61 6c 2d 74 65 73 74 l-test real-test 2d30: 0a 09 09 09 20 20 20 28 74 65 73 74 6e 61 6d 65 .... (testname 2d40: 20 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d (db:test-get- 2d50: 74 65 73 74 6e 61 6d 65 20 20 74 65 73 74 29 29 testname test)) 2d60: 0a 09 09 09 20 20 20 28 69 74 65 6d 70 61 74 68 .... (itempath 2d70: 20 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d (db:test-get- 2d80: 69 74 65 6d 2d 70 61 74 68 20 74 65 73 74 29 29 item-path test)) 2d90: 0a 09 09 09 20 20 20 28 74 65 73 74 66 75 6c 6c .... (testfull 2da0: 6e 61 6d 65 20 28 74 65 73 74 3a 74 65 73 74 2d name (test:test- 2db0: 67 65 74 2d 66 75 6c 6c 6e 61 6d 65 20 74 65 73 get-fullname tes 2dc0: 74 29 29 0a 09 09 09 20 20 20 28 74 65 73 74 73 t)).... (tests 2dd0: 74 61 74 75 73 20 28 64 62 3a 74 65 73 74 2d 67 tatus (db:test-g 2de0: 65 74 2d 73 74 61 74 75 73 20 20 20 74 65 73 74 et-status test 2df0: 29 29 0a 09 09 09 20 20 20 28 74 65 73 74 73 74 )).... (testst 2e00: 61 74 65 20 20 28 64 62 3a 74 65 73 74 2d 67 65 ate (db:test-ge 2e10: 74 2d 73 74 61 74 65 20 20 20 20 74 65 73 74 29 t-state test) 2e20: 29 0a 09 09 09 20 20 20 28 74 65 73 74 73 74 61 ).... (teststa 2e30: 72 74 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 rt (db:test-get 2e40: 2d 65 76 65 6e 74 5f 74 69 6d 65 20 74 65 73 74 -event_time test 2e50: 29 29 0a 09 09 09 20 20 20 28 72 75 6e 74 69 6d )).... (runtim 2e60: 65 20 20 20 20 28 64 62 3a 74 65 73 74 2d 67 65 e (db:test-ge 2e70: 74 2d 72 75 6e 5f 64 75 72 61 74 69 6f 6e 20 74 t-run_duration t 2e80: 65 73 74 29 29 0a 09 09 09 20 20 20 28 62 75 74 est)).... (but 2e90: 74 6f 6e 74 78 74 20 20 28 69 66 20 28 65 71 75 tontxt (if (equ 2ea0: 61 6c 3f 20 74 65 73 74 73 74 61 74 65 20 22 43 al? teststate "C 2eb0: 4f 4d 50 4c 45 54 45 44 22 29 20 74 65 73 74 73 OMPLETED") tests 2ec0: 74 61 74 75 73 20 74 65 73 74 73 74 61 74 65 29 tatus teststate) 2ed0: 29 0a 09 09 09 20 20 20 28 62 75 74 74 6f 6e 20 ).... (button 2ee0: 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 (vector-ref 2ef0: 63 6f 6c 75 6d 6e 64 61 74 20 72 6f 77 6e 29 29 columndat rown)) 2f00: 0a 09 09 09 20 20 20 28 63 6f 6c 6f 72 20 20 20 .... (color 2f10: 20 20 20 28 63 61 73 65 20 28 73 74 72 69 6e 67 (case (string 2f20: 2d 3e 73 79 6d 62 6f 6c 20 74 65 73 74 73 74 61 ->symbol teststa 2f30: 74 65 29 0a 09 09 09 09 09 20 28 28 43 4f 4d 50 te)...... ((COMP 2f40: 4c 45 54 45 44 29 0a 09 09 09 09 09 20 20 28 69 LETED)...... (i 2f50: 66 20 28 65 71 75 61 6c 3f 20 74 65 73 74 73 74 f (equal? testst 2f60: 61 74 75 73 20 22 50 41 53 53 22 29 0a 09 09 09 atus "PASS").... 2f70: 09 09 20 20 20 20 20 20 22 37 30 20 32 34 39 20 .. "70 249 2f80: 37 33 22 0a 09 09 09 09 09 20 20 20 20 20 20 28 73"...... ( 2f90: 69 66 20 28 65 71 75 61 6c 3f 20 74 65 73 74 73 if (equal? tests 2fa0: 74 61 74 75 73 20 22 57 41 52 4e 22 29 0a 09 09 tatus "WARN")... 2fb0: 09 09 09 09 20 20 22 32 35 35 20 31 37 32 20 31 .... "255 172 1 2fc0: 33 22 0a 09 09 09 09 09 09 20 20 22 32 32 33 20 3"....... "223 2fd0: 33 33 20 34 39 22 29 29 29 20 3b 3b 20 67 72 65 33 49"))) ;; gre 2fe0: 65 6e 69 73 68 20 6f 72 61 6e 67 65 69 73 68 20 enish orangeish 2ff0: 72 65 64 69 73 68 0a 09 09 09 09 09 20 28 28 4c redish...... ((L 3000: 41 55 4e 43 48 45 44 29 20 20 20 20 20 20 20 20 AUNCHED) 3010: 20 22 31 30 31 20 31 32 33 20 31 34 32 22 29 0a "101 123 142"). 3020: 09 09 09 09 09 20 28 28 43 48 45 43 4b 29 20 20 ..... ((CHECK) 3030: 20 20 20 20 20 20 20 20 20 20 22 32 35 35 20 31 "255 1 3040: 30 30 20 35 30 22 29 0a 09 09 09 09 09 20 28 28 00 50")...... (( 3050: 52 45 4d 4f 54 45 48 4f 53 54 53 54 41 52 54 29 REMOTEHOSTSTART) 3060: 20 20 22 35 30 20 31 33 30 20 31 39 35 22 29 0a "50 130 195"). 3070: 09 09 09 09 09 20 28 28 52 55 4e 4e 49 4e 47 29 ..... ((RUNNING) 3080: 20 20 20 20 20 20 20 20 20 20 22 39 20 31 33 31 "9 131 3090: 20 32 33 32 22 29 0a 09 09 09 09 09 20 28 28 4b 232")...... ((K 30a0: 49 4c 4c 52 45 51 29 20 20 20 20 20 20 20 20 20 ILLREQ) 30b0: 20 22 33 39 20 38 32 20 32 30 36 22 29 0a 09 09 "39 82 206")... 30c0: 09 09 09 20 28 28 4b 49 4c 4c 45 44 29 20 20 20 ... ((KILLED) 30d0: 20 20 20 20 20 20 20 20 22 32 33 34 20 31 30 31 "234 101 30e0: 20 31 37 22 29 0a 09 09 09 09 09 20 28 65 6c 73 17")...... (els 30f0: 65 20 22 31 39 32 20 31 39 32 20 31 39 32 22 29 e "192 192 192") 3100: 29 29 0a 09 09 09 20 20 20 28 63 75 72 72 2d 63 )).... (curr-c 3110: 6f 6c 6f 72 20 28 76 65 63 74 6f 72 2d 72 65 66 olor (vector-ref 3120: 20 62 75 74 74 6f 6e 64 61 74 20 31 29 29 20 3b buttondat 1)) ; 3130: 3b 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 ; (iup:attribute 3140: 20 62 75 74 74 6f 6e 20 22 42 47 43 4f 4c 4f 52 button "BGCOLOR 3150: 22 29 29 0a 09 09 09 20 20 20 28 63 75 72 72 2d ")).... (curr- 3160: 74 69 74 6c 65 20 28 76 65 63 74 6f 72 2d 72 65 title (vector-re 3170: 66 20 62 75 74 74 6f 6e 64 61 74 20 32 29 29 29 f buttondat 2))) 3180: 20 3b 3b 20 28 69 75 70 3a 61 74 74 72 69 62 75 ;; (iup:attribu 3190: 74 65 20 62 75 74 74 6f 6e 20 22 54 49 54 4c 45 te button "TITLE 31a0: 22 29 29 29 0a 09 09 3b 3b 20 20 20 20 20 20 20 ")))...;; 31b0: 28 69 66 20 28 61 6e 64 20 28 65 71 75 61 6c 3f (if (and (equal? 31c0: 20 74 65 73 74 73 74 61 74 65 20 22 52 55 4e 4e teststate "RUNN 31d0: 49 4e 47 22 29 0a 09 09 3b 3b 20 09 20 20 20 20 ING")...;; . 31e0: 20 20 20 28 3e 20 28 2d 20 28 63 75 72 72 65 6e (> (- (curren 31f0: 74 2d 73 65 63 6f 6e 64 73 29 20 28 2b 20 74 65 t-seconds) (+ te 3200: 73 74 73 74 61 72 74 20 72 75 6e 74 69 6d 65 29 ststart runtime) 3210: 29 20 31 30 30 29 29 20 3b 3b 20 69 66 20 74 65 ) 100)) ;; if te 3220: 73 74 20 68 61 73 20 62 65 65 6e 20 64 65 61 64 st has been dead 3230: 20 66 6f 72 20 6d 6f 72 65 20 74 68 61 6e 20 31 for more than 1 3240: 30 30 20 73 65 63 6f 6e 64 73 2c 20 63 61 6c 6c 00 seconds, call 3250: 20 69 74 20 64 65 61 64 0a 09 09 09 20 20 0a 09 it dead.... .. 3260: 09 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 . (if (not 3270: 28 65 71 75 61 6c 3f 20 63 75 72 72 2d 63 6f 6c (equal? curr-col 3280: 6f 72 20 63 6f 6c 6f 72 29 29 0a 09 09 09 20 20 or color)).... 3290: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 (iup:attribute-s 32a0: 65 74 21 20 62 75 74 74 6f 6e 20 22 42 47 43 4f et! button "BGCO 32b0: 4c 4f 52 22 20 63 6f 6c 6f 72 29 29 0a 09 09 20 LOR" color))... 32c0: 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 65 (if (not (e 32d0: 71 75 61 6c 3f 20 63 75 72 72 2d 74 69 74 6c 65 qual? curr-title 32e0: 20 62 75 74 74 6f 6e 74 78 74 29 29 0a 09 09 09 buttontxt)).... 32f0: 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 (iup:attribute 3300: 2d 73 65 74 21 20 62 75 74 74 6f 6e 20 22 54 49 -set! button "TI 3310: 54 4c 45 22 20 20 20 62 75 74 74 6f 6e 74 78 74 TLE" buttontxt 3320: 29 29 0a 09 09 20 20 20 20 20 20 28 76 65 63 74 ))... (vect 3330: 6f 72 2d 73 65 74 21 20 62 75 74 74 6f 6e 64 61 or-set! buttonda 3340: 74 20 30 20 72 75 6e 2d 69 64 29 0a 09 09 20 20 t 0 run-id)... 3350: 20 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 (vector-set! 3360: 20 62 75 74 74 6f 6e 64 61 74 20 31 20 63 6f 6c buttondat 1 col 3370: 6f 72 29 0a 09 09 20 20 20 20 20 20 28 76 65 63 or)... (vec 3380: 74 6f 72 2d 73 65 74 21 20 62 75 74 74 6f 6e 64 tor-set! buttond 3390: 61 74 20 32 20 62 75 74 74 6f 6e 74 78 74 29 0a at 2 buttontxt). 33a0: 09 09 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d .. (vector- 33b0: 73 65 74 21 20 62 75 74 74 6f 6e 64 61 74 20 33 set! buttondat 3 33c0: 20 74 65 73 74 29 0a 09 09 20 20 20 20 20 20 28 test)... ( 33d0: 76 65 63 74 6f 72 2d 73 65 74 21 20 62 75 74 74 vector-set! butt 33e0: 6f 6e 64 61 74 20 34 20 72 75 6e 2d 6b 65 79 29 ondat 4 run-key) 33f0: 0a 09 09 20 20 20 20 20 20 28 69 66 20 28 6e 6f ... (if (no 3400: 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 t (hash-table-re 3410: 66 2f 64 65 66 61 75 6c 74 20 2a 61 6c 6c 74 65 f/default *allte 3420: 73 74 6e 61 6d 65 73 2a 20 74 65 73 74 66 75 6c stnames* testful 3430: 6c 6e 61 6d 65 20 23 66 29 29 0a 09 09 09 20 20 lname #f)).... 3440: 28 62 65 67 69 6e 0a 09 09 09 20 20 20 20 28 68 (begin.... (h 3450: 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 2a ash-table-set! * 3460: 61 6c 6c 74 65 73 74 6e 61 6d 65 73 2a 20 74 65 alltestnames* te 3470: 73 74 66 75 6c 6c 6e 61 6d 65 20 23 74 29 0a 09 stfullname #t).. 3480: 09 09 20 20 20 20 28 73 65 74 21 20 2a 61 6c 6c .. (set! *all 3490: 74 65 73 74 6e 61 6d 65 6c 73 74 2a 20 28 61 70 testnamelst* (ap 34a0: 70 65 6e 64 20 2a 61 6c 6c 74 65 73 74 6e 61 6d pend *alltestnam 34b0: 65 6c 73 74 2a 20 28 6c 69 73 74 20 74 65 73 74 elst* (list test 34c0: 66 75 6c 6c 6e 61 6d 65 29 29 29 29 29 29 0a 09 fullname)))))).. 34d0: 09 20 20 20 20 29 0a 09 09 28 73 65 74 21 20 72 . )...(set! r 34e0: 6f 77 6e 20 28 2b 20 72 6f 77 6e 20 31 29 29 29 own (+ rown 1))) 34f0: 29 0a 09 20 20 20 20 28 6c 65 74 20 28 28 78 6c ).. (let ((xl 3500: 20 28 69 66 20 28 3e 20 28 6c 65 6e 67 74 68 20 (if (> (length 3510: 74 65 73 74 6e 61 6d 65 73 29 20 2a 73 74 61 72 testnames) *star 3520: 74 2d 74 65 73 74 2d 6f 66 66 73 65 74 2a 29 0a t-test-offset*). 3530: 09 09 09 20 20 28 64 72 6f 70 20 74 65 73 74 6e ... (drop testn 3540: 61 6d 65 73 20 2a 73 74 61 72 74 2d 74 65 73 74 ames *start-test 3550: 2d 6f 66 66 73 65 74 2a 29 0a 09 09 09 20 20 74 -offset*).... t 3560: 65 73 74 6e 61 6d 65 73 29 29 29 0a 09 20 20 20 estnames))).. 3570: 20 20 20 28 61 70 70 65 6e 64 20 78 6c 20 28 6d (append xl (m 3580: 61 6b 65 2d 6c 69 73 74 20 28 2d 20 2a 6e 75 6d ake-list (- *num 3590: 2d 74 65 73 74 73 2a 20 28 6c 65 6e 67 74 68 20 -tests* (length 35a0: 78 6c 29 29 20 22 22 29 29 29 29 29 0a 09 20 28 xl)) ""))))).. ( 35b0: 73 65 74 21 20 63 6f 6c 6e 20 28 2b 20 63 6f 6c set! coln (+ col 35c0: 6e 20 31 29 29 29 29 0a 20 20 20 20 20 72 75 6e n 1)))). run 35d0: 73 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 6d s)))..(define (m 35e0: 6b 73 74 72 20 2e 20 78 29 0a 20 20 28 73 74 72 kstr . x). (str 35f0: 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 ing-intersperse 3600: 28 6d 61 70 20 63 6f 6e 63 20 78 29 20 22 2c 22 (map conc x) "," 3610: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 75 70 64 ))..(define (upd 3620: 61 74 65 2d 73 65 61 72 63 68 20 78 20 76 61 6c ate-search x val 3630: 29 0a 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 53 ). ;; (print "S 3640: 65 74 74 69 6e 67 20 73 65 61 72 63 68 20 66 6f etting search fo 3650: 72 20 22 20 78 20 22 20 74 6f 20 22 20 76 61 6c r " x " to " val 3660: 29 0a 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d ). (hash-table- 3670: 73 65 74 21 20 2a 73 65 61 72 63 68 70 61 74 74 set! *searchpatt 3680: 73 2a 20 78 20 76 61 6c 29 29 0a 0a 28 64 65 66 s* x val))..(def 3690: 69 6e 65 20 28 6d 61 6b 65 2d 64 61 73 68 62 6f ine (make-dashbo 36a0: 61 72 64 2d 62 75 74 74 6f 6e 73 20 6e 72 75 6e ard-buttons nrun 36b0: 73 20 6e 74 65 73 74 73 20 6b 65 79 6e 61 6d 65 s ntests keyname 36c0: 73 29 0a 20 20 28 6c 65 74 2a 20 28 28 6e 6b 65 s). (let* ((nke 36d0: 79 73 20 20 20 28 6c 65 6e 67 74 68 20 6b 65 79 ys (length key 36e0: 6e 61 6d 65 73 29 29 0a 09 20 28 72 75 6e 73 76 names)).. (runsv 36f0: 65 63 20 28 6d 61 6b 65 2d 76 65 63 74 6f 72 20 ec (make-vector 3700: 6e 72 75 6e 73 29 29 0a 09 20 28 68 65 61 64 65 nruns)).. (heade 3710: 72 20 20 28 6d 61 6b 65 2d 76 65 63 74 6f 72 20 r (make-vector 3720: 6e 72 75 6e 73 29 29 0a 09 20 28 6c 66 74 63 6f nruns)).. (lftco 3730: 6c 20 20 28 6d 61 6b 65 2d 76 65 63 74 6f 72 20 l (make-vector 3740: 6e 74 65 73 74 73 29 29 0a 09 20 28 63 6f 6e 74 ntests)).. (cont 3750: 72 6f 6c 73 20 27 28 29 29 0a 09 20 28 6c 66 74 rols '()).. (lft 3760: 6c 73 74 20 20 27 28 29 29 0a 09 20 28 68 64 72 lst '()).. (hdr 3770: 6c 73 74 20 20 27 28 29 29 0a 09 20 28 62 64 79 lst '()).. (bdy 3780: 6c 73 74 20 20 27 28 29 29 0a 09 20 28 72 65 73 lst '()).. (res 3790: 75 6c 74 20 20 27 28 29 29 0a 09 20 28 69 20 20 ult '()).. (i 37a0: 20 20 20 20 20 30 29 29 0a 20 20 20 20 3b 3b 20 0)). ;; 37b0: 63 6f 6e 74 72 6f 6c 73 20 28 61 6c 6f 6e 67 20 controls (along 37c0: 62 6f 74 74 6f 6d 29 0a 20 20 20 20 28 73 65 74 bottom). (set 37d0: 21 20 63 6f 6e 74 72 6f 6c 73 0a 09 20 20 28 69 ! controls.. (i 37e0: 75 70 3a 68 62 6f 78 0a 09 20 20 20 28 69 75 70 up:hbox.. (iup 37f0: 3a 74 65 78 74 62 6f 78 20 23 3a 73 69 7a 65 20 :textbox #:size 3800: 22 36 30 78 31 35 22 20 23 3a 66 6f 6e 74 73 69 "60x15" #:fontsi 3810: 7a 65 20 22 31 30 22 20 23 3a 76 61 6c 75 65 20 ze "10" #:value 3820: 22 25 22 0a 09 09 09 23 3a 61 63 74 69 6f 6e 20 "%"....#:action 3830: 28 6c 61 6d 62 64 61 20 28 6f 62 6a 20 75 6e 6b (lambda (obj unk 3840: 20 76 61 6c 29 0a 09 09 09 09 20 20 20 28 75 70 val)..... (up 3850: 64 61 74 65 2d 73 65 61 72 63 68 20 22 74 65 73 date-search "tes 3860: 74 2d 6e 61 6d 65 22 20 76 61 6c 29 29 29 0a 09 t-name" val))).. 3870: 20 20 20 28 69 75 70 3a 74 65 78 74 62 6f 78 20 (iup:textbox 3880: 23 3a 73 69 7a 65 20 22 36 30 78 31 35 22 20 23 #:size "60x15" # 3890: 3a 66 6f 6e 74 73 69 7a 65 20 22 31 30 22 20 23 :fontsize "10" # 38a0: 3a 76 61 6c 75 65 20 22 25 22 0a 09 09 09 23 3a :value "%"....#: 38b0: 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 action (lambda ( 38c0: 6f 62 6a 20 75 6e 6b 20 76 61 6c 29 0a 09 09 09 obj unk val).... 38d0: 09 20 20 20 28 75 70 64 61 74 65 2d 73 65 61 72 . (update-sear 38e0: 63 68 20 22 69 74 65 6d 2d 6e 61 6d 65 22 20 76 ch "item-name" v 38f0: 61 6c 29 29 29 0a 09 20 20 20 28 69 75 70 3a 62 al))).. (iup:b 3900: 75 74 74 6f 6e 20 22 51 75 69 74 22 20 23 3a 61 utton "Quit" #:a 3910: 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f ction (lambda (o 3920: 62 6a 29 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 bj)(sqlite3:fina 3930: 6c 69 7a 65 21 20 2a 64 62 2a 29 28 65 78 69 74 lize! *db*)(exit 3940: 29 29 29 0a 09 20 20 20 28 69 75 70 3a 62 75 74 ))).. (iup:but 3950: 74 6f 6e 20 22 3c 2d 20 20 4c 65 66 74 22 20 23 ton "<- Left" # 3960: 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 :action (lambda 3970: 28 6f 62 6a 29 28 73 65 74 21 20 2a 73 74 61 72 (obj)(set! *star 3980: 74 2d 72 75 6e 2d 6f 66 66 73 65 74 2a 20 20 28 t-run-offset* ( 3990: 2b 20 2a 73 74 61 72 74 2d 72 75 6e 2d 6f 66 66 + *start-run-off 39a0: 73 65 74 2a 20 31 29 29 29 29 0a 09 20 20 20 28 set* 1)))).. ( 39b0: 69 75 70 3a 62 75 74 74 6f 6e 20 22 55 70 20 20 iup:button "Up 39c0: 20 20 20 5e 22 20 23 3a 61 63 74 69 6f 6e 20 28 ^" #:action ( 39d0: 6c 61 6d 62 64 61 20 28 6f 62 6a 29 28 73 65 74 lambda (obj)(set 39e0: 21 20 2a 73 74 61 72 74 2d 74 65 73 74 2d 6f 66 ! *start-test-of 39f0: 66 73 65 74 2a 20 28 69 66 20 28 3e 20 2a 73 74 fset* (if (> *st 3a00: 61 72 74 2d 74 65 73 74 2d 6f 66 66 73 65 74 2a art-test-offset* 3a10: 20 30 29 28 2d 20 2a 73 74 61 72 74 2d 74 65 73 0)(- *start-tes 3a20: 74 2d 6f 66 66 73 65 74 2a 20 31 29 20 30 29 29 t-offset* 1) 0)) 3a30: 29 29 0a 09 20 20 20 28 69 75 70 3a 62 75 74 74 )).. (iup:butt 3a40: 6f 6e 20 22 44 6f 77 6e 20 20 20 76 22 20 23 3a on "Down v" #: 3a50: 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 action (lambda ( 3a60: 6f 62 6a 29 28 73 65 74 21 20 2a 73 74 61 72 74 obj)(set! *start 3a70: 2d 74 65 73 74 2d 6f 66 66 73 65 74 2a 20 28 69 -test-offset* (i 3a80: 66 20 28 3e 3d 20 2a 73 74 61 72 74 2d 74 65 73 f (>= *start-tes 3a90: 74 2d 6f 66 66 73 65 74 2a 20 28 6c 65 6e 67 74 t-offset* (lengt 3aa0: 68 20 2a 61 6c 6c 74 65 73 74 6e 61 6d 65 6c 73 h *alltestnamels 3ab0: 74 2a 29 29 28 6c 65 6e 67 74 68 20 2a 61 6c 6c t*))(length *all 3ac0: 74 65 73 74 6e 61 6d 65 6c 73 74 2a 29 28 2b 20 testnamelst*)(+ 3ad0: 2a 73 74 61 72 74 2d 74 65 73 74 2d 6f 66 66 73 *start-test-offs 3ae0: 65 74 2a 20 31 29 29 29 29 29 0a 09 20 20 20 28 et* 1))))).. ( 3af0: 69 75 70 3a 62 75 74 74 6f 6e 20 22 52 69 67 68 iup:button "Righ 3b00: 74 20 2d 3e 22 20 23 3a 61 63 74 69 6f 6e 20 28 t ->" #:action ( 3b10: 6c 61 6d 62 64 61 20 28 6f 62 6a 29 28 73 65 74 lambda (obj)(set 3b20: 21 20 2a 73 74 61 72 74 2d 72 75 6e 2d 6f 66 66 ! *start-run-off 3b30: 73 65 74 2a 20 20 28 69 66 20 28 3e 20 2a 73 74 set* (if (> *st 3b40: 61 72 74 2d 72 75 6e 2d 6f 66 66 73 65 74 2a 20 art-run-offset* 3b50: 30 29 28 2d 20 2a 73 74 61 72 74 2d 72 75 6e 2d 0)(- *start-run- 3b60: 6f 66 66 73 65 74 2a 20 31 29 20 30 29 29 29 29 offset* 1) 0)))) 3b70: 29 29 0a 20 20 20 20 0a 20 20 20 20 3b 3b 20 63 )). . ;; c 3b80: 72 65 61 74 65 20 74 68 65 20 6c 65 66 74 20 6d reate the left m 3b90: 6f 73 74 20 63 6f 6c 75 6d 6e 20 66 6f 72 20 74 ost column for t 3ba0: 68 65 20 72 75 6e 20 6b 65 79 20 6e 61 6d 65 73 he run key names 3bb0: 20 61 6e 64 20 74 68 65 20 74 65 73 74 20 6e 61 and the test na 3bc0: 6d 65 73 20 0a 20 20 20 20 28 73 65 74 21 20 6c mes . (set! l 3bd0: 66 74 6c 73 74 20 28 6c 69 73 74 20 28 61 70 70 ftlst (list (app 3be0: 6c 79 20 69 75 70 3a 76 62 6f 78 20 0a 09 09 09 ly iup:vbox .... 3bf0: 20 20 20 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 (map (lamb 3c00: 64 61 20 28 78 29 09 09 0a 09 09 09 09 20 20 20 da (x)....... 3c10: 20 20 28 6c 65 74 20 28 28 72 65 73 20 28 69 75 (let ((res (iu 3c20: 70 3a 68 62 6f 78 0a 09 09 09 09 09 09 20 28 69 p:hbox....... (i 3c30: 75 70 3a 6c 61 62 65 6c 20 78 20 23 3a 73 69 7a up:label x #:siz 3c40: 65 20 22 34 30 78 31 35 22 20 23 3a 66 6f 6e 74 e "40x15" #:font 3c50: 73 69 7a 65 20 22 31 30 22 29 20 3b 3b 20 20 23 size "10") ;; # 3c60: 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e :expand "HORIZON 3c70: 54 41 4c 22 29 0a 09 09 09 09 09 09 20 28 69 75 TAL")....... (iu 3c80: 70 3a 74 65 78 74 62 6f 78 20 23 3a 73 69 7a 65 p:textbox #:size 3c90: 20 22 36 30 78 31 35 22 20 23 3a 66 6f 6e 74 73 "60x15" #:fonts 3ca0: 69 7a 65 20 22 31 30 22 20 23 3a 76 61 6c 75 65 ize "10" #:value 3cb0: 20 22 25 22 20 3b 3b 20 23 3a 65 78 70 61 6e 64 "%" ;; #:expand 3cc0: 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 0a 09 09 "HORIZONTAL"... 3cd0: 09 09 09 09 09 20 20 20 20 20 20 23 3a 61 63 74 ..... #:act 3ce0: 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a ion (lambda (obj 3cf0: 20 75 6e 6b 20 76 61 6c 29 0a 09 09 09 09 09 09 unk val)....... 3d00: 09 09 09 20 28 75 70 64 61 74 65 2d 73 65 61 72 ... (update-sear 3d10: 63 68 20 78 20 76 61 6c 29 29 29 29 29 29 0a 09 ch x val)))))).. 3d20: 09 09 09 20 20 20 20 20 20 20 28 73 65 74 21 20 ... (set! 3d30: 69 20 28 2b 20 69 20 31 29 29 0a 09 09 09 09 20 i (+ i 1))..... 3d40: 20 20 20 20 20 20 72 65 73 29 29 0a 09 09 09 09 res))..... 3d50: 20 20 20 6b 65 79 6e 61 6d 65 73 29 29 29 29 0a keynames)))). 3d60: 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 (let loop (( 3d70: 74 65 73 74 6e 75 6d 20 20 30 29 0a 09 20 20 20 testnum 0).. 3d80: 20 20 20 20 28 72 65 73 20 20 20 20 20 20 27 28 (res '( 3d90: 29 29 29 0a 20 20 20 20 20 20 28 63 6f 6e 64 0a ))). (cond. 3da0: 20 20 20 20 20 20 20 28 28 3e 3d 20 74 65 73 74 ((>= test 3db0: 6e 75 6d 20 6e 74 65 73 74 73 29 0a 09 3b 3b 20 num ntests)..;; 3dc0: 6e 6f 77 20 6c 66 74 6c 73 74 20 77 69 6c 6c 20 now lftlst will 3dd0: 62 65 20 61 6e 20 68 62 6f 78 20 77 69 74 68 20 be an hbox with 3de0: 74 68 65 20 74 65 73 74 20 6b 65 79 73 20 61 6e the test keys an 3df0: 64 20 74 68 65 20 74 65 73 74 20 6e 61 6d 65 20 d the test name 3e00: 6c 61 62 65 6c 73 0a 09 28 73 65 74 21 20 6c 66 labels..(set! lf 3e10: 74 6c 73 74 20 28 61 70 70 65 6e 64 20 6c 66 74 tlst (append lft 3e20: 6c 73 74 20 28 6c 69 73 74 20 28 61 70 70 6c 79 lst (list (apply 3e30: 20 69 75 70 3a 76 62 6f 78 20 28 72 65 76 65 72 iup:vbox (rever 3e40: 73 65 20 72 65 73 29 29 29 29 29 29 0a 20 20 20 se res)))))). 3e50: 20 20 20 20 28 65 6c 73 65 0a 09 28 6c 65 74 20 (else..(let 3e60: 28 28 6c 61 62 6c 20 20 28 69 75 70 3a 62 75 74 ((labl (iup:but 3e70: 74 6f 6e 20 22 22 20 23 3a 66 6c 61 74 20 22 59 ton "" #:flat "Y 3e80: 45 53 22 20 23 3a 73 69 7a 65 20 22 31 30 30 78 ES" #:size "100x 3e90: 31 35 22 20 23 3a 66 6f 6e 74 73 69 7a 65 20 22 15" #:fontsize " 3ea0: 31 30 22 29 29 29 0a 09 20 20 28 76 65 63 74 6f 10"))).. (vecto 3eb0: 72 2d 73 65 74 21 20 6c 66 74 63 6f 6c 20 74 65 r-set! lftcol te 3ec0: 73 74 6e 75 6d 20 6c 61 62 6c 29 0a 09 20 20 28 stnum labl).. ( 3ed0: 6c 6f 6f 70 20 28 2b 20 74 65 73 74 6e 75 6d 20 loop (+ testnum 3ee0: 31 29 28 63 6f 6e 73 20 6c 61 62 6c 20 72 65 73 1)(cons labl res 3ef0: 29 29 29 29 29 29 0a 20 20 20 20 3b 3b 20 0a 20 )))))). ;; . 3f00: 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 72 (let loop ((r 3f10: 75 6e 6e 75 6d 20 20 30 29 0a 09 20 20 20 20 20 unnum 0).. 3f20: 20 20 28 6b 65 79 6e 75 6d 20 20 30 29 0a 09 20 (keynum 0).. 3f30: 20 20 20 20 20 20 28 6b 65 79 76 65 63 20 20 28 (keyvec ( 3f40: 6d 61 6b 65 2d 76 65 63 74 6f 72 20 6e 6b 65 79 make-vector nkey 3f50: 73 29 29 0a 09 20 20 20 20 20 20 20 28 72 65 73 s)).. (res 3f60: 20 20 20 20 27 28 29 29 29 0a 20 20 20 20 20 20 '())). 3f70: 28 63 6f 6e 64 20 3b 3b 20 6e 62 2f 2f 20 6e 6f (cond ;; nb// no 3f80: 20 65 6c 73 65 20 66 6f 72 20 74 68 69 73 20 61 else for this a 3f90: 70 70 72 6f 61 63 68 2e 0a 20 20 20 20 20 20 20 pproach.. 3fa0: 28 28 3e 3d 20 72 75 6e 6e 75 6d 20 6e 72 75 6e ((>= runnum nrun 3fb0: 73 29 20 23 66 29 0a 20 20 20 20 20 20 20 28 28 s) #f). (( 3fc0: 3e 3d 20 6b 65 79 6e 75 6d 20 6e 6b 65 79 73 29 >= keynum nkeys) 3fd0: 20 0a 09 28 76 65 63 74 6f 72 2d 73 65 74 21 20 ..(vector-set! 3fe0: 68 65 61 64 65 72 20 72 75 6e 6e 75 6d 20 6b 65 header runnum ke 3ff0: 79 76 65 63 29 0a 09 28 73 65 74 21 20 68 64 72 yvec)..(set! hdr 4000: 6c 73 74 20 28 63 6f 6e 73 20 28 61 70 70 6c 79 lst (cons (apply 4010: 20 69 75 70 3a 76 62 6f 78 20 28 72 65 76 65 72 iup:vbox (rever 4020: 73 65 20 72 65 73 29 29 20 68 64 72 6c 73 74 29 se res)) hdrlst) 4030: 29 0a 09 28 6c 6f 6f 70 20 28 2b 20 72 75 6e 6e )..(loop (+ runn 4040: 75 6d 20 31 29 20 30 20 28 6d 61 6b 65 2d 76 65 um 1) 0 (make-ve 4050: 63 74 6f 72 20 6e 6b 65 79 73 29 20 27 28 29 29 ctor nkeys) '()) 4060: 29 0a 20 20 20 20 20 20 20 28 65 6c 73 65 0a 09 ). (else.. 4070: 28 6c 65 74 20 28 28 6c 61 62 6c 20 20 28 69 75 (let ((labl (iu 4080: 70 3a 6c 61 62 65 6c 20 22 22 20 23 3a 73 69 7a p:label "" #:siz 4090: 65 20 22 36 30 78 31 35 22 20 23 3a 66 6f 6e 74 e "60x15" #:font 40a0: 73 69 7a 65 20 22 31 30 22 20 3b 3b 20 23 3a 65 size "10" ;; #:e 40b0: 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 xpand "HORIZONTA 40c0: 4c 22 0a 09 09 09 09 29 29 29 0a 09 20 20 28 76 L".....))).. (v 40d0: 65 63 74 6f 72 2d 73 65 74 21 20 6b 65 79 76 65 ector-set! keyve 40e0: 63 20 6b 65 79 6e 75 6d 20 6c 61 62 6c 29 0a 09 c keynum labl).. 40f0: 20 20 28 6c 6f 6f 70 20 72 75 6e 6e 75 6d 20 28 (loop runnum ( 4100: 2b 20 6b 65 79 6e 75 6d 20 31 29 20 6b 65 79 76 + keynum 1) keyv 4110: 65 63 20 28 63 6f 6e 73 20 6c 61 62 6c 20 72 65 ec (cons labl re 4120: 73 29 29 29 29 29 29 0a 20 20 20 20 3b 3b 20 42 s)))))). ;; B 4130: 79 20 68 65 72 65 20 74 68 65 20 68 64 72 6c 73 y here the hdrls 4140: 74 20 63 6f 6e 74 61 69 6e 73 20 61 20 6c 69 73 t contains a lis 4150: 74 20 6f 66 20 76 62 6f 78 65 73 20 63 6f 6e 74 t of vboxes cont 4160: 61 69 6e 69 6e 67 20 6e 6b 65 79 73 20 6c 61 62 aining nkeys lab 4170: 65 6c 73 0a 20 20 20 20 28 6c 65 74 20 6c 6f 6f els. (let loo 4180: 70 20 28 28 72 75 6e 6e 75 6d 20 20 30 29 0a 09 p ((runnum 0).. 4190: 20 20 20 20 20 20 20 28 74 65 73 74 6e 75 6d 20 (testnum 41a0: 30 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 0).. (test 41b0: 76 65 63 20 20 28 6d 61 6b 65 2d 76 65 63 74 6f vec (make-vecto 41c0: 72 20 6e 74 65 73 74 73 29 29 0a 09 20 20 20 20 r ntests)).. 41d0: 20 20 20 28 72 65 73 20 20 20 20 27 28 29 29 29 (res '())) 41e0: 0a 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 . (cond. 41f0: 20 20 20 20 28 28 3e 3d 20 72 75 6e 6e 75 6d 20 ((>= runnum 4200: 6e 72 75 6e 73 29 20 23 66 29 20 3b 3b 20 20 28 nruns) #f) ;; ( 4210: 76 65 63 74 6f 72 20 74 61 62 6c 65 68 65 61 64 vector tablehead 4220: 65 72 20 72 75 6e 73 76 65 63 29 29 0a 20 20 20 er runsvec)). 4230: 20 20 20 20 28 28 3e 3d 20 74 65 73 74 6e 75 6d ((>= testnum 4240: 20 6e 74 65 73 74 73 29 20 0a 09 28 76 65 63 74 ntests) ..(vect 4250: 6f 72 2d 73 65 74 21 20 72 75 6e 73 76 65 63 20 or-set! runsvec 4260: 72 75 6e 6e 75 6d 20 74 65 73 74 76 65 63 29 0a runnum testvec). 4270: 09 28 73 65 74 21 20 62 64 79 6c 73 74 20 28 63 .(set! bdylst (c 4280: 6f 6e 73 20 28 61 70 70 6c 79 20 69 75 70 3a 76 ons (apply iup:v 4290: 62 6f 78 20 28 72 65 76 65 72 73 65 20 72 65 73 box (reverse res 42a0: 29 29 20 62 64 79 6c 73 74 29 29 0a 09 28 6c 6f )) bdylst))..(lo 42b0: 6f 70 20 28 2b 20 72 75 6e 6e 75 6d 20 31 29 20 op (+ runnum 1) 42c0: 30 20 28 6d 61 6b 65 2d 76 65 63 74 6f 72 20 6e 0 (make-vector n 42d0: 74 65 73 74 73 29 20 27 28 29 29 29 0a 20 20 20 tests) '())). 42e0: 20 20 20 20 28 65 6c 73 65 0a 09 28 6c 65 74 2a (else..(let* 42f0: 20 28 28 62 75 74 74 6f 6e 2d 6b 65 79 20 28 6d ((button-key (m 4300: 6b 73 74 72 20 72 75 6e 6e 75 6d 20 74 65 73 74 kstr runnum test 4310: 6e 75 6d 29 29 0a 09 20 20 20 20 20 20 20 28 62 num)).. (b 4320: 75 74 6e 20 20 20 20 20 20 20 28 69 75 70 3a 62 utn (iup:b 4330: 75 74 74 6f 6e 20 22 22 20 3b 3b 20 62 75 74 74 utton "" ;; butt 4340: 6f 6e 2d 6b 65 79 20 0a 09 09 09 09 20 20 20 20 on-key ..... 4350: 20 20 20 23 3a 73 69 7a 65 20 22 36 30 78 31 35 #:size "60x15 4360: 22 20 0a 09 09 09 09 20 20 20 20 20 20 20 3b 3b " ..... ;; 4370: 20 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a #:expand "HORIZ 4380: 4f 4e 54 41 4c 22 0a 09 09 09 09 20 20 20 20 20 ONTAL"..... 4390: 20 20 23 3a 66 6f 6e 74 73 69 7a 65 20 22 31 30 #:fontsize "10 43a0: 22 20 0a 09 09 09 09 20 20 20 20 20 20 20 23 3a " ..... #: 43b0: 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 action (lambda ( 43c0: 78 29 0a 09 09 09 09 09 09 20 20 28 65 78 61 6d x)....... (exam 43d0: 69 6e 65 2d 74 65 73 74 20 62 75 74 74 6f 6e 2d ine-test button- 43e0: 6b 65 79 29 29 29 29 29 0a 09 20 20 28 68 61 73 key))))).. (has 43f0: 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 2a 62 75 h-table-set! *bu 4400: 74 74 6f 6e 64 61 74 2a 20 62 75 74 74 6f 6e 2d ttondat* button- 4410: 6b 65 79 20 28 76 65 63 74 6f 72 20 30 20 22 31 key (vector 0 "1 4420: 30 30 20 31 30 30 20 31 30 30 22 20 62 75 74 74 00 100 100" butt 4430: 6f 6e 2d 6b 65 79 20 23 66 20 23 66 29 29 20 0a on-key #f #f)) . 4440: 09 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 . (vector-set! 4450: 74 65 73 74 76 65 63 20 74 65 73 74 6e 75 6d 20 testvec testnum 4460: 62 75 74 6e 29 0a 09 20 20 28 6c 6f 6f 70 20 72 butn).. (loop r 4470: 75 6e 6e 75 6d 20 28 2b 20 74 65 73 74 6e 75 6d unnum (+ testnum 4480: 20 31 29 20 74 65 73 74 76 65 63 20 28 63 6f 6e 1) testvec (con 4490: 73 20 62 75 74 6e 20 72 65 73 29 29 29 29 29 29 s butn res)))))) 44a0: 0a 20 20 20 20 3b 3b 20 6e 6f 77 20 61 73 73 65 . ;; now asse 44b0: 6d 62 6c 65 20 74 68 65 20 68 64 72 6c 73 74 20 mble the hdrlst 44c0: 61 6e 64 20 62 64 79 6c 73 74 20 61 6e 64 20 6b and bdylst and k 44d0: 69 63 6b 20 6f 66 66 20 74 68 65 20 64 69 61 6c ick off the dial 44e0: 6f 67 0a 20 20 20 20 28 69 75 70 3a 73 68 6f 77 og. (iup:show 44f0: 0a 20 20 20 20 20 28 69 75 70 3a 64 69 61 6c 6f . (iup:dialo 4500: 67 20 0a 20 20 20 20 20 20 23 3a 74 69 74 6c 65 g . #:title 4510: 20 22 4d 65 67 61 74 65 73 74 20 64 61 73 68 62 "Megatest dashb 4520: 6f 61 72 64 22 0a 20 20 20 20 20 20 28 69 75 70 oard". (iup 4530: 3a 76 62 6f 78 0a 09 28 61 70 70 6c 79 20 69 75 :vbox..(apply iu 4540: 70 3a 68 62 6f 78 20 0a 09 20 20 20 20 20 20 20 p:hbox .. 4550: 28 63 6f 6e 73 20 28 61 70 70 6c 79 20 69 75 70 (cons (apply iup 4560: 3a 76 62 6f 78 20 6c 66 74 6c 73 74 29 0a 09 09 :vbox lftlst)... 4570: 20 20 20 20 20 28 6c 69 73 74 20 0a 09 09 20 20 (list ... 4580: 20 20 20 20 28 69 75 70 3a 76 62 6f 78 0a 09 09 (iup:vbox... 4590: 20 20 20 20 20 20 20 3b 3b 20 74 68 65 20 68 65 ;; the he 45a0: 61 64 65 72 0a 09 09 20 20 20 20 20 20 20 28 61 ader... (a 45b0: 70 70 6c 79 20 69 75 70 3a 68 62 6f 78 20 28 72 pply iup:hbox (r 45c0: 65 76 65 72 73 65 20 68 64 72 6c 73 74 29 29 0a everse hdrlst)). 45d0: 09 09 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 .. (apply 45e0: 69 75 70 3a 68 62 6f 78 20 28 72 65 76 65 72 73 iup:hbox (revers 45f0: 65 20 62 64 79 6c 73 74 29 29 29 29 29 29 0a 20 e bdylst)))))). 4600: 20 20 20 20 20 20 63 6f 6e 74 72 6f 6c 73 29 29 controls)) 4610: 29 0a 20 20 20 20 28 76 65 63 74 6f 72 20 6c 66 ). (vector lf 4620: 74 63 6f 6c 20 68 65 61 64 65 72 20 72 75 6e 73 tcol header runs 4630: 76 65 63 29 29 29 0a 0a 28 73 65 74 21 20 2a 6e vec)))..(set! *n 4640: 75 6d 2d 74 65 73 74 73 2a 20 28 6d 69 6e 20 28 um-tests* (min ( 4650: 6d 61 78 20 28 75 70 64 61 74 65 2d 72 75 6e 64 max (update-rund 4660: 61 74 20 22 25 22 20 2a 6e 75 6d 2d 72 75 6e 73 at "%" *num-runs 4670: 2a 20 22 25 22 20 22 25 22 29 20 38 29 20 32 30 * "%" "%") 8) 20 4680: 29 29 0a 0a 28 73 65 74 21 20 75 69 64 61 74 20 ))..(set! uidat 4690: 28 6d 61 6b 65 2d 64 61 73 68 62 6f 61 72 64 2d (make-dashboard- 46a0: 62 75 74 74 6f 6e 73 20 2a 6e 75 6d 2d 72 75 6e buttons *num-run 46b0: 73 2a 20 2a 6e 75 6d 2d 74 65 73 74 73 2a 20 64 s* *num-tests* d 46c0: 62 6b 65 79 73 29 29 0a 3b 3b 20 28 6d 65 67 61 bkeys)).;; (mega 46d0: 74 65 73 74 2d 64 61 73 68 62 6f 61 72 64 29 0a test-dashboard). 46e0: 0a 28 64 65 66 69 6e 65 20 28 72 75 6e 2d 75 70 .(define (run-up 46f0: 64 61 74 65 20 6f 74 68 65 72 2d 74 68 72 65 61 date other-threa 4700: 64 29 0a 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 d). (let loop ( 4710: 28 69 20 30 29 29 0a 20 20 20 20 28 74 68 72 65 (i 0)). (thre 4720: 61 64 2d 73 6c 65 65 70 21 20 30 2e 31 29 0a 20 ad-sleep! 0.1). 4730: 20 20 20 28 74 68 72 65 61 64 2d 73 75 73 70 65 (thread-suspe 4740: 6e 64 21 20 6f 74 68 65 72 2d 74 68 72 65 61 64 nd! other-thread 4750: 29 0a 20 20 20 20 28 75 70 64 61 74 65 2d 62 75 ). (update-bu 4760: 74 74 6f 6e 73 20 75 69 64 61 74 20 2a 6e 75 6d ttons uidat *num 4770: 2d 72 75 6e 73 2a 20 2a 6e 75 6d 2d 74 65 73 74 -runs* *num-test 4780: 73 2a 29 0a 20 20 20 20 28 75 70 64 61 74 65 2d s*). (update- 4790: 72 75 6e 64 61 74 20 28 68 61 73 68 2d 74 61 62 rundat (hash-tab 47a0: 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 2a le-ref/default * 47b0: 73 65 61 72 63 68 70 61 74 74 73 2a 20 22 72 75 searchpatts* "ru 47c0: 6e 6e 61 6d 65 22 20 22 25 22 29 20 2a 6e 75 6d nname" "%") *num 47d0: 2d 72 75 6e 73 2a 0a 09 09 20 20 20 28 68 61 73 -runs*... (has 47e0: 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 h-table-ref/defa 47f0: 75 6c 74 20 2a 73 65 61 72 63 68 70 61 74 74 73 ult *searchpatts 4800: 2a 20 22 74 65 73 74 2d 6e 61 6d 65 22 20 22 25 * "test-name" "% 4810: 22 29 0a 09 09 20 20 20 28 68 61 73 68 2d 74 61 ")... (hash-ta 4820: 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 ble-ref/default 4830: 2a 73 65 61 72 63 68 70 61 74 74 73 2a 20 22 69 *searchpatts* "i 4840: 74 65 6d 2d 6e 61 6d 65 22 20 22 25 22 29 29 0a tem-name" "%")). 4850: 20 20 20 20 28 74 68 72 65 61 64 2d 72 65 73 75 (thread-resu 4860: 6d 65 21 20 6f 74 68 65 72 2d 74 68 72 65 61 64 me! other-thread 4870: 29 0a 20 20 20 20 28 6c 6f 6f 70 20 28 2b 20 69 ). (loop (+ i 4880: 20 31 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 1))))..(define 4890: 74 68 32 20 28 6d 61 6b 65 2d 74 68 72 65 61 64 th2 (make-thread 48a0: 20 69 75 70 3a 6d 61 69 6e 2d 6c 6f 6f 70 29 29 iup:main-loop)) 48b0: 0a 28 64 65 66 69 6e 65 20 74 68 31 20 28 6d 61 .(define th1 (ma 48c0: 6b 65 2d 74 68 72 65 61 64 20 28 72 75 6e 2d 75 ke-thread (run-u 48d0: 70 64 61 74 65 20 74 68 32 29 29 29 0a 28 74 68 pdate th2))).(th 48e0: 72 65 61 64 2d 73 74 61 72 74 21 20 74 68 31 29 read-start! th1) 48f0: 0a 28 74 68 72 65 61 64 2d 73 74 61 72 74 21 20 .(thread-start! 4900: 74 68 32 29 0a 28 74 68 72 65 61 64 2d 6a 6f 69 th2).(thread-joi 4910: 6e 21 20 74 68 32 29 0a n! th2).