Artifact d72b4fee0f77d68fc9a5b05b918f83f53bccebfe:
- File dashboard.scm — part of check-in [c075ebd51b] at 2011-06-15 18:11:59 on branch trunk — Added -keepgoing, removed the calls to run-queue, fixes to job limits, -runstep, and killreq (now will do signal/kill after first trying signal/term) (user: mrwellan size: 18705)
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 2e 2e 2e 22 20 23 3a 65 78 70 61 6e 64 20 ....." #:expand 1ad0: 22 59 45 53 22 29 29 29 0a 09 09 20 20 20 20 20 "YES")))... 1ae0: 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 (hash-table-set! 1af0: 20 77 69 64 67 65 74 73 20 22 54 65 73 74 20 53 widgets "Test S 1b00: 74 65 70 73 22 20 73 74 65 70 73 64 61 74 29 0a teps" stepsdat). 1b10: 09 09 20 20 20 20 20 73 74 65 70 73 64 61 74 29 .. stepsdat) 1b20: 0a 09 09 20 20 20 29 29 29 29 0a 09 20 20 28 69 ... )))).. (i 1b30: 75 70 3a 73 68 6f 77 20 73 65 6c 66 29 0a 09 20 up:show self).. 1b40: 20 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 ))))..(define ( 1b50: 63 6f 6c 6f 72 73 2d 73 69 6d 69 6c 61 72 3f 20 colors-similar? 1b60: 63 6f 6c 6f 72 31 20 63 6f 6c 6f 72 32 29 0a 20 color1 color2). 1b70: 20 28 6c 65 74 2a 20 28 28 63 31 20 28 6d 61 70 (let* ((c1 (map 1b80: 20 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 string->number 1b90: 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 63 6f (string-split co 1ba0: 6c 6f 72 31 29 29 29 0a 09 20 28 63 32 20 28 6d lor1))).. (c2 (m 1bb0: 61 70 20 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 ap string->numbe 1bc0: 72 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 r (string-split 1bd0: 63 6f 6c 6f 72 32 29 29 29 0a 09 20 28 64 65 6c color2))).. (del 1be0: 74 61 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 ta (map (lambda 1bf0: 28 61 20 62 29 28 61 62 73 20 28 2d 20 61 20 62 (a b)(abs (- a b 1c00: 29 29 29 20 63 31 20 63 32 29 29 29 0a 20 20 20 ))) c1 c2))). 1c10: 20 28 6e 75 6c 6c 3f 20 28 66 69 6c 74 65 72 20 (null? (filter 1c20: 28 6c 61 6d 62 64 61 20 28 78 29 28 3e 20 78 20 (lambda (x)(> x 1c30: 33 29 29 20 64 65 6c 74 61 29 29 29 29 0a 0a 28 3)) delta))))..( 1c40: 64 65 66 69 6e 65 20 28 75 70 64 61 74 65 2d 72 define (update-r 1c50: 75 6e 64 61 74 20 72 75 6e 6e 61 6d 65 70 61 74 undat runnamepat 1c60: 74 20 6e 75 6d 72 75 6e 73 20 74 65 73 74 6e 61 t numruns testna 1c70: 6d 65 70 61 74 74 20 69 74 65 6d 6e 61 6d 65 70 mepatt itemnamep 1c80: 61 74 74 29 0a 20 20 28 6c 65 74 2a 20 28 28 61 att). (let* ((a 1c90: 6c 6c 72 75 6e 73 20 20 20 20 20 28 64 62 2d 67 llruns (db-g 1ca0: 65 74 2d 72 75 6e 73 20 2a 64 62 2a 20 72 75 6e et-runs *db* run 1cb0: 6e 61 6d 65 70 61 74 74 20 6e 75 6d 72 75 6e 73 namepatt numruns 1cc0: 20 2a 73 74 61 72 74 2d 72 75 6e 2d 6f 66 66 73 *start-run-offs 1cd0: 65 74 2a 29 29 0a 09 20 28 68 65 61 64 65 72 20 et*)).. (header 1ce0: 20 20 20 20 20 28 64 62 3a 67 65 74 2d 68 65 61 (db:get-hea 1cf0: 64 65 72 20 61 6c 6c 72 75 6e 73 29 29 0a 09 20 der allruns)).. 1d00: 28 72 75 6e 73 20 20 20 20 20 20 20 20 28 64 62 (runs (db 1d10: 3a 67 65 74 2d 72 6f 77 73 20 20 20 61 6c 6c 72 :get-rows allr 1d20: 75 6e 73 29 29 0a 09 20 28 72 65 73 75 6c 74 20 uns)).. (result 1d30: 20 20 20 20 20 27 28 29 29 0a 09 20 28 6d 61 78 '()).. (max 1d40: 74 65 73 74 73 20 20 20 20 30 29 29 0a 20 20 20 tests 0)). 1d50: 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 (for-each (lamb 1d60: 64 61 20 28 72 75 6e 29 0a 09 09 28 6c 65 74 2a da (run)...(let* 1d70: 20 28 28 72 75 6e 2d 69 64 20 20 20 28 64 62 2d ((run-id (db- 1d80: 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 get-value-by-hea 1d90: 64 65 72 20 72 75 6e 20 68 65 61 64 65 72 20 22 der run header " 1da0: 69 64 22 29 29 0a 09 09 20 20 20 20 20 20 20 28 id"))... ( 1db0: 74 65 73 74 73 20 20 20 20 28 64 62 2d 67 65 74 tests (db-get 1dc0: 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e 20 2a -tests-for-run * 1dd0: 64 62 2a 20 72 75 6e 2d 69 64 20 74 65 73 74 6e db* run-id testn 1de0: 61 6d 65 70 61 74 74 20 69 74 65 6d 6e 61 6d 65 amepatt itemname 1df0: 70 61 74 74 29 29 0a 09 09 20 20 20 20 20 20 20 patt))... 1e00: 28 6b 65 79 2d 76 61 6c 73 20 28 67 65 74 2d 6b (key-vals (get-k 1e10: 65 79 2d 76 61 6c 73 20 2a 64 62 2a 20 72 75 6e ey-vals *db* run 1e20: 2d 69 64 29 29 29 0a 09 09 20 20 28 69 66 20 28 -id)))... (if ( 1e30: 3e 20 28 6c 65 6e 67 74 68 20 74 65 73 74 73 29 > (length tests) 1e40: 20 6d 61 78 74 65 73 74 73 29 0a 09 09 20 20 20 maxtests)... 1e50: 20 20 20 28 73 65 74 21 20 6d 61 78 74 65 73 74 (set! maxtest 1e60: 73 20 28 6c 65 6e 67 74 68 20 74 65 73 74 73 29 s (length tests) 1e70: 29 29 0a 09 09 20 20 28 73 65 74 21 20 72 65 73 ))... (set! res 1e80: 75 6c 74 20 28 63 6f 6e 73 20 28 76 65 63 74 6f ult (cons (vecto 1e90: 72 20 72 75 6e 20 74 65 73 74 73 20 6b 65 79 2d r run tests key- 1ea0: 76 61 6c 73 29 20 72 65 73 75 6c 74 29 29 29 29 vals) result)))) 1eb0: 0a 09 20 20 20 20 20 20 72 75 6e 73 29 0a 20 20 .. runs). 1ec0: 20 20 28 73 65 74 21 20 2a 68 65 61 64 65 72 2a (set! *header* 1ed0: 20 20 68 65 61 64 65 72 29 0a 20 20 20 20 28 73 header). (s 1ee0: 65 74 21 20 2a 61 6c 6c 72 75 6e 73 2a 20 72 65 et! *allruns* re 1ef0: 73 75 6c 74 29 0a 20 20 20 20 6d 61 78 74 65 73 sult). maxtes 1f00: 74 73 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 75 ts))..(define (u 1f10: 70 64 61 74 65 2d 6c 61 62 65 6c 73 20 75 69 64 pdate-labels uid 1f20: 61 74 29 0a 20 20 28 6c 65 74 2a 20 28 28 72 6f at). (let* ((ro 1f30: 77 6e 20 20 20 20 30 29 0a 09 20 28 6c 66 74 63 wn 0).. (lftc 1f40: 6f 6c 20 28 76 65 63 74 6f 72 2d 72 65 66 20 75 ol (vector-ref u 1f50: 69 64 61 74 20 30 29 29 0a 09 20 28 6d 61 78 6e idat 0)).. (maxn 1f60: 20 20 20 28 2d 20 28 76 65 63 74 6f 72 2d 6c 65 (- (vector-le 1f70: 6e 67 74 68 20 6c 66 74 63 6f 6c 29 20 31 29 29 ngth lftcol) 1)) 1f80: 29 0a 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 ). (let loop 1f90: 28 28 69 20 30 29 29 0a 20 20 20 20 20 20 28 69 ((i 0)). (i 1fa0: 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 up:attribute-set 1fb0: 21 20 28 76 65 63 74 6f 72 2d 72 65 66 20 6c 66 ! (vector-ref lf 1fc0: 74 63 6f 6c 20 69 29 20 22 54 49 54 4c 45 22 20 tcol i) "TITLE" 1fd0: 22 22 29 0a 20 20 20 20 20 20 28 69 66 20 28 3c ""). (if (< 1fe0: 20 69 20 6d 61 78 6e 29 0a 09 20 20 28 6c 6f 6f i maxn).. (loo 1ff0: 70 20 28 2b 20 69 20 31 29 29 29 29 0a 20 20 20 p (+ i 1)))). 2000: 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 (for-each (lamb 2010: 64 61 20 28 6e 61 6d 65 29 0a 09 09 28 69 66 20 da (name)...(if 2020: 28 3c 3d 20 72 6f 77 6e 20 6d 61 78 6e 29 0a 09 (<= rown maxn).. 2030: 09 20 20 20 20 28 6c 65 74 20 28 28 6c 61 62 6c . (let ((labl 2040: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 6c 66 74 (vector-ref lft 2050: 63 6f 6c 20 72 6f 77 6e 29 29 29 0a 09 09 20 20 col rown)))... 2060: 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 (iup:attribu 2070: 74 65 2d 73 65 74 21 20 6c 61 62 6c 20 22 54 49 te-set! labl "TI 2080: 54 4c 45 22 20 6e 61 6d 65 29 29 29 0a 09 09 28 TLE" name)))...( 2090: 73 65 74 21 20 72 6f 77 6e 20 28 2b 20 31 20 72 set! rown (+ 1 r 20a0: 6f 77 6e 29 29 29 0a 09 20 20 20 20 20 20 28 64 own))).. (d 20b0: 72 6f 70 20 2a 61 6c 6c 74 65 73 74 6e 61 6d 65 rop *alltestname 20c0: 6c 73 74 2a 20 2a 73 74 61 72 74 2d 74 65 73 74 lst* *start-test 20d0: 2d 6f 66 66 73 65 74 2a 29 29 29 29 0a 0a 28 64 -offset*))))..(d 20e0: 65 66 69 6e 65 20 28 75 70 64 61 74 65 2d 62 75 efine (update-bu 20f0: 74 74 6f 6e 73 20 75 69 64 61 74 20 6e 75 6d 72 ttons uidat numr 2100: 75 6e 73 20 6e 75 6d 74 65 73 74 73 29 0a 20 20 uns numtests). 2110: 28 6c 65 74 2a 20 28 28 72 75 6e 73 20 20 20 20 (let* ((runs 2120: 20 20 20 20 28 69 66 20 28 3e 20 28 6c 65 6e 67 (if (> (leng 2130: 74 68 20 2a 61 6c 6c 72 75 6e 73 2a 29 20 6e 75 th *allruns*) nu 2140: 6d 72 75 6e 73 29 0a 09 09 09 20 20 28 74 61 6b mruns).... (tak 2150: 65 2d 72 69 67 68 74 20 2a 61 6c 6c 72 75 6e 73 e-right *allruns 2160: 2a 20 6e 75 6d 72 75 6e 73 29 0a 09 09 09 20 20 * numruns).... 2170: 28 70 61 64 2d 6c 69 73 74 20 2a 61 6c 6c 72 75 (pad-list *allru 2180: 6e 73 2a 20 6e 75 6d 72 75 6e 73 29 29 29 0a 09 ns* numruns))).. 2190: 20 28 6c 66 74 63 6f 6c 20 20 20 20 20 20 28 76 (lftcol (v 21a0: 65 63 74 6f 72 2d 72 65 66 20 75 69 64 61 74 20 ector-ref uidat 21b0: 30 29 29 0a 09 20 28 74 61 62 6c 65 68 65 61 64 0)).. (tablehead 21c0: 65 72 20 28 76 65 63 74 6f 72 2d 72 65 66 20 75 er (vector-ref u 21d0: 69 64 61 74 20 31 29 29 0a 09 20 28 74 61 62 6c idat 1)).. (tabl 21e0: 65 20 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d e (vector- 21f0: 72 65 66 20 75 69 64 61 74 20 32 29 29 0a 09 20 ref uidat 2)).. 2200: 28 63 6f 6c 6e 20 20 20 20 20 20 20 20 30 29 29 (coln 0)) 2210: 0a 20 20 20 20 28 75 70 64 61 74 65 2d 6c 61 62 . (update-lab 2220: 65 6c 73 20 75 69 64 61 74 29 0a 20 20 20 20 28 els uidat). ( 2230: 66 6f 72 2d 65 61 63 68 20 0a 20 20 20 20 20 28 for-each . ( 2240: 6c 61 6d 62 64 61 20 28 70 6f 70 75 70 29 0a 20 lambda (popup). 2250: 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 74 65 (let* ((te 2260: 73 74 2d 69 64 20 20 28 63 61 72 20 70 6f 70 75 st-id (car popu 2270: 70 29 29 0a 09 20 20 20 20 20 20 28 77 69 64 67 p)).. (widg 2280: 65 74 73 20 20 28 68 61 73 68 2d 74 61 62 6c 65 ets (hash-table 2290: 2d 72 65 66 20 2a 65 78 61 6d 69 6e 65 2d 74 65 -ref *examine-te 22a0: 73 74 2d 64 61 74 2a 20 70 6f 70 75 70 29 29 0a st-dat* popup)). 22b0: 09 20 20 20 20 20 20 28 73 74 65 70 73 6c 62 6c . (stepslbl 22c0: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref 22d0: 2f 64 65 66 61 75 6c 74 20 77 69 64 67 65 74 73 /default widgets 22e0: 20 22 54 65 73 74 20 53 74 65 70 73 22 20 23 66 "Test Steps" #f 22f0: 29 29 29 0a 09 20 28 69 66 20 73 74 65 70 73 6c ))).. (if stepsl 2300: 62 6c 0a 09 20 20 20 20 20 28 6c 65 74 2a 20 28 bl.. (let* ( 2310: 28 66 6d 74 73 74 72 20 20 22 7e 31 35 61 7e 38 (fmtstr "~15a~8 2320: 61 7e 38 61 7e 32 30 61 22 29 0a 09 09 20 20 20 a~8a~20a")... 2330: 20 28 6e 65 77 74 78 74 20 20 28 73 74 72 69 6e (newtxt (strin 2340: 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 0a 09 g-intersperse .. 2350: 09 09 20 20 20 20 20 20 28 61 70 70 65 6e 64 0a .. (append. 2360: 09 09 09 20 20 20 20 20 20 20 28 6c 69 73 74 20 ... (list 2370: 0a 09 09 09 09 28 66 6f 72 6d 61 74 20 23 66 20 .....(format #f 2380: 66 6d 74 73 74 72 20 22 53 74 65 70 6e 61 6d 65 fmtstr "Stepname 2390: 22 20 22 53 74 61 74 65 22 20 22 53 74 61 74 75 " "State" "Statu 23a0: 73 22 20 22 45 76 65 6e 74 20 54 69 6d 65 22 29 s" "Event Time") 23b0: 0a 09 09 09 09 28 66 6f 72 6d 61 74 20 23 66 20 .....(format #f 23c0: 66 6d 74 73 74 72 20 22 3d 3d 3d 3d 3d 3d 3d 3d fmtstr "======== 23d0: 22 20 22 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d 3d " "=====" "===== 23e0: 3d 22 20 22 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 22 29 =" "==========") 23f0: 29 0a 09 09 09 20 20 20 20 20 20 20 28 6d 61 70 ).... (map 2400: 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 09 (lambda (x).... 2410: 09 20 20 20 20 20 20 3b 3b 20 74 61 6b 65 20 61 . ;; take a 2420: 64 76 61 6e 74 61 67 65 20 6f 66 20 74 68 65 20 dvantage of the 2430: 5c 6e 20 6f 6e 20 74 69 6d 65 2d 3e 73 74 72 69 \n on time->stri 2440: 6e 67 0a 09 09 09 09 20 20 20 20 20 20 28 66 6f ng..... (fo 2450: 72 6d 61 74 20 23 66 20 66 6d 74 73 74 72 0a 09 rmat #f fmtstr.. 2460: 09 09 09 09 20 20 20 20 20 20 28 64 62 3a 73 74 .... (db:st 2470: 65 70 2d 67 65 74 2d 73 74 65 70 6e 61 6d 65 20 ep-get-stepname 2480: 78 29 0a 09 09 09 09 09 20 20 20 20 20 20 28 64 x)...... (d 2490: 62 3a 73 74 65 70 2d 67 65 74 2d 73 74 61 74 65 b:step-get-state 24a0: 20 20 20 20 78 29 0a 09 09 09 09 09 20 20 20 20 x)...... 24b0: 20 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 73 (db:step-get-s 24c0: 74 61 74 75 73 20 20 20 78 29 0a 09 09 09 09 09 tatus x)...... 24d0: 20 20 20 20 20 20 28 74 69 6d 65 2d 3e 73 74 72 (time->str 24e0: 69 6e 67 20 0a 09 09 09 09 09 20 20 20 20 20 20 ing ...... 24f0: 20 28 73 65 63 6f 6e 64 73 2d 3e 6c 6f 63 61 6c (seconds->local 2500: 2d 74 69 6d 65 20 0a 09 09 09 09 09 09 28 64 62 -time .......(db 2510: 3a 73 74 65 70 2d 67 65 74 2d 65 76 65 6e 74 5f :step-get-event_ 2520: 74 69 6d 65 20 78 29 29 29 29 29 0a 09 09 09 09 time x)))))..... 2530: 20 20 20 20 28 64 62 2d 67 65 74 2d 74 65 73 74 (db-get-test 2540: 2d 73 74 65 70 73 2d 66 6f 72 2d 72 75 6e 20 2a -steps-for-run * 2550: 64 62 2a 20 74 65 73 74 2d 69 64 29 29 29 0a 09 db* test-id))).. 2560: 09 09 20 20 20 20 20 22 5c 6e 22 29 29 29 0a 09 .. "\n"))).. 2570: 20 20 20 20 20 20 20 28 69 75 70 3a 61 74 74 72 (iup:attr 2580: 69 62 75 74 65 2d 73 65 74 21 20 73 74 65 70 73 ibute-set! steps 2590: 6c 62 6c 20 22 54 49 54 4c 45 22 20 6e 65 77 74 lbl "TITLE" newt 25a0: 78 74 29 29 29 29 29 0a 20 20 20 20 20 28 68 61 xt))))). (ha 25b0: 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 2a 65 sh-table-keys *e 25c0: 78 61 6d 69 6e 65 2d 74 65 73 74 2d 64 61 74 2a xamine-test-dat* 25d0: 29 29 0a 20 20 20 20 28 73 65 74 21 20 2a 61 6c )). (set! *al 25e0: 6c 74 65 73 74 6e 61 6d 65 6c 73 74 2a 20 27 28 ltestnamelst* '( 25f0: 29 29 0a 20 20 20 20 28 66 6f 72 2d 65 61 63 68 )). (for-each 2600: 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 72 . (lambda (r 2610: 75 6e 64 61 74 29 0a 20 20 20 20 20 20 20 28 69 undat). (i 2620: 66 20 28 6e 6f 74 20 72 75 6e 64 61 74 29 20 3b f (not rundat) ; 2630: 3b 20 68 61 6e 64 6c 65 20 70 61 64 64 65 64 20 ; handle padded 2640: 72 75 6e 73 0a 09 20 20 20 3b 3b 20 20 20 20 20 runs.. ;; 2650: 20 20 20 20 20 20 3b 3b 20 69 64 20 72 75 6e 2d ;; id run- 2660: 69 64 20 74 65 73 74 6e 61 6d 65 20 73 74 61 74 id testname stat 2670: 65 20 73 74 61 74 75 73 20 65 76 65 6e 74 2d 74 e status event-t 2680: 69 6d 65 20 68 6f 73 74 20 63 70 75 6c 6f 61 64 ime host cpuload 2690: 20 64 69 73 6b 66 72 65 65 20 75 6e 61 6d 65 20 diskfree uname 26a0: 72 75 6e 64 69 72 20 69 74 65 6d 2d 70 61 74 68 rundir item-path 26b0: 20 72 75 6e 2d 64 75 72 61 74 69 6f 6e 0a 09 20 run-duration.. 26c0: 20 20 28 73 65 74 21 20 72 75 6e 64 61 74 20 28 (set! rundat ( 26d0: 76 65 63 74 6f 72 20 28 6d 61 6b 65 2d 76 65 63 vector (make-vec 26e0: 74 6f 72 20 32 30 20 23 66 29 20 27 28 29 20 28 tor 20 #f) '() ( 26f0: 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 78 29 20 map (lambda (x) 2700: 22 22 29 20 2a 6b 65 79 73 2a 29 29 29 29 3b 3b "") *keys*))));; 2710: 20 33 29 29 29 0a 20 20 20 20 20 20 20 28 6c 65 3))). (le 2720: 74 2a 20 28 28 72 75 6e 20 20 20 20 20 20 28 76 t* ((run (v 2730: 65 63 74 6f 72 2d 72 65 66 20 72 75 6e 64 61 74 ector-ref rundat 2740: 20 30 29 29 0a 09 20 20 20 20 20 20 28 74 65 73 0)).. (tes 2750: 74 73 64 61 74 20 28 76 65 63 74 6f 72 2d 72 65 tsdat (vector-re 2760: 66 20 72 75 6e 64 61 74 20 31 29 29 0a 09 20 20 f rundat 1)).. 2770: 20 20 20 20 28 6b 65 79 2d 76 61 6c 2d 64 61 74 (key-val-dat 2780: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 72 75 6e (vector-ref run 2790: 64 61 74 20 32 29 29 0a 09 20 20 20 20 20 20 28 dat 2)).. ( 27a0: 72 75 6e 2d 69 64 20 20 20 28 64 62 2d 67 65 74 run-id (db-get 27b0: 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 -value-by-header 27c0: 20 72 75 6e 20 2a 68 65 61 64 65 72 2a 20 22 69 run *header* "i 27d0: 64 22 29 29 0a 09 20 20 20 20 20 20 28 74 65 73 d")).. (tes 27e0: 74 6e 61 6d 65 73 20 28 64 65 6c 65 74 65 2d 64 tnames (delete-d 27f0: 75 70 6c 69 63 61 74 65 73 20 28 61 70 70 65 6e uplicates (appen 2800: 64 20 2a 61 6c 6c 74 65 73 74 6e 61 6d 65 6c 73 d *alltestnamels 2810: 74 2a 20 0a 09 09 09 09 09 09 20 20 20 20 28 6d t* ....... (m 2820: 61 70 20 74 65 73 74 3a 74 65 73 74 2d 67 65 74 ap test:test-get 2830: 2d 66 75 6c 6c 6e 61 6d 65 20 74 65 73 74 73 64 -fullname testsd 2840: 61 74 29 29 29 29 20 3b 3b 20 28 74 61 6b 65 20 at)))) ;; (take 2850: 28 70 61 64 2d 6c 69 73 74 20 74 65 73 74 73 64 (pad-list testsd 2860: 61 74 20 6e 75 6d 74 65 73 74 73 29 20 6e 75 6d at numtests) num 2870: 74 65 73 74 73 29 29 0a 09 20 20 20 20 20 20 28 tests)).. ( 2880: 6b 65 79 2d 76 61 6c 73 20 28 61 70 70 65 6e 64 key-vals (append 2890: 20 6b 65 79 2d 76 61 6c 2d 64 61 74 0a 09 09 09 key-val-dat.... 28a0: 09 28 6c 69 73 74 20 28 6c 65 74 20 28 28 78 20 .(list (let ((x 28b0: 28 64 62 2d 67 65 74 2d 76 61 6c 75 65 2d 62 79 (db-get-value-by 28c0: 2d 68 65 61 64 65 72 20 72 75 6e 20 2a 68 65 61 -header run *hea 28d0: 64 65 72 2a 20 22 72 75 6e 6e 61 6d 65 22 29 29 der* "runname")) 28e0: 29 0a 09 09 09 09 09 28 69 66 20 78 20 78 20 22 )......(if x x " 28f0: 22 29 29 29 29 29 0a 09 20 20 20 20 20 20 28 72 "))))).. (r 2900: 75 6e 2d 6b 65 79 20 20 28 73 74 72 69 6e 67 2d un-key (string- 2910: 69 6e 74 65 72 73 70 65 72 73 65 20 6b 65 79 2d intersperse key- 2920: 76 61 6c 73 20 22 5c 6e 22 29 29 29 0a 09 20 3b vals "\n"))).. ; 2930: 3b 20 28 72 75 6e 2d 68 74 20 20 28 68 61 73 68 ; (run-ht (hash 2940: 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 -table-ref/defau 2950: 6c 74 20 61 6c 6c 64 61 74 20 72 75 6e 2d 6b 65 lt alldat run-ke 2960: 79 20 23 66 29 29 29 0a 09 20 3b 3b 20 66 69 6c y #f))).. ;; fil 2970: 6c 20 69 6e 20 74 68 65 20 72 75 6e 20 68 65 61 l in the run hea 2980: 64 65 72 20 6b 65 79 20 76 61 6c 75 65 73 0a 09 der key values.. 2990: 20 28 73 65 74 21 20 2a 61 6c 6c 74 65 73 74 6e (set! *alltestn 29a0: 61 6d 65 6c 73 74 2a 20 74 65 73 74 6e 61 6d 65 amelst* testname 29b0: 73 29 0a 09 20 28 6c 65 74 20 28 28 72 6f 77 6e s).. (let ((rown 29c0: 20 20 20 20 20 20 30 29 0a 09 20 20 20 20 20 20 0).. 29d0: 20 28 68 65 61 64 65 72 63 6f 6c 20 28 76 65 63 (headercol (vec 29e0: 74 6f 72 2d 72 65 66 20 74 61 62 6c 65 68 65 61 tor-ref tablehea 29f0: 64 65 72 20 63 6f 6c 6e 29 29 29 0a 09 20 20 20 der coln))).. 2a00: 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 (for-each (lambd 2a10: 61 20 28 6b 76 61 6c 29 0a 09 09 20 20 20 20 20 a (kval)... 2a20: 20 20 28 6c 65 74 2a 20 28 28 6c 61 62 6c 20 20 (let* ((labl 2a30: 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 (vector-ref 2a40: 68 65 61 64 65 72 63 6f 6c 20 72 6f 77 6e 29 29 headercol rown)) 2a50: 29 0a 09 09 09 20 28 69 66 20 28 6e 6f 74 20 28 ).... (if (not ( 2a60: 65 71 75 61 6c 3f 20 6b 76 61 6c 20 28 69 75 70 equal? kval (iup 2a70: 3a 61 74 74 72 69 62 75 74 65 20 6c 61 62 6c 20 :attribute labl 2a80: 22 54 49 54 4c 45 22 29 29 29 0a 09 09 09 20 20 "TITLE"))).... 2a90: 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 (iup:attribut 2aa0: 65 2d 73 65 74 21 20 28 76 65 63 74 6f 72 2d 72 e-set! (vector-r 2ab0: 65 66 20 68 65 61 64 65 72 63 6f 6c 20 72 6f 77 ef headercol row 2ac0: 6e 29 20 22 54 49 54 4c 45 22 20 6b 76 61 6c 29 n) "TITLE" kval) 2ad0: 29 0a 09 09 09 20 28 73 65 74 21 20 72 6f 77 6e ).... (set! rown 2ae0: 20 28 2b 20 72 6f 77 6e 20 31 29 29 29 29 0a 09 (+ rown 1)))).. 2af0: 09 20 20 20 20 20 6b 65 79 2d 76 61 6c 73 29 29 . key-vals)) 2b00: 0a 0a 09 20 3b 3b 20 46 6f 72 20 74 68 69 73 20 ... ;; For this 2b10: 72 75 6e 20 6e 6f 77 20 66 69 6c 6c 20 69 6e 20 run now fill in 2b20: 74 68 65 20 62 75 74 74 6f 6e 73 20 66 6f 72 20 the buttons for 2b30: 65 61 63 68 20 74 65 73 74 0a 09 20 28 6c 65 74 each test.. (let 2b40: 20 28 28 72 6f 77 6e 20 30 29 0a 09 20 20 20 20 ((rown 0).. 2b50: 20 20 20 28 63 6f 6c 75 6d 6e 64 61 74 20 20 28 (columndat ( 2b60: 76 65 63 74 6f 72 2d 72 65 66 20 74 61 62 6c 65 vector-ref table 2b70: 20 63 6f 6c 6e 29 29 29 0a 09 20 20 20 28 66 6f coln))).. (fo 2b80: 72 2d 65 61 63 68 0a 09 20 20 20 20 28 6c 61 6d r-each.. (lam 2b90: 62 64 61 20 28 74 65 73 74 6e 61 6d 65 29 0a 09 bda (testname).. 2ba0: 20 20 20 20 20 20 28 6c 65 74 20 28 28 62 75 74 (let ((but 2bb0: 74 6f 6e 64 61 74 20 20 28 68 61 73 68 2d 74 61 tondat (hash-ta 2bc0: 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 ble-ref/default 2bd0: 2a 62 75 74 74 6f 6e 64 61 74 2a 20 28 6d 6b 73 *buttondat* (mks 2be0: 74 72 20 63 6f 6c 6e 20 72 6f 77 6e 29 20 23 66 tr coln rown) #f 2bf0: 29 29 29 0a 09 09 28 69 66 20 62 75 74 74 6f 6e )))...(if button 2c00: 64 61 74 0a 09 09 20 20 20 20 28 6c 65 74 2a 20 dat... (let* 2c10: 28 28 74 65 73 74 20 20 20 20 20 20 20 28 6c 65 ((test (le 2c20: 74 20 28 28 6d 61 74 63 68 69 6e 67 20 28 66 69 t ((matching (fi 2c30: 6c 74 65 72 20 0a 09 09 09 09 09 09 09 28 6c 61 lter ........(la 2c40: 6d 62 64 61 20 28 78 29 28 65 71 75 61 6c 3f 20 mbda (x)(equal? 2c50: 28 74 65 73 74 3a 74 65 73 74 2d 67 65 74 2d 66 (test:test-get-f 2c60: 75 6c 6c 6e 61 6d 65 20 78 29 20 74 65 73 74 6e ullname x) testn 2c70: 61 6d 65 29 29 0a 09 09 09 09 09 09 09 74 65 73 ame))........tes 2c80: 74 73 64 61 74 29 29 29 0a 09 09 09 09 09 20 28 tsdat)))...... ( 2c90: 69 66 20 28 6e 75 6c 6c 3f 20 6d 61 74 63 68 69 if (null? matchi 2ca0: 6e 67 29 0a 09 09 09 09 09 20 20 20 20 20 28 76 ng)...... (v 2cb0: 65 63 74 6f 72 20 2d 31 20 2d 31 20 22 22 20 22 ector -1 -1 "" " 2cc0: 22 20 22 22 20 30 20 22 22 20 22 22 20 30 20 22 " "" 0 "" "" 0 " 2cd0: 22 20 22 22 20 22 22 20 30 20 22 22 20 22 22 29 " "" "" 0 "" "") 2ce0: 0a 09 09 09 09 09 20 20 20 20 20 28 63 61 72 20 ...... (car 2cf0: 6d 61 74 63 68 69 6e 67 29 29 29 29 0a 09 09 09 matching)))).... 2d00: 20 20 20 3b 3b 20 28 74 65 73 74 20 20 20 20 20 ;; (test 2d10: 20 20 28 69 66 20 72 65 61 6c 2d 74 65 73 74 20 (if real-test 2d20: 72 65 61 6c 2d 74 65 73 74 0a 09 09 09 20 20 20 real-test.... 2d30: 28 74 65 73 74 6e 61 6d 65 20 20 20 28 64 62 3a (testname (db: 2d40: 74 65 73 74 2d 67 65 74 2d 74 65 73 74 6e 61 6d test-get-testnam 2d50: 65 20 20 74 65 73 74 29 29 0a 09 09 09 20 20 20 e test)).... 2d60: 28 69 74 65 6d 70 61 74 68 20 20 20 28 64 62 3a (itempath (db: 2d70: 74 65 73 74 2d 67 65 74 2d 69 74 65 6d 2d 70 61 test-get-item-pa 2d80: 74 68 20 74 65 73 74 29 29 0a 09 09 09 20 20 20 th test)).... 2d90: 28 74 65 73 74 66 75 6c 6c 6e 61 6d 65 20 28 74 (testfullname (t 2da0: 65 73 74 3a 74 65 73 74 2d 67 65 74 2d 66 75 6c est:test-get-ful 2db0: 6c 6e 61 6d 65 20 74 65 73 74 29 29 0a 09 09 09 lname test)).... 2dc0: 20 20 20 28 74 65 73 74 73 74 61 74 75 73 20 28 (teststatus ( 2dd0: 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 db:test-get-stat 2de0: 75 73 20 20 20 74 65 73 74 29 29 0a 09 09 09 20 us test)).... 2df0: 20 20 28 74 65 73 74 73 74 61 74 65 20 20 28 64 (teststate (d 2e00: 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 65 b:test-get-state 2e10: 20 20 20 20 74 65 73 74 29 29 0a 09 09 09 20 20 test)).... 2e20: 20 28 74 65 73 74 73 74 61 72 74 20 20 28 64 62 (teststart (db 2e30: 3a 74 65 73 74 2d 67 65 74 2d 65 76 65 6e 74 5f :test-get-event_ 2e40: 74 69 6d 65 20 74 65 73 74 29 29 0a 09 09 09 20 time test)).... 2e50: 20 20 28 72 75 6e 74 69 6d 65 20 20 20 20 28 64 (runtime (d 2e60: 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e 5f 64 b:test-get-run_d 2e70: 75 72 61 74 69 6f 6e 20 74 65 73 74 29 29 0a 09 uration test)).. 2e80: 09 09 20 20 20 28 62 75 74 74 6f 6e 74 78 74 20 .. (buttontxt 2e90: 20 28 69 66 20 28 65 71 75 61 6c 3f 20 74 65 73 (if (equal? tes 2ea0: 74 73 74 61 74 65 20 22 43 4f 4d 50 4c 45 54 45 tstate "COMPLETE 2eb0: 44 22 29 20 74 65 73 74 73 74 61 74 75 73 20 74 D") teststatus t 2ec0: 65 73 74 73 74 61 74 65 29 29 0a 09 09 09 20 20 eststate)).... 2ed0: 20 28 62 75 74 74 6f 6e 20 20 20 20 20 28 76 65 (button (ve 2ee0: 63 74 6f 72 2d 72 65 66 20 63 6f 6c 75 6d 6e 64 ctor-ref columnd 2ef0: 61 74 20 72 6f 77 6e 29 29 0a 09 09 09 20 20 20 at rown)).... 2f00: 28 63 6f 6c 6f 72 20 20 20 20 20 20 28 63 61 73 (color (cas 2f10: 65 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f e (string->symbo 2f20: 6c 20 74 65 73 74 73 74 61 74 65 29 0a 09 09 09 l teststate).... 2f30: 09 09 20 28 28 43 4f 4d 50 4c 45 54 45 44 29 0a .. ((COMPLETED). 2f40: 09 09 09 09 09 20 20 28 69 66 20 28 65 71 75 61 ..... (if (equa 2f50: 6c 3f 20 74 65 73 74 73 74 61 74 75 73 20 22 50 l? teststatus "P 2f60: 41 53 53 22 29 0a 09 09 09 09 09 20 20 20 20 20 ASS")...... 2f70: 20 22 37 30 20 32 34 39 20 37 33 22 0a 09 09 09 "70 249 73".... 2f80: 09 09 20 20 20 20 20 20 28 69 66 20 28 65 71 75 .. (if (equ 2f90: 61 6c 3f 20 74 65 73 74 73 74 61 74 75 73 20 22 al? teststatus " 2fa0: 57 41 52 4e 22 29 0a 09 09 09 09 09 09 20 20 22 WARN")....... " 2fb0: 32 35 35 20 31 37 32 20 31 33 22 0a 09 09 09 09 255 172 13"..... 2fc0: 09 09 20 20 22 32 32 33 20 33 33 20 34 39 22 29 .. "223 33 49") 2fd0: 29 29 20 3b 3b 20 67 72 65 65 6e 69 73 68 20 6f )) ;; greenish o 2fe0: 72 61 6e 67 65 69 73 68 20 72 65 64 69 73 68 0a rangeish redish. 2ff0: 09 09 09 09 09 20 28 28 4c 41 55 4e 43 48 45 44 ..... ((LAUNCHED 3000: 29 20 20 20 20 20 20 20 20 20 22 31 30 31 20 31 ) "101 1 3010: 32 33 20 31 34 32 22 29 0a 09 09 09 09 09 20 28 23 142")...... ( 3020: 28 43 48 45 43 4b 29 20 20 20 20 20 20 20 20 20 (CHECK) 3030: 20 20 20 22 32 35 35 20 31 30 30 20 35 30 22 29 "255 100 50") 3040: 0a 09 09 09 09 09 20 28 28 52 45 4d 4f 54 45 48 ...... ((REMOTEH 3050: 4f 53 54 53 54 41 52 54 29 20 20 22 35 30 20 31 OSTSTART) "50 1 3060: 33 30 20 31 39 35 22 29 0a 09 09 09 09 09 20 28 30 195")...... ( 3070: 28 52 55 4e 4e 49 4e 47 29 20 20 20 20 20 20 20 (RUNNING) 3080: 20 20 20 22 39 20 31 33 31 20 32 33 32 22 29 0a "9 131 232"). 3090: 09 09 09 09 09 20 28 28 4b 49 4c 4c 52 45 51 29 ..... ((KILLREQ) 30a0: 20 20 20 20 20 20 20 20 20 20 22 33 39 20 38 32 "39 82 30b0: 20 32 30 36 22 29 0a 09 09 09 09 09 20 28 28 4b 206")...... ((K 30c0: 49 4c 4c 45 44 29 20 20 20 20 20 20 20 20 20 20 ILLED) 30d0: 20 22 32 33 34 20 31 30 31 20 31 37 22 29 0a 09 "234 101 17").. 30e0: 09 09 09 09 20 28 65 6c 73 65 20 22 31 39 32 20 .... (else "192 30f0: 31 39 32 20 31 39 32 22 29 29 29 0a 09 09 09 20 192 192"))).... 3100: 20 20 28 63 75 72 72 2d 63 6f 6c 6f 72 20 28 76 (curr-color (v 3110: 65 63 74 6f 72 2d 72 65 66 20 62 75 74 74 6f 6e ector-ref button 3120: 64 61 74 20 31 29 29 20 3b 3b 20 28 69 75 70 3a dat 1)) ;; (iup: 3130: 61 74 74 72 69 62 75 74 65 20 62 75 74 74 6f 6e attribute button 3140: 20 22 42 47 43 4f 4c 4f 52 22 29 29 0a 09 09 09 "BGCOLOR")).... 3150: 20 20 20 28 63 75 72 72 2d 74 69 74 6c 65 20 28 (curr-title ( 3160: 76 65 63 74 6f 72 2d 72 65 66 20 62 75 74 74 6f vector-ref butto 3170: 6e 64 61 74 20 32 29 29 29 20 3b 3b 20 28 69 75 ndat 2))) ;; (iu 3180: 70 3a 61 74 74 72 69 62 75 74 65 20 62 75 74 74 p:attribute butt 3190: 6f 6e 20 22 54 49 54 4c 45 22 29 29 29 0a 09 09 on "TITLE")))... 31a0: 3b 3b 20 20 20 20 20 20 20 28 69 66 20 28 61 6e ;; (if (an 31b0: 64 20 28 65 71 75 61 6c 3f 20 74 65 73 74 73 74 d (equal? testst 31c0: 61 74 65 20 22 52 55 4e 4e 49 4e 47 22 29 0a 09 ate "RUNNING").. 31d0: 09 3b 3b 20 09 20 20 20 20 20 20 20 28 3e 20 28 .;; . (> ( 31e0: 2d 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e - (current-secon 31f0: 64 73 29 20 28 2b 20 74 65 73 74 73 74 61 72 74 ds) (+ teststart 3200: 20 72 75 6e 74 69 6d 65 29 29 20 31 30 30 29 29 runtime)) 100)) 3210: 20 3b 3b 20 69 66 20 74 65 73 74 20 68 61 73 20 ;; if test has 3220: 62 65 65 6e 20 64 65 61 64 20 66 6f 72 20 6d 6f been dead for mo 3230: 72 65 20 74 68 61 6e 20 31 30 30 20 73 65 63 6f re than 100 seco 3240: 6e 64 73 2c 20 63 61 6c 6c 20 69 74 20 64 65 61 nds, call it dea 3250: 64 0a 09 09 09 20 20 0a 09 09 20 20 20 20 20 20 d.... ... 3260: 28 69 66 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f (if (not (equal? 3270: 20 63 75 72 72 2d 63 6f 6c 6f 72 20 63 6f 6c 6f curr-color colo 3280: 72 29 29 0a 09 09 09 20 20 28 69 75 70 3a 61 74 r)).... (iup:at 3290: 74 72 69 62 75 74 65 2d 73 65 74 21 20 62 75 74 tribute-set! but 32a0: 74 6f 6e 20 22 42 47 43 4f 4c 4f 52 22 20 63 6f ton "BGCOLOR" co 32b0: 6c 6f 72 29 29 0a 09 09 20 20 20 20 20 20 28 69 lor))... (i 32c0: 66 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 63 f (not (equal? c 32d0: 75 72 72 2d 74 69 74 6c 65 20 62 75 74 74 6f 6e urr-title button 32e0: 74 78 74 29 29 0a 09 09 09 20 20 28 69 75 70 3a txt)).... (iup: 32f0: 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 62 attribute-set! b 3300: 75 74 74 6f 6e 20 22 54 49 54 4c 45 22 20 20 20 utton "TITLE" 3310: 62 75 74 74 6f 6e 74 78 74 29 29 0a 09 09 20 20 buttontxt))... 3320: 20 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 (vector-set! 3330: 20 62 75 74 74 6f 6e 64 61 74 20 30 20 72 75 6e buttondat 0 run 3340: 2d 69 64 29 0a 09 09 20 20 20 20 20 20 28 76 65 -id)... (ve 3350: 63 74 6f 72 2d 73 65 74 21 20 62 75 74 74 6f 6e ctor-set! button 3360: 64 61 74 20 31 20 63 6f 6c 6f 72 29 0a 09 09 20 dat 1 color)... 3370: 20 20 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 (vector-set 3380: 21 20 62 75 74 74 6f 6e 64 61 74 20 32 20 62 75 ! buttondat 2 bu 3390: 74 74 6f 6e 74 78 74 29 0a 09 09 20 20 20 20 20 ttontxt)... 33a0: 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 62 75 (vector-set! bu 33b0: 74 74 6f 6e 64 61 74 20 33 20 74 65 73 74 29 0a ttondat 3 test). 33c0: 09 09 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d .. (vector- 33d0: 73 65 74 21 20 62 75 74 74 6f 6e 64 61 74 20 34 set! buttondat 4 33e0: 20 72 75 6e 2d 6b 65 79 29 0a 09 09 20 20 20 20 run-key)... 33f0: 20 20 28 69 66 20 28 6e 6f 74 20 28 68 61 73 68 (if (not (hash 3400: 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 -table-ref/defau 3410: 6c 74 20 2a 61 6c 6c 74 65 73 74 6e 61 6d 65 73 lt *alltestnames 3420: 2a 20 74 65 73 74 66 75 6c 6c 6e 61 6d 65 20 23 * testfullname # 3430: 66 29 29 0a 09 09 09 20 20 28 62 65 67 69 6e 0a f)).... (begin. 3440: 09 09 09 20 20 20 20 28 68 61 73 68 2d 74 61 62 ... (hash-tab 3450: 6c 65 2d 73 65 74 21 20 2a 61 6c 6c 74 65 73 74 le-set! *alltest 3460: 6e 61 6d 65 73 2a 20 74 65 73 74 66 75 6c 6c 6e names* testfulln 3470: 61 6d 65 20 23 74 29 0a 09 09 09 20 20 20 20 28 ame #t).... ( 3480: 73 65 74 21 20 2a 61 6c 6c 74 65 73 74 6e 61 6d set! *alltestnam 3490: 65 6c 73 74 2a 20 28 61 70 70 65 6e 64 20 2a 61 elst* (append *a 34a0: 6c 6c 74 65 73 74 6e 61 6d 65 6c 73 74 2a 20 28 lltestnamelst* ( 34b0: 6c 69 73 74 20 74 65 73 74 66 75 6c 6c 6e 61 6d list testfullnam 34c0: 65 29 29 29 29 29 29 0a 09 09 20 20 20 20 29 0a e))))))... ). 34d0: 09 09 28 73 65 74 21 20 72 6f 77 6e 20 28 2b 20 ..(set! rown (+ 34e0: 72 6f 77 6e 20 31 29 29 29 29 0a 09 20 20 20 20 rown 1)))).. 34f0: 28 6c 65 74 20 28 28 78 6c 20 28 69 66 20 28 3e (let ((xl (if (> 3500: 20 28 6c 65 6e 67 74 68 20 74 65 73 74 6e 61 6d (length testnam 3510: 65 73 29 20 2a 73 74 61 72 74 2d 74 65 73 74 2d es) *start-test- 3520: 6f 66 66 73 65 74 2a 29 0a 09 09 09 20 20 28 64 offset*).... (d 3530: 72 6f 70 20 74 65 73 74 6e 61 6d 65 73 20 2a 73 rop testnames *s 3540: 74 61 72 74 2d 74 65 73 74 2d 6f 66 66 73 65 74 tart-test-offset 3550: 2a 29 0a 09 09 09 20 20 74 65 73 74 6e 61 6d 65 *).... testname 3560: 73 29 29 29 0a 09 20 20 20 20 20 20 28 61 70 70 s))).. (app 3570: 65 6e 64 20 78 6c 20 28 6d 61 6b 65 2d 6c 69 73 end xl (make-lis 3580: 74 20 28 2d 20 2a 6e 75 6d 2d 74 65 73 74 73 2a t (- *num-tests* 3590: 20 28 6c 65 6e 67 74 68 20 78 6c 29 29 20 22 22 (length xl)) "" 35a0: 29 29 29 29 29 0a 09 20 28 73 65 74 21 20 63 6f ))))).. (set! co 35b0: 6c 6e 20 28 2b 20 63 6f 6c 6e 20 31 29 29 29 29 ln (+ coln 1)))) 35c0: 0a 20 20 20 20 20 72 75 6e 73 29 29 29 0a 0a 28 . runs)))..( 35d0: 64 65 66 69 6e 65 20 28 6d 6b 73 74 72 20 2e 20 define (mkstr . 35e0: 78 29 0a 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 x). (string-int 35f0: 65 72 73 70 65 72 73 65 20 28 6d 61 70 20 63 6f ersperse (map co 3600: 6e 63 20 78 29 20 22 2c 22 29 29 0a 0a 28 64 65 nc x) ","))..(de 3610: 66 69 6e 65 20 28 75 70 64 61 74 65 2d 73 65 61 fine (update-sea 3620: 72 63 68 20 78 20 76 61 6c 29 0a 20 20 3b 3b 20 rch x val). ;; 3630: 28 70 72 69 6e 74 20 22 53 65 74 74 69 6e 67 20 (print "Setting 3640: 73 65 61 72 63 68 20 66 6f 72 20 22 20 78 20 22 search for " x " 3650: 20 74 6f 20 22 20 76 61 6c 29 0a 20 20 28 68 61 to " val). (ha 3660: 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 2a 73 sh-table-set! *s 3670: 65 61 72 63 68 70 61 74 74 73 2a 20 78 20 76 61 earchpatts* x va 3680: 6c 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 6d 61 l))..(define (ma 3690: 6b 65 2d 64 61 73 68 62 6f 61 72 64 2d 62 75 74 ke-dashboard-but 36a0: 74 6f 6e 73 20 6e 72 75 6e 73 20 6e 74 65 73 74 tons nruns ntest 36b0: 73 20 6b 65 79 6e 61 6d 65 73 29 0a 20 20 28 6c s keynames). (l 36c0: 65 74 2a 20 28 28 6e 6b 65 79 73 20 20 20 28 6c et* ((nkeys (l 36d0: 65 6e 67 74 68 20 6b 65 79 6e 61 6d 65 73 29 29 ength keynames)) 36e0: 0a 09 20 28 72 75 6e 73 76 65 63 20 28 6d 61 6b .. (runsvec (mak 36f0: 65 2d 76 65 63 74 6f 72 20 6e 72 75 6e 73 29 29 e-vector nruns)) 3700: 0a 09 20 28 68 65 61 64 65 72 20 20 28 6d 61 6b .. (header (mak 3710: 65 2d 76 65 63 74 6f 72 20 6e 72 75 6e 73 29 29 e-vector nruns)) 3720: 0a 09 20 28 6c 66 74 63 6f 6c 20 20 28 6d 61 6b .. (lftcol (mak 3730: 65 2d 76 65 63 74 6f 72 20 6e 74 65 73 74 73 29 e-vector ntests) 3740: 29 0a 09 20 28 63 6f 6e 74 72 6f 6c 73 20 27 28 ).. (controls '( 3750: 29 29 0a 09 20 28 6c 66 74 6c 73 74 20 20 27 28 )).. (lftlst '( 3760: 29 29 0a 09 20 28 68 64 72 6c 73 74 20 20 27 28 )).. (hdrlst '( 3770: 29 29 0a 09 20 28 62 64 79 6c 73 74 20 20 27 28 )).. (bdylst '( 3780: 29 29 0a 09 20 28 72 65 73 75 6c 74 20 20 27 28 )).. (result '( 3790: 29 29 0a 09 20 28 69 20 20 20 20 20 20 20 30 29 )).. (i 0) 37a0: 29 0a 20 20 20 20 3b 3b 20 63 6f 6e 74 72 6f 6c ). ;; control 37b0: 73 20 28 61 6c 6f 6e 67 20 62 6f 74 74 6f 6d 29 s (along bottom) 37c0: 0a 20 20 20 20 28 73 65 74 21 20 63 6f 6e 74 72 . (set! contr 37d0: 6f 6c 73 0a 09 20 20 28 69 75 70 3a 68 62 6f 78 ols.. (iup:hbox 37e0: 0a 09 20 20 20 28 69 75 70 3a 74 65 78 74 62 6f .. (iup:textbo 37f0: 78 20 23 3a 73 69 7a 65 20 22 36 30 78 31 35 22 x #:size "60x15" 3800: 20 23 3a 66 6f 6e 74 73 69 7a 65 20 22 31 30 22 #:fontsize "10" 3810: 20 23 3a 76 61 6c 75 65 20 22 25 22 0a 09 09 09 #:value "%".... 3820: 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 #:action (lambda 3830: 20 28 6f 62 6a 20 75 6e 6b 20 76 61 6c 29 0a 09 (obj unk val).. 3840: 09 09 09 20 20 20 28 75 70 64 61 74 65 2d 73 65 ... (update-se 3850: 61 72 63 68 20 22 74 65 73 74 2d 6e 61 6d 65 22 arch "test-name" 3860: 20 76 61 6c 29 29 29 0a 09 20 20 20 28 69 75 70 val))).. (iup 3870: 3a 74 65 78 74 62 6f 78 20 23 3a 73 69 7a 65 20 :textbox #:size 3880: 22 36 30 78 31 35 22 20 23 3a 66 6f 6e 74 73 69 "60x15" #:fontsi 3890: 7a 65 20 22 31 30 22 20 23 3a 76 61 6c 75 65 20 ze "10" #:value 38a0: 22 25 22 0a 09 09 09 23 3a 61 63 74 69 6f 6e 20 "%"....#:action 38b0: 28 6c 61 6d 62 64 61 20 28 6f 62 6a 20 75 6e 6b (lambda (obj unk 38c0: 20 76 61 6c 29 0a 09 09 09 09 20 20 20 28 75 70 val)..... (up 38d0: 64 61 74 65 2d 73 65 61 72 63 68 20 22 69 74 65 date-search "ite 38e0: 6d 2d 6e 61 6d 65 22 20 76 61 6c 29 29 29 0a 09 m-name" val))).. 38f0: 20 20 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 (iup:button " 3900: 51 75 69 74 22 20 23 3a 61 63 74 69 6f 6e 20 28 Quit" #:action ( 3910: 6c 61 6d 62 64 61 20 28 6f 62 6a 29 28 73 71 6c lambda (obj)(sql 3920: 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 2a ite3:finalize! * 3930: 64 62 2a 29 28 65 78 69 74 29 29 29 0a 09 20 20 db*)(exit))).. 3940: 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 3c 2d (iup:button "<- 3950: 20 20 4c 65 66 74 22 20 23 3a 61 63 74 69 6f 6e Left" #:action 3960: 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 29 28 73 (lambda (obj)(s 3970: 65 74 21 20 2a 73 74 61 72 74 2d 72 75 6e 2d 6f et! *start-run-o 3980: 66 66 73 65 74 2a 20 20 28 2b 20 2a 73 74 61 72 ffset* (+ *star 3990: 74 2d 72 75 6e 2d 6f 66 66 73 65 74 2a 20 31 29 t-run-offset* 1) 39a0: 29 29 29 0a 09 20 20 20 28 69 75 70 3a 62 75 74 ))).. (iup:but 39b0: 74 6f 6e 20 22 55 70 20 20 20 20 20 5e 22 20 23 ton "Up ^" # 39c0: 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 :action (lambda 39d0: 28 6f 62 6a 29 28 73 65 74 21 20 2a 73 74 61 72 (obj)(set! *star 39e0: 74 2d 74 65 73 74 2d 6f 66 66 73 65 74 2a 20 28 t-test-offset* ( 39f0: 69 66 20 28 3e 20 2a 73 74 61 72 74 2d 74 65 73 if (> *start-tes 3a00: 74 2d 6f 66 66 73 65 74 2a 20 30 29 28 2d 20 2a t-offset* 0)(- * 3a10: 73 74 61 72 74 2d 74 65 73 74 2d 6f 66 66 73 65 start-test-offse 3a20: 74 2a 20 31 29 20 30 29 29 29 29 0a 09 20 20 20 t* 1) 0)))).. 3a30: 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 44 6f 77 (iup:button "Dow 3a40: 6e 20 20 20 76 22 20 23 3a 61 63 74 69 6f 6e 20 n v" #:action 3a50: 28 6c 61 6d 62 64 61 20 28 6f 62 6a 29 28 73 65 (lambda (obj)(se 3a60: 74 21 20 2a 73 74 61 72 74 2d 74 65 73 74 2d 6f t! *start-test-o 3a70: 66 66 73 65 74 2a 20 28 69 66 20 28 3e 3d 20 2a ffset* (if (>= * 3a80: 73 74 61 72 74 2d 74 65 73 74 2d 6f 66 66 73 65 start-test-offse 3a90: 74 2a 20 28 6c 65 6e 67 74 68 20 2a 61 6c 6c 74 t* (length *allt 3aa0: 65 73 74 6e 61 6d 65 6c 73 74 2a 29 29 28 6c 65 estnamelst*))(le 3ab0: 6e 67 74 68 20 2a 61 6c 6c 74 65 73 74 6e 61 6d ngth *alltestnam 3ac0: 65 6c 73 74 2a 29 28 2b 20 2a 73 74 61 72 74 2d elst*)(+ *start- 3ad0: 74 65 73 74 2d 6f 66 66 73 65 74 2a 20 31 29 29 test-offset* 1)) 3ae0: 29 29 29 0a 09 20 20 20 28 69 75 70 3a 62 75 74 ))).. (iup:but 3af0: 74 6f 6e 20 22 52 69 67 68 74 20 2d 3e 22 20 23 ton "Right ->" # 3b00: 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 :action (lambda 3b10: 28 6f 62 6a 29 28 73 65 74 21 20 2a 73 74 61 72 (obj)(set! *star 3b20: 74 2d 72 75 6e 2d 6f 66 66 73 65 74 2a 20 20 28 t-run-offset* ( 3b30: 69 66 20 28 3e 20 2a 73 74 61 72 74 2d 72 75 6e if (> *start-run 3b40: 2d 6f 66 66 73 65 74 2a 20 30 29 28 2d 20 2a 73 -offset* 0)(- *s 3b50: 74 61 72 74 2d 72 75 6e 2d 6f 66 66 73 65 74 2a tart-run-offset* 3b60: 20 31 29 20 30 29 29 29 29 29 29 0a 20 20 20 20 1) 0)))))). 3b70: 0a 20 20 20 20 3b 3b 20 63 72 65 61 74 65 20 74 . ;; create t 3b80: 68 65 20 6c 65 66 74 20 6d 6f 73 74 20 63 6f 6c he left most col 3b90: 75 6d 6e 20 66 6f 72 20 74 68 65 20 72 75 6e 20 umn for the run 3ba0: 6b 65 79 20 6e 61 6d 65 73 20 61 6e 64 20 74 68 key names and th 3bb0: 65 20 74 65 73 74 20 6e 61 6d 65 73 20 0a 20 20 e test names . 3bc0: 20 20 28 73 65 74 21 20 6c 66 74 6c 73 74 20 28 (set! lftlst ( 3bd0: 6c 69 73 74 20 28 61 70 70 6c 79 20 69 75 70 3a list (apply iup: 3be0: 76 62 6f 78 20 0a 09 09 09 20 20 20 20 20 20 28 vbox .... ( 3bf0: 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 78 29 09 map (lambda (x). 3c00: 09 0a 09 09 09 09 20 20 20 20 20 28 6c 65 74 20 ...... (let 3c10: 28 28 72 65 73 20 28 69 75 70 3a 68 62 6f 78 0a ((res (iup:hbox. 3c20: 09 09 09 09 09 09 20 28 69 75 70 3a 6c 61 62 65 ...... (iup:labe 3c30: 6c 20 78 20 23 3a 73 69 7a 65 20 22 34 30 78 31 l x #:size "40x1 3c40: 35 22 20 23 3a 66 6f 6e 74 73 69 7a 65 20 22 31 5" #:fontsize "1 3c50: 30 22 29 20 3b 3b 20 20 23 3a 65 78 70 61 6e 64 0") ;; #:expand 3c60: 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 29 0a 09 "HORIZONTAL").. 3c70: 09 09 09 09 09 20 28 69 75 70 3a 74 65 78 74 62 ..... (iup:textb 3c80: 6f 78 20 23 3a 73 69 7a 65 20 22 36 30 78 31 35 ox #:size "60x15 3c90: 22 20 23 3a 66 6f 6e 74 73 69 7a 65 20 22 31 30 " #:fontsize "10 3ca0: 22 20 23 3a 76 61 6c 75 65 20 22 25 22 20 3b 3b " #:value "%" ;; 3cb0: 20 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a #:expand "HORIZ 3cc0: 4f 4e 54 41 4c 22 0a 09 09 09 09 09 09 09 20 20 ONTAL"........ 3cd0: 20 20 20 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 #:action (la 3ce0: 6d 62 64 61 20 28 6f 62 6a 20 75 6e 6b 20 76 61 mbda (obj unk va 3cf0: 6c 29 0a 09 09 09 09 09 09 09 09 09 20 28 75 70 l).......... (up 3d00: 64 61 74 65 2d 73 65 61 72 63 68 20 78 20 76 61 date-search x va 3d10: 6c 29 29 29 29 29 29 0a 09 09 09 09 20 20 20 20 l))))))..... 3d20: 20 20 20 28 73 65 74 21 20 69 20 28 2b 20 69 20 (set! i (+ i 3d30: 31 29 29 0a 09 09 09 09 20 20 20 20 20 20 20 72 1))..... r 3d40: 65 73 29 29 0a 09 09 09 09 20 20 20 6b 65 79 6e es))..... keyn 3d50: 61 6d 65 73 29 29 29 29 0a 20 20 20 20 28 6c 65 ames)))). (le 3d60: 74 20 6c 6f 6f 70 20 28 28 74 65 73 74 6e 75 6d t loop ((testnum 3d70: 20 20 30 29 0a 09 20 20 20 20 20 20 20 28 72 65 0).. (re 3d80: 73 20 20 20 20 20 20 27 28 29 29 29 0a 20 20 20 s '())). 3d90: 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 (cond. 3da0: 28 28 3e 3d 20 74 65 73 74 6e 75 6d 20 6e 74 65 ((>= testnum nte 3db0: 73 74 73 29 0a 09 3b 3b 20 6e 6f 77 20 6c 66 74 sts)..;; now lft 3dc0: 6c 73 74 20 77 69 6c 6c 20 62 65 20 61 6e 20 68 lst will be an h 3dd0: 62 6f 78 20 77 69 74 68 20 74 68 65 20 74 65 73 box with the tes 3de0: 74 20 6b 65 79 73 20 61 6e 64 20 74 68 65 20 74 t keys and the t 3df0: 65 73 74 20 6e 61 6d 65 20 6c 61 62 65 6c 73 0a est name labels. 3e00: 09 28 73 65 74 21 20 6c 66 74 6c 73 74 20 28 61 .(set! lftlst (a 3e10: 70 70 65 6e 64 20 6c 66 74 6c 73 74 20 28 6c 69 ppend lftlst (li 3e20: 73 74 20 28 61 70 70 6c 79 20 69 75 70 3a 76 62 st (apply iup:vb 3e30: 6f 78 20 28 72 65 76 65 72 73 65 20 72 65 73 29 ox (reverse res) 3e40: 29 29 29 29 29 0a 20 20 20 20 20 20 20 28 65 6c ))))). (el 3e50: 73 65 0a 09 28 6c 65 74 20 28 28 6c 61 62 6c 20 se..(let ((labl 3e60: 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 22 20 (iup:button "" 3e70: 23 3a 66 6c 61 74 20 22 59 45 53 22 20 23 3a 73 #:flat "YES" #:s 3e80: 69 7a 65 20 22 31 30 30 78 31 35 22 20 23 3a 66 ize "100x15" #:f 3e90: 6f 6e 74 73 69 7a 65 20 22 31 30 22 29 29 29 0a ontsize "10"))). 3ea0: 09 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 . (vector-set! 3eb0: 6c 66 74 63 6f 6c 20 74 65 73 74 6e 75 6d 20 6c lftcol testnum l 3ec0: 61 62 6c 29 0a 09 20 20 28 6c 6f 6f 70 20 28 2b abl).. (loop (+ 3ed0: 20 74 65 73 74 6e 75 6d 20 31 29 28 63 6f 6e 73 testnum 1)(cons 3ee0: 20 6c 61 62 6c 20 72 65 73 29 29 29 29 29 29 0a labl res)))))). 3ef0: 20 20 20 20 3b 3b 20 0a 20 20 20 20 28 6c 65 74 ;; . (let 3f00: 20 6c 6f 6f 70 20 28 28 72 75 6e 6e 75 6d 20 20 loop ((runnum 3f10: 30 29 0a 09 20 20 20 20 20 20 20 28 6b 65 79 6e 0).. (keyn 3f20: 75 6d 20 20 30 29 0a 09 20 20 20 20 20 20 20 28 um 0).. ( 3f30: 6b 65 79 76 65 63 20 20 28 6d 61 6b 65 2d 76 65 keyvec (make-ve 3f40: 63 74 6f 72 20 6e 6b 65 79 73 29 29 0a 09 20 20 ctor nkeys)).. 3f50: 20 20 20 20 20 28 72 65 73 20 20 20 20 27 28 29 (res '() 3f60: 29 29 0a 20 20 20 20 20 20 28 63 6f 6e 64 20 3b )). (cond ; 3f70: 3b 20 6e 62 2f 2f 20 6e 6f 20 65 6c 73 65 20 66 ; nb// no else f 3f80: 6f 72 20 74 68 69 73 20 61 70 70 72 6f 61 63 68 or this approach 3f90: 2e 0a 20 20 20 20 20 20 20 28 28 3e 3d 20 72 75 .. ((>= ru 3fa0: 6e 6e 75 6d 20 6e 72 75 6e 73 29 20 23 66 29 0a nnum nruns) #f). 3fb0: 20 20 20 20 20 20 20 28 28 3e 3d 20 6b 65 79 6e ((>= keyn 3fc0: 75 6d 20 6e 6b 65 79 73 29 20 0a 09 28 76 65 63 um nkeys) ..(vec 3fd0: 74 6f 72 2d 73 65 74 21 20 68 65 61 64 65 72 20 tor-set! header 3fe0: 72 75 6e 6e 75 6d 20 6b 65 79 76 65 63 29 0a 09 runnum keyvec).. 3ff0: 28 73 65 74 21 20 68 64 72 6c 73 74 20 28 63 6f (set! hdrlst (co 4000: 6e 73 20 28 61 70 70 6c 79 20 69 75 70 3a 76 62 ns (apply iup:vb 4010: 6f 78 20 28 72 65 76 65 72 73 65 20 72 65 73 29 ox (reverse res) 4020: 29 20 68 64 72 6c 73 74 29 29 0a 09 28 6c 6f 6f ) hdrlst))..(loo 4030: 70 20 28 2b 20 72 75 6e 6e 75 6d 20 31 29 20 30 p (+ runnum 1) 0 4040: 20 28 6d 61 6b 65 2d 76 65 63 74 6f 72 20 6e 6b (make-vector nk 4050: 65 79 73 29 20 27 28 29 29 29 0a 20 20 20 20 20 eys) '())). 4060: 20 20 28 65 6c 73 65 0a 09 28 6c 65 74 20 28 28 (else..(let (( 4070: 6c 61 62 6c 20 20 28 69 75 70 3a 6c 61 62 65 6c labl (iup:label 4080: 20 22 22 20 23 3a 73 69 7a 65 20 22 36 30 78 31 "" #:size "60x1 4090: 35 22 20 23 3a 66 6f 6e 74 73 69 7a 65 20 22 31 5" #:fontsize "1 40a0: 30 22 20 3b 3b 20 23 3a 65 78 70 61 6e 64 20 22 0" ;; #:expand " 40b0: 48 4f 52 49 5a 4f 4e 54 41 4c 22 0a 09 09 09 09 HORIZONTAL"..... 40c0: 29 29 29 0a 09 20 20 28 76 65 63 74 6f 72 2d 73 ))).. (vector-s 40d0: 65 74 21 20 6b 65 79 76 65 63 20 6b 65 79 6e 75 et! keyvec keynu 40e0: 6d 20 6c 61 62 6c 29 0a 09 20 20 28 6c 6f 6f 70 m labl).. (loop 40f0: 20 72 75 6e 6e 75 6d 20 28 2b 20 6b 65 79 6e 75 runnum (+ keynu 4100: 6d 20 31 29 20 6b 65 79 76 65 63 20 28 63 6f 6e m 1) keyvec (con 4110: 73 20 6c 61 62 6c 20 72 65 73 29 29 29 29 29 29 s labl res)))))) 4120: 0a 20 20 20 20 3b 3b 20 42 79 20 68 65 72 65 20 . ;; By here 4130: 74 68 65 20 68 64 72 6c 73 74 20 63 6f 6e 74 61 the hdrlst conta 4140: 69 6e 73 20 61 20 6c 69 73 74 20 6f 66 20 76 62 ins a list of vb 4150: 6f 78 65 73 20 63 6f 6e 74 61 69 6e 69 6e 67 20 oxes containing 4160: 6e 6b 65 79 73 20 6c 61 62 65 6c 73 0a 20 20 20 nkeys labels. 4170: 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 72 75 6e (let loop ((run 4180: 6e 75 6d 20 20 30 29 0a 09 20 20 20 20 20 20 20 num 0).. 4190: 28 74 65 73 74 6e 75 6d 20 30 29 0a 09 20 20 20 (testnum 0).. 41a0: 20 20 20 20 28 74 65 73 74 76 65 63 20 20 28 6d (testvec (m 41b0: 61 6b 65 2d 76 65 63 74 6f 72 20 6e 74 65 73 74 ake-vector ntest 41c0: 73 29 29 0a 09 20 20 20 20 20 20 20 28 72 65 73 s)).. (res 41d0: 20 20 20 20 27 28 29 29 29 0a 20 20 20 20 20 20 '())). 41e0: 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 28 28 3e (cond. ((> 41f0: 3d 20 72 75 6e 6e 75 6d 20 6e 72 75 6e 73 29 20 = runnum nruns) 4200: 23 66 29 20 3b 3b 20 20 28 76 65 63 74 6f 72 20 #f) ;; (vector 4210: 74 61 62 6c 65 68 65 61 64 65 72 20 72 75 6e 73 tableheader runs 4220: 76 65 63 29 29 0a 20 20 20 20 20 20 20 28 28 3e vec)). ((> 4230: 3d 20 74 65 73 74 6e 75 6d 20 6e 74 65 73 74 73 = testnum ntests 4240: 29 20 0a 09 28 76 65 63 74 6f 72 2d 73 65 74 21 ) ..(vector-set! 4250: 20 72 75 6e 73 76 65 63 20 72 75 6e 6e 75 6d 20 runsvec runnum 4260: 74 65 73 74 76 65 63 29 0a 09 28 73 65 74 21 20 testvec)..(set! 4270: 62 64 79 6c 73 74 20 28 63 6f 6e 73 20 28 61 70 bdylst (cons (ap 4280: 70 6c 79 20 69 75 70 3a 76 62 6f 78 20 28 72 65 ply iup:vbox (re 4290: 76 65 72 73 65 20 72 65 73 29 29 20 62 64 79 6c verse res)) bdyl 42a0: 73 74 29 29 0a 09 28 6c 6f 6f 70 20 28 2b 20 72 st))..(loop (+ r 42b0: 75 6e 6e 75 6d 20 31 29 20 30 20 28 6d 61 6b 65 unnum 1) 0 (make 42c0: 2d 76 65 63 74 6f 72 20 6e 74 65 73 74 73 29 20 -vector ntests) 42d0: 27 28 29 29 29 0a 20 20 20 20 20 20 20 28 65 6c '())). (el 42e0: 73 65 0a 09 28 6c 65 74 2a 20 28 28 62 75 74 74 se..(let* ((butt 42f0: 6f 6e 2d 6b 65 79 20 28 6d 6b 73 74 72 20 72 75 on-key (mkstr ru 4300: 6e 6e 75 6d 20 74 65 73 74 6e 75 6d 29 29 0a 09 nnum testnum)).. 4310: 20 20 20 20 20 20 20 28 62 75 74 6e 20 20 20 20 (butn 4320: 20 20 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 (iup:button " 4330: 22 20 3b 3b 20 62 75 74 74 6f 6e 2d 6b 65 79 20 " ;; button-key 4340: 0a 09 09 09 09 20 20 20 20 20 20 20 23 3a 73 69 ..... #:si 4350: 7a 65 20 22 36 30 78 31 35 22 20 0a 09 09 09 09 ze "60x15" ..... 4360: 20 20 20 20 20 20 20 3b 3b 20 23 3a 65 78 70 61 ;; #:expa 4370: 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 0a nd "HORIZONTAL". 4380: 09 09 09 09 20 20 20 20 20 20 20 23 3a 66 6f 6e .... #:fon 4390: 74 73 69 7a 65 20 22 31 30 22 20 0a 09 09 09 09 tsize "10" ..... 43a0: 20 20 20 20 20 20 20 23 3a 61 63 74 69 6f 6e 20 #:action 43b0: 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 09 09 (lambda (x)..... 43c0: 09 09 20 20 28 65 78 61 6d 69 6e 65 2d 74 65 73 .. (examine-tes 43d0: 74 20 62 75 74 74 6f 6e 2d 6b 65 79 29 29 29 29 t button-key)))) 43e0: 29 0a 09 20 20 28 68 61 73 68 2d 74 61 62 6c 65 ).. (hash-table 43f0: 2d 73 65 74 21 20 2a 62 75 74 74 6f 6e 64 61 74 -set! *buttondat 4400: 2a 20 62 75 74 74 6f 6e 2d 6b 65 79 20 28 76 65 * button-key (ve 4410: 63 74 6f 72 20 30 20 22 31 30 30 20 31 30 30 20 ctor 0 "100 100 4420: 31 30 30 22 20 62 75 74 74 6f 6e 2d 6b 65 79 20 100" button-key 4430: 23 66 20 23 66 29 29 20 0a 09 20 20 28 76 65 63 #f #f)) .. (vec 4440: 74 6f 72 2d 73 65 74 21 20 74 65 73 74 76 65 63 tor-set! testvec 4450: 20 74 65 73 74 6e 75 6d 20 62 75 74 6e 29 0a 09 testnum butn).. 4460: 20 20 28 6c 6f 6f 70 20 72 75 6e 6e 75 6d 20 28 (loop runnum ( 4470: 2b 20 74 65 73 74 6e 75 6d 20 31 29 20 74 65 73 + testnum 1) tes 4480: 74 76 65 63 20 28 63 6f 6e 73 20 62 75 74 6e 20 tvec (cons butn 4490: 72 65 73 29 29 29 29 29 29 0a 20 20 20 20 3b 3b res)))))). ;; 44a0: 20 6e 6f 77 20 61 73 73 65 6d 62 6c 65 20 74 68 now assemble th 44b0: 65 20 68 64 72 6c 73 74 20 61 6e 64 20 62 64 79 e hdrlst and bdy 44c0: 6c 73 74 20 61 6e 64 20 6b 69 63 6b 20 6f 66 66 lst and kick off 44d0: 20 74 68 65 20 64 69 61 6c 6f 67 0a 20 20 20 20 the dialog. 44e0: 28 69 75 70 3a 73 68 6f 77 0a 20 20 20 20 20 28 (iup:show. ( 44f0: 69 75 70 3a 64 69 61 6c 6f 67 20 0a 20 20 20 20 iup:dialog . 4500: 20 20 23 3a 74 69 74 6c 65 20 22 4d 65 67 61 74 #:title "Megat 4510: 65 73 74 20 64 61 73 68 62 6f 61 72 64 22 0a 20 est dashboard". 4520: 20 20 20 20 20 28 69 75 70 3a 76 62 6f 78 0a 09 (iup:vbox.. 4530: 28 61 70 70 6c 79 20 69 75 70 3a 68 62 6f 78 20 (apply iup:hbox 4540: 0a 09 20 20 20 20 20 20 20 28 63 6f 6e 73 20 28 .. (cons ( 4550: 61 70 70 6c 79 20 69 75 70 3a 76 62 6f 78 20 6c apply iup:vbox l 4560: 66 74 6c 73 74 29 0a 09 09 20 20 20 20 20 28 6c ftlst)... (l 4570: 69 73 74 20 0a 09 09 20 20 20 20 20 20 28 69 75 ist ... (iu 4580: 70 3a 76 62 6f 78 0a 09 09 20 20 20 20 20 20 20 p:vbox... 4590: 3b 3b 20 74 68 65 20 68 65 61 64 65 72 0a 09 09 ;; the header... 45a0: 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 69 75 (apply iu 45b0: 70 3a 68 62 6f 78 20 28 72 65 76 65 72 73 65 20 p:hbox (reverse 45c0: 68 64 72 6c 73 74 29 29 0a 09 09 20 20 20 20 20 hdrlst))... 45d0: 20 20 28 61 70 70 6c 79 20 69 75 70 3a 68 62 6f (apply iup:hbo 45e0: 78 20 28 72 65 76 65 72 73 65 20 62 64 79 6c 73 x (reverse bdyls 45f0: 74 29 29 29 29 29 29 0a 20 20 20 20 20 20 20 63 t)))))). c 4600: 6f 6e 74 72 6f 6c 73 29 29 29 0a 20 20 20 20 28 ontrols))). ( 4610: 76 65 63 74 6f 72 20 6c 66 74 63 6f 6c 20 68 65 vector lftcol he 4620: 61 64 65 72 20 72 75 6e 73 76 65 63 29 29 29 0a ader runsvec))). 4630: 0a 28 73 65 74 21 20 2a 6e 75 6d 2d 74 65 73 74 .(set! *num-test 4640: 73 2a 20 28 6d 69 6e 20 28 6d 61 78 20 28 75 70 s* (min (max (up 4650: 64 61 74 65 2d 72 75 6e 64 61 74 20 22 25 22 20 date-rundat "%" 4660: 2a 6e 75 6d 2d 72 75 6e 73 2a 20 22 25 22 20 22 *num-runs* "%" " 4670: 25 22 29 20 38 29 20 32 30 29 29 0a 0a 28 73 65 %") 8) 20))..(se 4680: 74 21 20 75 69 64 61 74 20 28 6d 61 6b 65 2d 64 t! uidat (make-d 4690: 61 73 68 62 6f 61 72 64 2d 62 75 74 74 6f 6e 73 ashboard-buttons 46a0: 20 2a 6e 75 6d 2d 72 75 6e 73 2a 20 2a 6e 75 6d *num-runs* *num 46b0: 2d 74 65 73 74 73 2a 20 64 62 6b 65 79 73 29 29 -tests* dbkeys)) 46c0: 0a 3b 3b 20 28 6d 65 67 61 74 65 73 74 2d 64 61 .;; (megatest-da 46d0: 73 68 62 6f 61 72 64 29 0a 0a 28 64 65 66 69 6e shboard)..(defin 46e0: 65 20 28 72 75 6e 2d 75 70 64 61 74 65 20 6f 74 e (run-update ot 46f0: 68 65 72 2d 74 68 72 65 61 64 29 0a 20 20 28 6c her-thread). (l 4700: 65 74 20 6c 6f 6f 70 20 28 28 69 20 30 29 29 0a et loop ((i 0)). 4710: 20 20 20 20 28 74 68 72 65 61 64 2d 73 6c 65 65 (thread-slee 4720: 70 21 20 30 2e 31 29 0a 20 20 20 20 28 74 68 72 p! 0.1). (thr 4730: 65 61 64 2d 73 75 73 70 65 6e 64 21 20 6f 74 68 ead-suspend! oth 4740: 65 72 2d 74 68 72 65 61 64 29 0a 20 20 20 20 28 er-thread). ( 4750: 75 70 64 61 74 65 2d 62 75 74 74 6f 6e 73 20 75 update-buttons u 4760: 69 64 61 74 20 2a 6e 75 6d 2d 72 75 6e 73 2a 20 idat *num-runs* 4770: 2a 6e 75 6d 2d 74 65 73 74 73 2a 29 0a 20 20 20 *num-tests*). 4780: 20 28 75 70 64 61 74 65 2d 72 75 6e 64 61 74 20 (update-rundat 4790: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f (hash-table-ref/ 47a0: 64 65 66 61 75 6c 74 20 2a 73 65 61 72 63 68 70 default *searchp 47b0: 61 74 74 73 2a 20 22 72 75 6e 6e 61 6d 65 22 20 atts* "runname" 47c0: 22 25 22 29 20 2a 6e 75 6d 2d 72 75 6e 73 2a 0a "%") *num-runs*. 47d0: 09 09 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 .. (hash-table 47e0: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 2a 73 65 -ref/default *se 47f0: 61 72 63 68 70 61 74 74 73 2a 20 22 74 65 73 74 archpatts* "test 4800: 2d 6e 61 6d 65 22 20 22 25 22 29 0a 09 09 20 20 -name" "%")... 4810: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref 4820: 2f 64 65 66 61 75 6c 74 20 2a 73 65 61 72 63 68 /default *search 4830: 70 61 74 74 73 2a 20 22 69 74 65 6d 2d 6e 61 6d patts* "item-nam 4840: 65 22 20 22 25 22 29 29 0a 20 20 20 20 28 74 68 e" "%")). (th 4850: 72 65 61 64 2d 72 65 73 75 6d 65 21 20 6f 74 68 read-resume! oth 4860: 65 72 2d 74 68 72 65 61 64 29 0a 20 20 20 20 28 er-thread). ( 4870: 6c 6f 6f 70 20 28 2b 20 69 20 31 29 29 29 29 0a loop (+ i 1)))). 4880: 0a 28 64 65 66 69 6e 65 20 74 68 32 20 28 6d 61 .(define th2 (ma 4890: 6b 65 2d 74 68 72 65 61 64 20 69 75 70 3a 6d 61 ke-thread iup:ma 48a0: 69 6e 2d 6c 6f 6f 70 29 29 0a 28 64 65 66 69 6e in-loop)).(defin 48b0: 65 20 74 68 31 20 28 6d 61 6b 65 2d 74 68 72 65 e th1 (make-thre 48c0: 61 64 20 28 72 75 6e 2d 75 70 64 61 74 65 20 74 ad (run-update t 48d0: 68 32 29 29 29 0a 28 74 68 72 65 61 64 2d 73 74 h2))).(thread-st 48e0: 61 72 74 21 20 74 68 31 29 0a 28 74 68 72 65 61 art! th1).(threa 48f0: 64 2d 73 74 61 72 74 21 20 74 68 32 29 0a 28 74 d-start! th2).(t 4900: 68 72 65 61 64 2d 6a 6f 69 6e 21 20 74 68 32 29 hread-join! th2) 4910: 0a .