Artifact 4e56d94d77f6ebf1fe0e961a29c75631d9554584:
- File dashboard-tests.scm — part of check-in [901608be34] at 2013-05-09 16:37:42 on branch v1.54 — Added Kill Jobs button/command (user: mrwellan size: 21180) [more...]
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 32 2c right 2006-2012, 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 3b 3b 3d 3d ==========..;;== 01e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 01f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0200: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0210: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0220: 3d 3d 3d 3d 0a 3b 3b 20 54 65 73 74 20 69 6e 66 ====.;; Test inf 0230: 6f 20 70 61 6e 65 6c 0a 3b 3b 3d 3d 3d 3d 3d 3d o panel.;;====== 0240: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0250: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0260: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0270: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0280: 0a 0a 28 75 73 65 20 66 6f 72 6d 61 74 20 66 6d ..(use format fm 0290: 74 29 0a 28 72 65 71 75 69 72 65 2d 6c 69 62 72 t).(require-libr 02a0: 61 72 79 20 69 75 70 29 0a 28 69 6d 70 6f 72 74 ary iup).(import 02b0: 20 28 70 72 65 66 69 78 20 69 75 70 20 69 75 70 (prefix iup iup 02c0: 3a 29 29 0a 0a 28 75 73 65 20 63 61 6e 76 61 73 :))..(use canvas 02d0: 2d 64 72 61 77 29 0a 0a 28 75 73 65 20 73 71 6c -draw)..(use sql 02e0: 69 74 65 33 20 73 72 66 69 2d 31 20 70 6f 73 69 ite3 srfi-1 posi 02f0: 78 20 72 65 67 65 78 20 72 65 67 65 78 2d 63 61 x regex regex-ca 0300: 73 65 20 73 72 66 69 2d 36 39 29 0a 28 69 6d 70 se srfi-69).(imp 0310: 6f 72 74 20 28 70 72 65 66 69 78 20 73 71 6c 69 ort (prefix sqli 0320: 74 65 33 20 73 71 6c 69 74 65 33 3a 29 29 0a 0a te3 sqlite3:)).. 0330: 28 64 65 63 6c 61 72 65 20 28 75 6e 69 74 20 64 (declare (unit d 0340: 61 73 68 62 6f 61 72 64 2d 74 65 73 74 73 29 29 ashboard-tests)) 0350: 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 .(declare (uses 0360: 63 6f 6d 6d 6f 6e 29 29 0a 28 64 65 63 6c 61 72 common)).(declar 0370: 65 20 28 75 73 65 73 20 64 62 29 29 0a 0a 28 69 e (uses db))..(i 0380: 6e 63 6c 75 64 65 20 22 63 6f 6d 6d 6f 6e 5f 72 nclude "common_r 0390: 65 63 6f 72 64 73 2e 73 63 6d 22 29 0a 28 69 6e ecords.scm").(in 03a0: 63 6c 75 64 65 20 22 64 62 5f 72 65 63 6f 72 64 clude "db_record 03b0: 73 2e 73 63 6d 22 29 0a 28 69 6e 63 6c 75 64 65 s.scm").(include 03c0: 20 22 72 75 6e 5f 72 65 63 6f 72 64 73 2e 73 63 "run_records.sc 03d0: 6d 22 29 0a 0a 28 64 65 66 69 6e 65 20 28 74 65 m")..(define (te 03e0: 73 74 2d 69 6e 66 6f 2d 70 61 6e 65 6c 20 74 65 st-info-panel te 03f0: 73 74 64 61 74 20 73 74 6f 72 65 2d 6c 61 62 65 stdat store-labe 0400: 6c 20 77 69 64 67 65 74 73 29 0a 20 20 28 69 75 l widgets). (iu 0410: 70 3a 66 72 61 6d 65 20 0a 20 20 20 23 3a 74 69 p:frame . #:ti 0420: 74 6c 65 20 22 54 65 73 74 20 49 6e 66 6f 22 20 tle "Test Info" 0430: 3b 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53 22 ; #:expand "YES" 0440: 0a 20 20 20 28 69 75 70 3a 68 62 6f 78 20 3b 20 . (iup:hbox ; 0450: 23 3a 65 78 70 61 6e 64 20 22 59 45 53 22 0a 20 #:expand "YES". 0460: 20 20 20 28 61 70 70 6c 79 20 69 75 70 3a 76 62 (apply iup:vb 0470: 6f 78 20 3b 20 23 3a 65 78 70 61 6e 64 20 22 59 ox ; #:expand "Y 0480: 45 53 22 0a 09 20 20 20 28 61 70 70 65 6e 64 20 ES".. (append 0490: 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 76 61 (map (lambda (va 04a0: 6c 29 0a 09 09 09 20 20 28 69 75 70 3a 6c 61 62 l).... (iup:lab 04b0: 65 6c 20 76 61 6c 20 3b 20 23 3a 65 78 70 61 6e el val ; #:expan 04c0: 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 0a 09 d "HORIZONTAL".. 04d0: 09 09 09 20 20 20 20 20 29 29 0a 09 09 09 28 6c ... ))....(l 04e0: 69 73 74 20 22 54 65 73 74 6e 61 6d 65 3a 20 22 ist "Testname: " 04f0: 0a 09 09 09 20 20 20 20 20 20 22 49 74 65 6d 20 .... "Item 0500: 70 61 74 68 3a 20 22 0a 09 09 09 20 20 20 20 20 path: ".... 0510: 20 22 43 75 72 72 65 6e 74 20 73 74 61 74 65 3a "Current state: 0520: 20 22 0a 09 09 09 20 20 20 20 20 20 22 43 75 72 ".... "Cur 0530: 72 65 6e 74 20 73 74 61 74 75 73 3a 20 22 0a 09 rent status: ".. 0540: 09 09 20 20 20 20 20 20 22 54 65 73 74 20 63 6f .. "Test co 0550: 6d 6d 65 6e 74 3a 20 22 0a 09 09 09 20 20 20 20 mment: ".... 0560: 20 20 22 54 65 73 74 20 69 64 3a 20 22 29 29 0a "Test id: ")). 0570: 09 09 20 20 20 28 6c 69 73 74 20 28 69 75 70 3a .. (list (iup: 0580: 6c 61 62 65 6c 20 22 22 20 23 3a 65 78 70 61 6e label "" #:expan 0590: 64 20 22 56 45 52 54 49 43 41 4c 22 29 29 29 29 d "VERTICAL")))) 05a0: 0a 20 20 20 20 28 61 70 70 6c 79 20 69 75 70 3a . (apply iup: 05b0: 76 62 6f 78 20 20 3b 20 23 3a 65 78 70 61 6e 64 vbox ; #:expand 05c0: 20 22 59 45 53 22 0a 09 20 20 20 28 6c 69 73 74 "YES".. (list 05d0: 20 0a 09 20 20 20 20 28 73 74 6f 72 65 2d 6c 61 .. (store-la 05e0: 62 65 6c 20 22 74 65 73 74 6e 61 6d 65 22 0a 09 bel "testname".. 05f0: 09 09 20 28 69 75 70 3a 6c 61 62 65 6c 20 28 64 .. (iup:label (d 0600: 62 3a 74 65 73 74 2d 67 65 74 2d 74 65 73 74 6e b:test-get-testn 0610: 61 6d 65 20 20 74 65 73 74 64 61 74 29 20 23 3a ame testdat) #: 0620: 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 expand "HORIZONT 0630: 41 4c 22 29 0a 09 09 09 20 28 6c 61 6d 62 64 61 AL").... (lambda 0640: 20 28 74 65 73 74 64 61 74 29 28 64 62 3a 74 65 (testdat)(db:te 0650: 73 74 2d 67 65 74 2d 74 65 73 74 6e 61 6d 65 20 st-get-testname 0660: 74 65 73 74 64 61 74 29 29 29 0a 09 20 20 20 20 testdat))).. 0670: 28 73 74 6f 72 65 2d 6c 61 62 65 6c 20 22 69 74 (store-label "it 0680: 65 6d 2d 70 61 74 68 22 0a 09 09 09 20 28 69 75 em-path".... (iu 0690: 70 3a 6c 61 62 65 6c 20 28 64 62 3a 74 65 73 74 p:label (db:test 06a0: 2d 67 65 74 2d 69 74 65 6d 2d 70 61 74 68 20 74 -get-item-path t 06b0: 65 73 74 64 61 74 29 20 23 3a 65 78 70 61 6e 64 estdat) #:expand 06c0: 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 29 0a 09 "HORIZONTAL").. 06d0: 09 09 20 28 6c 61 6d 62 64 61 20 28 74 65 73 74 .. (lambda (test 06e0: 64 61 74 29 28 64 62 3a 74 65 73 74 2d 67 65 74 dat)(db:test-get 06f0: 2d 69 74 65 6d 2d 70 61 74 68 20 74 65 73 74 64 -item-path testd 0700: 61 74 29 29 29 0a 09 20 20 20 20 28 73 74 6f 72 at))).. (stor 0710: 65 2d 6c 61 62 65 6c 20 22 74 65 73 74 73 74 61 e-label "teststa 0720: 74 65 22 20 0a 09 09 09 20 28 69 75 70 3a 6c 61 te" .... (iup:la 0730: 62 65 6c 20 28 64 62 3a 74 65 73 74 2d 67 65 74 bel (db:test-get 0740: 2d 73 74 61 74 65 20 74 65 73 74 64 61 74 29 20 -state testdat) 0750: 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f #:expand "HORIZO 0760: 4e 54 41 4c 22 29 0a 09 09 09 20 28 6c 61 6d 62 NTAL").... (lamb 0770: 64 61 20 28 74 65 73 74 64 61 74 29 0a 09 09 09 da (testdat).... 0780: 20 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d (db:test-get- 0790: 73 74 61 74 65 20 74 65 73 74 64 61 74 29 29 29 state testdat))) 07a0: 0a 09 20 20 20 20 28 6c 65 74 20 28 28 6c 62 6c .. (let ((lbl 07b0: 20 20 20 28 69 75 70 3a 6c 61 62 65 6c 20 28 64 (iup:label (d 07c0: 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 75 b:test-get-statu 07d0: 73 20 74 65 73 74 64 61 74 29 20 23 3a 65 78 70 s testdat) #:exp 07e0: 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 and "HORIZONTAL" 07f0: 29 29 29 0a 09 20 20 20 20 20 20 28 68 61 73 68 ))).. (hash 0800: 2d 74 61 62 6c 65 2d 73 65 74 21 20 77 69 64 67 -table-set! widg 0810: 65 74 73 20 22 74 65 73 74 73 74 61 74 75 73 22 ets "teststatus" 0820: 0a 09 09 09 20 20 20 20 20 20 20 28 6c 61 6d 62 .... (lamb 0830: 64 61 20 28 74 65 73 74 64 61 74 29 0a 09 09 09 da (testdat).... 0840: 09 20 28 6c 65 74 20 28 28 6e 65 77 73 74 61 74 . (let ((newstat 0850: 75 73 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d us (db:test-get- 0860: 73 74 61 74 75 73 20 74 65 73 74 64 61 74 29 29 status testdat)) 0870: 0a 09 09 09 09 20 20 20 20 20 20 20 28 6f 6c 64 ..... (old 0880: 73 74 61 74 75 73 20 28 69 75 70 3a 61 74 74 72 status (iup:attr 0890: 69 62 75 74 65 20 6c 62 6c 20 22 54 49 54 4c 45 ibute lbl "TITLE 08a0: 22 29 29 29 0a 09 09 09 09 20 20 20 28 69 66 20 ")))..... (if 08b0: 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 6f 6c 64 (not (equal? old 08c0: 73 74 61 74 75 73 20 6e 65 77 73 74 61 74 75 73 status newstatus 08d0: 29 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 62 ))..... (b 08e0: 65 67 69 6e 0a 09 09 09 09 09 20 28 69 75 70 3a egin...... (iup: 08f0: 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 6c attribute-set! l 0900: 62 6c 20 22 46 47 43 4f 4c 4f 52 22 20 28 63 6f bl "FGCOLOR" (co 0910: 6d 6d 6f 6e 3a 67 65 74 2d 63 6f 6c 6f 72 2d 66 mmon:get-color-f 0920: 6f 72 2d 73 74 61 74 65 2d 73 74 61 74 75 73 20 or-state-status 0930: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 (db:test-get-sta 0940: 74 65 20 74 65 73 74 64 61 74 29 0a 09 09 09 09 te testdat)..... 0950: 09 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 ........ ( 0960: 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 db:test-get-stat 0970: 75 73 20 74 65 73 74 64 61 74 29 29 29 0a 09 09 us testdat)))... 0980: 09 09 09 20 28 69 75 70 3a 61 74 74 72 69 62 75 ... (iup:attribu 0990: 74 65 2d 73 65 74 21 20 6c 62 6c 20 22 54 49 54 te-set! lbl "TIT 09a0: 4c 45 22 20 28 64 62 3a 74 65 73 74 2d 67 65 74 LE" (db:test-get 09b0: 2d 73 74 61 74 75 73 20 74 65 73 74 64 61 74 29 -status testdat) 09c0: 29 29 29 29 29 29 0a 09 20 20 20 20 20 20 6c 62 )))))).. lb 09d0: 6c 29 0a 09 20 20 20 20 28 73 74 6f 72 65 2d 6c l).. (store-l 09e0: 61 62 65 6c 20 22 74 65 73 74 63 6f 6d 6d 65 6e abel "testcommen 09f0: 74 22 0a 09 09 09 20 28 69 75 70 3a 6c 61 62 65 t".... (iup:labe 0a00: 6c 20 22 54 65 73 74 43 6f 6d 6d 65 6e 74 20 20 l "TestComment 0a10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0a20: 20 20 20 20 20 20 20 20 20 20 20 22 0a 09 09 09 ".... 0a30: 09 20 20 20 20 23 3a 65 78 70 61 6e 64 20 22 48 . #:expand "H 0a40: 4f 52 49 5a 4f 4e 54 41 4c 22 29 0a 09 09 09 20 ORIZONTAL").... 0a50: 28 6c 61 6d 62 64 61 20 28 74 65 73 74 64 61 74 (lambda (testdat 0a60: 29 0a 09 09 09 20 20 20 28 64 62 3a 74 65 73 74 ).... (db:test 0a70: 2d 67 65 74 2d 63 6f 6d 6d 65 6e 74 20 74 65 73 -get-comment tes 0a80: 74 64 61 74 29 29 29 0a 09 20 20 20 20 28 73 74 tdat))).. (st 0a90: 6f 72 65 2d 6c 61 62 65 6c 20 22 74 65 73 74 69 ore-label "testi 0aa0: 64 22 0a 09 09 09 20 28 69 75 70 3a 6c 61 62 65 d".... (iup:labe 0ab0: 6c 20 22 54 65 73 74 49 64 20 20 20 20 20 20 20 l "TestId 0ac0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0ad0: 20 20 20 20 20 20 22 0a 09 09 09 09 20 20 20 20 "..... 0ae0: 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f #:expand "HORIZO 0af0: 4e 54 41 4c 22 29 0a 09 09 09 20 28 6c 61 6d 62 NTAL").... (lamb 0b00: 64 61 20 28 74 65 73 74 64 61 74 29 0a 09 09 09 da (testdat).... 0b10: 20 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d (db:test-get- 0b20: 69 64 20 74 65 73 74 64 61 74 29 29 29 0a 09 20 id testdat))).. 0b30: 20 20 20 29 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d )))))..;;==== 0b40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0b50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0b60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0b70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0b80: 3d 3d 0a 3b 3b 20 54 65 73 74 20 6d 65 74 61 20 ==.;; Test meta 0b90: 70 61 6e 65 6c 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d panel.;;======== 0ba0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0bb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0bc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0bd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a ==============.. 0be0: 28 64 65 66 69 6e 65 20 28 74 65 73 74 2d 6d 65 (define (test-me 0bf0: 74 61 2d 70 61 6e 65 6c 2d 67 65 74 2d 64 65 73 ta-panel-get-des 0c00: 63 72 69 70 74 69 6f 6e 20 74 65 73 74 6d 65 74 cription testmet 0c10: 61 29 0a 20 20 28 66 6d 74 20 23 66 20 28 77 69 a). (fmt #f (wi 0c20: 74 68 2d 77 69 64 74 68 20 34 30 20 28 77 72 61 th-width 40 (wra 0c30: 70 2d 6c 69 6e 65 73 20 28 64 62 3a 74 65 73 74 p-lines (db:test 0c40: 6d 65 74 61 2d 67 65 74 2d 64 65 73 63 72 69 70 meta-get-descrip 0c50: 74 69 6f 6e 20 74 65 73 74 6d 65 74 61 29 29 29 tion testmeta))) 0c60: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 74 65 73 ))..(define (tes 0c70: 74 2d 6d 65 74 61 2d 70 61 6e 65 6c 20 74 65 73 t-meta-panel tes 0c80: 74 6d 65 74 61 20 73 74 6f 72 65 2d 6d 65 74 61 tmeta store-meta 0c90: 29 0a 20 20 28 69 75 70 3a 66 72 61 6d 65 20 0a ). (iup:frame . 0ca0: 20 20 20 23 3a 74 69 74 6c 65 20 22 54 65 73 74 #:title "Test 0cb0: 20 4d 65 74 61 20 44 61 74 61 22 20 3b 20 23 3a Meta Data" ; #: 0cc0: 65 78 70 61 6e 64 20 22 59 45 53 22 0a 20 20 20 expand "YES". 0cd0: 28 69 75 70 3a 68 62 6f 78 20 3b 20 23 3a 65 78 (iup:hbox ; #:ex 0ce0: 70 61 6e 64 20 22 59 45 53 22 0a 20 20 20 20 28 pand "YES". ( 0cf0: 61 70 70 6c 79 20 69 75 70 3a 76 62 6f 78 20 3b apply iup:vbox ; 0d00: 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53 22 0a #:expand "YES". 0d10: 09 20 20 20 28 61 70 70 65 6e 64 20 28 6d 61 70 . (append (map 0d20: 20 28 6c 61 6d 62 64 61 20 28 76 61 6c 29 0a 09 (lambda (val).. 0d30: 09 09 20 20 28 69 75 70 3a 6c 61 62 65 6c 20 76 .. (iup:label v 0d40: 61 6c 20 3b 20 23 3a 65 78 70 61 6e 64 20 22 48 al ; #:expand "H 0d50: 4f 52 49 5a 4f 4e 54 41 4c 22 0a 09 09 09 09 20 ORIZONTAL"..... 0d60: 20 20 20 20 29 29 0a 09 09 09 28 6c 69 73 74 20 ))....(list 0d70: 22 41 75 74 68 6f 72 3a 20 22 0a 09 09 09 20 20 "Author: ".... 0d80: 20 20 20 20 22 4f 77 6e 65 72 3a 20 22 0a 09 09 "Owner: "... 0d90: 09 20 20 20 20 20 20 22 52 65 76 69 65 77 65 64 . "Reviewed 0da0: 3a 20 22 0a 09 09 09 20 20 20 20 20 20 22 54 61 : ".... "Ta 0db0: 67 73 3a 20 22 0a 09 09 09 20 20 20 20 20 20 22 gs: ".... " 0dc0: 44 65 73 63 72 69 70 74 69 6f 6e 3a 20 22 0a 09 Description: ".. 0dd0: 09 09 20 20 20 20 20 20 29 29 0a 09 09 20 20 20 .. ))... 0de0: 28 6c 69 73 74 20 28 69 75 70 3a 6c 61 62 65 6c (list (iup:label 0df0: 20 22 22 20 23 3a 65 78 70 61 6e 64 20 22 56 45 "" #:expand "VE 0e00: 52 54 49 43 41 4c 22 29 29 29 29 0a 20 20 20 20 RTICAL")))). 0e10: 28 61 70 70 6c 79 20 69 75 70 3a 76 62 6f 78 20 (apply iup:vbox 0e20: 20 3b 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53 ; #:expand "YES 0e30: 22 0a 09 20 20 20 28 6c 69 73 74 20 0a 09 20 20 ".. (list .. 0e40: 20 20 28 73 74 6f 72 65 2d 6d 65 74 61 20 22 61 (store-meta "a 0e50: 75 74 68 6f 72 22 0a 09 09 09 20 28 69 75 70 3a uthor".... (iup: 0e60: 6c 61 62 65 6c 20 28 64 62 3a 74 65 73 74 6d 65 label (db:testme 0e70: 74 61 2d 67 65 74 2d 61 75 74 68 6f 72 20 74 65 ta-get-author te 0e80: 73 74 6d 65 74 61 29 20 23 3a 65 78 70 61 6e 64 stmeta) #:expand 0e90: 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 29 0a 09 "HORIZONTAL").. 0ea0: 09 09 20 28 6c 61 6d 62 64 61 20 28 74 65 73 74 .. (lambda (test 0eb0: 6d 65 74 61 29 28 64 62 3a 74 65 73 74 6d 65 74 meta)(db:testmet 0ec0: 61 2d 67 65 74 2d 61 75 74 68 6f 72 20 74 65 73 a-get-author tes 0ed0: 74 6d 65 74 61 29 29 29 0a 09 20 20 20 20 28 73 tmeta))).. (s 0ee0: 74 6f 72 65 2d 6d 65 74 61 20 22 6f 77 6e 65 72 tore-meta "owner 0ef0: 22 0a 09 09 09 20 28 69 75 70 3a 6c 61 62 65 6c ".... (iup:label 0f00: 20 28 64 62 3a 74 65 73 74 6d 65 74 61 2d 67 65 (db:testmeta-ge 0f10: 74 2d 6f 77 6e 65 72 20 74 65 73 74 6d 65 74 61 t-owner testmeta 0f20: 29 20 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 ) #:expand "HORI 0f30: 5a 4f 4e 54 41 4c 22 29 0a 09 09 09 20 28 6c 61 ZONTAL").... (la 0f40: 6d 62 64 61 20 28 74 65 73 74 6d 65 74 61 29 28 mbda (testmeta)( 0f50: 64 62 3a 74 65 73 74 6d 65 74 61 2d 67 65 74 2d db:testmeta-get- 0f60: 6f 77 6e 65 72 20 74 65 73 74 6d 65 74 61 29 29 owner testmeta)) 0f70: 29 0a 09 20 20 20 20 28 73 74 6f 72 65 2d 6d 65 ).. (store-me 0f80: 74 61 20 22 72 65 76 69 65 77 65 64 22 20 0a 09 ta "reviewed" .. 0f90: 09 09 20 28 69 75 70 3a 6c 61 62 65 6c 20 28 64 .. (iup:label (d 0fa0: 62 3a 74 65 73 74 6d 65 74 61 2d 67 65 74 2d 72 b:testmeta-get-r 0fb0: 65 76 69 65 77 65 64 20 74 65 73 74 6d 65 74 61 eviewed testmeta 0fc0: 29 20 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 ) #:expand "HORI 0fd0: 5a 4f 4e 54 41 4c 22 29 0a 09 09 09 20 28 6c 61 ZONTAL").... (la 0fe0: 6d 62 64 61 20 28 74 65 73 74 6d 65 74 61 29 28 mbda (testmeta)( 0ff0: 64 62 3a 74 65 73 74 6d 65 74 61 2d 67 65 74 2d db:testmeta-get- 1000: 72 65 76 69 65 77 65 64 20 74 65 73 74 6d 65 74 reviewed testmet 1010: 61 29 29 29 0a 09 20 20 20 20 28 73 74 6f 72 65 a))).. (store 1020: 2d 6d 65 74 61 20 22 74 61 67 73 22 20 0a 09 09 -meta "tags" ... 1030: 09 20 28 69 75 70 3a 6c 61 62 65 6c 20 28 64 62 . (iup:label (db 1040: 3a 74 65 73 74 6d 65 74 61 2d 67 65 74 2d 74 61 :testmeta-get-ta 1050: 67 73 20 74 65 73 74 6d 65 74 61 29 20 23 3a 65 gs testmeta) #:e 1060: 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 xpand "HORIZONTA 1070: 4c 22 29 0a 09 09 09 20 28 6c 61 6d 62 64 61 20 L").... (lambda 1080: 28 74 65 73 74 6d 65 74 61 29 28 64 62 3a 74 65 (testmeta)(db:te 1090: 73 74 6d 65 74 61 2d 67 65 74 2d 74 61 67 73 20 stmeta-get-tags 10a0: 74 65 73 74 6d 65 74 61 29 29 29 0a 09 20 20 20 testmeta))).. 10b0: 20 28 73 74 6f 72 65 2d 6d 65 74 61 20 22 64 65 (store-meta "de 10c0: 73 63 72 69 70 74 69 6f 6e 22 20 0a 09 09 09 20 scription" .... 10d0: 28 69 75 70 3a 6c 61 62 65 6c 20 28 74 65 73 74 (iup:label (test 10e0: 2d 6d 65 74 61 2d 70 61 6e 65 6c 2d 67 65 74 2d -meta-panel-get- 10f0: 64 65 73 63 72 69 70 74 69 6f 6e 20 74 65 73 74 description test 1100: 6d 65 74 61 29 20 23 3a 73 69 7a 65 20 22 78 35 meta) #:size "x5 1110: 30 22 29 3b 20 23 3a 65 78 70 61 6e 64 20 22 48 0"); #:expand "H 1120: 4f 52 49 5a 4f 4e 54 41 4c 22 29 0a 09 09 09 20 ORIZONTAL").... 1130: 28 6c 61 6d 62 64 61 20 28 74 65 73 74 6d 65 74 (lambda (testmet 1140: 61 29 0a 09 09 09 20 20 20 28 74 65 73 74 2d 6d a).... (test-m 1150: 65 74 61 2d 70 61 6e 65 6c 2d 67 65 74 2d 64 65 eta-panel-get-de 1160: 73 63 72 69 70 74 69 6f 6e 20 74 65 73 74 6d 65 scription testme 1170: 74 61 29 29 29 0a 09 20 20 20 20 29 29 29 29 29 ta))).. ))))) 1180: 0a 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ...;;=========== 1190: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 11a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 11b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 11c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 52 ===========.;; R 11d0: 75 6e 20 69 6e 66 6f 20 70 61 6e 65 6c 0a 3b 3b un info panel.;; 11e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 11f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1200: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1210: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1220: 3d 3d 3d 3d 3d 3d 0a 28 64 65 66 69 6e 65 20 28 ======.(define ( 1230: 72 75 6e 2d 69 6e 66 6f 2d 70 61 6e 65 6c 20 6b run-info-panel k 1240: 65 79 64 61 74 20 74 65 73 74 64 61 74 20 72 75 eydat testdat ru 1250: 6e 6e 61 6d 65 29 0a 20 20 28 69 75 70 3a 66 72 nname). (iup:fr 1260: 61 6d 65 20 0a 20 20 20 23 3a 74 69 74 6c 65 20 ame . #:title 1270: 22 4d 65 67 61 74 65 73 74 20 52 75 6e 20 49 6e "Megatest Run In 1280: 66 6f 22 20 3b 20 23 3a 65 78 70 61 6e 64 20 22 fo" ; #:expand " 1290: 59 45 53 22 0a 20 20 20 28 69 75 70 3a 68 62 6f YES". (iup:hbo 12a0: 78 20 3b 20 23 3a 65 78 70 61 6e 64 20 22 59 45 x ; #:expand "YE 12b0: 53 22 0a 20 20 20 20 28 61 70 70 6c 79 20 69 75 S". (apply iu 12c0: 70 3a 76 62 6f 78 20 3b 20 23 3a 65 78 70 61 6e p:vbox ; #:expan 12d0: 64 20 22 59 45 53 22 0a 09 20 20 20 28 61 70 70 d "YES".. (app 12e0: 65 6e 64 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 end (map (lambda 12f0: 20 28 6b 65 79 76 61 6c 29 0a 09 09 09 20 20 28 (keyval).... ( 1300: 69 75 70 3a 6c 61 62 65 6c 20 28 63 6f 6e 63 20 iup:label (conc 1310: 28 63 61 72 20 6b 65 79 76 61 6c 29 20 22 20 22 (car keyval) " " 1320: 29 20 3b 20 23 3a 65 78 70 61 6e 64 20 22 48 4f ) ; #:expand "HO 1330: 52 49 5a 4f 4e 54 41 4c 22 0a 09 09 09 09 20 20 RIZONTAL"..... 1340: 20 20 20 29 29 0a 09 09 09 6b 65 79 64 61 74 29 ))....keydat) 1350: 0a 09 09 20 20 20 28 6c 69 73 74 20 28 69 75 70 ... (list (iup 1360: 3a 6c 61 62 65 6c 20 22 72 75 6e 6e 61 6d 65 20 :label "runname 1370: 22 29 28 69 75 70 3a 6c 61 62 65 6c 20 22 72 75 ")(iup:label "ru 1380: 6e 2d 69 64 22 29 29 29 29 0a 20 20 20 20 28 61 n-id")))). (a 1390: 70 70 6c 79 20 69 75 70 3a 76 62 6f 78 0a 09 20 pply iup:vbox.. 13a0: 20 20 28 61 70 70 65 6e 64 20 28 6d 61 70 20 28 (append (map ( 13b0: 6c 61 6d 62 64 61 20 28 6b 65 79 76 61 6c 29 0a lambda (keyval). 13c0: 09 09 09 20 20 28 69 75 70 3a 6c 61 62 65 6c 20 ... (iup:label 13d0: 28 63 61 64 72 20 6b 65 79 76 61 6c 29 20 23 3a (cadr keyval) #: 13e0: 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 expand "HORIZONT 13f0: 41 4c 22 29 29 0a 09 09 09 6b 65 79 64 61 74 29 AL"))....keydat) 1400: 0a 09 09 20 20 20 28 6c 69 73 74 20 28 69 75 70 ... (list (iup 1410: 3a 6c 61 62 65 6c 20 72 75 6e 6e 61 6d 65 29 0a :label runname). 1420: 09 09 09 20 28 69 75 70 3a 6c 61 62 65 6c 20 28 ... (iup:label ( 1430: 63 6f 6e 63 20 28 64 62 3a 74 65 73 74 2d 67 65 conc (db:test-ge 1440: 74 2d 72 75 6e 5f 69 64 20 74 65 73 74 64 61 74 t-run_id testdat 1450: 29 29 29 0a 09 09 09 20 28 69 75 70 3a 6c 61 62 ))).... (iup:lab 1460: 65 6c 20 22 22 20 23 3a 65 78 70 61 6e 64 20 22 el "" #:expand " 1470: 56 45 52 54 49 43 41 4c 22 29 29 29 29 29 29 29 VERTICAL"))))))) 1480: 0a 20 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d . .;;========== 1490: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 14a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 14b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 14c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;; 14d0: 48 6f 73 74 20 69 6e 66 6f 20 70 61 6e 65 6c 0a Host info panel. 14e0: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;============== 14f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1500: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1510: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1520: 3d 3d 3d 3d 3d 3d 3d 3d 0a 28 64 65 66 69 6e 65 ========.(define 1530: 20 28 68 6f 73 74 2d 69 6e 66 6f 2d 70 61 6e 65 (host-info-pane 1540: 6c 20 74 65 73 74 64 61 74 20 73 74 6f 72 65 2d l testdat store- 1550: 6c 61 62 65 6c 29 0a 20 20 28 69 75 70 3a 66 72 label). (iup:fr 1560: 61 6d 65 0a 20 20 20 23 3a 74 69 74 6c 65 20 22 ame. #:title " 1570: 52 65 6d 6f 74 65 20 68 6f 73 74 20 61 6e 64 20 Remote host and 1580: 54 65 73 74 20 52 75 6e 20 49 6e 66 6f 22 20 3b Test Run Info" ; 1590: 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53 22 0a #:expand "YES". 15a0: 20 20 20 28 69 75 70 3a 68 62 6f 78 20 3b 20 23 (iup:hbox ; # 15b0: 3a 65 78 70 61 6e 64 20 22 59 45 53 22 0a 20 20 :expand "YES". 15c0: 20 20 28 61 70 70 6c 79 20 69 75 70 3a 76 62 6f (apply iup:vbo 15d0: 78 20 3b 20 23 3a 65 78 70 61 6e 64 20 22 59 45 x ; #:expand "YE 15e0: 53 22 20 3b 3b 20 54 68 65 20 68 65 61 64 69 6e S" ;; The headin 15f0: 67 20 6c 61 62 65 6c 73 0a 09 20 20 20 28 61 70 g labels.. (ap 1600: 70 65 6e 64 20 28 6d 61 70 20 28 6c 61 6d 62 64 pend (map (lambd 1610: 61 20 28 76 61 6c 29 0a 09 09 09 20 20 28 69 75 a (val).... (iu 1620: 70 3a 6c 61 62 65 6c 20 76 61 6c 20 3b 20 23 3a p:label val ; #: 1630: 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 expand "HORIZONT 1640: 41 4c 22 0a 09 09 09 09 20 20 20 20 20 29 29 0a AL"..... )). 1650: 09 09 09 28 6c 69 73 74 20 22 48 6f 73 74 6e 61 ...(list "Hostna 1660: 6d 65 3a 20 22 0a 09 09 09 20 20 20 20 20 20 22 me: ".... " 1670: 55 6e 61 6d 65 20 2d 61 3a 20 22 0a 09 09 09 20 Uname -a: ".... 1680: 20 20 20 20 20 22 44 69 73 6b 20 66 72 65 65 3a "Disk free: 1690: 20 22 0a 09 09 09 20 20 20 20 20 20 22 43 50 55 ".... "CPU 16a0: 20 4c 6f 61 64 3a 20 22 0a 09 09 09 20 20 20 20 Load: ".... 16b0: 20 20 22 52 75 6e 20 64 75 72 61 74 69 6f 6e 3a "Run duration: 16c0: 20 22 0a 09 09 09 20 20 20 20 20 20 22 4c 6f 67 ".... "Log 16d0: 66 69 6c 65 3a 20 22 29 29 0a 09 09 20 20 20 28 file: "))... ( 16e0: 69 75 70 3a 6c 61 62 65 6c 20 22 22 20 23 3a 65 iup:label "" #:e 16f0: 78 70 61 6e 64 20 22 56 45 52 54 49 43 41 4c 22 xpand "VERTICAL" 1700: 29 29 29 0a 20 20 20 20 28 61 70 70 6c 79 20 69 ))). (apply i 1710: 75 70 3a 76 62 6f 78 20 3b 20 23 3a 65 78 70 61 up:vbox ; #:expa 1720: 6e 64 20 22 59 45 53 22 0a 09 20 20 20 28 6c 69 nd "YES".. (li 1730: 73 74 0a 09 20 20 20 20 3b 3b 20 4e 4f 54 45 3a st.. ;; NOTE: 1740: 20 59 65 73 2c 20 74 68 65 20 68 6f 73 74 20 63 Yes, the host c 1750: 61 6e 20 63 68 61 6e 67 65 21 0a 09 20 20 20 20 an change!.. 1760: 28 73 74 6f 72 65 2d 6c 61 62 65 6c 20 22 48 6f (store-label "Ho 1770: 73 74 4e 61 6d 65 22 0a 09 09 09 20 28 69 75 70 stName".... (iup 1780: 3a 6c 61 62 65 6c 20 28 64 62 3a 74 65 73 74 2d :label (db:test- 1790: 67 65 74 2d 68 6f 73 74 20 74 65 73 74 64 61 74 get-host testdat 17a0: 29 20 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 ) #:expand "HORI 17b0: 5a 4f 4e 54 41 4c 22 29 0a 09 09 09 20 28 6c 61 ZONTAL").... (la 17c0: 6d 62 64 61 20 28 74 65 73 74 64 61 74 29 28 64 mbda (testdat)(d 17d0: 62 3a 74 65 73 74 2d 67 65 74 2d 68 6f 73 74 20 b:test-get-host 17e0: 74 65 73 74 64 61 74 29 29 29 0a 09 20 20 20 20 testdat))).. 17f0: 28 73 74 6f 72 65 2d 6c 61 62 65 6c 20 22 55 6e (store-label "Un 1800: 61 6d 65 22 0a 09 09 09 20 28 69 75 70 3a 6c 61 ame".... (iup:la 1810: 62 65 6c 20 22 20 20 20 20 20 20 20 20 20 20 20 bel " 1820: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 1830: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 1840: 20 20 20 20 20 20 20 20 22 20 23 3a 65 78 70 61 " #:expa 1850: 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 29 nd "HORIZONTAL") 1860: 0a 09 09 09 20 28 6c 61 6d 62 64 61 20 28 74 65 .... (lambda (te 1870: 73 74 64 61 74 29 28 64 62 3a 74 65 73 74 2d 67 stdat)(db:test-g 1880: 65 74 2d 75 6e 61 6d 65 20 74 65 73 74 64 61 74 et-uname testdat 1890: 29 29 29 0a 09 20 20 20 20 28 73 74 6f 72 65 2d ))).. (store- 18a0: 6c 61 62 65 6c 20 22 44 69 73 6b 46 72 65 65 22 label "DiskFree" 18b0: 0a 09 09 09 20 28 69 75 70 3a 6c 61 62 65 6c 20 .... (iup:label 18c0: 28 63 6f 6e 63 20 28 64 62 3a 74 65 73 74 2d 67 (conc (db:test-g 18d0: 65 74 2d 64 69 73 6b 66 72 65 65 20 74 65 73 74 et-diskfree test 18e0: 64 61 74 29 29 20 23 3a 65 78 70 61 6e 64 20 22 dat)) #:expand " 18f0: 48 4f 52 49 5a 4f 4e 54 41 4c 22 29 0a 09 09 09 HORIZONTAL").... 1900: 20 28 6c 61 6d 62 64 61 20 28 74 65 73 74 64 61 (lambda (testda 1910: 74 29 28 63 6f 6e 63 20 28 64 62 3a 74 65 73 74 t)(conc (db:test 1920: 2d 67 65 74 2d 64 69 73 6b 66 72 65 65 20 74 65 -get-diskfree te 1930: 73 74 64 61 74 29 29 29 29 0a 09 20 20 20 20 28 stdat)))).. ( 1940: 73 74 6f 72 65 2d 6c 61 62 65 6c 20 22 43 50 55 store-label "CPU 1950: 4c 6f 61 64 22 0a 09 09 09 20 28 69 75 70 3a 6c Load".... (iup:l 1960: 61 62 65 6c 20 28 63 6f 6e 63 20 28 64 62 3a 74 abel (conc (db:t 1970: 65 73 74 2d 67 65 74 2d 63 70 75 6c 6f 61 64 20 est-get-cpuload 1980: 74 65 73 74 64 61 74 29 29 20 23 3a 65 78 70 61 testdat)) #:expa 1990: 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 29 nd "HORIZONTAL") 19a0: 0a 09 09 09 20 28 6c 61 6d 62 64 61 20 28 74 65 .... (lambda (te 19b0: 73 74 64 61 74 29 28 63 6f 6e 63 20 28 64 62 3a stdat)(conc (db: 19c0: 74 65 73 74 2d 67 65 74 2d 63 70 75 6c 6f 61 64 test-get-cpuload 19d0: 20 74 65 73 74 64 61 74 29 29 29 29 0a 09 20 20 testdat)))).. 19e0: 20 20 28 73 74 6f 72 65 2d 6c 61 62 65 6c 20 22 (store-label " 19f0: 52 75 6e 44 75 72 61 74 69 6f 6e 22 0a 09 09 09 RunDuration".... 1a00: 20 28 69 75 70 3a 6c 61 62 65 6c 20 28 63 6f 6e (iup:label (con 1a10: 63 20 28 73 65 63 6f 6e 64 73 2d 3e 68 72 2d 6d c (seconds->hr-m 1a20: 69 6e 2d 73 65 63 20 28 64 62 3a 74 65 73 74 2d in-sec (db:test- 1a30: 67 65 74 2d 72 75 6e 5f 64 75 72 61 74 69 6f 6e get-run_duration 1a40: 20 74 65 73 74 64 61 74 29 29 29 20 23 3a 65 78 testdat))) #:ex 1a50: 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c pand "HORIZONTAL 1a60: 22 29 0a 09 09 09 20 28 6c 61 6d 62 64 61 20 28 ").... (lambda ( 1a70: 74 65 73 74 64 61 74 29 28 63 6f 6e 63 20 28 73 testdat)(conc (s 1a80: 65 63 6f 6e 64 73 2d 3e 68 72 2d 6d 69 6e 2d 73 econds->hr-min-s 1a90: 65 63 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d ec (db:test-get- 1aa0: 72 75 6e 5f 64 75 72 61 74 69 6f 6e 20 74 65 73 run_duration tes 1ab0: 74 64 61 74 29 29 29 29 29 0a 09 20 20 20 20 28 tdat))))).. ( 1ac0: 73 74 6f 72 65 2d 6c 61 62 65 6c 20 22 43 50 55 store-label "CPU 1ad0: 4c 6f 61 64 22 0a 09 09 09 20 28 69 75 70 3a 6c Load".... (iup:l 1ae0: 61 62 65 6c 20 28 63 6f 6e 63 20 28 64 62 3a 74 abel (conc (db:t 1af0: 65 73 74 2d 67 65 74 2d 66 69 6e 61 6c 5f 6c 6f est-get-final_lo 1b00: 67 66 20 74 65 73 74 64 61 74 29 29 20 23 3a 65 gf testdat)) #:e 1b10: 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 xpand "HORIZONTA 1b20: 4c 22 29 0a 09 09 09 20 28 6c 61 6d 62 64 61 20 L").... (lambda 1b30: 28 74 65 73 74 64 61 74 29 28 63 6f 6e 63 20 28 (testdat)(conc ( 1b40: 64 62 3a 74 65 73 74 2d 67 65 74 2d 66 69 6e 61 db:test-get-fina 1b50: 6c 5f 6c 6f 67 66 20 74 65 73 74 64 61 74 29 29 l_logf testdat)) 1b60: 29 29 29 29 29 29 29 0a 0a 3b 3b 20 75 73 65 20 )))))))..;; use 1b70: 61 20 67 6c 6f 62 61 6c 20 66 6f 72 20 73 65 74 a global for set 1b80: 74 69 6e 67 20 74 68 65 20 62 75 74 74 6f 6e 73 ting the buttons 1b90: 20 63 6f 6c 6f 72 73 0a 3b 3b 20 20 20 20 20 20 colors.;; 1ba0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 1bb0: 20 20 20 20 20 73 74 61 74 65 20 73 74 61 74 75 state statu 1bc0: 73 20 74 65 73 74 73 74 65 70 73 0a 28 64 65 66 s teststeps.(def 1bd0: 69 6e 65 20 2a 73 74 61 74 65 2d 73 74 61 74 75 ine *state-statu 1be0: 73 2a 20 28 76 65 63 74 6f 72 20 23 66 20 23 66 s* (vector #f #f 1bf0: 20 23 66 29 29 0a 28 64 65 66 69 6e 65 20 28 75 #f)).(define (u 1c00: 70 64 61 74 65 2d 73 74 61 74 65 2d 73 74 61 74 pdate-state-stat 1c10: 75 73 2d 62 75 74 74 6f 6e 73 20 74 65 73 74 64 us-buttons testd 1c20: 61 74 29 0a 20 20 28 6c 65 74 2a 20 28 28 73 74 at). (let* ((st 1c30: 61 74 65 20 20 28 64 62 3a 74 65 73 74 2d 67 65 ate (db:test-ge 1c40: 74 2d 73 74 61 74 65 20 20 74 65 73 74 64 61 74 t-state testdat 1c50: 29 29 0a 09 20 28 73 74 61 74 75 73 20 28 64 62 )).. (status (db 1c60: 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 75 73 :test-get-status 1c70: 20 74 65 73 74 64 61 74 29 29 0a 09 20 28 63 6f testdat)).. (co 1c80: 6c 6f 72 20 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 lor (common:get 1c90: 2d 63 6f 6c 6f 72 2d 66 6f 72 2d 73 74 61 74 65 -color-for-state 1ca0: 2d 73 74 61 74 75 73 20 73 74 61 74 65 20 73 74 -status state st 1cb0: 61 74 75 73 29 29 29 0a 20 20 20 20 28 28 76 65 atus))). ((ve 1cc0: 63 74 6f 72 2d 72 65 66 20 2a 73 74 61 74 65 2d ctor-ref *state- 1cd0: 73 74 61 74 75 73 2a 20 30 29 20 73 74 61 74 65 status* 0) state 1ce0: 20 63 6f 6c 6f 72 29 0a 20 20 20 20 28 28 76 65 color). ((ve 1cf0: 63 74 6f 72 2d 72 65 66 20 2a 73 74 61 74 65 2d ctor-ref *state- 1d00: 73 74 61 74 75 73 2a 20 31 29 20 73 74 61 74 75 status* 1) statu 1d10: 73 20 63 6f 6c 6f 72 29 29 29 0a 0a 3b 3b 3d 3d s color)))..;;== 1d20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1d30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1d40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1d50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1d60: 3d 3d 3d 3d 0a 3b 3b 20 53 65 74 20 66 69 65 6c ====.;; Set fiel 1d70: 64 73 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ds .;;========== 1d80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1d90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1da0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1db0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 28 64 65 ============.(de 1dc0: 66 69 6e 65 20 28 73 65 74 2d 66 69 65 6c 64 73 fine (set-fields 1dd0: 2d 70 61 6e 65 6c 20 74 65 73 74 2d 69 64 20 74 -panel test-id t 1de0: 65 73 74 64 61 74 29 0a 20 20 28 6c 65 74 20 28 estdat). (let ( 1df0: 28 6e 65 77 63 6f 6d 6d 65 6e 74 20 23 66 29 0a (newcomment #f). 1e00: 09 28 6e 65 77 73 74 61 74 75 73 20 20 23 66 29 .(newstatus #f) 1e10: 0a 09 28 6e 65 77 73 74 61 74 65 20 20 20 23 66 ..(newstate #f 1e20: 29 29 0a 20 20 20 20 28 69 75 70 3a 66 72 61 6d )). (iup:fram 1e30: 65 0a 20 20 20 20 20 23 3a 74 69 74 6c 65 20 22 e. #:title " 1e40: 53 65 74 20 66 69 65 6c 64 73 22 0a 20 20 20 20 Set fields". 1e50: 20 28 69 75 70 3a 76 62 6f 78 0a 20 20 20 20 20 (iup:vbox. 1e60: 20 28 69 75 70 3a 68 62 6f 78 20 28 69 75 70 3a (iup:hbox (iup: 1e70: 6c 61 62 65 6c 20 22 43 6f 6d 6d 65 6e 74 3a 22 label "Comment:" 1e80: 29 0a 09 09 28 69 75 70 3a 74 65 78 74 62 6f 78 )...(iup:textbox 1e90: 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 #:action (lambd 1ea0: 61 20 28 76 61 6c 20 61 20 62 29 0a 09 09 09 09 a (val a b)..... 1eb0: 09 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 .(open-run-close 1ec0: 20 64 62 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 db:test-set-sta 1ed0: 74 65 2d 73 74 61 74 75 73 2d 62 79 2d 69 64 20 te-status-by-id 1ee0: 23 66 20 74 65 73 74 2d 69 64 20 23 66 20 23 66 #f test-id #f #f 1ef0: 20 62 29 0a 09 09 09 09 09 28 73 65 74 21 20 6e b)......(set! n 1f00: 65 77 63 6f 6d 6d 65 6e 74 20 62 29 29 0a 09 09 ewcomment b))... 1f10: 09 20 20 20 20 20 23 3a 76 61 6c 75 65 20 28 64 . #:value (d 1f20: 62 3a 74 65 73 74 2d 67 65 74 2d 63 6f 6d 6d 65 b:test-get-comme 1f30: 6e 74 20 74 65 73 74 64 61 74 29 0a 09 09 09 20 nt testdat).... 1f40: 20 20 20 20 23 3a 65 78 70 61 6e 64 20 22 48 4f #:expand "HO 1f50: 52 49 5a 4f 4e 54 41 4c 22 29 29 0a 20 20 20 20 RIZONTAL")). 1f60: 20 20 28 61 70 70 6c 79 20 69 75 70 3a 68 62 6f (apply iup:hbo 1f70: 78 0a 09 20 20 20 20 20 28 69 75 70 3a 6c 61 62 x.. (iup:lab 1f80: 65 6c 20 22 53 54 41 54 45 3a 22 20 23 3a 73 69 el "STATE:" #:si 1f90: 7a 65 20 22 33 30 78 22 29 0a 09 20 20 20 20 20 ze "30x").. 1fa0: 28 6c 65 74 2a 20 28 28 62 74 6e 73 20 20 28 6d (let* ((btns (m 1fb0: 61 70 20 28 6c 61 6d 62 64 61 20 28 73 74 61 74 ap (lambda (stat 1fc0: 65 29 0a 09 09 09 09 20 20 28 6c 65 74 20 28 28 e)..... (let (( 1fd0: 62 74 6e 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 btn (iup:button 1fe0: 73 74 61 74 65 0a 09 09 09 09 09 09 09 20 23 3a state........ #: 1ff0: 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 expand "HORIZONT 2000: 41 4c 22 20 23 3a 73 69 7a 65 20 22 35 30 78 22 AL" #:size "50x" 2010: 20 23 3a 66 6f 6e 74 20 22 43 6f 75 72 69 65 72 #:font "Courier 2020: 20 4e 65 77 2c 20 2d 31 30 22 0a 09 09 09 09 09 New, -10"...... 2030: 09 09 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d .. #:action (lam 2040: 62 64 61 20 28 78 29 0a 09 09 09 09 09 09 09 09 bda (x)......... 2050: 20 20 20 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c (open-run-cl 2060: 6f 73 65 20 64 62 3a 74 65 73 74 2d 73 65 74 2d ose db:test-set- 2070: 73 74 61 74 65 2d 73 74 61 74 75 73 2d 62 79 2d state-status-by- 2080: 69 64 20 23 66 20 74 65 73 74 2d 69 64 20 73 74 id #f test-id st 2090: 61 74 65 20 23 66 20 23 66 29 0a 09 09 09 09 09 ate #f #f)...... 20a0: 09 09 09 20 20 20 20 28 64 62 3a 74 65 73 74 2d ... (db:test- 20b0: 73 65 74 2d 73 74 61 74 65 21 20 74 65 73 74 64 set-state! testd 20c0: 61 74 20 73 74 61 74 65 29 29 29 29 29 0a 09 09 at state)))))... 20d0: 09 09 20 20 20 20 62 74 6e 29 29 0a 09 09 09 09 .. btn))..... 20e0: 28 6c 69 73 74 20 22 43 4f 4d 50 4c 45 54 45 44 (list "COMPLETED 20f0: 22 20 22 4e 4f 54 5f 53 54 41 52 54 45 44 22 20 " "NOT_STARTED" 2100: 22 52 55 4e 4e 49 4e 47 22 20 22 52 45 4d 4f 54 "RUNNING" "REMOT 2110: 45 48 4f 53 54 53 54 41 52 54 22 20 22 4b 49 4c EHOSTSTART" "KIL 2120: 4c 45 44 22 20 22 4b 49 4c 4c 52 45 51 22 29 29 LED" "KILLREQ")) 2130: 29 29 0a 09 20 20 20 20 20 20 20 28 76 65 63 74 )).. (vect 2140: 6f 72 2d 73 65 74 21 20 2a 73 74 61 74 65 2d 73 or-set! *state-s 2150: 74 61 74 75 73 2a 20 30 0a 09 09 09 20 20 20 20 tatus* 0.... 2160: 28 6c 61 6d 62 64 61 20 28 73 74 61 74 65 20 63 (lambda (state c 2170: 6f 6c 6f 72 29 0a 09 09 09 20 20 20 20 20 20 28 olor).... ( 2180: 66 6f 72 2d 65 61 63 68 20 0a 09 09 09 20 20 20 for-each .... 2190: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 62 74 6e (lambda (btn 21a0: 29 0a 09 09 09 09 20 28 6c 65 74 2a 20 28 28 6e )..... (let* ((n 21b0: 61 6d 65 20 20 20 20 20 28 69 75 70 3a 61 74 74 ame (iup:att 21c0: 72 69 62 75 74 65 20 62 74 6e 20 22 54 49 54 4c ribute btn "TITL 21d0: 45 22 29 29 0a 09 09 09 09 09 28 6e 65 77 63 6f E"))......(newco 21e0: 6c 6f 72 20 28 69 66 20 28 65 71 75 61 6c 3f 20 lor (if (equal? 21f0: 6e 61 6d 65 20 73 74 61 74 65 29 20 63 6f 6c 6f name state) colo 2200: 72 20 22 31 39 32 20 31 39 32 20 31 39 32 22 29 r "192 192 192") 2210: 29 29 0a 09 09 09 09 20 20 20 28 69 66 20 28 6e ))..... (if (n 2220: 6f 74 20 28 63 6f 6c 6f 72 73 2d 73 69 6d 69 6c ot (colors-simil 2230: 61 72 3f 20 6e 65 77 63 6f 6c 6f 72 20 28 69 75 ar? newcolor (iu 2240: 70 3a 61 74 74 72 69 62 75 74 65 20 62 74 6e 20 p:attribute btn 2250: 22 42 47 43 4f 4c 4f 52 22 29 29 29 0a 09 09 09 "BGCOLOR"))).... 2260: 09 20 20 20 20 20 20 20 28 69 75 70 3a 61 74 74 . (iup:att 2270: 72 69 62 75 74 65 2d 73 65 74 21 20 62 74 6e 20 ribute-set! btn 2280: 22 42 47 43 4f 4c 4f 52 22 20 6e 65 77 63 6f 6c "BGCOLOR" newcol 2290: 6f 72 29 29 29 29 0a 09 09 09 20 20 20 20 20 20 or)))).... 22a0: 20 62 74 6e 73 29 29 29 0a 09 20 20 20 20 20 20 btns))).. 22b0: 20 62 74 6e 73 29 29 0a 20 20 20 20 20 20 28 61 btns)). (a 22c0: 70 70 6c 79 20 69 75 70 3a 68 62 6f 78 0a 09 20 pply iup:hbox.. 22d0: 20 20 20 20 28 69 75 70 3a 6c 61 62 65 6c 20 22 (iup:label " 22e0: 53 54 41 54 55 53 3a 22 20 23 3a 73 69 7a 65 20 STATUS:" #:size 22f0: 22 33 30 78 22 29 0a 09 20 20 20 20 20 28 6c 65 "30x").. (le 2300: 74 2a 20 28 28 62 74 6e 73 20 20 28 6d 61 70 20 t* ((btns (map 2310: 28 6c 61 6d 62 64 61 20 28 73 74 61 74 75 73 29 (lambda (status) 2320: 0a 09 09 09 09 20 20 28 6c 65 74 20 28 28 62 74 ..... (let ((bt 2330: 6e 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 73 74 n (iup:button st 2340: 61 74 75 73 0a 09 09 09 09 09 09 09 20 23 3a 65 atus........ #:e 2350: 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 xpand "HORIZONTA 2360: 4c 22 20 23 3a 73 69 7a 65 20 22 35 30 78 22 20 L" #:size "50x" 2370: 23 3a 66 6f 6e 74 20 22 43 6f 75 72 69 65 72 20 #:font "Courier 2380: 4e 65 77 2c 20 2d 31 30 22 0a 09 09 09 09 09 09 New, -10"....... 2390: 09 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 . #:action (lamb 23a0: 64 61 20 28 78 29 0a 09 09 09 09 09 09 09 09 20 da (x)......... 23b0: 20 20 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f (open-run-clo 23c0: 73 65 20 64 62 3a 74 65 73 74 2d 73 65 74 2d 73 se db:test-set-s 23d0: 74 61 74 65 2d 73 74 61 74 75 73 2d 62 79 2d 69 tate-status-by-i 23e0: 64 20 23 66 20 74 65 73 74 2d 69 64 20 23 66 20 d #f test-id #f 23f0: 73 74 61 74 75 73 20 23 66 29 0a 09 09 09 09 09 status #f)...... 2400: 09 09 09 20 20 20 20 28 64 62 3a 74 65 73 74 2d ... (db:test- 2410: 73 65 74 2d 73 74 61 74 75 73 21 20 74 65 73 74 set-status! test 2420: 64 61 74 20 73 74 61 74 75 73 29 29 29 29 29 0a dat status))))). 2430: 09 09 09 09 20 20 20 20 62 74 6e 29 29 0a 09 09 .... btn))... 2440: 09 09 28 6c 69 73 74 20 20 22 50 41 53 53 22 20 ..(list "PASS" 2450: 22 57 41 52 4e 22 20 22 46 41 49 4c 22 20 22 43 "WARN" "FAIL" "C 2460: 48 45 43 4b 22 20 22 6e 2f 61 22 20 22 57 41 49 HECK" "n/a" "WAI 2470: 56 45 44 22 20 22 53 4b 49 50 22 29 29 29 29 0a VED" "SKIP")))). 2480: 09 20 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d . (vector- 2490: 73 65 74 21 20 2a 73 74 61 74 65 2d 73 74 61 74 set! *state-stat 24a0: 75 73 2a 20 31 0a 09 09 09 20 20 20 20 28 6c 61 us* 1.... (la 24b0: 6d 62 64 61 20 28 73 74 61 74 75 73 20 63 6f 6c mbda (status col 24c0: 6f 72 29 0a 09 09 09 20 20 20 20 20 20 28 66 6f or).... (fo 24d0: 72 2d 65 61 63 68 20 0a 09 09 09 20 20 20 20 20 r-each .... 24e0: 20 20 28 6c 61 6d 62 64 61 20 28 62 74 6e 29 0a (lambda (btn). 24f0: 09 09 09 09 20 28 6c 65 74 2a 20 28 28 6e 61 6d .... (let* ((nam 2500: 65 20 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 e (iup:attri 2510: 62 75 74 65 20 62 74 6e 20 22 54 49 54 4c 45 22 bute btn "TITLE" 2520: 29 29 0a 09 09 09 09 09 28 6e 65 77 63 6f 6c 6f ))......(newcolo 2530: 72 20 28 69 66 20 28 65 71 75 61 6c 3f 20 6e 61 r (if (equal? na 2540: 6d 65 20 73 74 61 74 75 73 29 20 63 6f 6c 6f 72 me status) color 2550: 20 22 31 39 32 20 31 39 32 20 31 39 32 22 29 29 "192 192 192")) 2560: 29 0a 09 09 09 09 20 20 20 28 69 66 20 28 6e 6f )..... (if (no 2570: 74 20 28 63 6f 6c 6f 72 73 2d 73 69 6d 69 6c 61 t (colors-simila 2580: 72 3f 20 6e 65 77 63 6f 6c 6f 72 20 28 69 75 70 r? newcolor (iup 2590: 3a 61 74 74 72 69 62 75 74 65 20 62 74 6e 20 22 :attribute btn " 25a0: 42 47 43 4f 4c 4f 52 22 29 29 29 0a 09 09 09 09 BGCOLOR")))..... 25b0: 20 20 20 20 20 20 20 28 69 75 70 3a 61 74 74 72 (iup:attr 25c0: 69 62 75 74 65 2d 73 65 74 21 20 62 74 6e 20 22 ibute-set! btn " 25d0: 42 47 43 4f 4c 4f 52 22 20 6e 65 77 63 6f 6c 6f BGCOLOR" newcolo 25e0: 72 29 29 29 29 0a 09 09 09 20 20 20 20 20 20 20 r)))).... 25f0: 62 74 6e 73 29 29 29 0a 09 20 20 20 20 20 20 20 btns))).. 2600: 62 74 6e 73 29 29 29 29 29 29 0a 0a 0a 3b 3b 3d btns))))))...;;= 2610: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 2620: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 2630: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 2640: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 2650: 3d 3d 3d 3d 3d 0a 3b 3b 0a 3b 3b 3d 3d 3d 3d 3d =====.;;.;;===== 2660: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 2670: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 2680: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 2690: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 26a0: 3d 0a 28 64 65 66 69 6e 65 20 28 65 78 61 6d 69 =.(define (exami 26b0: 6e 65 2d 74 65 73 74 20 74 65 73 74 2d 69 64 29 ne-test test-id) 26c0: 20 3b 3b 20 72 75 6e 2d 69 64 20 72 75 6e 2d 6b ;; run-id run-k 26d0: 65 79 20 6f 72 69 67 74 65 73 74 29 0a 20 20 28 ey origtest). ( 26e0: 6c 65 74 2a 20 28 28 74 65 73 74 64 61 74 20 20 let* ((testdat 26f0: 20 20 20 20 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 (open-run-c 2700: 6c 6f 73 65 20 64 62 3a 67 65 74 2d 74 65 73 74 lose db:get-test 2710: 2d 69 6e 66 6f 2d 62 79 2d 69 64 20 23 66 20 74 -info-by-id #f t 2720: 65 73 74 2d 69 64 29 29 0a 09 20 28 64 62 2d 70 est-id)).. (db-p 2730: 61 74 68 20 20 20 20 20 20 20 28 63 6f 6e 63 20 ath (conc 2740: 2a 74 6f 70 70 61 74 68 2a 20 22 2f 6d 65 67 61 *toppath* "/mega 2750: 74 65 73 74 2e 64 62 22 29 29 0a 09 20 28 64 62 test.db")).. (db 2760: 2d 6d 6f 64 2d 74 69 6d 65 20 20 20 30 29 20 3b -mod-time 0) ; 2770: 3b 20 28 66 69 6c 65 2d 6d 6f 64 69 66 69 63 61 ; (file-modifica 2780: 74 69 6f 6e 2d 74 69 6d 65 20 64 62 2d 70 61 74 tion-time db-pat 2790: 68 29 29 0a 09 20 28 6c 61 73 74 2d 75 70 64 61 h)).. (last-upda 27a0: 74 65 20 20 20 30 29 20 3b 3b 20 28 63 75 72 72 te 0) ;; (curr 27b0: 65 6e 74 2d 73 65 63 6f 6e 64 73 29 29 0a 09 20 ent-seconds)).. 27c0: 28 72 65 71 75 65 73 74 2d 75 70 64 61 74 65 20 (request-update 27d0: 23 74 29 0a 09 20 28 64 62 20 20 20 20 20 20 20 #t).. (db 27e0: 20 20 20 20 20 20 23 66 29 29 0a 20 20 20 20 28 #f)). ( 27f0: 69 66 20 28 6e 6f 74 20 74 65 73 74 64 61 74 29 if (not testdat) 2800: 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 64 65 62 ..(begin.. (deb 2810: 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f ug:print 0 "ERRO 2820: 52 3a 20 4e 6f 20 74 65 73 74 20 64 61 74 61 20 R: No test data 2830: 66 6f 75 6e 64 20 66 6f 72 20 74 65 73 74 20 22 found for test " 2840: 20 74 65 73 74 2d 69 64 20 22 2c 20 65 78 69 74 test-id ", exit 2850: 69 6e 67 22 29 0a 09 20 20 28 65 78 69 74 20 31 ing").. (exit 1 2860: 29 29 0a 09 28 6c 65 74 2a 20 28 28 72 75 6e 2d ))..(let* ((run- 2870: 69 64 20 20 20 20 20 20 20 20 28 69 66 20 74 65 id (if te 2880: 73 74 64 61 74 20 28 64 62 3a 74 65 73 74 2d 67 stdat (db:test-g 2890: 65 74 2d 72 75 6e 5f 69 64 20 74 65 73 74 64 61 et-run_id testda 28a0: 74 29 20 23 66 29 29 0a 09 20 20 20 20 20 20 20 t) #f)).. 28b0: 28 6b 65 79 64 61 74 20 20 20 20 20 20 20 20 28 (keydat ( 28c0: 69 66 20 74 65 73 74 64 61 74 20 28 6f 70 65 6e if testdat (open 28d0: 2d 72 75 6e 2d 63 6c 6f 73 65 20 64 62 3a 67 65 -run-close db:ge 28e0: 74 2d 6b 65 79 2d 76 61 6c 2d 70 61 69 72 73 20 t-key-val-pairs 28f0: 23 66 20 72 75 6e 2d 69 64 29 20 23 66 29 29 0a #f run-id) #f)). 2900: 09 20 20 20 20 20 20 20 28 72 75 6e 64 61 74 20 . (rundat 2910: 20 20 20 20 20 20 20 28 69 66 20 74 65 73 74 64 (if testd 2920: 61 74 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f at (open-run-clo 2930: 73 65 20 64 62 3a 67 65 74 2d 72 75 6e 2d 69 6e se db:get-run-in 2940: 66 6f 20 23 66 20 72 75 6e 2d 69 64 29 20 23 66 fo #f run-id) #f 2950: 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e 6e )).. (runn 2960: 61 6d 65 20 20 20 20 20 20 20 28 69 66 20 74 65 ame (if te 2970: 73 74 64 61 74 20 28 64 62 3a 67 65 74 2d 76 61 stdat (db:get-va 2980: 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 28 64 lue-by-header (d 2990: 62 3a 67 65 74 2d 72 6f 77 20 72 75 6e 64 61 74 b:get-row rundat 29a0: 29 0a 09 09 09 09 09 09 09 09 20 20 28 64 62 3a )......... (db: 29b0: 67 65 74 2d 68 65 61 64 65 72 20 72 75 6e 64 61 get-header runda 29c0: 74 29 0a 09 09 09 09 09 09 09 09 20 20 22 72 75 t)......... "ru 29d0: 6e 6e 61 6d 65 22 29 20 23 66 29 29 0a 09 20 20 nname") #f)).. 29e0: 20 20 20 20 20 28 6c 6f 67 66 69 6c 65 20 20 20 (logfile 29f0: 20 20 20 20 22 2f 74 68 69 73 2f 64 69 72 2f 62 "/this/dir/b 2a00: 65 74 74 65 72 2f 6e 6f 74 2f 65 78 69 73 74 22 etter/not/exist" 2a10: 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e 64 69 ).. (rundi 2a20: 72 20 20 20 20 20 20 20 20 6c 6f 67 66 69 6c 65 r logfile 2a30: 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 73 ).. (tests 2a40: 74 65 70 73 20 20 20 20 20 28 69 66 20 74 65 73 teps (if tes 2a50: 74 64 61 74 20 28 64 62 3a 67 65 74 2d 63 6f 6d tdat (db:get-com 2a60: 70 72 65 73 73 65 64 2d 73 74 65 70 73 20 74 65 pressed-steps te 2a70: 73 74 2d 69 64 20 77 6f 72 6b 2d 61 72 65 61 3a st-id work-area: 2a80: 20 72 75 6e 64 69 72 29 20 27 28 29 29 29 0a 09 rundir) '())).. 2a90: 20 20 20 20 20 20 20 28 74 65 73 74 66 75 6c 6c (testfull 2aa0: 6e 61 6d 65 20 20 28 69 66 20 74 65 73 74 64 61 name (if testda 2ab0: 74 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 66 t (db:test-get-f 2ac0: 75 6c 6c 6e 61 6d 65 20 74 65 73 74 64 61 74 29 ullname testdat) 2ad0: 20 22 47 61 74 68 65 72 69 6e 67 20 64 61 74 61 "Gathering data 2ae0: 20 2e 2e 2e 22 29 29 0a 09 20 20 20 20 20 20 20 ...")).. 2af0: 28 74 65 73 74 6e 61 6d 65 20 20 20 20 20 20 28 (testname ( 2b00: 69 66 20 74 65 73 74 64 61 74 20 28 64 62 3a 74 if testdat (db:t 2b10: 65 73 74 2d 67 65 74 2d 74 65 73 74 6e 61 6d 65 est-get-testname 2b20: 20 74 65 73 74 64 61 74 29 20 22 6e 2f 61 22 29 testdat) "n/a") 2b30: 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 6d ).. (testm 2b40: 65 74 61 20 20 20 20 20 20 28 69 66 20 74 65 73 eta (if tes 2b50: 74 64 61 74 20 0a 09 09 09 09 20 20 28 6c 65 74 tdat ..... (let 2b60: 20 28 28 74 6d 20 28 6f 70 65 6e 2d 72 75 6e 2d ((tm (open-run- 2b70: 63 6c 6f 73 65 20 64 62 3a 74 65 73 74 6d 65 74 close db:testmet 2b80: 61 2d 67 65 74 2d 72 65 63 6f 72 64 20 23 66 20 a-get-record #f 2b90: 74 65 73 74 6e 61 6d 65 29 29 29 0a 09 09 09 09 testname)))..... 2ba0: 20 20 20 20 28 69 66 20 74 6d 20 74 6d 20 28 6d (if tm tm (m 2bb0: 61 6b 65 2d 64 62 3a 74 65 73 74 6d 65 74 61 29 ake-db:testmeta) 2bc0: 29 29 0a 09 09 09 09 20 20 28 6d 61 6b 65 2d 64 ))..... (make-d 2bd0: 62 3a 74 65 73 74 6d 65 74 61 29 29 29 0a 0a 09 b:testmeta)))... 2be0: 20 20 20 20 20 20 20 28 6b 65 79 73 74 72 69 6e (keystrin 2bf0: 67 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 g (string-inter 2c00: 73 70 65 72 73 65 20 0a 09 09 09 20 20 20 20 28 sperse .... ( 2c10: 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 6b 65 79 map (lambda (key 2c20: 76 61 6c 29 0a 09 09 09 09 20 20 20 3b 3b 20 28 val)..... ;; ( 2c30: 63 6f 6e 63 20 22 3a 22 20 28 63 61 72 20 6b 65 conc ":" (car ke 2c40: 79 76 61 6c 29 20 22 20 22 20 28 63 61 64 72 20 yval) " " (cadr 2c50: 6b 65 79 76 61 6c 29 29 29 0a 09 09 09 09 20 20 keyval)))..... 2c60: 20 28 63 61 64 72 20 6b 65 79 76 61 6c 29 29 0a (cadr keyval)). 2c70: 09 09 09 09 20 6b 65 79 64 61 74 29 0a 09 09 09 .... keydat).... 2c80: 20 20 20 20 22 2f 22 29 29 0a 09 20 20 20 20 20 "/")).. 2c90: 20 20 28 69 74 65 6d 2d 70 61 74 68 20 20 28 64 (item-path (d 2ca0: 62 3a 74 65 73 74 2d 67 65 74 2d 69 74 65 6d 2d b:test-get-item- 2cb0: 70 61 74 68 20 74 65 73 74 64 61 74 29 29 0a 09 path testdat)).. 2cc0: 20 20 20 20 20 20 20 28 76 69 65 77 6c 6f 67 20 (viewlog 2cd0: 20 20 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 (lambda (x).. 2ce0: 09 09 20 20 20 20 20 28 69 66 20 28 66 69 6c 65 .. (if (file 2cf0: 2d 65 78 69 73 74 73 3f 20 6c 6f 67 66 69 6c 65 -exists? logfile 2d00: 29 0a 09 09 09 09 09 3b 28 73 79 73 74 65 6d 20 )......;(system 2d10: 28 63 6f 6e 63 20 22 66 69 72 65 66 6f 78 20 22 (conc "firefox " 2d20: 20 6c 6f 67 66 69 6c 65 20 22 26 22 29 29 0a 09 logfile "&")).. 2d30: 09 09 09 20 28 69 75 70 3a 73 65 6e 64 2d 75 72 ... (iup:send-ur 2d40: 6c 20 6c 6f 67 66 69 6c 65 29 0a 09 09 09 09 20 l logfile)..... 2d50: 28 6d 65 73 73 61 67 65 2d 77 69 6e 64 6f 77 20 (message-window 2d60: 28 63 6f 6e 63 20 22 46 69 6c 65 20 22 20 6c 6f (conc "File " lo 2d70: 67 66 69 6c 65 20 22 20 6e 6f 74 20 66 6f 75 6e gfile " not foun 2d80: 64 22 29 29 29 29 29 0a 09 20 20 20 20 20 20 20 d"))))).. 2d90: 28 78 74 65 72 6d 20 20 20 20 20 20 28 6c 61 6d (xterm (lam 2da0: 62 64 61 20 28 78 29 0a 09 09 09 20 20 20 20 20 bda (x).... 2db0: 28 69 66 20 28 64 69 72 65 63 74 6f 72 79 2d 65 (if (directory-e 2dc0: 78 69 73 74 73 3f 20 72 75 6e 64 69 72 29 0a 09 xists? rundir).. 2dd0: 09 09 09 20 28 6c 65 74 20 28 28 73 68 65 6c 6c ... (let ((shell 2de0: 20 28 69 66 20 28 67 65 74 2d 65 6e 76 69 72 6f (if (get-enviro 2df0: 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 22 nment-variable " 2e00: 53 48 45 4c 4c 22 29 20 0a 09 09 09 09 09 09 20 SHELL") ....... 2e10: 20 28 63 6f 6e 63 20 22 2d 65 20 22 20 28 67 65 (conc "-e " (ge 2e20: 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 t-environment-va 2e30: 72 69 61 62 6c 65 20 22 53 48 45 4c 4c 22 29 29 riable "SHELL")) 2e40: 0a 09 09 09 09 09 09 20 20 22 22 29 29 29 0a 09 ....... ""))).. 2e50: 09 09 09 20 20 20 28 73 79 73 74 65 6d 20 28 63 ... (system (c 2e60: 6f 6e 63 20 22 63 64 20 22 20 72 75 6e 64 69 72 onc "cd " rundir 2e70: 20 0a 09 09 09 09 09 09 20 22 3b 78 74 65 72 6d ....... ";xterm 2e80: 20 2d 54 20 5c 22 22 20 28 73 74 72 69 6e 67 2d -T \"" (string- 2e90: 74 72 61 6e 73 6c 61 74 65 20 74 65 73 74 66 75 translate testfu 2ea0: 6c 6c 6e 61 6d 65 20 22 28 29 22 20 22 20 20 22 llname "()" " " 2eb0: 29 20 22 5c 22 20 22 20 73 68 65 6c 6c 20 22 26 ) "\" " shell "& 2ec0: 22 29 29 29 0a 09 09 09 09 20 28 6d 65 73 73 61 ")))..... (messa 2ed0: 67 65 2d 77 69 6e 64 6f 77 20 20 28 63 6f 6e 63 ge-window (conc 2ee0: 20 22 44 69 72 65 63 74 6f 72 79 20 22 20 72 75 "Directory " ru 2ef0: 6e 64 69 72 20 22 20 6e 6f 74 20 66 6f 75 6e 64 ndir " not found 2f00: 22 29 29 29 29 29 0a 09 20 20 20 20 20 20 20 28 "))))).. ( 2f10: 72 65 66 72 65 73 68 64 61 74 20 28 6c 61 6d 62 refreshdat (lamb 2f20: 64 61 20 28 29 0a 09 09 09 20 20 20 20 20 28 6c da ().... (l 2f30: 65 74 2a 20 28 28 63 75 72 72 2d 6d 6f 64 2d 74 et* ((curr-mod-t 2f40: 69 6d 65 20 28 66 69 6c 65 2d 6d 6f 64 69 66 69 ime (file-modifi 2f50: 63 61 74 69 6f 6e 2d 74 69 6d 65 20 64 62 2d 70 cation-time db-p 2f60: 61 74 68 29 29 0a 09 09 09 09 20 20 20 20 28 6e ath))..... (n 2f70: 65 65 64 2d 75 70 64 61 74 65 20 20 20 28 6f 72 eed-update (or 2f80: 20 28 61 6e 64 20 28 3e 20 63 75 72 72 2d 6d 6f (and (> curr-mo 2f90: 64 2d 74 69 6d 65 20 64 62 2d 6d 6f 64 2d 74 69 d-time db-mod-ti 2fa0: 6d 65 29 0a 09 09 09 09 09 09 09 20 20 20 20 28 me)........ ( 2fb0: 3e 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e > (current-secon 2fc0: 64 73 29 20 28 2b 20 6c 61 73 74 2d 75 70 64 61 ds) (+ last-upda 2fd0: 74 65 20 32 29 29 29 20 3b 3b 20 65 76 65 72 79 te 2))) ;; every 2fe0: 20 74 77 6f 20 73 65 63 6f 6e 64 73 20 69 66 20 two seconds if 2ff0: 64 62 20 74 6f 75 63 68 65 64 0a 09 09 09 09 09 db touched...... 3000: 09 20 20 20 20 20 20 20 72 65 71 75 65 73 74 2d . request- 3010: 75 70 64 61 74 65 29 29 0a 09 09 09 09 20 20 20 update))..... 3020: 20 28 6e 65 77 74 65 73 74 64 61 74 20 28 69 66 (newtestdat (if 3030: 20 6e 65 65 64 2d 75 70 64 61 74 65 20 0a 09 09 need-update ... 3040: 09 09 09 09 20 20 20 20 28 68 61 6e 64 6c 65 2d .... (handle- 3050: 65 78 63 65 70 74 69 6f 6e 73 0a 09 09 09 09 09 exceptions...... 3060: 09 20 20 20 20 20 65 78 6e 20 0a 09 09 09 09 09 . exn ...... 3070: 09 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 . (debug:pri 3080: 6e 74 2d 69 6e 66 6f 20 32 20 22 74 65 73 74 20 nt-info 2 "test 3090: 64 62 20 61 63 63 65 73 73 20 69 73 73 75 65 3a db access issue: 30a0: 20 22 20 28 28 63 6f 6e 64 69 74 69 6f 6e 2d 70 " ((condition-p 30b0: 72 6f 70 65 72 74 79 2d 61 63 63 65 73 73 6f 72 roperty-accessor 30c0: 20 27 65 78 6e 20 27 6d 65 73 73 61 67 65 29 20 'exn 'message) 30d0: 65 78 6e 29 29 0a 09 09 09 09 09 09 20 20 20 20 exn))....... 30e0: 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 (open-run-close 30f0: 20 64 62 3a 67 65 74 2d 74 65 73 74 2d 69 6e 66 db:get-test-inf 3100: 6f 2d 62 79 2d 69 64 20 23 66 20 74 65 73 74 2d o-by-id #f test- 3110: 69 64 20 29 29 29 29 29 0a 09 09 09 20 20 20 20 id ))))).... 3120: 20 20 20 28 63 6f 6e 64 0a 09 09 09 09 28 28 61 (cond.....((a 3130: 6e 64 20 6e 65 65 64 2d 75 70 64 61 74 65 20 6e nd need-update n 3140: 65 77 74 65 73 74 64 61 74 29 0a 09 09 09 09 20 ewtestdat)..... 3150: 28 73 65 74 21 20 74 65 73 74 64 61 74 20 6e 65 (set! testdat ne 3160: 77 74 65 73 74 64 61 74 29 0a 09 09 09 09 20 28 wtestdat)..... ( 3170: 73 65 74 21 20 74 65 73 74 73 74 65 70 73 20 20 set! teststeps 3180: 20 20 28 64 62 3a 67 65 74 2d 63 6f 6d 70 72 65 (db:get-compre 3190: 73 73 65 64 2d 73 74 65 70 73 20 74 65 73 74 2d ssed-steps test- 31a0: 69 64 20 77 6f 72 6b 2d 61 72 65 61 3a 20 72 75 id work-area: ru 31b0: 6e 64 69 72 29 29 0a 09 09 09 09 20 28 73 65 74 ndir))..... (set 31c0: 21 20 6c 6f 67 66 69 6c 65 20 20 20 20 20 20 28 ! logfile ( 31d0: 63 6f 6e 63 20 28 64 62 3a 74 65 73 74 2d 67 65 conc (db:test-ge 31e0: 74 2d 72 75 6e 64 69 72 20 74 65 73 74 64 61 74 t-rundir testdat 31f0: 29 20 22 2f 22 20 28 64 62 3a 74 65 73 74 2d 67 ) "/" (db:test-g 3200: 65 74 2d 66 69 6e 61 6c 5f 6c 6f 67 66 20 74 65 et-final_logf te 3210: 73 74 64 61 74 29 29 29 0a 09 09 09 09 20 28 73 stdat)))..... (s 3220: 65 74 21 20 72 75 6e 64 69 72 20 20 20 20 20 20 et! rundir 3230: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 (db:test-get-ru 3240: 6e 64 69 72 20 74 65 73 74 64 61 74 29 29 0a 09 ndir testdat)).. 3250: 09 09 09 20 28 73 65 74 21 20 74 65 73 74 66 75 ... (set! testfu 3260: 6c 6c 6e 61 6d 65 20 28 64 62 3a 74 65 73 74 2d llname (db:test- 3270: 67 65 74 2d 66 75 6c 6c 6e 61 6d 65 20 74 65 73 get-fullname tes 3280: 74 64 61 74 29 29 0a 09 09 09 09 20 3b 3b 20 28 tdat))..... ;; ( 3290: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 49 debug:print 0 "I 32a0: 4e 46 4f 3a 20 74 65 73 74 73 74 65 70 73 3d 22 NFO: teststeps=" 32b0: 20 28 69 6e 74 65 72 73 70 65 72 73 65 20 74 65 (intersperse te 32c0: 73 74 73 74 65 70 73 20 22 5c 6e 20 20 20 20 22 ststeps "\n " 32d0: 29 29 0a 09 09 09 09 20 29 0a 09 09 09 09 28 6e ))..... ).....(n 32e0: 65 65 64 2d 75 70 64 61 74 65 20 3b 3b 20 69 66 eed-update ;; if 32f0: 20 74 68 69 73 20 77 61 73 20 74 72 75 65 20 61 this was true a 3300: 6e 64 20 79 65 74 20 74 68 65 72 65 20 69 73 20 nd yet there is 3310: 6e 6f 20 64 61 74 61 20 2e 2e 2e 2e 0a 09 09 09 no data ........ 3320: 09 20 28 64 62 3a 74 65 73 74 2d 73 65 74 2d 74 . (db:test-set-t 3330: 65 73 74 6e 61 6d 65 21 20 74 65 73 74 64 61 74 estname! testdat 3340: 20 22 44 45 41 44 20 4f 52 20 44 45 4c 45 54 45 "DEAD OR DELETE 3350: 44 20 54 45 53 54 22 29 29 29 29 29 29 0a 09 20 D TEST")))))).. 3360: 20 20 20 20 20 20 28 77 69 64 67 65 74 73 20 20 (widgets 3370: 20 20 20 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 (make-hash-t 3380: 61 62 6c 65 29 29 0a 09 20 20 20 20 20 20 20 28 able)).. ( 3390: 6d 65 74 61 2d 77 69 64 67 65 74 73 20 28 6d 61 meta-widgets (ma 33a0: 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 0a ke-hash-table)). 33b0: 09 20 20 20 20 20 20 20 28 73 65 6c 66 20 20 20 . (self 33c0: 20 20 20 20 20 20 23 66 29 0a 09 20 20 20 20 20 #f).. 33d0: 20 20 28 73 74 6f 72 65 2d 6c 61 62 65 6c 20 20 (store-label 33e0: 28 6c 61 6d 62 64 61 20 28 6e 61 6d 65 20 6c 62 (lambda (name lb 33f0: 6c 20 63 6d 64 29 0a 09 09 09 20 20 20 20 20 20 l cmd).... 3400: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 (hash-table-set 3410: 21 20 77 69 64 67 65 74 73 20 6e 61 6d 65 20 0a ! widgets name . 3420: 09 09 09 09 09 09 28 6c 61 6d 62 64 61 20 28 74 ......(lambda (t 3430: 65 73 74 64 61 74 29 0a 09 09 09 09 09 09 20 20 estdat)....... 3440: 28 6c 65 74 20 28 28 6e 65 77 76 61 6c 20 28 63 (let ((newval (c 3450: 6d 64 20 74 65 73 74 64 61 74 29 29 0a 09 09 09 md testdat)).... 3460: 09 09 09 09 28 6f 6c 64 76 61 6c 20 28 69 75 70 ....(oldval (iup 3470: 3a 61 74 74 72 69 62 75 74 65 20 6c 62 6c 20 22 :attribute lbl " 3480: 54 49 54 4c 45 22 29 29 29 0a 09 09 09 09 09 09 TITLE")))....... 3490: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 65 71 (if (not (eq 34a0: 75 61 6c 3f 20 6e 65 77 76 61 6c 20 6f 6c 64 76 ual? newval oldv 34b0: 61 6c 29 29 0a 09 09 09 09 09 09 09 28 62 65 67 al))........(beg 34c0: 69 6e 0a 09 09 09 09 09 3b 28 6d 75 74 65 78 2d in......;(mutex- 34d0: 6c 6f 63 6b 21 20 6d 78 31 29 0a 09 09 09 09 09 lock! mx1)...... 34e0: 09 09 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 .. (iup:attribu 34f0: 74 65 2d 73 65 74 21 20 6c 62 6c 20 22 54 49 54 te-set! lbl "TIT 3500: 4c 45 22 20 6e 65 77 76 61 6c 29 0a 09 09 09 09 LE" newval)..... 3510: 09 3b 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 .;(mutex-unlock! 3520: 20 6d 78 31 29 0a 09 09 09 09 09 09 09 20 20 29 mx1)........ ) 3530: 29 29 29 29 0a 09 09 09 20 20 20 20 20 20 20 6c )))).... l 3540: 62 6c 29 29 0a 09 20 20 20 20 20 20 20 28 73 74 bl)).. (st 3550: 6f 72 65 2d 6d 65 74 61 20 20 28 6c 61 6d 62 64 ore-meta (lambd 3560: 61 20 28 6e 61 6d 65 20 6c 62 6c 20 63 6d 64 29 a (name lbl cmd) 3570: 0a 09 09 09 20 20 20 20 20 20 28 68 61 73 68 2d .... (hash- 3580: 74 61 62 6c 65 2d 73 65 74 21 20 6d 65 74 61 2d table-set! meta- 3590: 77 69 64 67 65 74 73 20 6e 61 6d 65 20 0a 09 09 widgets name ... 35a0: 09 09 09 20 20 20 20 20 20 20 28 6c 61 6d 62 64 ... (lambd 35b0: 61 20 28 74 65 73 74 6d 65 74 61 29 0a 09 09 09 a (testmeta).... 35c0: 09 09 09 20 28 6c 65 74 20 28 28 6e 65 77 76 61 ... (let ((newva 35d0: 6c 20 28 63 6d 64 20 74 65 73 74 6d 65 74 61 29 l (cmd testmeta) 35e0: 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 28 )....... ( 35f0: 6f 6c 64 76 61 6c 20 28 69 75 70 3a 61 74 74 72 oldval (iup:attr 3600: 69 62 75 74 65 20 6c 62 6c 20 22 54 49 54 4c 45 ibute lbl "TITLE 3610: 22 29 29 29 0a 09 09 09 09 09 09 20 20 20 28 69 ")))....... (i 3620: 66 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 6e f (not (equal? n 3630: 65 77 76 61 6c 20 6f 6c 64 76 61 6c 29 29 0a 09 ewval oldval)).. 3640: 09 09 09 09 09 20 20 20 20 20 20 20 28 62 65 67 ..... (beg 3650: 69 6e 0a 09 09 09 09 09 3b 28 6d 75 74 65 78 2d in......;(mutex- 3660: 6c 6f 63 6b 21 20 6d 78 31 29 0a 09 09 09 09 09 lock! mx1)...... 3670: 09 09 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 .. (iup:attribut 3680: 65 2d 73 65 74 21 20 6c 62 6c 20 22 54 49 54 4c e-set! lbl "TITL 3690: 45 22 20 6e 65 77 76 61 6c 29 0a 09 09 09 09 09 E" newval)...... 36a0: 3b 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 ;(mutex-unlock! 36b0: 6d 78 31 29 0a 09 09 09 09 09 09 09 20 29 29 29 mx1)........ ))) 36c0: 29 29 0a 09 09 09 20 20 20 20 20 20 6c 62 6c 29 )).... lbl) 36d0: 29 0a 09 20 20 20 20 20 20 20 28 73 74 6f 72 65 ).. (store 36e0: 2d 62 75 74 74 6f 6e 20 73 74 6f 72 65 2d 6c 61 -button store-la 36f0: 62 65 6c 29 0a 09 20 20 20 20 20 20 20 28 63 6f bel).. (co 3700: 6d 6d 61 6e 64 2d 74 65 78 74 2d 62 6f 78 20 28 mmand-text-box ( 3710: 69 75 70 3a 74 65 78 74 62 6f 78 20 23 3a 65 78 iup:textbox #:ex 3720: 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c pand "HORIZONTAL 3730: 22 20 23 3a 66 6f 6e 74 20 22 43 6f 75 72 69 65 " #:font "Courie 3740: 72 20 4e 65 77 2c 20 2d 31 30 22 29 29 0a 09 20 r New, -10")).. 3750: 20 20 20 20 20 20 28 63 6f 6d 6d 61 6e 64 2d 6c (command-l 3760: 61 75 6e 63 68 2d 62 75 74 74 6f 6e 20 28 69 75 aunch-button (iu 3770: 70 3a 62 75 74 74 6f 6e 20 22 45 78 65 63 75 74 p:button "Execut 3780: 65 21 22 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 e!" #:action (la 3790: 6d 62 64 61 20 28 78 29 0a 09 09 09 09 09 09 09 mbda (x)........ 37a0: 09 09 28 6c 65 74 20 28 28 63 6d 64 20 28 69 75 ..(let ((cmd (iu 37b0: 70 3a 61 74 74 72 69 62 75 74 65 20 63 6f 6d 6d p:attribute comm 37c0: 61 6e 64 2d 74 65 78 74 2d 62 6f 78 20 22 56 41 and-text-box "VA 37d0: 4c 55 45 22 29 29 29 0a 09 09 09 09 09 09 09 09 LUE")))......... 37e0: 09 20 20 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 . (system (conc 37f0: 20 63 6d 64 20 22 20 20 26 22 29 29 29 29 29 29 cmd " &")))))) 3800: 0a 09 20 20 20 20 20 20 20 28 6b 69 6c 6c 2d 6a .. (kill-j 3810: 6f 62 73 20 28 6c 61 6d 62 64 61 20 28 78 29 0a obs (lambda (x). 3820: 09 09 09 20 20 20 20 28 69 75 70 3a 61 74 74 72 ... (iup:attr 3830: 69 62 75 74 65 2d 73 65 74 21 20 0a 09 09 09 20 ibute-set! .... 3840: 20 20 20 20 63 6f 6d 6d 61 6e 64 2d 74 65 78 74 command-text 3850: 2d 62 6f 78 20 22 56 41 4c 55 45 22 0a 09 09 09 -box "VALUE".... 3860: 20 20 20 20 20 28 63 6f 6e 63 20 22 78 74 65 72 (conc "xter 3870: 6d 20 2d 67 65 6f 6d 65 74 72 79 20 31 38 30 78 m -geometry 180x 3880: 32 30 20 2d 65 20 5c 22 6d 65 67 61 74 65 73 74 20 -e \"megatest 3890: 20 2d 74 61 72 67 65 74 20 22 20 6b 65 79 73 74 -target " keyst 38a0: 72 69 6e 67 20 22 20 3a 72 75 6e 6e 61 6d 65 20 ring " :runname 38b0: 22 20 20 72 75 6e 6e 61 6d 65 20 0a 09 09 09 09 " runname ..... 38c0: 20 20 20 22 20 2d 73 65 74 2d 73 74 61 74 65 2d " -set-state- 38d0: 73 74 61 74 75 73 20 4b 49 4c 4c 52 45 51 2c 6e status KILLREQ,n 38e0: 2f 61 20 2d 74 65 73 74 70 61 74 74 20 25 2f 25 /a -testpatt %/% 38f0: 20 22 0a 09 09 09 09 20 20 20 3b 3b 20 28 63 6f "..... ;; (co 3900: 6e 63 20 74 65 73 74 6e 61 6d 65 20 22 2f 22 20 nc testname "/" 3910: 28 69 66 20 28 65 71 75 61 6c 3f 20 69 74 65 6d (if (equal? item 3920: 2d 70 61 74 68 20 22 22 29 20 22 25 22 20 69 74 -path "") "%" it 3930: 65 6d 2d 70 61 74 68 29 29 0a 09 09 09 09 20 20 em-path))..... 3940: 20 22 20 3a 73 74 61 74 65 20 52 55 4e 4e 49 4e " :state RUNNIN 3950: 47 20 3b 65 63 68 6f 20 50 72 65 73 73 20 61 6e G ;echo Press an 3960: 79 20 6b 65 79 20 74 6f 20 63 6f 6e 74 69 6e 75 y key to continu 3970: 65 3b 62 61 73 68 20 2d 63 20 27 72 65 61 64 20 e;bash -c 'read 3980: 2d 6e 20 31 20 2d 73 27 5c 22 22 29 29 29 29 0a -n 1 -s'\"")))). 3990: 09 20 20 20 20 20 20 20 28 72 75 6e 2d 74 65 73 . (run-tes 39a0: 74 20 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 t (lambda (x).. 39b0: 09 09 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 .. (iup:attri 39c0: 62 75 74 65 2d 73 65 74 21 20 0a 09 09 09 20 20 bute-set! .... 39d0: 20 20 20 63 6f 6d 6d 61 6e 64 2d 74 65 78 74 2d command-text- 39e0: 62 6f 78 20 22 56 41 4c 55 45 22 0a 09 09 09 20 box "VALUE".... 39f0: 20 20 20 20 28 63 6f 6e 63 20 22 78 74 65 72 6d (conc "xterm 3a00: 20 2d 67 65 6f 6d 65 74 72 79 20 31 38 30 78 32 -geometry 180x2 3a10: 30 20 2d 65 20 5c 22 6d 65 67 61 74 65 73 74 20 0 -e \"megatest 3a20: 2d 74 61 72 67 65 74 20 22 20 6b 65 79 73 74 72 -target " keystr 3a30: 69 6e 67 20 22 20 3a 72 75 6e 6e 61 6d 65 20 22 ing " :runname " 3a40: 20 72 75 6e 6e 61 6d 65 20 0a 09 09 09 09 20 20 runname ..... 3a50: 20 22 20 2d 72 75 6e 74 65 73 74 73 20 22 20 28 " -runtests " ( 3a60: 63 6f 6e 63 20 74 65 73 74 6e 61 6d 65 20 22 2f conc testname "/ 3a70: 22 20 28 69 66 20 28 65 71 75 61 6c 3f 20 69 74 " (if (equal? it 3a80: 65 6d 2d 70 61 74 68 20 22 22 29 0a 09 09 09 09 em-path "")..... 3a90: 09 09 09 09 09 22 25 22 20 0a 09 09 09 09 09 09 ....."%" ....... 3aa0: 09 09 09 69 74 65 6d 2d 70 61 74 68 29 29 0a 09 ...item-path)).. 3ab0: 09 09 09 20 20 20 22 20 3b 65 63 68 6f 20 50 72 ... " ;echo Pr 3ac0: 65 73 73 20 61 6e 79 20 6b 65 79 20 74 6f 20 63 ess any key to c 3ad0: 6f 6e 74 69 6e 75 65 3b 62 61 73 68 20 2d 63 20 ontinue;bash -c 3ae0: 27 72 65 61 64 20 2d 6e 20 31 20 2d 73 27 5c 22 'read -n 1 -s'\" 3af0: 22 29 29 29 29 0a 09 20 20 20 20 20 20 20 28 72 ")))).. (r 3b00: 65 6d 6f 76 65 2d 74 65 73 74 20 28 6c 61 6d 62 emove-test (lamb 3b10: 64 61 20 28 78 29 0a 09 09 09 20 20 20 20 20 20 da (x).... 3b20: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 (iup:attribute-s 3b30: 65 74 21 0a 09 09 09 20 20 20 20 20 20 20 63 6f et!.... co 3b40: 6d 6d 61 6e 64 2d 74 65 78 74 2d 62 6f 78 20 22 mmand-text-box " 3b50: 56 41 4c 55 45 22 0a 09 09 09 20 20 20 20 20 20 VALUE".... 3b60: 20 28 63 6f 6e 63 20 22 78 74 65 72 6d 20 2d 67 (conc "xterm -g 3b70: 65 6f 6d 65 74 72 79 20 31 38 30 78 32 30 20 2d eometry 180x20 - 3b80: 65 20 5c 22 6d 65 67 61 74 65 73 74 20 2d 72 65 e \"megatest -re 3b90: 6d 6f 76 65 2d 72 75 6e 73 20 2d 74 61 72 67 65 move-runs -targe 3ba0: 74 20 22 20 6b 65 79 73 74 72 69 6e 67 20 22 20 t " keystring " 3bb0: 3a 72 75 6e 6e 61 6d 65 20 22 20 72 75 6e 6e 61 :runname " runna 3bc0: 6d 65 0a 09 09 09 09 20 20 20 20 20 22 20 2d 74 me..... " -t 3bd0: 65 73 74 70 61 74 74 20 22 20 28 63 6f 6e 63 20 estpatt " (conc 3be0: 74 65 73 74 6e 61 6d 65 20 22 2f 22 20 28 69 66 testname "/" (if 3bf0: 20 28 65 71 75 61 6c 3f 20 69 74 65 6d 2d 70 61 (equal? item-pa 3c00: 74 68 20 22 22 29 0a 09 09 09 09 09 09 09 09 09 th "").......... 3c10: 20 20 22 25 22 0a 09 09 09 09 09 09 09 09 09 20 "%".......... 3c20: 20 69 74 65 6d 2d 70 61 74 68 29 29 0a 09 09 09 item-path)).... 3c30: 09 20 20 20 20 20 22 20 2d 76 20 3b 65 63 68 6f . " -v ;echo 3c40: 20 50 72 65 73 73 20 61 6e 79 20 6b 65 79 20 74 Press any key t 3c50: 6f 20 63 6f 6e 74 69 6e 75 65 3b 62 61 73 68 20 o continue;bash 3c60: 2d 63 20 27 72 65 61 64 20 2d 6e 20 31 20 2d 73 -c 'read -n 1 -s 3c70: 27 5c 22 22 29 29 29 29 29 0a 09 20 20 28 63 6f '\""))))).. (co 3c80: 6e 64 0a 09 20 20 20 28 28 6e 6f 74 20 74 65 73 nd.. ((not tes 3c90: 74 64 61 74 29 28 62 65 67 69 6e 20 28 70 72 69 tdat)(begin (pri 3ca0: 6e 74 20 22 45 52 52 4f 52 3a 20 62 61 64 20 74 nt "ERROR: bad t 3cb0: 65 73 74 20 69 6e 66 6f 20 66 6f 72 20 22 20 74 est info for " t 3cc0: 65 73 74 2d 69 64 29 28 65 78 69 74 20 31 29 29 est-id)(exit 1)) 3cd0: 29 0a 09 20 20 20 28 28 6e 6f 74 20 72 75 6e 64 ).. ((not rund 3ce0: 61 74 29 28 62 65 67 69 6e 20 28 70 72 69 6e 74 at)(begin (print 3cf0: 20 22 45 52 52 4f 52 3a 20 66 6f 75 6e 64 20 74 "ERROR: found t 3d00: 65 73 74 20 69 6e 66 6f 20 62 75 74 20 74 68 65 est info but the 3d10: 72 65 20 69 73 20 61 20 70 72 6f 62 6c 65 6d 20 re is a problem 3d20: 77 69 74 68 20 74 68 65 20 72 75 6e 20 69 6e 66 with the run inf 3d30: 6f 20 66 6f 72 20 22 20 72 75 6e 2d 69 64 29 28 o for " run-id)( 3d40: 65 78 69 74 20 31 29 29 29 0a 09 20 20 20 28 65 exit 1))).. (e 3d50: 6c 73 65 0a 09 20 20 20 20 3b 3b 20 20 28 74 65 lse.. ;; (te 3d60: 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 64 st-set-status! d 3d70: 62 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 b run-id test-na 3d80: 6d 65 20 73 74 61 74 65 20 73 74 61 74 75 73 20 me state status 3d90: 69 74 65 6d 64 61 74 29 0a 09 20 20 20 20 28 73 itemdat).. (s 3da0: 65 74 21 20 73 65 6c 66 20 3b 20 0a 09 09 20 20 et! self ; ... 3db0: 28 69 75 70 3a 64 69 61 6c 6f 67 20 23 3a 63 6c (iup:dialog #:cl 3dc0: 6f 73 65 5f 63 62 20 28 6c 61 6d 62 64 61 20 28 ose_cb (lambda ( 3dd0: 61 29 28 65 78 69 74 29 29 20 3b 20 23 3a 65 78 a)(exit)) ; #:ex 3de0: 70 61 6e 64 20 22 59 45 53 22 0a 09 09 09 20 20 pand "YES".... 3df0: 20 20 20 20 23 3a 74 69 74 6c 65 20 74 65 73 74 #:title test 3e00: 66 75 6c 6c 6e 61 6d 65 0a 09 09 09 20 20 20 20 fullname.... 3e10: 20 20 28 69 75 70 3a 76 62 6f 78 20 3b 20 23 3a (iup:vbox ; #: 3e20: 65 78 70 61 6e 64 20 22 59 45 53 22 0a 09 09 09 expand "YES".... 3e30: 20 20 20 20 20 20 20 3b 3b 20 54 68 65 20 72 75 ;; The ru 3e40: 6e 20 61 6e 64 20 74 65 73 74 20 69 6e 66 6f 0a n and test info. 3e50: 09 09 09 20 20 20 20 20 20 20 28 69 75 70 3a 68 ... (iup:h 3e60: 62 6f 78 20 20 3b 20 23 3a 65 78 70 61 6e 64 20 box ; #:expand 3e70: 22 59 45 53 22 0a 09 09 09 09 28 72 75 6e 2d 69 "YES".....(run-i 3e80: 6e 66 6f 2d 70 61 6e 65 6c 20 6b 65 79 64 61 74 nfo-panel keydat 3e90: 20 74 65 73 74 64 61 74 20 72 75 6e 6e 61 6d 65 testdat runname 3ea0: 29 0a 09 09 09 09 28 74 65 73 74 2d 69 6e 66 6f ).....(test-info 3eb0: 2d 70 61 6e 65 6c 20 74 65 73 74 64 61 74 20 73 -panel testdat s 3ec0: 74 6f 72 65 2d 6c 61 62 65 6c 20 77 69 64 67 65 tore-label widge 3ed0: 74 73 29 0a 09 09 09 09 28 74 65 73 74 2d 6d 65 ts).....(test-me 3ee0: 74 61 2d 70 61 6e 65 6c 20 74 65 73 74 6d 65 74 ta-panel testmet 3ef0: 61 20 73 74 6f 72 65 2d 6d 65 74 61 29 29 0a 09 a store-meta)).. 3f00: 09 09 20 20 20 20 20 20 20 28 68 6f 73 74 2d 69 .. (host-i 3f10: 6e 66 6f 2d 70 61 6e 65 6c 20 74 65 73 74 64 61 nfo-panel testda 3f20: 74 20 73 74 6f 72 65 2d 6c 61 62 65 6c 29 0a 09 t store-label).. 3f30: 09 09 20 20 20 20 20 20 20 3b 3b 20 54 68 65 20 .. ;; The 3f40: 63 6f 6e 74 72 6f 6c 73 0a 09 09 09 20 20 20 20 controls.... 3f50: 20 20 20 28 69 75 70 3a 66 72 61 6d 65 20 23 3a (iup:frame #: 3f60: 74 69 74 6c 65 20 22 41 63 74 69 6f 6e 73 22 20 title "Actions" 3f70: 0a 09 09 09 09 09 20 20 28 69 75 70 3a 76 62 6f ...... (iup:vbo 3f80: 78 0a 09 09 09 09 09 20 20 20 28 69 75 70 3a 68 x...... (iup:h 3f90: 62 6f 78 20 0a 09 09 09 09 09 20 20 20 20 28 69 box ...... (i 3fa0: 75 70 3a 62 75 74 74 6f 6e 20 22 56 69 65 77 20 up:button "View 3fb0: 4c 6f 67 22 20 20 20 20 20 20 23 3a 61 63 74 69 Log" #:acti 3fc0: 6f 6e 20 76 69 65 77 6c 6f 67 20 20 20 20 20 23 on viewlog # 3fd0: 3a 73 69 7a 65 20 22 38 30 78 22 29 0a 09 09 09 :size "80x").... 3fe0: 09 09 20 20 20 20 28 69 75 70 3a 62 75 74 74 6f .. (iup:butto 3ff0: 6e 20 22 53 74 61 72 74 20 58 74 65 72 6d 22 20 n "Start Xterm" 4000: 20 20 23 3a 61 63 74 69 6f 6e 20 78 74 65 72 6d #:action xterm 4010: 20 20 20 20 20 20 20 23 3a 73 69 7a 65 20 22 38 #:size "8 4020: 30 78 22 29 0a 09 09 09 09 09 20 20 20 20 28 69 0x")...... (i 4030: 75 70 3a 62 75 74 74 6f 6e 20 22 52 75 6e 20 54 up:button "Run T 4040: 65 73 74 22 20 20 20 20 20 20 23 3a 61 63 74 69 est" #:acti 4050: 6f 6e 20 72 75 6e 2d 74 65 73 74 20 20 20 20 23 on run-test # 4060: 3a 73 69 7a 65 20 22 38 30 78 22 29 0a 09 09 09 :size "80x").... 4070: 09 09 20 20 20 20 28 69 75 70 3a 62 75 74 74 6f .. (iup:butto 4080: 6e 20 22 43 6c 65 61 6e 20 54 65 73 74 22 20 20 n "Clean Test" 4090: 20 20 23 3a 61 63 74 69 6f 6e 20 72 65 6d 6f 76 #:action remov 40a0: 65 2d 74 65 73 74 20 23 3a 73 69 7a 65 20 22 38 e-test #:size "8 40b0: 30 78 22 29 0a 09 09 09 09 09 20 20 20 20 28 69 0x")...... (i 40c0: 75 70 3a 62 75 74 74 6f 6e 20 22 4b 69 6c 6c 20 up:button "Kill 40d0: 41 6c 6c 20 4a 6f 62 73 22 20 23 3a 61 63 74 69 All Jobs" #:acti 40e0: 6f 6e 20 6b 69 6c 6c 2d 6a 6f 62 73 20 20 20 23 on kill-jobs # 40f0: 3a 73 69 7a 65 20 22 38 30 78 22 29 0a 09 09 09 :size "80x").... 4100: 09 09 20 20 20 20 28 69 75 70 3a 62 75 74 74 6f .. (iup:butto 4110: 6e 20 22 43 6c 6f 73 65 22 20 20 20 20 20 20 20 n "Close" 4120: 20 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 #:action (lamb 4130: 64 61 20 28 78 29 28 65 78 69 74 29 29 20 23 3a da (x)(exit)) #: 4140: 73 69 7a 65 20 22 38 30 78 22 29 29 0a 09 09 09 size "80x")).... 4150: 09 09 20 20 20 28 61 70 70 6c 79 20 0a 09 09 09 .. (apply .... 4160: 09 09 20 20 20 20 69 75 70 3a 68 62 6f 78 0a 09 .. iup:hbox.. 4170: 09 09 09 09 20 20 20 20 28 6c 69 73 74 20 63 6f .... (list co 4180: 6d 6d 61 6e 64 2d 74 65 78 74 2d 62 6f 78 20 63 mmand-text-box c 4190: 6f 6d 6d 61 6e 64 2d 6c 61 75 6e 63 68 2d 62 75 ommand-launch-bu 41a0: 74 74 6f 6e 29 29 29 29 0a 09 09 09 20 20 20 20 tton)))).... 41b0: 20 20 20 28 73 65 74 2d 66 69 65 6c 64 73 2d 70 (set-fields-p 41c0: 61 6e 65 6c 20 74 65 73 74 2d 69 64 20 74 65 73 anel test-id tes 41d0: 74 64 61 74 29 0a 09 09 09 20 20 20 20 20 20 20 tdat).... 41e0: 28 6c 65 74 20 28 28 74 61 62 73 20 0a 09 09 09 (let ((tabs .... 41f0: 09 20 20 20 20 20 20 28 69 75 70 3a 74 61 62 73 . (iup:tabs 4200: 0a 09 09 09 09 20 20 20 20 20 20 20 3b 3b 20 52 ..... ;; R 4210: 65 70 6c 61 63 65 20 68 65 72 65 20 77 69 74 68 eplace here with 4220: 20 6d 61 74 72 69 78 0a 09 09 09 09 20 20 20 20 matrix..... 4230: 20 20 20 28 6c 65 74 20 28 28 73 74 65 70 73 2d (let ((steps- 4240: 6d 61 74 72 69 78 20 28 69 75 70 3a 6d 61 74 72 matrix (iup:matr 4250: 69 78 0a 09 09 09 09 09 09 09 20 20 20 20 23 3a ix........ #: 4260: 66 6f 6e 74 20 20 20 22 43 6f 75 72 69 65 72 20 font "Courier 4270: 4e 65 77 2c 20 2d 38 22 0a 09 09 09 09 09 09 09 New, -8"........ 4280: 20 20 20 20 23 3a 65 78 70 61 6e 64 20 22 59 45 #:expand "YE 4290: 53 22 0a 09 09 09 09 09 09 09 20 20 20 20 23 3a S"........ #: 42a0: 73 63 72 6f 6c 6c 62 61 72 20 22 59 45 53 22 0a scrollbar "YES". 42b0: 09 09 09 09 09 09 09 20 20 20 20 23 3a 6e 75 6d ....... #:num 42c0: 63 6f 6c 20 36 0a 09 09 09 09 09 09 09 20 20 20 col 6........ 42d0: 20 23 3a 6e 75 6d 6c 69 6e 20 33 30 0a 09 09 09 #:numlin 30.... 42e0: 09 09 09 09 20 20 20 20 23 3a 6e 75 6d 63 6f 6c .... #:numcol 42f0: 2d 76 69 73 69 62 6c 65 20 36 0a 09 09 09 09 09 -visible 6...... 4300: 09 09 20 20 20 20 23 3a 6e 75 6d 6c 69 6e 2d 76 .. #:numlin-v 4310: 69 73 69 62 6c 65 20 35 0a 09 09 09 09 09 09 09 isible 5........ 4320: 20 20 20 20 23 3a 63 6c 69 63 6b 2d 63 62 20 28 #:click-cb ( 4330: 6c 61 6d 62 64 61 20 28 6f 62 6a 20 6c 69 6e 20 lambda (obj lin 4340: 63 6f 6c 20 73 74 61 74 75 73 29 0a 09 09 09 09 col status)..... 4350: 09 09 09 09 09 20 28 69 66 20 28 65 71 75 61 6c ..... (if (equal 4360: 3f 20 63 6f 6c 20 36 29 0a 09 09 09 09 09 09 09 ? col 6)........ 4370: 09 09 20 20 20 20 20 28 6c 65 74 20 28 28 66 6e .. (let ((fn 4380: 61 6d 65 20 28 69 75 70 3a 61 74 74 72 69 62 75 ame (iup:attribu 4390: 74 65 20 6f 62 6a 20 28 63 6f 6e 63 20 6c 69 6e te obj (conc lin 43a0: 20 22 3a 22 20 63 6f 6c 29 29 29 29 0a 09 09 09 ":" col)))).... 43b0: 09 09 09 09 09 09 20 20 20 20 20 20 20 28 76 69 ...... (vi 43c0: 65 77 6c 6f 67 20 66 6e 61 6d 65 29 0a 09 09 09 ewlog fname).... 43d0: 09 09 09 09 09 09 20 20 20 20 20 20 20 28 70 72 ...... (pr 43e0: 69 6e 74 20 22 6f 62 6a 3a 20 22 20 6f 62 6a 20 int "obj: " obj 43f0: 22 20 6c 69 6e 3a 20 22 20 6c 69 6e 20 22 20 63 " lin: " lin " c 4400: 6f 6c 3a 20 22 20 63 6f 6c 20 22 20 73 74 61 74 ol: " col " stat 4410: 75 73 3a 20 22 20 73 74 61 74 75 73 29 29 29 29 us: " status)))) 4420: 29 0a 09 09 09 09 09 09 09 20 20 20 29 29 0a 09 )........ )).. 4430: 09 09 09 09 20 3b 3b 20 28 6c 65 74 20 6c 6f 6f .... ;; (let loo 4440: 70 20 28 28 63 6f 75 6e 74 20 30 29 29 0a 09 09 p ((count 0))... 4450: 09 09 09 20 3b 3b 20 20 20 28 69 75 70 3a 61 74 ... ;; (iup:at 4460: 74 72 69 62 75 74 65 2d 73 65 74 21 20 73 74 65 tribute-set! ste 4470: 70 73 2d 6d 61 74 72 69 78 20 22 46 49 54 54 4f ps-matrix "FITTO 4480: 54 45 58 54 22 20 28 63 6f 6e 63 20 22 4c 22 20 TEXT" (conc "L" 4490: 63 6f 75 6e 74 29 29 0a 09 09 09 09 09 20 3b 3b count))...... ;; 44a0: 20 20 20 28 69 66 20 28 3c 20 63 6f 75 6e 74 20 (if (< count 44b0: 33 30 29 0a 09 09 09 09 09 20 3b 3b 20 20 20 20 30)...... ;; 44c0: 20 20 20 28 6c 6f 6f 70 20 28 2b 20 63 6f 75 6e (loop (+ coun 44d0: 74 20 31 29 29 29 29 0a 09 09 09 09 09 20 28 69 t 1))))...... (i 44e0: 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 up:attribute-set 44f0: 21 20 73 74 65 70 73 2d 6d 61 74 72 69 78 20 22 ! steps-matrix " 4500: 30 3a 31 22 20 22 53 74 65 70 20 4e 61 6d 65 22 0:1" "Step Name" 4510: 29 0a 09 09 09 09 09 20 28 69 75 70 3a 61 74 74 )...... (iup:att 4520: 72 69 62 75 74 65 2d 73 65 74 21 20 73 74 65 70 ribute-set! step 4530: 73 2d 6d 61 74 72 69 78 20 22 30 3a 32 22 20 22 s-matrix "0:2" " 4540: 53 74 61 72 74 22 29 0a 09 09 09 09 09 20 28 69 Start")...... (i 4550: 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 up:attribute-set 4560: 21 20 73 74 65 70 73 2d 6d 61 74 72 69 78 20 22 ! steps-matrix " 4570: 30 3a 33 22 20 22 45 6e 64 22 29 0a 09 09 09 09 0:3" "End")..... 4580: 09 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 . (iup:attribute 4590: 2d 73 65 74 21 20 73 74 65 70 73 2d 6d 61 74 72 -set! steps-matr 45a0: 69 78 20 22 57 49 44 54 48 33 22 20 22 35 30 22 ix "WIDTH3" "50" 45b0: 29 0a 09 09 09 09 09 20 28 69 75 70 3a 61 74 74 )...... (iup:att 45c0: 72 69 62 75 74 65 2d 73 65 74 21 20 73 74 65 70 ribute-set! step 45d0: 73 2d 6d 61 74 72 69 78 20 22 30 3a 34 22 20 22 s-matrix "0:4" " 45e0: 53 74 61 74 75 73 22 29 0a 09 09 09 09 09 20 28 Status")...... ( 45f0: 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 iup:attribute-se 4600: 74 21 20 73 74 65 70 73 2d 6d 61 74 72 69 78 20 t! steps-matrix 4610: 22 57 49 44 54 48 34 22 20 22 35 30 22 29 0a 09 "WIDTH4" "50").. 4620: 09 09 09 09 20 28 69 75 70 3a 61 74 74 72 69 62 .... (iup:attrib 4630: 75 74 65 2d 73 65 74 21 20 73 74 65 70 73 2d 6d ute-set! steps-m 4640: 61 74 72 69 78 20 22 30 3a 35 22 20 22 44 75 72 atrix "0:5" "Dur 4650: 61 74 69 6f 6e 22 29 0a 09 09 09 09 09 20 28 69 ation")...... (i 4660: 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 up:attribute-set 4670: 21 20 73 74 65 70 73 2d 6d 61 74 72 69 78 20 22 ! steps-matrix " 4680: 30 3a 36 22 20 22 4c 6f 67 20 46 69 6c 65 22 29 0:6" "Log File") 4690: 0a 09 09 09 09 09 20 28 69 75 70 3a 61 74 74 72 ...... (iup:attr 46a0: 69 62 75 74 65 2d 73 65 74 21 20 73 74 65 70 73 ibute-set! steps 46b0: 2d 6d 61 74 72 69 78 20 22 41 4c 49 47 4e 4d 45 -matrix "ALIGNME 46c0: 4e 54 31 22 20 22 41 4c 45 46 54 22 29 0a 09 09 NT1" "ALEFT")... 46d0: 09 09 09 20 3b 3b 20 28 69 75 70 3a 61 74 74 72 ... ;; (iup:attr 46e0: 69 62 75 74 65 2d 73 65 74 21 20 73 74 65 70 73 ibute-set! steps 46f0: 2d 6d 61 74 72 69 78 20 22 46 49 58 54 4f 54 45 -matrix "FIXTOTE 4700: 58 54 22 20 22 43 31 22 29 0a 09 09 09 09 09 20 XT" "C1")...... 4710: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 (iup:attribute-s 4720: 65 74 21 20 73 74 65 70 73 2d 6d 61 74 72 69 78 et! steps-matrix 4730: 20 22 52 45 53 49 5a 45 4d 41 54 52 49 58 22 20 "RESIZEMATRIX" 4740: 22 59 45 53 22 29 0a 09 09 09 09 09 20 28 6c 65 "YES")...... (le 4750: 74 20 28 28 70 72 6f 63 0a 09 09 09 09 09 09 28 t ((proc.......( 4760: 6c 61 6d 62 64 61 20 28 74 65 73 74 64 61 74 29 lambda (testdat) 4770: 0a 09 09 09 09 09 09 20 20 28 69 66 20 28 6e 6f ....... (if (no 4780: 74 20 28 6e 75 6c 6c 3f 20 74 65 73 74 73 74 65 t (null? testste 4790: 70 73 29 29 0a 09 09 09 09 09 09 20 20 20 20 20 ps))....... 47a0: 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 68 65 64 (let loop ((hed 47b0: 20 20 20 20 28 63 61 72 20 74 65 73 74 73 74 65 (car testste 47c0: 70 73 29 29 0a 09 09 09 09 09 09 09 09 20 28 74 ps))......... (t 47d0: 61 6c 20 20 20 20 28 63 64 72 20 74 65 73 74 73 al (cdr tests 47e0: 74 65 70 73 29 29 0a 09 09 09 09 09 09 09 09 20 teps))......... 47f0: 28 72 6f 77 6e 75 6d 20 31 29 0a 09 09 09 09 09 (rownum 1)...... 4800: 09 09 09 20 28 63 6f 6c 6e 75 6d 20 31 29 29 0a ... (colnum 1)). 4810: 09 09 09 09 09 09 09 28 6c 65 74 20 28 28 76 61 .......(let ((va 4820: 6c 20 28 76 65 63 74 6f 72 2d 72 65 66 20 68 65 l (vector-ref he 4830: 64 20 28 2d 20 63 6f 6c 6e 75 6d 20 31 29 29 29 d (- colnum 1))) 4840: 29 0a 09 09 09 09 09 09 09 20 20 28 69 75 70 3a )........ (iup: 4850: 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 73 attribute-set! s 4860: 74 65 70 73 2d 6d 61 74 72 69 78 20 20 28 63 6f teps-matrix (co 4870: 6e 63 20 72 6f 77 6e 75 6d 20 22 3a 22 20 63 6f nc rownum ":" co 4880: 6c 6e 75 6d 29 28 69 66 20 76 61 6c 20 28 63 6f lnum)(if val (co 4890: 6e 63 20 76 61 6c 29 20 22 22 29 29 0a 09 09 09 nc val) "")).... 48a0: 09 09 09 09 20 20 28 69 66 20 28 3c 20 63 6f 6c .... (if (< col 48b0: 6e 75 6d 20 36 29 0a 09 09 09 09 09 09 09 20 20 num 6)........ 48c0: 20 20 20 20 28 6c 6f 6f 70 20 68 65 64 20 74 61 (loop hed ta 48d0: 6c 20 72 6f 77 6e 75 6d 20 28 2b 20 63 6f 6c 6e l rownum (+ coln 48e0: 75 6d 20 31 29 29 0a 09 09 09 09 09 09 09 20 20 um 1))........ 48f0: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 6e 75 (if (not (nu 4900: 6c 6c 3f 20 74 61 6c 29 29 0a 09 09 09 09 09 09 ll? tal))....... 4910: 09 09 20 20 28 6c 6f 6f 70 20 28 63 61 72 20 74 .. (loop (car t 4920: 61 6c 29 28 63 64 72 20 74 61 6c 29 28 2b 20 72 al)(cdr tal)(+ r 4930: 6f 77 6e 75 6d 20 31 29 20 31 29 29 29 29 0a 09 ownum 1) 1)))).. 4940: 09 09 09 09 09 09 28 69 75 70 3a 61 74 74 72 69 ......(iup:attri 4950: 62 75 74 65 2d 73 65 74 21 20 73 74 65 70 73 2d bute-set! steps- 4960: 6d 61 74 72 69 78 20 22 52 45 44 52 41 57 22 20 matrix "REDRAW" 4970: 22 41 4c 4c 22 29 29 29 29 29 29 0a 09 09 09 09 "ALL"))))))..... 4980: 09 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d . (hash-table- 4990: 73 65 74 21 20 77 69 64 67 65 74 73 20 22 53 74 set! widgets "St 49a0: 65 70 73 4d 61 74 72 69 78 22 20 70 72 6f 63 29 epsMatrix" proc) 49b0: 0a 09 09 09 09 09 20 20 20 28 70 72 6f 63 20 74 ...... (proc t 49c0: 65 73 74 64 61 74 29 29 0a 09 09 09 09 09 20 73 estdat))...... s 49d0: 74 65 70 73 2d 6d 61 74 72 69 78 29 0a 09 09 09 teps-matrix).... 49e0: 09 20 20 20 20 20 20 20 3b 3b 20 70 6f 70 75 6c . ;; popul 49f0: 61 74 65 20 74 68 65 20 54 65 73 74 20 44 61 74 ate the Test Dat 4a00: 61 20 70 61 6e 65 6c 0a 09 09 09 09 20 20 20 20 a panel..... 4a10: 20 20 20 28 69 75 70 3a 66 72 61 6d 65 0a 09 09 (iup:frame... 4a20: 09 09 09 23 3a 74 69 74 6c 65 20 22 54 65 73 74 ...#:title "Test 4a30: 20 44 61 74 61 22 0a 09 09 09 09 09 28 6c 65 74 Data"......(let 4a40: 20 28 28 74 65 73 74 2d 64 61 74 61 0a 09 09 09 ((test-data.... 4a50: 09 09 20 20 20 20 20 20 20 28 69 75 70 3a 74 65 .. (iup:te 4a60: 78 74 62 6f 78 20 20 3b 3b 20 23 3a 61 63 74 69 xtbox ;; #:acti 4a70: 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 20 on (lambda (obj 4a80: 63 68 61 72 20 76 61 6c 29 0a 09 09 09 09 09 09 char val)....... 4a90: 3b 3b 20 20 20 09 23 66 29 0a 09 09 09 09 09 09 ;; .#f)....... 4aa0: 23 3a 65 78 70 61 6e 64 20 22 59 45 53 22 0a 09 #:expand "YES".. 4ab0: 09 09 09 09 09 23 3a 6d 75 6c 74 69 6c 69 6e 65 .....#:multiline 4ac0: 20 22 59 45 53 22 0a 09 09 09 09 09 09 23 3a 66 "YES".......#:f 4ad0: 6f 6e 74 20 22 43 6f 75 72 69 65 72 20 4e 65 77 ont "Courier New 4ae0: 2c 20 2d 31 30 22 0a 09 09 09 09 09 09 23 3a 73 , -10".......#:s 4af0: 69 7a 65 20 22 31 30 30 78 31 30 30 22 29 29 29 ize "100x100"))) 4b00: 0a 09 09 09 09 09 20 20 28 68 61 73 68 2d 74 61 ...... (hash-ta 4b10: 62 6c 65 2d 73 65 74 21 20 77 69 64 67 65 74 73 ble-set! widgets 4b20: 20 22 54 65 73 74 20 44 61 74 61 22 0a 09 09 09 "Test Data".... 4b30: 09 09 09 09 20 20 20 28 6c 61 6d 62 64 61 20 28 .... (lambda ( 4b40: 74 65 73 74 64 61 74 29 20 3b 3b 20 0a 09 09 09 testdat) ;; .... 4b50: 09 09 09 09 20 20 20 20 20 28 6c 65 74 2a 20 28 .... (let* ( 4b60: 28 63 75 72 72 76 61 6c 20 28 69 75 70 3a 61 74 (currval (iup:at 4b70: 74 72 69 62 75 74 65 20 74 65 73 74 2d 64 61 74 tribute test-dat 4b80: 61 20 22 56 41 4c 55 45 22 29 29 20 3b 3b 20 22 a "VALUE")) ;; " 4b90: 54 49 54 4c 45 22 29 29 0a 09 09 09 09 09 09 09 TITLE"))........ 4ba0: 09 20 20 20 20 28 66 6d 74 73 74 72 20 20 22 7e . (fmtstr "~ 4bb0: 31 30 61 7e 31 30 61 7e 31 30 61 7e 31 30 61 7e 10a~10a~10a~10a~ 4bc0: 37 61 7e 37 61 7e 36 61 7e 36 61 7e 61 22 29 20 7a~7a~6a~6a~a") 4bd0: 3b 3b 20 63 61 74 65 67 6f 72 79 2c 76 61 72 69 ;; category,vari 4be0: 61 62 6c 65 2c 76 61 6c 75 65 2c 65 78 70 65 63 able,value,expec 4bf0: 74 65 64 2c 74 6f 6c 2c 75 6e 69 74 73 2c 74 79 ted,tol,units,ty 4c00: 70 65 2c 63 6f 6d 6d 65 6e 74 0a 09 09 09 09 09 pe,comment...... 4c10: 09 09 09 20 20 20 20 28 6e 65 77 76 61 6c 20 20 ... (newval 4c20: 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 (string-interspe 4c30: 72 73 65 20 0a 09 09 09 09 09 09 09 09 09 20 20 rse .......... 4c40: 20 20 20 20 28 61 70 70 65 6e 64 0a 09 09 09 09 (append..... 4c50: 09 09 09 09 09 20 20 20 20 20 20 20 28 6c 69 73 ..... (lis 4c60: 74 20 0a 09 09 09 09 09 09 09 09 09 09 28 66 6f t ...........(fo 4c70: 72 6d 61 74 20 23 66 20 66 6d 74 73 74 72 20 22 rmat #f fmtstr " 4c80: 43 61 74 65 67 6f 72 79 22 20 22 56 61 72 69 61 Category" "Varia 4c90: 62 6c 65 22 20 22 56 61 6c 75 65 22 20 22 45 78 ble" "Value" "Ex 4ca0: 70 65 63 74 65 64 22 20 22 54 6f 6c 22 20 22 53 pected" "Tol" "S 4cb0: 74 61 74 75 73 22 20 22 55 6e 69 74 73 22 20 22 tatus" "Units" " 4cc0: 54 79 70 65 22 20 22 43 6f 6d 6d 65 6e 74 22 29 Type" "Comment") 4cd0: 0a 09 09 09 09 09 09 09 09 09 09 28 66 6f 72 6d ...........(form 4ce0: 61 74 20 23 66 20 66 6d 74 73 74 72 20 22 3d 3d at #f fmtstr "== 4cf0: 3d 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d 3d 3d 3d ======" "======= 4d00: 3d 22 20 22 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d =" "=====" "==== 4d10: 3d 3d 3d 3d 22 20 22 3d 3d 3d 22 20 22 3d 3d 3d ====" "===" "=== 4d20: 3d 3d 3d 22 20 22 3d 3d 3d 3d 3d 22 20 22 3d 3d ===" "=====" "== 4d30: 3d 3d 22 20 22 3d 3d 3d 3d 3d 3d 3d 22 29 29 0a ==" "=======")). 4d40: 09 09 09 09 09 09 09 09 09 20 20 20 20 20 20 20 ......... 4d50: 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 78 29 (map (lambda (x) 4d60: 0a 09 09 09 09 09 09 09 09 09 09 20 20 20 20 20 ........... 4d70: 20 28 66 6f 72 6d 61 74 20 23 66 20 66 6d 74 73 (format #f fmts 4d80: 74 72 0a 09 09 09 09 09 09 09 09 09 09 09 20 20 tr............ 4d90: 20 20 20 20 28 64 62 3a 74 65 73 74 2d 64 61 74 (db:test-dat 4da0: 61 2d 67 65 74 2d 63 61 74 65 67 6f 72 79 20 78 a-get-category x 4db0: 29 0a 09 09 09 09 09 09 09 09 09 09 09 20 20 20 )............ 4dc0: 20 20 20 28 64 62 3a 74 65 73 74 2d 64 61 74 61 (db:test-data 4dd0: 2d 67 65 74 2d 76 61 72 69 61 62 6c 65 20 78 29 -get-variable x) 4de0: 0a 09 09 09 09 09 09 09 09 09 09 09 20 20 20 20 ............ 4df0: 20 20 28 64 62 3a 74 65 73 74 2d 64 61 74 61 2d (db:test-data- 4e00: 67 65 74 2d 76 61 6c 75 65 20 20 20 20 78 29 0a get-value x). 4e10: 09 09 09 09 09 09 09 09 09 09 09 20 20 20 20 20 ........... 4e20: 20 28 64 62 3a 74 65 73 74 2d 64 61 74 61 2d 67 (db:test-data-g 4e30: 65 74 2d 65 78 70 65 63 74 65 64 20 78 29 0a 09 et-expected x).. 4e40: 09 09 09 09 09 09 09 09 09 09 20 20 20 20 20 20 .......... 4e50: 28 64 62 3a 74 65 73 74 2d 64 61 74 61 2d 67 65 (db:test-data-ge 4e60: 74 2d 74 6f 6c 20 20 20 20 20 20 78 29 0a 09 09 t-tol x)... 4e70: 09 09 09 09 09 09 09 09 09 20 20 20 20 20 20 28 ......... ( 4e80: 64 62 3a 74 65 73 74 2d 64 61 74 61 2d 67 65 74 db:test-data-get 4e90: 2d 73 74 61 74 75 73 20 20 20 78 29 0a 09 09 09 -status x).... 4ea0: 09 09 09 09 09 09 09 09 20 20 20 20 20 20 28 64 ........ (d 4eb0: 62 3a 74 65 73 74 2d 64 61 74 61 2d 67 65 74 2d b:test-data-get- 4ec0: 75 6e 69 74 73 20 20 20 20 78 29 0a 09 09 09 09 units x)..... 4ed0: 09 09 09 09 09 09 09 20 20 20 20 20 20 28 64 62 ....... (db 4ee0: 3a 74 65 73 74 2d 64 61 74 61 2d 67 65 74 2d 74 :test-data-get-t 4ef0: 79 70 65 20 20 20 20 20 78 29 0a 09 09 09 09 09 ype x)...... 4f00: 09 09 09 09 09 09 20 20 20 20 20 20 28 64 62 3a ...... (db: 4f10: 74 65 73 74 2d 64 61 74 61 2d 67 65 74 2d 63 6f test-data-get-co 4f20: 6d 6d 65 6e 74 20 20 78 29 29 29 0a 09 09 09 09 mment x)))..... 4f30: 09 09 09 09 09 09 20 20 20 20 28 6f 70 65 6e 2d ...... (open- 4f40: 72 75 6e 2d 63 6c 6f 73 65 20 64 62 3a 72 65 61 run-close db:rea 4f50: 64 2d 74 65 73 74 2d 64 61 74 61 20 23 66 20 74 d-test-data #f t 4f60: 65 73 74 2d 69 64 20 22 25 22 29 29 29 0a 09 09 est-id "%")))... 4f70: 09 09 09 09 09 09 09 20 20 20 20 20 20 22 5c 6e ....... "\n 4f80: 22 29 29 29 0a 09 09 09 09 09 09 09 20 20 20 20 ")))........ 4f90: 20 20 20 28 69 66 20 28 6e 6f 74 20 28 65 71 75 (if (not (equ 4fa0: 61 6c 3f 20 63 75 72 72 76 61 6c 20 6e 65 77 76 al? currval newv 4fb0: 61 6c 29 29 0a 09 09 09 09 09 09 09 09 20 20 20 al))......... 4fc0: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 (iup:attribute-s 4fd0: 65 74 21 20 74 65 73 74 2d 64 61 74 61 20 22 56 et! test-data "V 4fe0: 41 4c 55 45 22 20 6e 65 77 76 61 6c 20 29 29 29 ALUE" newval ))) 4ff0: 29 29 20 3b 3b 20 22 54 49 54 4c 45 22 20 6e 65 )) ;; "TITLE" ne 5000: 77 76 61 6c 29 29 29 29 29 0a 09 09 09 09 09 20 wval)))))...... 5010: 20 74 65 73 74 2d 64 61 74 61 29 29 29 29 29 0a test-data))))). 5020: 09 09 09 09 20 28 69 75 70 3a 61 74 74 72 69 62 .... (iup:attrib 5030: 75 74 65 2d 73 65 74 21 20 74 61 62 73 20 22 54 ute-set! tabs "T 5040: 41 42 54 49 54 4c 45 30 22 20 22 53 74 65 70 73 ABTITLE0" "Steps 5050: 22 29 0a 09 09 09 09 20 28 69 75 70 3a 61 74 74 ")..... (iup:att 5060: 72 69 62 75 74 65 2d 73 65 74 21 20 74 61 62 73 ribute-set! tabs 5070: 20 22 54 41 42 54 49 54 4c 45 31 22 20 22 54 65 "TABTITLE1" "Te 5080: 73 74 20 44 61 74 61 22 29 0a 09 09 09 09 20 74 st Data")..... t 5090: 61 62 73 29 29 29 29 0a 09 20 20 20 20 28 69 75 abs)))).. (iu 50a0: 70 3a 73 68 6f 77 20 73 65 6c 66 29 0a 09 20 20 p:show self).. 50b0: 20 20 28 69 75 70 3a 63 61 6c 6c 62 61 63 6b 2d (iup:callback- 50c0: 73 65 74 21 20 2a 74 69 6d 2a 20 22 41 43 54 49 set! *tim* "ACTI 50d0: 4f 4e 5f 43 42 22 0a 09 09 09 20 20 20 20 20 20 ON_CB".... 50e0: 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 09 (lambda (x).... 50f0: 09 20 3b 3b 20 4e 6f 77 20 73 74 61 72 74 20 6b . ;; Now start k 5100: 65 65 70 69 6e 67 20 74 68 65 20 67 75 69 20 75 eeping the gui u 5110: 70 64 61 74 65 64 20 66 72 6f 6d 20 74 68 65 20 pdated from the 5120: 64 62 0a 09 09 09 09 20 28 72 65 66 72 65 73 68 db..... (refresh 5130: 64 61 74 29 20 3b 3b 20 75 70 64 61 74 65 20 66 dat) ;; update f 5140: 72 6f 6d 20 74 68 65 20 64 62 20 68 65 72 65 0a rom the db here. 5150: 09 09 09 09 09 3b 28 74 68 72 65 61 64 2d 73 75 .....;(thread-su 5160: 73 70 65 6e 64 21 20 6f 74 68 65 72 2d 74 68 72 spend! other-thr 5170: 65 61 64 29 0a 09 09 09 09 20 3b 3b 20 75 70 64 ead)..... ;; upd 5180: 61 74 65 20 74 68 65 20 67 75 69 20 65 6c 65 6d ate the gui elem 5190: 65 6e 74 73 20 68 65 72 65 0a 09 09 09 09 20 28 ents here..... ( 51a0: 66 6f 72 2d 65 61 63 68 20 0a 09 09 09 09 20 20 for-each ..... 51b0: 28 6c 61 6d 62 64 61 20 28 6b 65 79 29 0a 09 09 (lambda (key)... 51c0: 09 09 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 .. ;; (print 51d0: 22 55 70 64 61 74 69 6e 67 20 22 20 6b 65 79 29 "Updating " key) 51e0: 0a 09 09 09 09 20 20 20 20 28 28 68 61 73 68 2d ..... ((hash- 51f0: 74 61 62 6c 65 2d 72 65 66 20 77 69 64 67 65 74 table-ref widget 5200: 73 20 6b 65 79 29 20 74 65 73 74 64 61 74 29 29 s key) testdat)) 5210: 0a 09 09 09 09 20 20 28 68 61 73 68 2d 74 61 62 ..... (hash-tab 5220: 6c 65 2d 6b 65 79 73 20 77 69 64 67 65 74 73 29 le-keys widgets) 5230: 29 0a 09 09 09 09 20 28 75 70 64 61 74 65 2d 73 )..... (update-s 5240: 74 61 74 65 2d 73 74 61 74 75 73 2d 62 75 74 74 tate-status-butt 5250: 6f 6e 73 20 74 65 73 74 64 61 74 29 0a 09 09 09 ons testdat).... 5260: 09 09 3b 20 28 69 75 70 3a 72 65 66 72 65 73 68 ..; (iup:refresh 5270: 20 73 65 6c 66 29 0a 09 09 09 09 20 28 69 66 20 self)..... (if 5280: 2a 65 78 69 74 2d 73 74 61 72 74 65 64 2a 0a 09 *exit-started*.. 5290: 09 09 09 20 20 20 20 20 28 73 65 74 21 20 2a 65 ... (set! *e 52a0: 78 69 74 2d 73 74 61 72 74 65 64 2a 20 27 6f 6b xit-started* 'ok 52b0: 29 29 29 29 29 29 29 29 29 29 0a 0a ))))))))))..