Artifact 1c5b5c3f8a2f42e7210aaff8cda95173bed13193:
- File dashboard-tests.scm — part of check-in [f195933f52] at 2012-04-19 00:09:20 on branch trunk — Made xterms wider and shorter for run launching and test removal (user: matt size: 19668)
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 29 0a 28 ..(use format).( 0290: 72 65 71 75 69 72 65 2d 6c 69 62 72 61 72 79 20 require-library 02a0: 69 75 70 29 0a 28 69 6d 70 6f 72 74 20 28 70 72 iup).(import (pr 02b0: 65 66 69 78 20 69 75 70 20 69 75 70 3a 29 29 0a efix iup iup:)). 02c0: 0a 28 75 73 65 20 63 61 6e 76 61 73 2d 64 72 61 .(use canvas-dra 02d0: 77 29 0a 0a 28 75 73 65 20 73 71 6c 69 74 65 33 w)..(use sqlite3 02e0: 20 73 72 66 69 2d 31 20 70 6f 73 69 78 20 72 65 srfi-1 posix re 02f0: 67 65 78 20 72 65 67 65 78 2d 63 61 73 65 20 73 gex regex-case s 0300: 72 66 69 2d 36 39 29 0a 28 69 6d 70 6f 72 74 20 rfi-69).(import 0310: 28 70 72 65 66 69 78 20 73 71 6c 69 74 65 33 20 (prefix sqlite3 0320: 73 71 6c 69 74 65 33 3a 29 29 0a 0a 28 64 65 63 sqlite3:))..(dec 0330: 6c 61 72 65 20 28 75 6e 69 74 20 64 61 73 68 62 lare (unit dashb 0340: 6f 61 72 64 2d 74 65 73 74 73 29 29 0a 28 64 65 oard-tests)).(de 0350: 63 6c 61 72 65 20 28 75 73 65 73 20 63 6f 6d 6d clare (uses comm 0360: 6f 6e 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 on)).(declare (u 0370: 73 65 73 20 64 62 29 29 0a 0a 28 69 6e 63 6c 75 ses db))..(inclu 0380: 64 65 20 22 63 6f 6d 6d 6f 6e 5f 72 65 63 6f 72 de "common_recor 0390: 64 73 2e 73 63 6d 22 29 0a 28 69 6e 63 6c 75 64 ds.scm").(includ 03a0: 65 20 22 64 62 5f 72 65 63 6f 72 64 73 2e 73 63 e "db_records.sc 03b0: 6d 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 72 75 m").(include "ru 03c0: 6e 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 29 0a n_records.scm"). 03d0: 0a 28 64 65 66 69 6e 65 20 28 74 65 73 74 2d 69 .(define (test-i 03e0: 6e 66 6f 2d 70 61 6e 65 6c 20 74 65 73 74 64 61 nfo-panel testda 03f0: 74 20 73 74 6f 72 65 2d 6c 61 62 65 6c 20 77 69 t store-label wi 0400: 64 67 65 74 73 29 0a 20 20 28 69 75 70 3a 66 72 dgets). (iup:fr 0410: 61 6d 65 20 0a 20 20 20 23 3a 74 69 74 6c 65 20 ame . #:title 0420: 22 54 65 73 74 20 49 6e 66 6f 22 20 3b 20 23 3a "Test Info" ; #: 0430: 65 78 70 61 6e 64 20 22 59 45 53 22 0a 20 20 20 expand "YES". 0440: 28 69 75 70 3a 68 62 6f 78 20 3b 20 23 3a 65 78 (iup:hbox ; #:ex 0450: 70 61 6e 64 20 22 59 45 53 22 0a 20 20 20 20 28 pand "YES". ( 0460: 61 70 70 6c 79 20 69 75 70 3a 76 62 6f 78 20 3b apply iup:vbox ; 0470: 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53 22 0a #:expand "YES". 0480: 09 20 20 20 28 61 70 70 65 6e 64 20 28 6d 61 70 . (append (map 0490: 20 28 6c 61 6d 62 64 61 20 28 76 61 6c 29 0a 09 (lambda (val).. 04a0: 09 09 20 20 28 69 75 70 3a 6c 61 62 65 6c 20 76 .. (iup:label v 04b0: 61 6c 20 3b 20 23 3a 65 78 70 61 6e 64 20 22 48 al ; #:expand "H 04c0: 4f 52 49 5a 4f 4e 54 41 4c 22 0a 09 09 09 09 20 ORIZONTAL"..... 04d0: 20 20 20 20 29 29 0a 09 09 09 28 6c 69 73 74 20 ))....(list 04e0: 22 54 65 73 74 6e 61 6d 65 3a 20 22 0a 09 09 09 "Testname: ".... 04f0: 20 20 20 20 20 20 22 49 74 65 6d 20 70 61 74 68 "Item path 0500: 3a 20 22 0a 09 09 09 20 20 20 20 20 20 22 43 75 : ".... "Cu 0510: 72 72 65 6e 74 20 73 74 61 74 65 3a 20 22 0a 09 rrent state: ".. 0520: 09 09 20 20 20 20 20 20 22 43 75 72 72 65 6e 74 .. "Current 0530: 20 73 74 61 74 75 73 3a 20 22 0a 09 09 09 20 20 status: ".... 0540: 20 20 20 20 22 54 65 73 74 20 63 6f 6d 6d 65 6e "Test commen 0550: 74 3a 20 22 0a 09 09 09 20 20 20 20 20 20 22 54 t: ".... "T 0560: 65 73 74 20 69 64 3a 20 22 29 29 0a 09 09 20 20 est id: "))... 0570: 20 28 6c 69 73 74 20 28 69 75 70 3a 6c 61 62 65 (list (iup:labe 0580: 6c 20 22 22 20 23 3a 65 78 70 61 6e 64 20 22 56 l "" #:expand "V 0590: 45 52 54 49 43 41 4c 22 29 29 29 29 0a 20 20 20 ERTICAL")))). 05a0: 20 28 61 70 70 6c 79 20 69 75 70 3a 76 62 6f 78 (apply iup:vbox 05b0: 20 20 3b 20 23 3a 65 78 70 61 6e 64 20 22 59 45 ; #:expand "YE 05c0: 53 22 0a 09 20 20 20 28 6c 69 73 74 20 0a 09 20 S".. (list .. 05d0: 20 20 20 28 73 74 6f 72 65 2d 6c 61 62 65 6c 20 (store-label 05e0: 22 74 65 73 74 6e 61 6d 65 22 0a 09 09 09 20 28 "testname".... ( 05f0: 69 75 70 3a 6c 61 62 65 6c 20 28 64 62 3a 74 65 iup:label (db:te 0600: 73 74 2d 67 65 74 2d 74 65 73 74 6e 61 6d 65 20 st-get-testname 0610: 20 74 65 73 74 64 61 74 29 20 23 3a 65 78 70 61 testdat) #:expa 0620: 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 29 nd "HORIZONTAL") 0630: 0a 09 09 09 20 28 6c 61 6d 62 64 61 20 28 74 65 .... (lambda (te 0640: 73 74 64 61 74 29 28 64 62 3a 74 65 73 74 2d 67 stdat)(db:test-g 0650: 65 74 2d 74 65 73 74 6e 61 6d 65 20 74 65 73 74 et-testname test 0660: 64 61 74 29 29 29 0a 09 20 20 20 20 28 73 74 6f dat))).. (sto 0670: 72 65 2d 6c 61 62 65 6c 20 22 69 74 65 6d 2d 70 re-label "item-p 0680: 61 74 68 22 0a 09 09 09 20 28 69 75 70 3a 6c 61 ath".... (iup:la 0690: 62 65 6c 20 28 64 62 3a 74 65 73 74 2d 67 65 74 bel (db:test-get 06a0: 2d 69 74 65 6d 2d 70 61 74 68 20 74 65 73 74 64 -item-path testd 06b0: 61 74 29 20 23 3a 65 78 70 61 6e 64 20 22 48 4f at) #:expand "HO 06c0: 52 49 5a 4f 4e 54 41 4c 22 29 0a 09 09 09 20 28 RIZONTAL").... ( 06d0: 6c 61 6d 62 64 61 20 28 74 65 73 74 64 61 74 29 lambda (testdat) 06e0: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 74 65 (db:test-get-ite 06f0: 6d 2d 70 61 74 68 20 74 65 73 74 64 61 74 29 29 m-path testdat)) 0700: 29 0a 09 20 20 20 20 28 73 74 6f 72 65 2d 6c 61 ).. (store-la 0710: 62 65 6c 20 22 74 65 73 74 73 74 61 74 65 22 20 bel "teststate" 0720: 0a 09 09 09 20 28 69 75 70 3a 6c 61 62 65 6c 20 .... (iup:label 0730: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 (db:test-get-sta 0740: 74 65 20 74 65 73 74 64 61 74 29 20 23 3a 65 78 te testdat) #:ex 0750: 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c pand "HORIZONTAL 0760: 22 29 0a 09 09 09 20 28 6c 61 6d 62 64 61 20 28 ").... (lambda ( 0770: 74 65 73 74 64 61 74 29 0a 09 09 09 20 20 20 28 testdat).... ( 0780: 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 db:test-get-stat 0790: 65 20 74 65 73 74 64 61 74 29 29 29 0a 09 20 20 e testdat))).. 07a0: 20 20 28 6c 65 74 20 28 28 6c 62 6c 20 20 20 28 (let ((lbl ( 07b0: 69 75 70 3a 6c 61 62 65 6c 20 28 64 62 3a 74 65 iup:label (db:te 07c0: 73 74 2d 67 65 74 2d 73 74 61 74 75 73 20 74 65 st-get-status te 07d0: 73 74 64 61 74 29 20 23 3a 65 78 70 61 6e 64 20 stdat) #:expand 07e0: 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 29 29 29 0a "HORIZONTAL"))). 07f0: 09 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 . (hash-tab 0800: 6c 65 2d 73 65 74 21 20 77 69 64 67 65 74 73 20 le-set! widgets 0810: 22 74 65 73 74 73 74 61 74 75 73 22 0a 09 09 09 "teststatus".... 0820: 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 (lambda ( 0830: 74 65 73 74 64 61 74 29 0a 09 09 09 09 20 28 6c testdat)..... (l 0840: 65 74 20 28 28 6e 65 77 73 74 61 74 75 73 20 28 et ((newstatus ( 0850: 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 db:test-get-stat 0860: 75 73 20 74 65 73 74 64 61 74 29 29 0a 09 09 09 us testdat)).... 0870: 09 20 20 20 20 20 20 20 28 6f 6c 64 73 74 61 74 . (oldstat 0880: 75 73 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 us (iup:attribut 0890: 65 20 6c 62 6c 20 22 54 49 54 4c 45 22 29 29 29 e lbl "TITLE"))) 08a0: 0a 09 09 09 09 20 20 20 28 69 66 20 28 6e 6f 74 ..... (if (not 08b0: 20 28 65 71 75 61 6c 3f 20 6f 6c 64 73 74 61 74 (equal? oldstat 08c0: 75 73 20 6e 65 77 73 74 61 74 75 73 29 29 0a 09 us newstatus)).. 08d0: 09 09 09 20 20 20 20 20 20 20 28 62 65 67 69 6e ... (begin 08e0: 0a 09 09 09 09 09 20 28 69 75 70 3a 61 74 74 72 ...... (iup:attr 08f0: 69 62 75 74 65 2d 73 65 74 21 20 6c 62 6c 20 22 ibute-set! lbl " 0900: 46 47 43 4f 4c 4f 52 22 20 28 67 65 74 2d 63 6f FGCOLOR" (get-co 0910: 6c 6f 72 2d 66 6f 72 2d 73 74 61 74 65 2d 73 74 lor-for-state-st 0920: 61 74 75 73 20 28 64 62 3a 74 65 73 74 2d 67 65 atus (db:test-ge 0930: 74 2d 73 74 61 74 65 20 74 65 73 74 64 61 74 29 t-state testdat) 0940: 0a 09 09 09 09 09 09 09 09 09 09 09 09 20 20 20 ............. 0950: 20 20 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 (db:test-get 0960: 2d 73 74 61 74 75 73 20 74 65 73 74 64 61 74 29 -status testdat) 0970: 29 29 0a 09 09 09 09 09 20 28 69 75 70 3a 61 74 ))...... (iup:at 0980: 74 72 69 62 75 74 65 2d 73 65 74 21 20 6c 62 6c tribute-set! lbl 0990: 20 22 54 49 54 4c 45 22 20 28 64 62 3a 74 65 73 "TITLE" (db:tes 09a0: 74 2d 67 65 74 2d 73 74 61 74 75 73 20 74 65 73 t-get-status tes 09b0: 74 64 61 74 29 29 29 29 29 29 29 0a 09 20 20 20 tdat))))))).. 09c0: 20 20 20 6c 62 6c 29 0a 09 20 20 20 20 28 73 74 lbl).. (st 09d0: 6f 72 65 2d 6c 61 62 65 6c 20 22 74 65 73 74 63 ore-label "testc 09e0: 6f 6d 6d 65 6e 74 22 0a 09 09 09 20 28 69 75 70 omment".... (iup 09f0: 3a 6c 61 62 65 6c 20 22 54 65 73 74 43 6f 6d 6d :label "TestComm 0a00: 65 6e 74 20 20 20 20 20 20 20 20 20 20 20 20 20 ent 0a10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0a20: 22 0a 09 09 09 09 20 20 20 20 23 3a 65 78 70 61 "..... #:expa 0a30: 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 29 nd "HORIZONTAL") 0a40: 0a 09 09 09 20 28 6c 61 6d 62 64 61 20 28 74 65 .... (lambda (te 0a50: 73 74 64 61 74 29 0a 09 09 09 20 20 20 28 64 62 stdat).... (db 0a60: 3a 74 65 73 74 2d 67 65 74 2d 63 6f 6d 6d 65 6e :test-get-commen 0a70: 74 20 74 65 73 74 64 61 74 29 29 29 0a 09 20 20 t testdat))).. 0a80: 20 20 28 73 74 6f 72 65 2d 6c 61 62 65 6c 20 22 (store-label " 0a90: 74 65 73 74 69 64 22 0a 09 09 09 20 28 69 75 70 testid".... (iup 0aa0: 3a 6c 61 62 65 6c 20 22 54 65 73 74 49 64 20 20 :label "TestId 0ab0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0ac0: 20 20 20 20 20 20 20 20 20 20 20 22 0a 09 09 09 ".... 0ad0: 09 20 20 20 20 23 3a 65 78 70 61 6e 64 20 22 48 . #:expand "H 0ae0: 4f 52 49 5a 4f 4e 54 41 4c 22 29 0a 09 09 09 20 ORIZONTAL").... 0af0: 28 6c 61 6d 62 64 61 20 28 74 65 73 74 64 61 74 (lambda (testdat 0b00: 29 0a 09 09 09 20 20 20 28 64 62 3a 74 65 73 74 ).... (db:test 0b10: 2d 67 65 74 2d 69 64 20 74 65 73 74 64 61 74 29 -get-id testdat) 0b20: 29 29 0a 09 20 20 20 20 29 29 29 29 29 0a 0a 3b )).. )))))..; 0b30: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 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 0a 3b 3b 20 54 65 73 74 20 =======.;; Test 0b80: 6d 65 74 61 20 70 61 6e 65 6c 0a 3b 3b 3d 3d 3d meta panel.;;=== 0b90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 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 0a 28 64 65 66 69 6e 65 20 28 74 65 73 ===.(define (tes 0be0: 74 2d 6d 65 74 61 2d 70 61 6e 65 6c 20 74 65 73 t-meta-panel tes 0bf0: 74 6d 65 74 61 20 73 74 6f 72 65 2d 6d 65 74 61 tmeta store-meta 0c00: 29 0a 20 20 28 69 75 70 3a 66 72 61 6d 65 20 0a ). (iup:frame . 0c10: 20 20 20 23 3a 74 69 74 6c 65 20 22 54 65 73 74 #:title "Test 0c20: 20 4d 65 74 61 20 44 61 74 61 22 20 3b 20 23 3a Meta Data" ; #: 0c30: 65 78 70 61 6e 64 20 22 59 45 53 22 0a 20 20 20 expand "YES". 0c40: 28 69 75 70 3a 68 62 6f 78 20 3b 20 23 3a 65 78 (iup:hbox ; #:ex 0c50: 70 61 6e 64 20 22 59 45 53 22 0a 20 20 20 20 28 pand "YES". ( 0c60: 61 70 70 6c 79 20 69 75 70 3a 76 62 6f 78 20 3b apply iup:vbox ; 0c70: 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53 22 0a #:expand "YES". 0c80: 09 20 20 20 28 61 70 70 65 6e 64 20 28 6d 61 70 . (append (map 0c90: 20 28 6c 61 6d 62 64 61 20 28 76 61 6c 29 0a 09 (lambda (val).. 0ca0: 09 09 20 20 28 69 75 70 3a 6c 61 62 65 6c 20 76 .. (iup:label v 0cb0: 61 6c 20 3b 20 23 3a 65 78 70 61 6e 64 20 22 48 al ; #:expand "H 0cc0: 4f 52 49 5a 4f 4e 54 41 4c 22 0a 09 09 09 09 20 ORIZONTAL"..... 0cd0: 20 20 20 20 29 29 0a 09 09 09 28 6c 69 73 74 20 ))....(list 0ce0: 22 41 75 74 68 6f 72 3a 20 22 0a 09 09 09 20 20 "Author: ".... 0cf0: 20 20 20 20 22 4f 77 6e 65 72 3a 20 22 0a 09 09 "Owner: "... 0d00: 09 20 20 20 20 20 20 22 52 65 76 69 65 77 65 64 . "Reviewed 0d10: 3a 20 22 0a 09 09 09 20 20 20 20 20 20 22 54 61 : ".... "Ta 0d20: 67 73 3a 20 22 0a 09 09 09 20 20 20 20 20 20 22 gs: ".... " 0d30: 44 65 73 63 72 69 70 74 69 6f 6e 3a 20 22 0a 09 Description: ".. 0d40: 09 09 20 20 20 20 20 20 29 29 0a 09 09 20 20 20 .. ))... 0d50: 28 6c 69 73 74 20 28 69 75 70 3a 6c 61 62 65 6c (list (iup:label 0d60: 20 22 22 20 23 3a 65 78 70 61 6e 64 20 22 56 45 "" #:expand "VE 0d70: 52 54 49 43 41 4c 22 29 29 29 29 0a 20 20 20 20 RTICAL")))). 0d80: 28 61 70 70 6c 79 20 69 75 70 3a 76 62 6f 78 20 (apply iup:vbox 0d90: 20 3b 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53 ; #:expand "YES 0da0: 22 0a 09 20 20 20 28 6c 69 73 74 20 0a 09 20 20 ".. (list .. 0db0: 20 20 28 73 74 6f 72 65 2d 6d 65 74 61 20 22 61 (store-meta "a 0dc0: 75 74 68 6f 72 22 0a 09 09 09 20 28 69 75 70 3a uthor".... (iup: 0dd0: 6c 61 62 65 6c 20 28 64 62 3a 74 65 73 74 6d 65 label (db:testme 0de0: 74 61 2d 67 65 74 2d 61 75 74 68 6f 72 20 74 65 ta-get-author te 0df0: 73 74 6d 65 74 61 29 20 23 3a 65 78 70 61 6e 64 stmeta) #:expand 0e00: 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 29 0a 09 "HORIZONTAL").. 0e10: 09 09 20 28 6c 61 6d 62 64 61 20 28 74 65 73 74 .. (lambda (test 0e20: 6d 65 74 61 29 28 64 62 3a 74 65 73 74 6d 65 74 meta)(db:testmet 0e30: 61 2d 67 65 74 2d 61 75 74 68 6f 72 20 74 65 73 a-get-author tes 0e40: 74 6d 65 74 61 29 29 29 0a 09 20 20 20 20 28 73 tmeta))).. (s 0e50: 74 6f 72 65 2d 6d 65 74 61 20 22 6f 77 6e 65 72 tore-meta "owner 0e60: 22 0a 09 09 09 20 28 69 75 70 3a 6c 61 62 65 6c ".... (iup:label 0e70: 20 28 64 62 3a 74 65 73 74 6d 65 74 61 2d 67 65 (db:testmeta-ge 0e80: 74 2d 6f 77 6e 65 72 20 74 65 73 74 6d 65 74 61 t-owner testmeta 0e90: 29 20 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 ) #:expand "HORI 0ea0: 5a 4f 4e 54 41 4c 22 29 0a 09 09 09 20 28 6c 61 ZONTAL").... (la 0eb0: 6d 62 64 61 20 28 74 65 73 74 6d 65 74 61 29 28 mbda (testmeta)( 0ec0: 64 62 3a 74 65 73 74 6d 65 74 61 2d 67 65 74 2d db:testmeta-get- 0ed0: 6f 77 6e 65 72 20 74 65 73 74 6d 65 74 61 29 29 owner testmeta)) 0ee0: 29 0a 09 20 20 20 20 28 73 74 6f 72 65 2d 6d 65 ).. (store-me 0ef0: 74 61 20 22 72 65 76 69 65 77 65 64 22 20 0a 09 ta "reviewed" .. 0f00: 09 09 20 28 69 75 70 3a 6c 61 62 65 6c 20 28 64 .. (iup:label (d 0f10: 62 3a 74 65 73 74 6d 65 74 61 2d 67 65 74 2d 72 b:testmeta-get-r 0f20: 65 76 69 65 77 65 64 20 74 65 73 74 6d 65 74 61 eviewed testmeta 0f30: 29 20 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 ) #:expand "HORI 0f40: 5a 4f 4e 54 41 4c 22 29 0a 09 09 09 20 28 6c 61 ZONTAL").... (la 0f50: 6d 62 64 61 20 28 74 65 73 74 6d 65 74 61 29 28 mbda (testmeta)( 0f60: 64 62 3a 74 65 73 74 6d 65 74 61 2d 67 65 74 2d db:testmeta-get- 0f70: 72 65 76 69 65 77 65 64 20 74 65 73 74 6d 65 74 reviewed testmet 0f80: 61 29 29 29 0a 09 20 20 20 20 28 73 74 6f 72 65 a))).. (store 0f90: 2d 6d 65 74 61 20 22 74 61 67 73 22 20 0a 09 09 -meta "tags" ... 0fa0: 09 20 28 69 75 70 3a 6c 61 62 65 6c 20 28 64 62 . (iup:label (db 0fb0: 3a 74 65 73 74 6d 65 74 61 2d 67 65 74 2d 74 61 :testmeta-get-ta 0fc0: 67 73 20 74 65 73 74 6d 65 74 61 29 20 23 3a 65 gs testmeta) #:e 0fd0: 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 xpand "HORIZONTA 0fe0: 4c 22 29 0a 09 09 09 20 28 6c 61 6d 62 64 61 20 L").... (lambda 0ff0: 28 74 65 73 74 6d 65 74 61 29 28 64 62 3a 74 65 (testmeta)(db:te 1000: 73 74 6d 65 74 61 2d 67 65 74 2d 74 61 67 73 20 stmeta-get-tags 1010: 74 65 73 74 6d 65 74 61 29 29 29 0a 09 20 20 20 testmeta))).. 1020: 20 28 73 74 6f 72 65 2d 6d 65 74 61 20 22 64 65 (store-meta "de 1030: 73 63 72 69 70 74 69 6f 6e 22 20 0a 09 09 09 20 scription" .... 1040: 28 69 75 70 3a 6c 61 62 65 6c 20 28 64 62 3a 74 (iup:label (db:t 1050: 65 73 74 6d 65 74 61 2d 67 65 74 2d 64 65 73 63 estmeta-get-desc 1060: 72 69 70 74 69 6f 6e 20 74 65 73 74 6d 65 74 61 ription testmeta 1070: 29 20 23 3a 73 69 7a 65 20 22 78 35 30 22 29 3b ) #:size "x50"); 1080: 20 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a #:expand "HORIZ 1090: 4f 4e 54 41 4c 22 29 0a 09 09 09 20 28 6c 61 6d ONTAL").... (lam 10a0: 62 64 61 20 28 74 65 73 74 6d 65 74 61 29 28 64 bda (testmeta)(d 10b0: 62 3a 74 65 73 74 6d 65 74 61 2d 67 65 74 2d 64 b:testmeta-get-d 10c0: 65 73 63 72 69 70 74 69 6f 6e 20 74 65 73 74 6d escription testm 10d0: 65 74 61 29 29 29 0a 09 20 20 20 20 29 29 29 29 eta))).. )))) 10e0: 29 0a 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )...;;========== 10f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1100: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1110: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1120: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;; 1130: 52 75 6e 20 69 6e 66 6f 20 70 61 6e 65 6c 0a 3b Run info panel.; 1140: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;=============== 1150: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1160: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1170: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1180: 3d 3d 3d 3d 3d 3d 3d 0a 28 64 65 66 69 6e 65 20 =======.(define 1190: 28 72 75 6e 2d 69 6e 66 6f 2d 70 61 6e 65 6c 20 (run-info-panel 11a0: 6b 65 79 64 61 74 20 74 65 73 74 64 61 74 20 72 keydat testdat r 11b0: 75 6e 6e 61 6d 65 29 0a 20 20 28 69 75 70 3a 66 unname). (iup:f 11c0: 72 61 6d 65 20 0a 20 20 20 23 3a 74 69 74 6c 65 rame . #:title 11d0: 20 22 4d 65 67 61 74 65 73 74 20 52 75 6e 20 49 "Megatest Run I 11e0: 6e 66 6f 22 20 3b 20 23 3a 65 78 70 61 6e 64 20 nfo" ; #:expand 11f0: 22 59 45 53 22 0a 20 20 20 28 69 75 70 3a 68 62 "YES". (iup:hb 1200: 6f 78 20 3b 20 23 3a 65 78 70 61 6e 64 20 22 59 ox ; #:expand "Y 1210: 45 53 22 0a 20 20 20 20 28 61 70 70 6c 79 20 69 ES". (apply i 1220: 75 70 3a 76 62 6f 78 20 3b 20 23 3a 65 78 70 61 up:vbox ; #:expa 1230: 6e 64 20 22 59 45 53 22 0a 09 20 20 20 28 61 70 nd "YES".. (ap 1240: 70 65 6e 64 20 28 6d 61 70 20 28 6c 61 6d 62 64 pend (map (lambd 1250: 61 20 28 6b 65 79 76 61 6c 29 0a 09 09 09 20 20 a (keyval).... 1260: 28 69 75 70 3a 6c 61 62 65 6c 20 28 63 6f 6e 63 (iup:label (conc 1270: 20 28 63 61 72 20 6b 65 79 76 61 6c 29 20 22 20 (car keyval) " 1280: 22 29 20 3b 20 23 3a 65 78 70 61 6e 64 20 22 48 ") ; #:expand "H 1290: 4f 52 49 5a 4f 4e 54 41 4c 22 0a 09 09 09 09 20 ORIZONTAL"..... 12a0: 20 20 20 20 29 29 0a 09 09 09 6b 65 79 64 61 74 ))....keydat 12b0: 29 0a 09 09 20 20 20 28 6c 69 73 74 20 28 69 75 )... (list (iu 12c0: 70 3a 6c 61 62 65 6c 20 22 72 75 6e 6e 61 6d 65 p:label "runname 12d0: 20 22 29 29 29 29 0a 20 20 20 20 28 61 70 70 6c ")))). (appl 12e0: 79 20 69 75 70 3a 76 62 6f 78 0a 09 20 20 20 28 y iup:vbox.. ( 12f0: 61 70 70 65 6e 64 20 28 6d 61 70 20 28 6c 61 6d append (map (lam 1300: 62 64 61 20 28 6b 65 79 76 61 6c 29 0a 09 09 09 bda (keyval).... 1310: 20 20 28 69 75 70 3a 6c 61 62 65 6c 20 28 63 61 (iup:label (ca 1320: 64 72 20 6b 65 79 76 61 6c 29 20 23 3a 65 78 70 dr keyval) #:exp 1330: 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 and "HORIZONTAL" 1340: 29 29 0a 09 09 09 6b 65 79 64 61 74 29 0a 09 09 ))....keydat)... 1350: 20 20 20 28 6c 69 73 74 20 28 69 75 70 3a 6c 61 (list (iup:la 1360: 62 65 6c 20 72 75 6e 6e 61 6d 65 29 28 69 75 70 bel runname)(iup 1370: 3a 6c 61 62 65 6c 20 22 22 20 23 3a 65 78 70 61 :label "" #:expa 1380: 6e 64 20 22 56 45 52 54 49 43 41 4c 22 29 29 29 nd "VERTICAL"))) 1390: 29 29 29 29 0a 20 20 0a 3b 3b 3d 3d 3d 3d 3d 3d )))). .;;====== 13a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 13b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 13c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 13d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 13e0: 0a 3b 3b 20 48 6f 73 74 20 69 6e 66 6f 20 70 61 .;; Host info pa 13f0: 6e 65 6c 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d nel.;;========== 1400: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1410: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1420: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1430: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 28 64 65 ============.(de 1440: 66 69 6e 65 20 28 68 6f 73 74 2d 69 6e 66 6f 2d fine (host-info- 1450: 70 61 6e 65 6c 20 74 65 73 74 64 61 74 20 73 74 panel testdat st 1460: 6f 72 65 2d 6c 61 62 65 6c 29 0a 20 20 28 69 75 ore-label). (iu 1470: 70 3a 66 72 61 6d 65 0a 20 20 20 23 3a 74 69 74 p:frame. #:tit 1480: 6c 65 20 22 52 65 6d 6f 74 65 20 68 6f 73 74 20 le "Remote host 1490: 61 6e 64 20 54 65 73 74 20 52 75 6e 20 49 6e 66 and Test Run Inf 14a0: 6f 22 20 3b 20 23 3a 65 78 70 61 6e 64 20 22 59 o" ; #:expand "Y 14b0: 45 53 22 0a 20 20 20 28 69 75 70 3a 68 62 6f 78 ES". (iup:hbox 14c0: 20 3b 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53 ; #:expand "YES 14d0: 22 0a 20 20 20 20 28 61 70 70 6c 79 20 69 75 70 ". (apply iup 14e0: 3a 76 62 6f 78 20 3b 20 23 3a 65 78 70 61 6e 64 :vbox ; #:expand 14f0: 20 22 59 45 53 22 20 3b 3b 20 54 68 65 20 68 65 "YES" ;; The he 1500: 61 64 69 6e 67 20 6c 61 62 65 6c 73 0a 09 20 20 ading labels.. 1510: 20 28 61 70 70 65 6e 64 20 28 6d 61 70 20 28 6c (append (map (l 1520: 61 6d 62 64 61 20 28 76 61 6c 29 0a 09 09 09 20 ambda (val).... 1530: 20 28 69 75 70 3a 6c 61 62 65 6c 20 76 61 6c 20 (iup:label val 1540: 3b 20 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 ; #:expand "HORI 1550: 5a 4f 4e 54 41 4c 22 0a 09 09 09 09 20 20 20 20 ZONTAL"..... 1560: 20 29 29 0a 09 09 09 28 6c 69 73 74 20 22 48 6f ))....(list "Ho 1570: 73 74 6e 61 6d 65 3a 20 22 0a 09 09 09 20 20 20 stname: ".... 1580: 20 20 20 22 55 6e 61 6d 65 20 2d 61 3a 20 22 0a "Uname -a: ". 1590: 09 09 09 20 20 20 20 20 20 22 44 69 73 6b 20 66 ... "Disk f 15a0: 72 65 65 3a 20 22 0a 09 09 09 20 20 20 20 20 20 ree: ".... 15b0: 22 43 50 55 20 4c 6f 61 64 3a 20 22 0a 09 09 09 "CPU Load: ".... 15c0: 20 20 20 20 20 20 22 52 75 6e 20 64 75 72 61 74 "Run durat 15d0: 69 6f 6e 3a 20 22 0a 09 09 09 20 20 20 20 20 20 ion: ".... 15e0: 22 4c 6f 67 66 69 6c 65 3a 20 22 29 29 0a 09 09 "Logfile: "))... 15f0: 20 20 20 28 69 75 70 3a 6c 61 62 65 6c 20 22 22 (iup:label "" 1600: 20 23 3a 65 78 70 61 6e 64 20 22 56 45 52 54 49 #:expand "VERTI 1610: 43 41 4c 22 29 29 29 0a 20 20 20 20 28 61 70 70 CAL"))). (app 1620: 6c 79 20 69 75 70 3a 76 62 6f 78 20 3b 20 23 3a ly iup:vbox ; #: 1630: 65 78 70 61 6e 64 20 22 59 45 53 22 0a 09 20 20 expand "YES".. 1640: 20 28 6c 69 73 74 0a 09 20 20 20 20 3b 3b 20 4e (list.. ;; N 1650: 4f 54 45 3a 20 59 65 73 2c 20 74 68 65 20 68 6f OTE: Yes, the ho 1660: 73 74 20 63 61 6e 20 63 68 61 6e 67 65 21 0a 09 st can change!.. 1670: 20 20 20 20 28 73 74 6f 72 65 2d 6c 61 62 65 6c (store-label 1680: 20 22 48 6f 73 74 4e 61 6d 65 22 0a 09 09 09 20 "HostName".... 1690: 28 69 75 70 3a 6c 61 62 65 6c 20 28 64 62 3a 74 (iup:label (db:t 16a0: 65 73 74 2d 67 65 74 2d 68 6f 73 74 20 74 65 73 est-get-host tes 16b0: 74 64 61 74 29 20 23 3a 65 78 70 61 6e 64 20 22 tdat) #:expand " 16c0: 48 4f 52 49 5a 4f 4e 54 41 4c 22 29 0a 09 09 09 HORIZONTAL").... 16d0: 20 28 6c 61 6d 62 64 61 20 28 74 65 73 74 64 61 (lambda (testda 16e0: 74 29 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 68 t)(db:test-get-h 16f0: 6f 73 74 20 74 65 73 74 64 61 74 29 29 29 0a 09 ost testdat))).. 1700: 20 20 20 20 28 73 74 6f 72 65 2d 6c 61 62 65 6c (store-label 1710: 20 22 55 6e 61 6d 65 22 0a 09 09 09 20 28 69 75 "Uname".... (iu 1720: 70 3a 6c 61 62 65 6c 20 22 20 20 20 20 20 20 20 p:label " 1730: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 1740: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 1750: 20 20 20 20 20 20 20 20 20 20 20 20 22 20 23 3a " #: 1760: 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 expand "HORIZONT 1770: 41 4c 22 29 0a 09 09 09 20 28 6c 61 6d 62 64 61 AL").... (lambda 1780: 20 28 74 65 73 74 64 61 74 29 28 64 62 3a 74 65 (testdat)(db:te 1790: 73 74 2d 67 65 74 2d 75 6e 61 6d 65 20 74 65 73 st-get-uname tes 17a0: 74 64 61 74 29 29 29 0a 09 20 20 20 20 28 73 74 tdat))).. (st 17b0: 6f 72 65 2d 6c 61 62 65 6c 20 22 44 69 73 6b 46 ore-label "DiskF 17c0: 72 65 65 22 0a 09 09 09 20 28 69 75 70 3a 6c 61 ree".... (iup:la 17d0: 62 65 6c 20 28 63 6f 6e 63 20 28 64 62 3a 74 65 bel (conc (db:te 17e0: 73 74 2d 67 65 74 2d 64 69 73 6b 66 72 65 65 20 st-get-diskfree 17f0: 74 65 73 74 64 61 74 29 29 20 23 3a 65 78 70 61 testdat)) #:expa 1800: 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 29 nd "HORIZONTAL") 1810: 0a 09 09 09 20 28 6c 61 6d 62 64 61 20 28 74 65 .... (lambda (te 1820: 73 74 64 61 74 29 28 63 6f 6e 63 20 28 64 62 3a stdat)(conc (db: 1830: 74 65 73 74 2d 67 65 74 2d 64 69 73 6b 66 72 65 test-get-diskfre 1840: 65 20 74 65 73 74 64 61 74 29 29 29 29 0a 09 20 e testdat)))).. 1850: 20 20 20 28 73 74 6f 72 65 2d 6c 61 62 65 6c 20 (store-label 1860: 22 43 50 55 4c 6f 61 64 22 0a 09 09 09 20 28 69 "CPULoad".... (i 1870: 75 70 3a 6c 61 62 65 6c 20 28 63 6f 6e 63 20 28 up:label (conc ( 1880: 64 62 3a 74 65 73 74 2d 67 65 74 2d 63 70 75 6c db:test-get-cpul 1890: 6f 61 64 20 74 65 73 74 64 61 74 29 29 20 23 3a oad testdat)) #: 18a0: 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 expand "HORIZONT 18b0: 41 4c 22 29 0a 09 09 09 20 28 6c 61 6d 62 64 61 AL").... (lambda 18c0: 20 28 74 65 73 74 64 61 74 29 28 63 6f 6e 63 20 (testdat)(conc 18d0: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 63 70 75 (db:test-get-cpu 18e0: 6c 6f 61 64 20 74 65 73 74 64 61 74 29 29 29 29 load testdat)))) 18f0: 0a 09 20 20 20 20 28 73 74 6f 72 65 2d 6c 61 62 .. (store-lab 1900: 65 6c 20 22 52 75 6e 44 75 72 61 74 69 6f 6e 22 el "RunDuration" 1910: 0a 09 09 09 20 28 69 75 70 3a 6c 61 62 65 6c 20 .... (iup:label 1920: 28 63 6f 6e 63 20 28 73 65 63 6f 6e 64 73 2d 3e (conc (seconds-> 1930: 68 72 2d 6d 69 6e 2d 73 65 63 20 28 64 62 3a 74 hr-min-sec (db:t 1940: 65 73 74 2d 67 65 74 2d 72 75 6e 5f 64 75 72 61 est-get-run_dura 1950: 74 69 6f 6e 20 74 65 73 74 64 61 74 29 29 29 20 tion testdat))) 1960: 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f #:expand "HORIZO 1970: 4e 54 41 4c 22 29 0a 09 09 09 20 28 6c 61 6d 62 NTAL").... (lamb 1980: 64 61 20 28 74 65 73 74 64 61 74 29 28 63 6f 6e da (testdat)(con 1990: 63 20 28 73 65 63 6f 6e 64 73 2d 3e 68 72 2d 6d c (seconds->hr-m 19a0: 69 6e 2d 73 65 63 20 28 64 62 3a 74 65 73 74 2d in-sec (db:test- 19b0: 67 65 74 2d 72 75 6e 5f 64 75 72 61 74 69 6f 6e get-run_duration 19c0: 20 74 65 73 74 64 61 74 29 29 29 29 29 0a 09 20 testdat))))).. 19d0: 20 20 20 28 73 74 6f 72 65 2d 6c 61 62 65 6c 20 (store-label 19e0: 22 43 50 55 4c 6f 61 64 22 0a 09 09 09 20 28 69 "CPULoad".... (i 19f0: 75 70 3a 6c 61 62 65 6c 20 28 63 6f 6e 63 20 28 up:label (conc ( 1a00: 64 62 3a 74 65 73 74 2d 67 65 74 2d 66 69 6e 61 db:test-get-fina 1a10: 6c 5f 6c 6f 67 66 20 74 65 73 74 64 61 74 29 29 l_logf testdat)) 1a20: 20 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a #:expand "HORIZ 1a30: 4f 4e 54 41 4c 22 29 0a 09 09 09 20 28 6c 61 6d ONTAL").... (lam 1a40: 62 64 61 20 28 74 65 73 74 64 61 74 29 28 63 6f bda (testdat)(co 1a50: 6e 63 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d nc (db:test-get- 1a60: 66 69 6e 61 6c 5f 6c 6f 67 66 20 74 65 73 74 64 final_logf testd 1a70: 61 74 29 29 29 29 29 29 29 29 29 0a 0a 3b 3b 20 at)))))))))..;; 1a80: 75 73 65 20 61 20 67 6c 6f 62 61 6c 20 66 6f 72 use a global for 1a90: 20 73 65 74 74 69 6e 67 20 74 68 65 20 62 75 74 setting the but 1aa0: 74 6f 6e 73 20 63 6f 6c 6f 72 73 0a 3b 3b 20 20 tons colors.;; 1ab0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 1ac0: 20 20 20 20 20 20 20 20 20 73 74 61 74 65 20 73 state s 1ad0: 74 61 74 75 73 20 74 65 73 74 73 74 65 70 73 0a tatus teststeps. 1ae0: 28 64 65 66 69 6e 65 20 2a 73 74 61 74 65 2d 73 (define *state-s 1af0: 74 61 74 75 73 2a 20 28 76 65 63 74 6f 72 20 23 tatus* (vector # 1b00: 66 20 23 66 20 23 66 29 29 0a 28 64 65 66 69 6e f #f #f)).(defin 1b10: 65 20 28 75 70 64 61 74 65 2d 73 74 61 74 65 2d e (update-state- 1b20: 73 74 61 74 75 73 2d 62 75 74 74 6f 6e 73 20 74 status-buttons t 1b30: 65 73 74 64 61 74 29 0a 20 20 28 6c 65 74 2a 20 estdat). (let* 1b40: 28 28 73 74 61 74 65 20 20 28 64 62 3a 74 65 73 ((state (db:tes 1b50: 74 2d 67 65 74 2d 73 74 61 74 65 20 20 74 65 73 t-get-state tes 1b60: 74 64 61 74 29 29 0a 09 20 28 73 74 61 74 75 73 tdat)).. (status 1b70: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 (db:test-get-st 1b80: 61 74 75 73 20 74 65 73 74 64 61 74 29 29 0a 09 atus testdat)).. 1b90: 20 28 63 6f 6c 6f 72 20 20 28 67 65 74 2d 63 6f (color (get-co 1ba0: 6c 6f 72 2d 66 6f 72 2d 73 74 61 74 65 2d 73 74 lor-for-state-st 1bb0: 61 74 75 73 20 73 74 61 74 65 20 73 74 61 74 75 atus state statu 1bc0: 73 29 29 29 0a 20 20 20 20 28 28 76 65 63 74 6f s))). ((vecto 1bd0: 72 2d 72 65 66 20 2a 73 74 61 74 65 2d 73 74 61 r-ref *state-sta 1be0: 74 75 73 2a 20 30 29 20 73 74 61 74 65 20 63 6f tus* 0) state co 1bf0: 6c 6f 72 29 0a 20 20 20 20 28 28 76 65 63 74 6f lor). ((vecto 1c00: 72 2d 72 65 66 20 2a 73 74 61 74 65 2d 73 74 61 r-ref *state-sta 1c10: 74 75 73 2a 20 31 29 20 73 74 61 74 75 73 20 63 tus* 1) status c 1c20: 6f 6c 6f 72 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d olor)))..;;===== 1c30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1c40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1c50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1c60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1c70: 3d 0a 3b 3b 20 53 65 74 20 66 69 65 6c 64 73 20 =.;; Set fields 1c80: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;============= 1c90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1ca0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1cb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1cc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 28 64 65 66 69 6e =========.(defin 1cd0: 65 20 28 73 65 74 2d 66 69 65 6c 64 73 2d 70 61 e (set-fields-pa 1ce0: 6e 65 6c 20 74 65 73 74 2d 69 64 20 74 65 73 74 nel test-id test 1cf0: 64 61 74 29 0a 20 20 28 6c 65 74 20 28 28 6e 65 dat). (let ((ne 1d00: 77 63 6f 6d 6d 65 6e 74 20 23 66 29 0a 09 28 6e wcomment #f)..(n 1d10: 65 77 73 74 61 74 75 73 20 20 23 66 29 0a 09 28 ewstatus #f)..( 1d20: 6e 65 77 73 74 61 74 65 20 20 20 23 66 29 29 0a newstate #f)). 1d30: 20 20 20 20 28 69 75 70 3a 66 72 61 6d 65 0a 20 (iup:frame. 1d40: 20 20 20 20 23 3a 74 69 74 6c 65 20 22 53 65 74 #:title "Set 1d50: 20 66 69 65 6c 64 73 22 0a 20 20 20 20 20 28 69 fields". (i 1d60: 75 70 3a 76 62 6f 78 0a 20 20 20 20 20 20 28 69 up:vbox. (i 1d70: 75 70 3a 68 62 6f 78 20 28 69 75 70 3a 6c 61 62 up:hbox (iup:lab 1d80: 65 6c 20 22 43 6f 6d 6d 65 6e 74 3a 22 29 0a 09 el "Comment:").. 1d90: 09 28 69 75 70 3a 74 65 78 74 62 6f 78 20 23 3a .(iup:textbox #: 1da0: 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 action (lambda ( 1db0: 76 61 6c 20 61 20 62 29 0a 09 09 09 09 09 28 72 val a b)......(r 1dc0: 64 62 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 db:test-set-stat 1dd0: 65 2d 73 74 61 74 75 73 2d 62 79 2d 69 64 20 2a e-status-by-id * 1de0: 64 62 2a 20 74 65 73 74 2d 69 64 20 23 66 20 23 db* test-id #f # 1df0: 66 20 62 29 0a 09 09 09 09 09 28 73 65 74 21 20 f b)......(set! 1e00: 6e 65 77 63 6f 6d 6d 65 6e 74 20 62 29 29 0a 09 newcomment b)).. 1e10: 09 09 20 20 20 20 20 23 3a 76 61 6c 75 65 20 28 .. #:value ( 1e20: 64 62 3a 74 65 73 74 2d 67 65 74 2d 63 6f 6d 6d db:test-get-comm 1e30: 65 6e 74 20 74 65 73 74 64 61 74 29 0a 09 09 09 ent testdat).... 1e40: 20 20 20 20 20 23 3a 65 78 70 61 6e 64 20 22 48 #:expand "H 1e50: 4f 52 49 5a 4f 4e 54 41 4c 22 29 29 0a 20 20 20 ORIZONTAL")). 1e60: 20 20 20 28 61 70 70 6c 79 20 69 75 70 3a 68 62 (apply iup:hb 1e70: 6f 78 0a 09 20 20 20 20 20 28 69 75 70 3a 6c 61 ox.. (iup:la 1e80: 62 65 6c 20 22 53 54 41 54 45 3a 22 20 23 3a 73 bel "STATE:" #:s 1e90: 69 7a 65 20 22 33 30 78 22 29 0a 09 20 20 20 20 ize "30x").. 1ea0: 20 28 6c 65 74 2a 20 28 28 62 74 6e 73 20 20 28 (let* ((btns ( 1eb0: 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 73 74 61 map (lambda (sta 1ec0: 74 65 29 0a 09 09 09 09 20 20 28 6c 65 74 20 28 te)..... (let ( 1ed0: 28 62 74 6e 20 28 69 75 70 3a 62 75 74 74 6f 6e (btn (iup:button 1ee0: 20 73 74 61 74 65 0a 09 09 09 09 09 09 09 20 23 state........ # 1ef0: 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e :expand "HORIZON 1f00: 54 41 4c 22 20 23 3a 73 69 7a 65 20 22 35 30 78 TAL" #:size "50x 1f10: 22 20 23 3a 66 6f 6e 74 20 22 43 6f 75 72 69 65 " #:font "Courie 1f20: 72 20 4e 65 77 2c 20 2d 31 30 22 0a 09 09 09 09 r New, -10"..... 1f30: 09 09 09 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 ... #:action (la 1f40: 6d 62 64 61 20 28 78 29 0a 09 09 09 09 09 09 09 mbda (x)........ 1f50: 09 20 20 20 20 28 72 64 62 3a 74 65 73 74 2d 73 . (rdb:test-s 1f60: 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 2d et-state-status- 1f70: 62 79 2d 69 64 20 2a 64 62 2a 20 74 65 73 74 2d by-id *db* test- 1f80: 69 64 20 73 74 61 74 65 20 23 66 20 23 66 29 0a id state #f #f). 1f90: 09 09 09 09 09 09 09 09 20 20 20 20 28 64 62 3a ........ (db: 1fa0: 74 65 73 74 2d 73 65 74 2d 73 74 61 74 65 21 20 test-set-state! 1fb0: 74 65 73 74 64 61 74 20 73 74 61 74 65 29 29 29 testdat state))) 1fc0: 29 29 0a 09 09 09 09 20 20 20 20 62 74 6e 29 29 ))..... btn)) 1fd0: 0a 09 09 09 09 28 6c 69 73 74 20 22 43 4f 4d 50 .....(list "COMP 1fe0: 4c 45 54 45 44 22 20 22 4e 4f 54 5f 53 54 41 52 LETED" "NOT_STAR 1ff0: 54 45 44 22 20 22 52 55 4e 4e 49 4e 47 22 20 22 TED" "RUNNING" " 2000: 52 45 4d 4f 54 45 48 4f 53 54 53 54 41 52 54 22 REMOTEHOSTSTART" 2010: 20 22 4b 49 4c 4c 45 44 22 20 22 4b 49 4c 4c 52 "KILLED" "KILLR 2020: 45 51 22 29 29 29 29 0a 09 20 20 20 20 20 20 20 EQ")))).. 2030: 28 76 65 63 74 6f 72 2d 73 65 74 21 20 2a 73 74 (vector-set! *st 2040: 61 74 65 2d 73 74 61 74 75 73 2a 20 30 0a 09 09 ate-status* 0... 2050: 09 20 20 20 20 28 6c 61 6d 62 64 61 20 28 73 74 . (lambda (st 2060: 61 74 65 20 63 6f 6c 6f 72 29 0a 09 09 09 20 20 ate color).... 2070: 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 0a 09 (for-each .. 2080: 09 09 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 .. (lambda 2090: 20 28 62 74 6e 29 0a 09 09 09 09 20 28 6c 65 74 (btn)..... (let 20a0: 2a 20 28 28 6e 61 6d 65 20 20 20 20 20 28 69 75 * ((name (iu 20b0: 70 3a 61 74 74 72 69 62 75 74 65 20 62 74 6e 20 p:attribute btn 20c0: 22 54 49 54 4c 45 22 29 29 0a 09 09 09 09 09 28 "TITLE"))......( 20d0: 6e 65 77 63 6f 6c 6f 72 20 28 69 66 20 28 65 71 newcolor (if (eq 20e0: 75 61 6c 3f 20 6e 61 6d 65 20 73 74 61 74 65 29 ual? name state) 20f0: 20 63 6f 6c 6f 72 20 22 31 39 32 20 31 39 32 20 color "192 192 2100: 31 39 32 22 29 29 29 0a 09 09 09 09 20 20 20 28 192")))..... ( 2110: 69 66 20 28 6e 6f 74 20 28 63 6f 6c 6f 72 73 2d if (not (colors- 2120: 73 69 6d 69 6c 61 72 3f 20 6e 65 77 63 6f 6c 6f similar? newcolo 2130: 72 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 r (iup:attribute 2140: 20 62 74 6e 20 22 42 47 43 4f 4c 4f 52 22 29 29 btn "BGCOLOR")) 2150: 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 69 75 )..... (iu 2160: 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 p:attribute-set! 2170: 20 62 74 6e 20 22 42 47 43 4f 4c 4f 52 22 20 6e btn "BGCOLOR" n 2180: 65 77 63 6f 6c 6f 72 29 29 29 29 0a 09 09 09 20 ewcolor)))).... 2190: 20 20 20 20 20 20 62 74 6e 73 29 29 29 0a 09 20 btns))).. 21a0: 20 20 20 20 20 20 62 74 6e 73 29 29 0a 20 20 20 btns)). 21b0: 20 20 20 28 61 70 70 6c 79 20 69 75 70 3a 68 62 (apply iup:hb 21c0: 6f 78 0a 09 20 20 20 20 20 28 69 75 70 3a 6c 61 ox.. (iup:la 21d0: 62 65 6c 20 22 53 54 41 54 55 53 3a 22 20 23 3a bel "STATUS:" #: 21e0: 73 69 7a 65 20 22 33 30 78 22 29 0a 09 20 20 20 size "30x").. 21f0: 20 20 28 6c 65 74 2a 20 28 28 62 74 6e 73 20 20 (let* ((btns 2200: 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 73 74 (map (lambda (st 2210: 61 74 75 73 29 0a 09 09 09 09 20 20 28 6c 65 74 atus)..... (let 2220: 20 28 28 62 74 6e 20 28 69 75 70 3a 62 75 74 74 ((btn (iup:butt 2230: 6f 6e 20 73 74 61 74 75 73 0a 09 09 09 09 09 09 on status....... 2240: 09 20 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 . #:expand "HORI 2250: 5a 4f 4e 54 41 4c 22 20 23 3a 73 69 7a 65 20 22 ZONTAL" #:size " 2260: 35 30 78 22 20 23 3a 66 6f 6e 74 20 22 43 6f 75 50x" #:font "Cou 2270: 72 69 65 72 20 4e 65 77 2c 20 2d 31 30 22 0a 09 rier New, -10".. 2280: 09 09 09 09 09 09 20 23 3a 61 63 74 69 6f 6e 20 ...... #:action 2290: 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 09 09 (lambda (x)..... 22a0: 09 09 09 09 20 20 20 20 28 72 64 62 3a 74 65 73 .... (rdb:tes 22b0: 74 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 t-set-state-stat 22c0: 75 73 2d 62 79 2d 69 64 20 2a 64 62 2a 20 74 65 us-by-id *db* te 22d0: 73 74 2d 69 64 20 23 66 20 73 74 61 74 75 73 20 st-id #f status 22e0: 23 66 29 0a 09 09 09 09 09 09 09 09 20 20 20 20 #f)......... 22f0: 28 64 62 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 (db:test-set-sta 2300: 74 75 73 21 20 74 65 73 74 64 61 74 20 73 74 61 tus! testdat sta 2310: 74 75 73 29 29 29 29 29 0a 09 09 09 09 20 20 20 tus)))))..... 2320: 20 62 74 6e 29 29 0a 09 09 09 09 28 6c 69 73 74 btn)).....(list 2330: 20 20 22 50 41 53 53 22 20 22 57 41 52 4e 22 20 "PASS" "WARN" 2340: 22 46 41 49 4c 22 20 22 43 48 45 43 4b 22 20 22 "FAIL" "CHECK" " 2350: 6e 2f 61 22 20 22 57 41 49 56 45 44 22 29 29 29 n/a" "WAIVED"))) 2360: 29 0a 09 20 20 20 20 20 20 20 28 76 65 63 74 6f ).. (vecto 2370: 72 2d 73 65 74 21 20 2a 73 74 61 74 65 2d 73 74 r-set! *state-st 2380: 61 74 75 73 2a 20 31 0a 09 09 09 20 20 20 20 28 atus* 1.... ( 2390: 6c 61 6d 62 64 61 20 28 73 74 61 74 75 73 20 63 lambda (status c 23a0: 6f 6c 6f 72 29 0a 09 09 09 20 20 20 20 20 20 28 olor).... ( 23b0: 66 6f 72 2d 65 61 63 68 20 0a 09 09 09 20 20 20 for-each .... 23c0: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 62 74 6e (lambda (btn 23d0: 29 0a 09 09 09 09 20 28 6c 65 74 2a 20 28 28 6e )..... (let* ((n 23e0: 61 6d 65 20 20 20 20 20 28 69 75 70 3a 61 74 74 ame (iup:att 23f0: 72 69 62 75 74 65 20 62 74 6e 20 22 54 49 54 4c ribute btn "TITL 2400: 45 22 29 29 0a 09 09 09 09 09 28 6e 65 77 63 6f E"))......(newco 2410: 6c 6f 72 20 28 69 66 20 28 65 71 75 61 6c 3f 20 lor (if (equal? 2420: 6e 61 6d 65 20 73 74 61 74 75 73 29 20 63 6f 6c name status) col 2430: 6f 72 20 22 31 39 32 20 31 39 32 20 31 39 32 22 or "192 192 192" 2440: 29 29 29 0a 09 09 09 09 20 20 20 28 69 66 20 28 )))..... (if ( 2450: 6e 6f 74 20 28 63 6f 6c 6f 72 73 2d 73 69 6d 69 not (colors-simi 2460: 6c 61 72 3f 20 6e 65 77 63 6f 6c 6f 72 20 28 69 lar? newcolor (i 2470: 75 70 3a 61 74 74 72 69 62 75 74 65 20 62 74 6e up:attribute btn 2480: 20 22 42 47 43 4f 4c 4f 52 22 29 29 29 0a 09 09 "BGCOLOR")))... 2490: 09 09 20 20 20 20 20 20 20 28 69 75 70 3a 61 74 .. (iup:at 24a0: 74 72 69 62 75 74 65 2d 73 65 74 21 20 62 74 6e tribute-set! btn 24b0: 20 22 42 47 43 4f 4c 4f 52 22 20 6e 65 77 63 6f "BGCOLOR" newco 24c0: 6c 6f 72 29 29 29 29 0a 09 09 09 20 20 20 20 20 lor)))).... 24d0: 20 20 62 74 6e 73 29 29 29 0a 09 20 20 20 20 20 btns))).. 24e0: 20 20 62 74 6e 73 29 29 29 29 29 29 0a 0a 0a 3b btns))))))...; 24f0: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;=============== 2500: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 2510: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 2520: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 2530: 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 0a 3b 3b 3d 3d 3d =======.;;.;;=== 2540: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 2550: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 2560: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 2570: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 2580: 3d 3d 3d 0a 28 64 65 66 69 6e 65 20 28 65 78 61 ===.(define (exa 2590: 6d 69 6e 65 2d 74 65 73 74 20 64 62 20 74 65 73 mine-test db tes 25a0: 74 2d 69 64 29 20 3b 3b 20 72 75 6e 2d 69 64 20 t-id) ;; run-id 25b0: 72 75 6e 2d 6b 65 79 20 6f 72 69 67 74 65 73 74 run-key origtest 25c0: 29 0a 20 20 28 6c 65 74 2a 20 28 28 74 65 73 74 ). (let* ((test 25d0: 64 61 74 20 20 20 20 20 20 20 28 72 64 62 3a 67 dat (rdb:g 25e0: 65 74 2d 74 65 73 74 2d 64 61 74 61 2d 62 79 2d et-test-data-by- 25f0: 69 64 20 64 62 20 74 65 73 74 2d 69 64 29 29 0a id db test-id)). 2600: 09 20 28 64 62 2d 70 61 74 68 20 20 20 20 20 20 . (db-path 2610: 20 28 63 6f 6e 63 20 2a 74 6f 70 70 61 74 68 2a (conc *toppath* 2620: 20 22 2f 6d 65 67 61 74 65 73 74 2e 64 62 22 29 "/megatest.db") 2630: 29 0a 09 20 28 64 62 2d 6d 6f 64 2d 74 69 6d 65 ).. (db-mod-time 2640: 20 20 20 30 29 20 3b 3b 20 28 66 69 6c 65 2d 6d 0) ;; (file-m 2650: 6f 64 69 66 69 63 61 74 69 6f 6e 2d 74 69 6d 65 odification-time 2660: 20 64 62 2d 70 61 74 68 29 29 0a 09 20 28 6c 61 db-path)).. (la 2670: 73 74 2d 75 70 64 61 74 65 20 20 20 30 29 20 3b st-update 0) ; 2680: 3b 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e ; (current-secon 2690: 64 73 29 29 0a 09 20 28 72 65 71 75 65 73 74 2d ds)).. (request- 26a0: 75 70 64 61 74 65 20 23 74 29 29 0a 20 20 20 20 update #t)). 26b0: 28 69 66 20 28 6e 6f 74 20 74 65 73 74 64 61 74 (if (not testdat 26c0: 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 64 65 )..(begin.. (de 26d0: 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 bug:print 0 "ERR 26e0: 4f 52 3a 20 4e 6f 20 74 65 73 74 20 64 61 74 61 OR: No test data 26f0: 20 66 6f 75 6e 64 20 66 6f 72 20 74 65 73 74 20 found for test 2700: 22 20 74 65 73 74 2d 69 64 20 22 2c 20 65 78 69 " test-id ", exi 2710: 74 69 6e 67 22 29 0a 09 20 20 28 65 78 69 74 20 ting").. (exit 2720: 31 29 29 0a 09 28 6c 65 74 2a 20 28 28 72 75 6e 1))..(let* ((run 2730: 2d 69 64 20 20 20 20 20 20 20 20 28 69 66 20 74 -id (if t 2740: 65 73 74 64 61 74 20 28 64 62 3a 74 65 73 74 2d estdat (db:test- 2750: 67 65 74 2d 72 75 6e 5f 69 64 20 74 65 73 74 64 get-run_id testd 2760: 61 74 29 20 23 66 29 29 0a 09 20 20 20 20 20 20 at) #f)).. 2770: 20 28 6b 65 79 64 61 74 20 20 20 20 20 20 20 20 (keydat 2780: 28 69 66 20 74 65 73 74 64 61 74 20 28 72 64 62 (if testdat (rdb 2790: 3a 67 65 74 2d 6b 65 79 2d 76 61 6c 2d 70 61 69 :get-key-val-pai 27a0: 72 73 20 64 62 20 72 75 6e 2d 69 64 29 20 23 66 rs db run-id) #f 27b0: 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e 64 )).. (rund 27c0: 61 74 20 20 20 20 20 20 20 20 28 69 66 20 74 65 at (if te 27d0: 73 74 64 61 74 20 28 72 64 62 3a 67 65 74 2d 72 stdat (rdb:get-r 27e0: 75 6e 2d 69 6e 66 6f 20 64 62 20 72 75 6e 2d 69 un-info db run-i 27f0: 64 29 20 23 66 29 29 0a 09 20 20 20 20 20 20 20 d) #f)).. 2800: 28 72 75 6e 6e 61 6d 65 20 20 20 20 20 20 20 28 (runname ( 2810: 69 66 20 74 65 73 74 64 61 74 20 28 64 62 3a 67 if testdat (db:g 2820: 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 et-value-by-head 2830: 65 72 20 28 64 62 3a 67 65 74 2d 72 6f 77 20 72 er (db:get-row r 2840: 75 6e 64 61 74 29 0a 09 09 09 09 09 09 09 09 20 undat)......... 2850: 20 28 64 62 3a 67 65 74 2d 68 65 61 64 65 72 20 (db:get-header 2860: 72 75 6e 64 61 74 29 0a 09 09 09 09 09 09 09 09 rundat)......... 2870: 20 20 22 72 75 6e 6e 61 6d 65 22 29 20 23 66 29 "runname") #f) 2880: 29 0a 09 09 09 09 09 3b 28 74 65 73 74 73 74 65 )......;(testste 2890: 70 73 20 20 20 20 20 28 69 66 20 74 65 73 74 64 ps (if testd 28a0: 61 74 20 28 64 62 3a 67 65 74 2d 73 74 65 70 73 at (db:get-steps 28b0: 2d 66 6f 72 2d 74 65 73 74 20 64 62 20 74 65 73 -for-test db tes 28c0: 74 2d 69 64 29 20 23 66 29 29 0a 09 20 20 20 20 t-id) #f)).. 28d0: 20 20 20 28 6c 6f 67 66 69 6c 65 20 20 20 20 20 (logfile 28e0: 20 20 22 2f 74 68 69 73 2f 64 69 72 2f 62 65 74 "/this/dir/bet 28f0: 74 65 72 2f 6e 6f 74 2f 65 78 69 73 74 22 29 0a ter/not/exist"). 2900: 09 20 20 20 20 20 20 20 28 72 75 6e 64 69 72 20 . (rundir 2910: 20 20 20 20 20 20 20 6c 6f 67 66 69 6c 65 29 0a logfile). 2920: 09 20 20 20 20 20 20 20 28 74 65 73 74 66 75 6c . (testful 2930: 6c 6e 61 6d 65 20 20 28 69 66 20 74 65 73 74 64 lname (if testd 2940: 61 74 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d at (db:test-get- 2950: 66 75 6c 6c 6e 61 6d 65 20 74 65 73 74 64 61 74 fullname testdat 2960: 29 20 22 47 61 74 68 65 72 69 6e 67 20 64 61 74 ) "Gathering dat 2970: 61 20 2e 2e 2e 22 29 29 0a 09 20 20 20 20 20 20 a ...")).. 2980: 20 28 74 65 73 74 6e 61 6d 65 20 20 20 20 20 20 (testname 2990: 28 69 66 20 74 65 73 74 64 61 74 20 28 64 62 3a (if testdat (db: 29a0: 74 65 73 74 2d 67 65 74 2d 74 65 73 74 6e 61 6d test-get-testnam 29b0: 65 20 74 65 73 74 64 61 74 29 20 22 6e 2f 61 22 e testdat) "n/a" 29c0: 29 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 )).. (test 29d0: 6d 65 74 61 20 20 20 20 20 20 28 69 66 20 74 65 meta (if te 29e0: 73 74 64 61 74 20 0a 09 09 09 09 20 20 28 6c 65 stdat ..... (le 29f0: 74 20 28 28 74 6d 20 28 64 62 3a 74 65 73 74 6d t ((tm (db:testm 2a00: 65 74 61 2d 67 65 74 2d 72 65 63 6f 72 64 20 64 eta-get-record d 2a10: 62 20 74 65 73 74 6e 61 6d 65 29 29 29 0a 09 09 b testname)))... 2a20: 09 09 20 20 20 20 28 69 66 20 74 6d 20 74 6d 20 .. (if tm tm 2a30: 28 6d 61 6b 65 2d 64 62 3a 74 65 73 74 6d 65 74 (make-db:testmet 2a40: 61 29 29 29 0a 09 09 09 09 20 20 28 6d 61 6b 65 a)))..... (make 2a50: 2d 64 62 3a 74 65 73 74 6d 65 74 61 29 29 29 0a -db:testmeta))). 2a60: 0a 09 20 20 20 20 20 20 20 28 6b 65 79 73 74 72 .. (keystr 2a70: 69 6e 67 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 ing (string-int 2a80: 65 72 73 70 65 72 73 65 20 0a 09 09 09 20 20 20 ersperse .... 2a90: 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 6b (map (lambda (k 2aa0: 65 79 76 61 6c 29 0a 09 09 09 09 20 20 20 3b 3b eyval)..... ;; 2ab0: 20 28 63 6f 6e 63 20 22 3a 22 20 28 63 61 72 20 (conc ":" (car 2ac0: 6b 65 79 76 61 6c 29 20 22 20 22 20 28 63 61 64 keyval) " " (cad 2ad0: 72 20 6b 65 79 76 61 6c 29 29 29 0a 09 09 09 09 r keyval)))..... 2ae0: 20 20 20 28 63 61 64 72 20 6b 65 79 76 61 6c 29 (cadr keyval) 2af0: 29 0a 09 09 09 09 20 6b 65 79 64 61 74 29 0a 09 )..... keydat).. 2b00: 09 09 20 20 20 20 22 2f 22 29 29 0a 09 20 20 20 .. "/")).. 2b10: 20 20 20 20 28 69 74 65 6d 2d 70 61 74 68 20 20 (item-path 2b20: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 74 65 (db:test-get-ite 2b30: 6d 2d 70 61 74 68 20 74 65 73 74 64 61 74 29 29 m-path testdat)) 2b40: 0a 09 20 20 20 20 20 20 20 28 76 69 65 77 6c 6f .. (viewlo 2b50: 67 20 20 20 20 28 6c 61 6d 62 64 61 20 28 78 29 g (lambda (x) 2b60: 0a 09 09 09 20 20 20 20 20 28 69 66 20 28 66 69 .... (if (fi 2b70: 6c 65 2d 65 78 69 73 74 73 3f 20 6c 6f 67 66 69 le-exists? logfi 2b80: 6c 65 29 0a 09 09 09 09 09 3b 28 73 79 73 74 65 le)......;(syste 2b90: 6d 20 28 63 6f 6e 63 20 22 66 69 72 65 66 6f 78 m (conc "firefox 2ba0: 20 22 20 6c 6f 67 66 69 6c 65 20 22 26 22 29 29 " logfile "&")) 2bb0: 0a 09 09 09 09 20 28 69 75 70 3a 73 65 6e 64 2d ..... (iup:send- 2bc0: 75 72 6c 20 6c 6f 67 66 69 6c 65 29 0a 09 09 09 url logfile).... 2bd0: 09 20 28 6d 65 73 73 61 67 65 2d 77 69 6e 64 6f . (message-windo 2be0: 77 20 28 63 6f 6e 63 20 22 46 69 6c 65 20 22 20 w (conc "File " 2bf0: 6c 6f 67 66 69 6c 65 20 22 20 6e 6f 74 20 66 6f logfile " not fo 2c00: 75 6e 64 22 29 29 29 29 29 0a 09 20 20 20 20 20 und"))))).. 2c10: 20 20 28 78 74 65 72 6d 20 20 20 20 20 20 28 6c (xterm (l 2c20: 61 6d 62 64 61 20 28 78 29 0a 09 09 09 20 20 20 ambda (x).... 2c30: 20 20 28 69 66 20 28 64 69 72 65 63 74 6f 72 79 (if (directory 2c40: 2d 65 78 69 73 74 73 3f 20 72 75 6e 64 69 72 29 -exists? rundir) 2c50: 0a 09 09 09 09 20 28 6c 65 74 20 28 28 73 68 65 ..... (let ((she 2c60: 6c 6c 20 28 69 66 20 28 67 65 74 2d 65 6e 76 69 ll (if (get-envi 2c70: 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 ronment-variable 2c80: 20 22 53 48 45 4c 4c 22 29 20 0a 09 09 09 09 09 "SHELL") ...... 2c90: 09 20 20 28 63 6f 6e 63 20 22 2d 65 20 22 20 28 . (conc "-e " ( 2ca0: 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d get-environment- 2cb0: 76 61 72 69 61 62 6c 65 20 22 53 48 45 4c 4c 22 variable "SHELL" 2cc0: 29 29 0a 09 09 09 09 09 09 20 20 22 22 29 29 29 ))....... ""))) 2cd0: 0a 09 09 09 09 20 20 20 28 73 79 73 74 65 6d 20 ..... (system 2ce0: 28 63 6f 6e 63 20 22 63 64 20 22 20 72 75 6e 64 (conc "cd " rund 2cf0: 69 72 20 0a 09 09 09 09 09 09 20 22 3b 78 74 65 ir ....... ";xte 2d00: 72 6d 20 2d 54 20 5c 22 22 20 28 73 74 72 69 6e rm -T \"" (strin 2d10: 67 2d 74 72 61 6e 73 6c 61 74 65 20 74 65 73 74 g-translate test 2d20: 66 75 6c 6c 6e 61 6d 65 20 22 28 29 22 20 22 20 fullname "()" " 2d30: 20 22 29 20 22 5c 22 20 22 20 73 68 65 6c 6c 20 ") "\" " shell 2d40: 22 26 22 29 29 29 0a 09 09 09 09 20 28 6d 65 73 "&")))..... (mes 2d50: 73 61 67 65 2d 77 69 6e 64 6f 77 20 20 28 63 6f sage-window (co 2d60: 6e 63 20 22 44 69 72 65 63 74 6f 72 79 20 22 20 nc "Directory " 2d70: 72 75 6e 64 69 72 20 22 20 6e 6f 74 20 66 6f 75 rundir " not fou 2d80: 6e 64 22 29 29 29 29 29 0a 09 20 20 20 20 20 20 nd"))))).. 2d90: 20 28 72 65 66 72 65 73 68 64 61 74 20 28 6c 61 (refreshdat (la 2da0: 6d 62 64 61 20 28 29 0a 09 09 09 20 20 20 20 20 mbda ().... 2db0: 28 6c 65 74 2a 20 28 28 63 75 72 72 2d 6d 6f 64 (let* ((curr-mod 2dc0: 2d 74 69 6d 65 20 28 66 69 6c 65 2d 6d 6f 64 69 -time (file-modi 2dd0: 66 69 63 61 74 69 6f 6e 2d 74 69 6d 65 20 64 62 fication-time db 2de0: 2d 70 61 74 68 29 29 0a 09 09 09 09 20 20 20 20 -path))..... 2df0: 28 6e 65 65 64 2d 75 70 64 61 74 65 20 20 20 28 (need-update ( 2e00: 6f 72 20 28 61 6e 64 20 28 3e 20 63 75 72 72 2d or (and (> curr- 2e10: 6d 6f 64 2d 74 69 6d 65 20 64 62 2d 6d 6f 64 2d mod-time db-mod- 2e20: 74 69 6d 65 29 0a 09 09 09 09 09 09 09 20 20 20 time)........ 2e30: 20 28 3e 20 28 63 75 72 72 65 6e 74 2d 73 65 63 (> (current-sec 2e40: 6f 6e 64 73 29 20 28 2b 20 6c 61 73 74 2d 75 70 onds) (+ last-up 2e50: 64 61 74 65 20 32 29 29 29 20 3b 3b 20 65 76 65 date 2))) ;; eve 2e60: 72 79 20 74 77 6f 20 73 65 63 6f 6e 64 73 20 69 ry two seconds i 2e70: 66 20 64 62 20 74 6f 75 63 68 65 64 0a 09 09 09 f db touched.... 2e80: 09 09 09 20 20 20 20 20 20 20 72 65 71 75 65 73 ... reques 2e90: 74 2d 75 70 64 61 74 65 29 29 0a 09 09 09 09 20 t-update))..... 2ea0: 20 20 20 28 6e 65 77 74 65 73 74 64 61 74 20 28 (newtestdat ( 2eb0: 69 66 20 6e 65 65 64 2d 75 70 64 61 74 65 20 28 if need-update ( 2ec0: 72 64 62 3a 67 65 74 2d 74 65 73 74 2d 64 61 74 rdb:get-test-dat 2ed0: 61 2d 62 79 2d 69 64 20 64 62 20 74 65 73 74 2d a-by-id db test- 2ee0: 69 64 29 29 29 29 0a 09 09 09 20 20 20 20 20 20 id)))).... 2ef0: 20 28 63 6f 6e 64 0a 09 09 09 09 28 28 61 6e 64 (cond.....((and 2f00: 20 6e 65 65 64 2d 75 70 64 61 74 65 20 6e 65 77 need-update new 2f10: 74 65 73 74 64 61 74 29 0a 09 09 09 09 20 28 73 testdat)..... (s 2f20: 65 74 21 20 74 65 73 74 64 61 74 20 6e 65 77 74 et! testdat newt 2f30: 65 73 74 64 61 74 29 0a 09 09 09 09 20 28 73 65 estdat)..... (se 2f40: 74 21 20 74 65 73 74 73 74 65 70 73 20 20 20 20 t! teststeps 2f50: 28 72 64 62 3a 67 65 74 2d 73 74 65 70 73 2d 66 (rdb:get-steps-f 2f60: 6f 72 2d 74 65 73 74 20 64 62 20 74 65 73 74 2d or-test db test- 2f70: 69 64 29 29 0a 09 09 09 09 20 28 73 65 74 21 20 id))..... (set! 2f80: 6c 6f 67 66 69 6c 65 20 20 20 20 20 20 28 63 6f logfile (co 2f90: 6e 63 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d nc (db:test-get- 2fa0: 72 75 6e 64 69 72 20 74 65 73 74 64 61 74 29 20 rundir testdat) 2fb0: 22 2f 22 20 28 64 62 3a 74 65 73 74 2d 67 65 74 "/" (db:test-get 2fc0: 2d 66 69 6e 61 6c 5f 6c 6f 67 66 20 74 65 73 74 -final_logf test 2fd0: 64 61 74 29 29 29 0a 09 09 09 09 20 28 73 65 74 dat)))..... (set 2fe0: 21 20 72 75 6e 64 69 72 20 20 20 20 20 20 20 28 ! rundir ( 2ff0: 64 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e 64 db:test-get-rund 3000: 69 72 20 74 65 73 74 64 61 74 29 29 0a 09 09 09 ir testdat)).... 3010: 09 20 28 73 65 74 21 20 74 65 73 74 66 75 6c 6c . (set! testfull 3020: 6e 61 6d 65 20 28 64 62 3a 74 65 73 74 2d 67 65 name (db:test-ge 3030: 74 2d 66 75 6c 6c 6e 61 6d 65 20 74 65 73 74 64 t-fullname testd 3040: 61 74 29 29 29 0a 09 09 09 09 28 6e 65 65 64 2d at))).....(need- 3050: 75 70 64 61 74 65 20 3b 3b 20 69 66 20 74 68 69 update ;; if thi 3060: 73 20 77 61 73 20 74 72 75 65 20 61 6e 64 20 79 s was true and y 3070: 65 74 20 74 68 65 72 65 20 69 73 20 6e 6f 20 64 et there is no d 3080: 61 74 61 20 2e 2e 2e 2e 0a 09 09 09 09 20 28 64 ata ......... (d 3090: 62 3a 74 65 73 74 2d 73 65 74 2d 74 65 73 74 6e b:test-set-testn 30a0: 61 6d 65 21 20 74 65 73 74 64 61 74 20 22 44 45 ame! testdat "DE 30b0: 41 44 20 4f 52 20 44 45 4c 45 54 45 44 20 54 45 AD OR DELETED TE 30c0: 53 54 22 29 29 29 29 29 29 0a 09 20 20 20 20 20 ST")))))).. 30d0: 20 20 28 77 69 64 67 65 74 73 20 20 20 20 20 20 (widgets 30e0: 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 (make-hash-table 30f0: 29 29 0a 09 20 20 20 20 20 20 20 28 6d 65 74 61 )).. (meta 3100: 2d 77 69 64 67 65 74 73 20 28 6d 61 6b 65 2d 68 -widgets (make-h 3110: 61 73 68 2d 74 61 62 6c 65 29 29 0a 09 20 20 20 ash-table)).. 3120: 20 20 20 20 28 73 65 6c 66 20 20 20 20 20 20 20 (self 3130: 20 20 23 66 29 0a 09 20 20 20 20 20 20 20 28 73 #f).. (s 3140: 74 6f 72 65 2d 6c 61 62 65 6c 20 20 28 6c 61 6d tore-label (lam 3150: 62 64 61 20 28 6e 61 6d 65 20 6c 62 6c 20 63 6d bda (name lbl cm 3160: 64 29 0a 09 09 09 20 20 20 20 20 20 20 28 68 61 d).... (ha 3170: 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 77 69 sh-table-set! wi 3180: 64 67 65 74 73 20 6e 61 6d 65 20 0a 09 09 09 09 dgets name ..... 3190: 09 09 28 6c 61 6d 62 64 61 20 28 74 65 73 74 64 ..(lambda (testd 31a0: 61 74 29 0a 09 09 09 09 09 09 20 20 28 6c 65 74 at)....... (let 31b0: 20 28 28 6e 65 77 76 61 6c 20 28 63 6d 64 20 74 ((newval (cmd t 31c0: 65 73 74 64 61 74 29 29 0a 09 09 09 09 09 09 09 estdat))........ 31d0: 28 6f 6c 64 76 61 6c 20 28 69 75 70 3a 61 74 74 (oldval (iup:att 31e0: 72 69 62 75 74 65 20 6c 62 6c 20 22 54 49 54 4c ribute lbl "TITL 31f0: 45 22 29 29 29 0a 09 09 09 09 09 09 20 20 20 20 E")))....... 3200: 28 69 66 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f (if (not (equal? 3210: 20 6e 65 77 76 61 6c 20 6f 6c 64 76 61 6c 29 29 newval oldval)) 3220: 0a 09 09 09 09 09 09 09 28 62 65 67 69 6e 0a 09 ........(begin.. 3230: 09 09 09 09 3b 28 6d 75 74 65 78 2d 6c 6f 63 6b ....;(mutex-lock 3240: 21 20 6d 78 31 29 0a 09 09 09 09 09 09 09 20 20 ! mx1)........ 3250: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 (iup:attribute-s 3260: 65 74 21 20 6c 62 6c 20 22 54 49 54 4c 45 22 20 et! lbl "TITLE" 3270: 6e 65 77 76 61 6c 29 0a 09 09 09 09 09 3b 28 6d newval)......;(m 3280: 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 6d 78 31 utex-unlock! mx1 3290: 29 0a 09 09 09 09 09 09 09 20 20 29 29 29 29 29 )........ ))))) 32a0: 0a 09 09 09 20 20 20 20 20 20 20 6c 62 6c 29 29 .... lbl)) 32b0: 0a 09 20 20 20 20 20 20 20 28 73 74 6f 72 65 2d .. (store- 32c0: 6d 65 74 61 20 20 28 6c 61 6d 62 64 61 20 28 6e meta (lambda (n 32d0: 61 6d 65 20 6c 62 6c 20 63 6d 64 29 0a 09 09 09 ame lbl cmd).... 32e0: 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c (hash-tabl 32f0: 65 2d 73 65 74 21 20 6d 65 74 61 2d 77 69 64 67 e-set! meta-widg 3300: 65 74 73 20 6e 61 6d 65 20 0a 09 09 09 09 09 20 ets name ...... 3310: 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 74 (lambda (t 3320: 65 73 74 6d 65 74 61 29 0a 09 09 09 09 09 09 20 estmeta)....... 3330: 28 6c 65 74 20 28 28 6e 65 77 76 61 6c 20 28 63 (let ((newval (c 3340: 6d 64 20 74 65 73 74 6d 65 74 61 29 29 0a 09 09 md testmeta))... 3350: 09 09 09 09 20 20 20 20 20 20 20 28 6f 6c 64 76 .... (oldv 3360: 61 6c 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 al (iup:attribut 3370: 65 20 6c 62 6c 20 22 54 49 54 4c 45 22 29 29 29 e lbl "TITLE"))) 3380: 0a 09 09 09 09 09 09 20 20 20 28 69 66 20 28 6e ....... (if (n 3390: 6f 74 20 28 65 71 75 61 6c 3f 20 6e 65 77 76 61 ot (equal? newva 33a0: 6c 20 6f 6c 64 76 61 6c 29 29 0a 09 09 09 09 09 l oldval))...... 33b0: 09 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 . (begin.. 33c0: 09 09 09 09 3b 28 6d 75 74 65 78 2d 6c 6f 63 6b ....;(mutex-lock 33d0: 21 20 6d 78 31 29 0a 09 09 09 09 09 09 09 20 28 ! mx1)........ ( 33e0: 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 iup:attribute-se 33f0: 74 21 20 6c 62 6c 20 22 54 49 54 4c 45 22 20 6e t! lbl "TITLE" n 3400: 65 77 76 61 6c 29 0a 09 09 09 09 09 3b 28 6d 75 ewval)......;(mu 3410: 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 6d 78 31 29 tex-unlock! mx1) 3420: 0a 09 09 09 09 09 09 09 20 29 29 29 29 29 0a 09 ........ ))))).. 3430: 09 09 20 20 20 20 20 20 6c 62 6c 29 29 0a 09 20 .. lbl)).. 3440: 20 20 20 20 20 20 28 73 74 6f 72 65 2d 62 75 74 (store-but 3450: 74 6f 6e 20 73 74 6f 72 65 2d 6c 61 62 65 6c 29 ton store-label) 3460: 0a 09 20 20 20 20 20 20 20 28 63 6f 6d 6d 61 6e .. (comman 3470: 64 2d 74 65 78 74 2d 62 6f 78 20 28 69 75 70 3a d-text-box (iup: 3480: 74 65 78 74 62 6f 78 20 23 3a 65 78 70 61 6e 64 textbox #:expand 3490: 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 20 23 3a "HORIZONTAL" #: 34a0: 66 6f 6e 74 20 22 43 6f 75 72 69 65 72 20 4e 65 font "Courier Ne 34b0: 77 2c 20 2d 31 30 22 29 29 0a 09 20 20 20 20 20 w, -10")).. 34c0: 20 20 28 63 6f 6d 6d 61 6e 64 2d 6c 61 75 6e 63 (command-launc 34d0: 68 2d 62 75 74 74 6f 6e 20 28 69 75 70 3a 62 75 h-button (iup:bu 34e0: 74 74 6f 6e 20 22 45 78 65 63 75 74 65 21 22 20 tton "Execute!" 34f0: 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 #:action (lambda 3500: 20 28 78 29 0a 09 09 09 09 09 09 09 09 09 28 6c (x)..........(l 3510: 65 74 20 28 28 63 6d 64 20 28 69 75 70 3a 61 74 et ((cmd (iup:at 3520: 74 72 69 62 75 74 65 20 63 6f 6d 6d 61 6e 64 2d tribute command- 3530: 74 65 78 74 2d 62 6f 78 20 22 56 41 4c 55 45 22 text-box "VALUE" 3540: 29 29 29 0a 09 09 09 09 09 09 09 09 09 20 20 28 ))).......... ( 3550: 73 79 73 74 65 6d 20 28 63 6f 6e 63 20 63 6d 64 system (conc cmd 3560: 20 22 20 20 26 22 29 29 29 29 29 29 0a 09 20 20 " &")))))).. 3570: 20 20 20 20 20 28 72 75 6e 2d 74 65 73 74 20 20 (run-test 3580: 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 09 20 (lambda (x).... 3590: 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 (iup:attribut 35a0: 65 2d 73 65 74 21 20 0a 09 09 09 20 20 20 20 20 e-set! .... 35b0: 63 6f 6d 6d 61 6e 64 2d 74 65 78 74 2d 62 6f 78 command-text-box 35c0: 20 22 56 41 4c 55 45 22 0a 09 09 09 20 20 20 20 "VALUE".... 35d0: 20 28 63 6f 6e 63 20 22 78 74 65 72 6d 20 2d 67 (conc "xterm -g 35e0: 65 6f 6d 65 74 72 79 20 31 38 30 78 32 30 20 2d eometry 180x20 - 35f0: 65 20 5c 22 6d 65 67 61 74 65 73 74 20 2d 72 75 e \"megatest -ru 3600: 6e 74 65 73 74 73 20 22 20 74 65 73 74 6e 61 6d ntests " testnam 3610: 65 20 22 20 2d 74 61 72 67 65 74 20 22 20 6b 65 e " -target " ke 3620: 79 73 74 72 69 6e 67 20 22 20 3a 72 75 6e 6e 61 ystring " :runna 3630: 6d 65 20 22 20 72 75 6e 6e 61 6d 65 20 0a 09 09 me " runname ... 3640: 09 09 20 20 20 22 20 2d 69 74 65 6d 70 61 74 74 .. " -itempatt 3650: 20 22 20 28 69 66 20 28 65 71 75 61 6c 3f 20 69 " (if (equal? i 3660: 74 65 6d 2d 70 61 74 68 20 22 22 29 0a 09 09 09 tem-path "").... 3670: 09 09 09 20 20 20 20 20 22 25 22 20 0a 09 09 09 ... "%" .... 3680: 09 09 09 20 20 20 20 20 69 74 65 6d 2d 70 61 74 ... item-pat 3690: 68 29 0a 09 09 09 09 20 20 20 22 3b 65 63 68 6f h)..... ";echo 36a0: 20 50 72 65 73 73 20 61 6e 79 20 6b 65 79 20 74 Press any key t 36b0: 6f 20 63 6f 6e 74 69 6e 75 65 3b 62 61 73 68 20 o continue;bash 36c0: 2d 63 20 27 72 65 61 64 20 2d 6e 20 31 20 2d 73 -c 'read -n 1 -s 36d0: 27 5c 22 22 29 29 29 29 0a 09 20 20 20 20 20 20 '\"")))).. 36e0: 20 28 72 65 6d 6f 76 65 2d 74 65 73 74 20 28 6c (remove-test (l 36f0: 61 6d 62 64 61 20 28 78 29 0a 09 09 09 20 20 20 ambda (x).... 3700: 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 (iup:attribut 3710: 65 2d 73 65 74 21 0a 09 09 09 20 20 20 20 20 20 e-set!.... 3720: 20 63 6f 6d 6d 61 6e 64 2d 74 65 78 74 2d 62 6f command-text-bo 3730: 78 20 22 56 41 4c 55 45 22 0a 09 09 09 20 20 20 x "VALUE".... 3740: 20 20 20 20 28 63 6f 6e 63 20 22 78 74 65 72 6d (conc "xterm 3750: 20 2d 67 65 6f 6d 65 74 72 79 20 31 38 30 78 32 -geometry 180x2 3760: 30 20 2d 65 20 5c 22 6d 65 67 61 74 65 73 74 20 0 -e \"megatest 3770: 2d 72 65 6d 6f 76 65 2d 72 75 6e 73 20 2d 74 61 -remove-runs -ta 3780: 72 67 65 74 20 22 20 6b 65 79 73 74 72 69 6e 67 rget " keystring 3790: 20 22 20 3a 72 75 6e 6e 61 6d 65 20 22 20 72 75 " :runname " ru 37a0: 6e 6e 61 6d 65 20 22 20 2d 74 65 73 74 70 61 74 nname " -testpat 37b0: 74 20 22 20 74 65 73 74 6e 61 6d 65 20 22 20 2d t " testname " - 37c0: 69 74 65 6d 70 61 74 74 20 22 0a 09 09 09 09 20 itempatt "..... 37d0: 20 20 20 20 28 69 66 20 28 65 71 75 61 6c 3f 20 (if (equal? 37e0: 69 74 65 6d 2d 70 61 74 68 20 22 22 29 0a 09 09 item-path "")... 37f0: 09 09 09 20 22 25 22 0a 09 09 09 09 09 20 69 74 ... "%"...... it 3800: 65 6d 2d 70 61 74 68 29 0a 09 09 09 09 20 20 20 em-path)..... 3810: 20 20 22 20 2d 76 3b 65 63 68 6f 20 50 72 65 73 " -v;echo Pres 3820: 73 20 61 6e 79 20 6b 65 79 20 74 6f 20 63 6f 6e s any key to con 3830: 74 69 6e 75 65 3b 62 61 73 68 20 2d 63 20 27 72 tinue;bash -c 'r 3840: 65 61 64 20 2d 6e 20 31 20 2d 73 27 5c 22 22 29 ead -n 1 -s'\"") 3850: 29 29 29 29 0a 09 20 20 28 63 6f 6e 64 0a 09 20 )))).. (cond.. 3860: 20 20 28 28 6e 6f 74 20 74 65 73 74 64 61 74 29 ((not testdat) 3870: 28 62 65 67 69 6e 20 28 70 72 69 6e 74 20 22 45 (begin (print "E 3880: 52 52 4f 52 3a 20 62 61 64 20 74 65 73 74 20 69 RROR: bad test i 3890: 6e 66 6f 20 66 6f 72 20 22 20 74 65 73 74 2d 69 nfo for " test-i 38a0: 64 29 28 65 78 69 74 20 31 29 29 29 0a 09 20 20 d)(exit 1))).. 38b0: 20 28 28 6e 6f 74 20 72 75 6e 64 61 74 29 28 62 ((not rundat)(b 38c0: 65 67 69 6e 20 28 70 72 69 6e 74 20 22 45 52 52 egin (print "ERR 38d0: 4f 52 3a 20 66 6f 75 6e 64 20 74 65 73 74 20 69 OR: found test i 38e0: 6e 66 6f 20 62 75 74 20 74 68 65 72 65 20 69 73 nfo but there is 38f0: 20 61 20 70 72 6f 62 6c 65 6d 20 77 69 74 68 20 a problem with 3900: 74 68 65 20 72 75 6e 20 69 6e 66 6f 20 66 6f 72 the run info for 3910: 20 22 20 72 75 6e 2d 69 64 29 28 65 78 69 74 20 " run-id)(exit 3920: 31 29 29 29 0a 09 20 20 20 28 65 6c 73 65 0a 09 1))).. (else.. 3930: 20 20 20 20 3b 3b 20 20 28 74 65 73 74 2d 73 65 ;; (test-se 3940: 74 2d 73 74 61 74 75 73 21 20 64 62 20 72 75 6e t-status! db run 3950: 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 73 74 -id test-name st 3960: 61 74 65 20 73 74 61 74 75 73 20 69 74 65 6d 64 ate status itemd 3970: 61 74 29 0a 09 20 20 20 20 28 73 65 74 21 20 73 at).. (set! s 3980: 65 6c 66 20 3b 20 0a 09 09 20 20 28 69 75 70 3a elf ; ... (iup: 3990: 64 69 61 6c 6f 67 20 23 3a 63 6c 6f 73 65 5f 63 dialog #:close_c 39a0: 62 20 28 6c 61 6d 62 64 61 20 28 61 29 28 65 78 b (lambda (a)(ex 39b0: 69 74 29 29 20 3b 20 23 3a 65 78 70 61 6e 64 20 it)) ; #:expand 39c0: 22 59 45 53 22 0a 09 09 09 20 20 20 20 20 20 23 "YES".... # 39d0: 3a 74 69 74 6c 65 20 74 65 73 74 66 75 6c 6c 6e :title testfulln 39e0: 61 6d 65 0a 09 09 09 20 20 20 20 20 20 28 69 75 ame.... (iu 39f0: 70 3a 76 62 6f 78 20 3b 20 23 3a 65 78 70 61 6e p:vbox ; #:expan 3a00: 64 20 22 59 45 53 22 0a 09 09 09 20 20 20 20 20 d "YES".... 3a10: 20 20 3b 3b 20 54 68 65 20 72 75 6e 20 61 6e 64 ;; The run and 3a20: 20 74 65 73 74 20 69 6e 66 6f 0a 09 09 09 20 20 test info.... 3a30: 20 20 20 20 20 28 69 75 70 3a 68 62 6f 78 20 20 (iup:hbox 3a40: 3b 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53 22 ; #:expand "YES" 3a50: 0a 09 09 09 09 28 72 75 6e 2d 69 6e 66 6f 2d 70 .....(run-info-p 3a60: 61 6e 65 6c 20 6b 65 79 64 61 74 20 74 65 73 74 anel keydat test 3a70: 64 61 74 20 72 75 6e 6e 61 6d 65 29 0a 09 09 09 dat runname).... 3a80: 09 28 74 65 73 74 2d 69 6e 66 6f 2d 70 61 6e 65 .(test-info-pane 3a90: 6c 20 74 65 73 74 64 61 74 20 73 74 6f 72 65 2d l testdat store- 3aa0: 6c 61 62 65 6c 20 77 69 64 67 65 74 73 29 0a 09 label widgets).. 3ab0: 09 09 09 28 74 65 73 74 2d 6d 65 74 61 2d 70 61 ...(test-meta-pa 3ac0: 6e 65 6c 20 74 65 73 74 6d 65 74 61 20 73 74 6f nel testmeta sto 3ad0: 72 65 2d 6d 65 74 61 29 29 0a 09 09 09 20 20 20 re-meta)).... 3ae0: 20 20 20 20 28 68 6f 73 74 2d 69 6e 66 6f 2d 70 (host-info-p 3af0: 61 6e 65 6c 20 74 65 73 74 64 61 74 20 73 74 6f anel testdat sto 3b00: 72 65 2d 6c 61 62 65 6c 29 0a 09 09 09 20 20 20 re-label).... 3b10: 20 20 20 20 3b 3b 20 54 68 65 20 63 6f 6e 74 72 ;; The contr 3b20: 6f 6c 73 0a 09 09 09 20 20 20 20 20 20 20 28 69 ols.... (i 3b30: 75 70 3a 66 72 61 6d 65 20 23 3a 74 69 74 6c 65 up:frame #:title 3b40: 20 22 41 63 74 69 6f 6e 73 22 20 0a 09 09 09 09 "Actions" ..... 3b50: 09 20 20 28 69 75 70 3a 76 62 6f 78 0a 09 09 09 . (iup:vbox.... 3b60: 09 09 20 20 20 28 69 75 70 3a 68 62 6f 78 20 0a .. (iup:hbox . 3b70: 09 09 09 09 09 20 20 20 20 28 69 75 70 3a 62 75 ..... (iup:bu 3b80: 74 74 6f 6e 20 22 56 69 65 77 20 4c 6f 67 22 20 tton "View Log" 3b90: 20 20 20 23 3a 61 63 74 69 6f 6e 20 76 69 65 77 #:action view 3ba0: 6c 6f 67 20 20 20 20 20 23 3a 73 69 7a 65 20 22 log #:size " 3bb0: 38 30 78 22 29 0a 09 09 09 09 09 20 20 20 20 28 80x")...... ( 3bc0: 69 75 70 3a 62 75 74 74 6f 6e 20 22 53 74 61 72 iup:button "Star 3bd0: 74 20 58 74 65 72 6d 22 20 23 3a 61 63 74 69 6f t Xterm" #:actio 3be0: 6e 20 78 74 65 72 6d 20 20 20 20 20 20 20 23 3a n xterm #: 3bf0: 73 69 7a 65 20 22 38 30 78 22 29 0a 09 09 09 09 size "80x")..... 3c00: 09 20 20 20 20 28 69 75 70 3a 62 75 74 74 6f 6e . (iup:button 3c10: 20 22 52 75 6e 20 54 65 73 74 22 20 20 20 20 23 "Run Test" # 3c20: 3a 61 63 74 69 6f 6e 20 72 75 6e 2d 74 65 73 74 :action run-test 3c30: 20 20 20 20 23 3a 73 69 7a 65 20 22 38 30 78 22 #:size "80x" 3c40: 29 0a 09 09 09 09 09 20 20 20 20 28 69 75 70 3a )...... (iup: 3c50: 62 75 74 74 6f 6e 20 22 43 6c 65 61 6e 20 54 65 button "Clean Te 3c60: 73 74 22 20 20 23 3a 61 63 74 69 6f 6e 20 72 65 st" #:action re 3c70: 6d 6f 76 65 2d 74 65 73 74 20 23 3a 73 69 7a 65 move-test #:size 3c80: 20 22 38 30 78 22 29 0a 09 09 09 09 09 20 20 20 "80x")...... 3c90: 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 43 6c (iup:button "Cl 3ca0: 6f 73 65 22 20 20 20 20 20 20 20 23 3a 61 63 74 ose" #:act 3cb0: 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 78 29 28 ion (lambda (x)( 3cc0: 65 78 69 74 29 29 20 23 3a 73 69 7a 65 20 22 38 exit)) #:size "8 3cd0: 30 78 22 29 29 0a 09 09 09 09 09 20 20 20 28 61 0x"))...... (a 3ce0: 70 70 6c 79 20 0a 09 09 09 09 09 20 20 20 20 69 pply ...... i 3cf0: 75 70 3a 68 62 6f 78 0a 09 09 09 09 09 20 20 20 up:hbox...... 3d00: 20 28 6c 69 73 74 20 63 6f 6d 6d 61 6e 64 2d 74 (list command-t 3d10: 65 78 74 2d 62 6f 78 20 63 6f 6d 6d 61 6e 64 2d ext-box command- 3d20: 6c 61 75 6e 63 68 2d 62 75 74 74 6f 6e 29 29 29 launch-button))) 3d30: 29 0a 09 09 09 20 20 20 20 20 20 20 28 73 65 74 ).... (set 3d40: 2d 66 69 65 6c 64 73 2d 70 61 6e 65 6c 20 74 65 -fields-panel te 3d50: 73 74 2d 69 64 20 74 65 73 74 64 61 74 29 0a 09 st-id testdat).. 3d60: 09 09 20 20 20 20 20 20 20 28 69 75 70 3a 68 62 .. (iup:hb 3d70: 6f 78 0a 09 09 09 09 28 69 75 70 3a 66 72 61 6d ox.....(iup:fram 3d80: 65 20 0a 09 09 09 09 20 23 3a 74 69 74 6c 65 20 e ..... #:title 3d90: 22 54 65 73 74 20 53 74 65 70 73 22 0a 09 09 09 "Test Steps".... 3da0: 09 20 28 6c 65 74 20 28 28 73 74 65 70 73 64 61 . (let ((stepsda 3db0: 74 20 3b 3b 28 69 75 70 3a 6c 61 62 65 6c 20 22 t ;;(iup:label " 3dc0: 54 65 73 74 20 73 74 65 70 73 20 2e 2e 2e 2e 2e Test steps ..... 3dd0: 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e ................ 3de0: 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e ................ 3df0: 2e 2e 2e 2e 22 20 0a 09 09 09 09 09 3b 3b 09 20 ...." ......;;. 3e00: 20 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53 22 #:expand "YES" 3e10: 20 0a 09 09 09 09 09 3b 3b 09 20 20 20 23 3a 73 ......;;. #:s 3e20: 69 7a 65 20 22 32 30 30 78 31 35 30 22 0a 09 09 ize "200x150"... 3e30: 09 09 09 3b 3b 09 20 20 20 23 3a 61 6c 69 67 6e ...;;. #:align 3e40: 6d 65 6e 74 20 22 41 4c 45 46 54 3a 41 54 4f 50 ment "ALEFT:ATOP 3e50: 22 29 29 29 0a 09 09 09 09 09 28 69 75 70 3a 74 ")))......(iup:t 3e60: 65 78 74 62 6f 78 20 3b 3b 20 23 3a 61 63 74 69 extbox ;; #:acti 3e70: 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 20 on (lambda (obj 3e80: 63 68 61 72 20 76 61 6c 29 0a 09 09 09 09 09 20 char val)...... 3e90: 3b 3b 20 20 20 20 09 23 66 29 0a 09 09 09 09 09 ;; .#f)...... 3ea0: 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53 22 0a #:expand "YES". 3eb0: 09 09 09 09 09 20 23 3a 6d 75 6c 74 69 6c 69 6e ..... #:multilin 3ec0: 65 20 22 59 45 53 22 0a 09 09 09 09 09 20 23 3a e "YES"...... #: 3ed0: 66 6f 6e 74 20 22 43 6f 75 72 69 65 72 20 4e 65 font "Courier Ne 3ee0: 77 2c 20 2d 31 30 22 0a 09 09 09 09 09 20 23 3a w, -10"...... #: 3ef0: 73 69 7a 65 20 22 36 30 78 31 30 30 22 29 29 29 size "60x100"))) 3f00: 0a 09 09 09 09 20 20 20 28 68 61 73 68 2d 74 61 ..... (hash-ta 3f10: 62 6c 65 2d 73 65 74 21 20 77 69 64 67 65 74 73 ble-set! widgets 3f20: 20 22 54 65 73 74 20 53 74 65 70 73 22 20 0a 09 "Test Steps" .. 3f30: 09 09 09 09 09 20 20 20 20 28 6c 61 6d 62 64 61 ..... (lambda 3f40: 20 28 74 65 73 74 64 61 74 29 0a 09 09 09 09 09 (testdat)...... 3f50: 09 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 63 . (let* ((c 3f60: 75 72 72 76 61 6c 20 28 69 75 70 3a 61 74 74 72 urrval (iup:attr 3f70: 69 62 75 74 65 20 73 74 65 70 73 64 61 74 20 22 ibute stepsdat " 3f80: 56 41 4c 55 45 22 29 29 20 3b 3b 20 22 54 49 54 VALUE")) ;; "TIT 3f90: 4c 45 22 29 29 0a 09 09 09 09 09 09 09 20 20 20 LE"))........ 3fa0: 20 20 28 66 6d 74 73 74 72 20 20 22 7e 32 30 61 (fmtstr "~20a 3fb0: 7e 31 30 61 7e 31 30 61 7e 31 32 61 7e 31 35 61 ~10a~10a~12a~15a 3fc0: 7e 32 30 61 22 29 0a 09 09 09 09 09 09 09 20 20 ~20a")........ 3fd0: 20 20 20 28 63 6f 6d 70 72 73 74 65 70 73 20 28 (comprsteps ( 3fe0: 72 64 62 3a 67 65 74 2d 73 74 65 70 73 2d 74 61 rdb:get-steps-ta 3ff0: 62 6c 65 20 64 62 20 74 65 73 74 2d 69 64 29 29 ble db test-id)) 4000: 0a 09 09 09 09 09 09 09 20 20 20 20 20 28 6e 65 ........ (ne 4010: 77 76 61 6c 20 20 28 73 74 72 69 6e 67 2d 69 6e wval (string-in 4020: 74 65 72 73 70 65 72 73 65 20 0a 09 09 09 09 09 tersperse ...... 4030: 09 09 09 20 20 20 20 20 20 20 28 61 70 70 65 6e ... (appen 4040: 64 0a 09 09 09 09 09 09 09 09 09 28 6c 69 73 74 d..........(list 4050: 20 0a 09 09 09 09 09 09 09 09 09 20 28 66 6f 72 .......... (for 4060: 6d 61 74 20 23 66 20 66 6d 74 73 74 72 20 22 53 mat #f fmtstr "S 4070: 74 65 70 6e 61 6d 65 22 20 22 53 74 61 72 74 22 tepname" "Start" 4080: 20 22 45 6e 64 22 20 22 53 74 61 74 75 73 22 20 "End" "Status" 4090: 22 54 69 6d 65 22 20 22 4c 6f 67 66 69 6c 65 22 "Time" "Logfile" 40a0: 29 0a 09 09 09 09 09 09 09 09 09 20 28 66 6f 72 ).......... (for 40b0: 6d 61 74 20 23 66 20 66 6d 74 73 74 72 20 22 3d mat #f fmtstr "= 40c0: 3d 3d 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d 3d 22 =======" "=====" 40d0: 20 22 3d 3d 3d 22 20 22 3d 3d 3d 3d 3d 3d 22 20 "===" "======" 40e0: 22 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d 3d 3d 3d 22 "====" "=======" 40f0: 29 29 0a 09 09 09 09 09 09 09 09 09 28 6d 61 70 ))..........(map 4100: 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 09 (lambda (x).... 4110: 09 09 09 09 09 09 20 20 20 20 20 20 20 3b 3b 20 ...... ;; 4120: 74 61 6b 65 20 61 64 76 61 6e 74 61 67 65 20 6f take advantage o 4130: 66 20 74 68 65 20 5c 6e 20 6f 6e 20 74 69 6d 65 f the \n on time 4140: 2d 3e 73 74 72 69 6e 67 0a 09 09 09 09 09 09 09 ->string........ 4150: 09 09 20 20 20 20 20 20 20 28 66 6f 72 6d 61 74 .. (format 4160: 20 23 66 20 66 6d 74 73 74 72 0a 09 09 09 09 09 #f fmtstr...... 4170: 09 09 09 09 09 20 20 20 20 20 20 20 28 76 65 63 ..... (vec 4180: 74 6f 72 2d 72 65 66 20 78 20 30 29 0a 09 09 09 tor-ref x 0).... 4190: 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 6c ....... (l 41a0: 65 74 20 28 28 73 20 28 76 65 63 74 6f 72 2d 72 et ((s (vector-r 41b0: 65 66 20 78 20 31 29 29 29 0a 09 09 09 09 09 09 ef x 1)))....... 41c0: 09 09 09 09 09 20 28 69 66 20 28 6e 75 6d 62 65 ..... (if (numbe 41d0: 72 3f 20 73 29 28 73 65 63 6f 6e 64 73 2d 3e 74 r? s)(seconds->t 41e0: 69 6d 65 2d 73 74 72 69 6e 67 20 73 29 20 73 29 ime-string s) s) 41f0: 29 0a 09 09 09 09 09 09 09 09 09 09 20 20 20 20 )........... 4200: 20 20 20 28 6c 65 74 20 28 28 73 20 28 76 65 63 (let ((s (vec 4210: 74 6f 72 2d 72 65 66 20 78 20 32 29 29 29 0a 09 tor-ref x 2))).. 4220: 09 09 09 09 09 09 09 09 09 09 20 28 69 66 20 28 .......... (if ( 4230: 6e 75 6d 62 65 72 3f 20 73 29 28 73 65 63 6f 6e number? s)(secon 4240: 64 73 2d 3e 74 69 6d 65 2d 73 74 72 69 6e 67 20 ds->time-string 4250: 73 29 20 73 29 29 0a 09 09 09 09 09 09 09 09 09 s) s)).......... 4260: 09 20 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d . (vector- 4270: 72 65 66 20 78 20 33 29 20 20 20 20 3b 3b 20 73 ref x 3) ;; s 4280: 74 61 74 75 73 0a 09 09 09 09 09 09 09 09 09 09 tatus........... 4290: 20 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d 72 (vector-r 42a0: 65 66 20 78 20 34 29 0a 09 09 09 09 09 09 09 09 ef x 4)......... 42b0: 09 09 20 20 20 20 20 20 20 28 76 65 63 74 6f 72 .. (vector 42c0: 2d 72 65 66 20 78 20 35 29 29 29 20 20 3b 3b 20 -ref x 5))) ;; 42d0: 74 69 6d 65 20 64 65 6c 74 61 0a 09 09 09 09 09 time delta...... 42e0: 09 09 09 09 20 20 20 20 20 28 73 6f 72 74 20 28 .... (sort ( 42f0: 68 61 73 68 2d 74 61 62 6c 65 2d 76 61 6c 75 65 hash-table-value 4300: 73 20 63 6f 6d 70 72 73 74 65 70 73 29 0a 09 09 s comprsteps)... 4310: 09 09 09 09 09 09 09 09 20 20 20 28 6c 61 6d 62 ........ (lamb 4320: 64 61 20 28 61 20 62 29 0a 09 09 09 09 09 09 09 da (a b)........ 4330: 09 09 09 20 20 20 20 20 28 6c 65 74 20 28 28 74 ... (let ((t 4340: 69 6d 65 2d 61 20 28 76 65 63 74 6f 72 2d 72 65 ime-a (vector-re 4350: 66 20 61 20 31 29 29 0a 09 09 09 09 09 09 09 09 f a 1))......... 4360: 09 09 09 20 20 20 28 74 69 6d 65 2d 62 20 28 76 ... (time-b (v 4370: 65 63 74 6f 72 2d 72 65 66 20 62 20 31 29 29 29 ector-ref b 1))) 4380: 0a 09 09 09 09 09 09 09 09 09 09 20 20 20 20 20 ........... 4390: 20 20 28 69 66 20 28 61 6e 64 20 28 6e 75 6d 62 (if (and (numb 43a0: 65 72 3f 20 74 69 6d 65 2d 61 29 28 6e 75 6d 62 er? time-a)(numb 43b0: 65 72 3f 20 74 69 6d 65 2d 62 29 29 0a 09 09 09 er? time-b)).... 43c0: 09 09 09 09 09 09 09 09 20 20 20 28 3c 20 74 69 ........ (< ti 43d0: 6d 65 2d 61 20 74 69 6d 65 2d 62 29 0a 09 09 09 me-a time-b).... 43e0: 09 09 09 09 09 09 09 09 20 20 20 23 74 29 29 29 ........ #t))) 43f0: 29 29 29 0a 09 09 09 09 09 09 09 09 20 20 20 20 )))......... 4400: 20 20 20 22 5c 6e 22 29 29 29 0a 09 09 09 09 09 "\n")))...... 4410: 09 09 28 69 66 20 28 6e 6f 74 20 28 65 71 75 61 ..(if (not (equa 4420: 6c 3f 20 63 75 72 72 76 61 6c 20 6e 65 77 76 61 l? currval newva 4430: 6c 29 29 0a 09 09 09 09 09 09 09 20 20 20 20 28 l))........ ( 4440: 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 iup:attribute-se 4450: 74 21 20 73 74 65 70 73 64 61 74 20 22 56 41 4c t! stepsdat "VAL 4460: 55 45 22 20 6e 65 77 76 61 6c 20 29 29 29 29 29 UE" newval ))))) 4470: 20 3b 3b 20 22 54 49 54 4c 45 22 20 6e 65 77 76 ;; "TITLE" newv 4480: 61 6c 29 29 29 29 29 0a 09 09 09 09 20 20 20 73 al)))))..... s 4490: 74 65 70 73 64 61 74 29 29 0a 09 09 09 09 3b 3b tepsdat)).....;; 44a0: 20 70 6f 70 75 6c 61 74 65 20 74 68 65 20 54 65 populate the Te 44b0: 73 74 20 44 61 74 61 20 70 61 6e 65 6c 0a 09 09 st Data panel... 44c0: 09 09 28 69 75 70 3a 66 72 61 6d 65 0a 09 09 09 ..(iup:frame.... 44d0: 09 20 23 3a 74 69 74 6c 65 20 22 54 65 73 74 20 . #:title "Test 44e0: 44 61 74 61 22 0a 09 09 09 09 20 28 6c 65 74 20 Data"..... (let 44f0: 28 28 74 65 73 74 2d 64 61 74 61 0a 09 09 09 09 ((test-data..... 4500: 09 28 69 75 70 3a 74 65 78 74 62 6f 78 20 20 3b .(iup:textbox ; 4510: 3b 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 ; #:action (lamb 4520: 64 61 20 28 6f 62 6a 20 63 68 61 72 20 76 61 6c da (obj char val 4530: 29 0a 09 09 09 09 09 20 3b 3b 20 20 20 09 23 66 )...... ;; .#f 4540: 29 0a 09 09 09 09 09 20 23 3a 65 78 70 61 6e 64 )...... #:expand 4550: 20 22 59 45 53 22 0a 09 09 09 09 09 20 23 3a 6d "YES"...... #:m 4560: 75 6c 74 69 6c 69 6e 65 20 22 59 45 53 22 0a 09 ultiline "YES".. 4570: 09 09 09 09 20 23 3a 66 6f 6e 74 20 22 43 6f 75 .... #:font "Cou 4580: 72 69 65 72 20 4e 65 77 2c 20 2d 31 30 22 0a 09 rier New, -10".. 4590: 09 09 09 09 20 23 3a 73 69 7a 65 20 22 31 30 30 .... #:size "100 45a0: 78 31 30 30 22 29 29 29 0a 09 09 09 09 20 20 20 x100")))..... 45b0: 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 (hash-table-set! 45c0: 20 77 69 64 67 65 74 73 20 22 54 65 73 74 20 44 widgets "Test D 45d0: 61 74 61 22 0a 09 09 09 09 09 09 20 20 20 20 28 ata"....... ( 45e0: 6c 61 6d 62 64 61 20 28 74 65 73 74 64 61 74 29 lambda (testdat) 45f0: 20 3b 3b 20 0a 09 09 09 09 09 09 20 20 20 20 20 ;; ....... 4600: 20 28 6c 65 74 2a 20 28 28 63 75 72 72 76 61 6c (let* ((currval 4610: 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 20 (iup:attribute 4620: 74 65 73 74 2d 64 61 74 61 20 22 56 41 4c 55 45 test-data "VALUE 4630: 22 29 29 20 3b 3b 20 22 54 49 54 4c 45 22 29 29 ")) ;; "TITLE")) 4640: 0a 09 09 09 09 09 09 09 20 20 20 20 20 28 66 6d ........ (fm 4650: 74 73 74 72 20 20 22 7e 31 30 61 7e 31 30 61 7e tstr "~10a~10a~ 4660: 31 30 61 7e 31 30 61 7e 37 61 7e 37 61 7e 36 61 10a~10a~7a~7a~6a 4670: 7e 36 61 7e 61 22 29 20 3b 3b 20 63 61 74 65 67 ~6a~a") ;; categ 4680: 6f 72 79 2c 76 61 72 69 61 62 6c 65 2c 76 61 6c ory,variable,val 4690: 75 65 2c 65 78 70 65 63 74 65 64 2c 74 6f 6c 2c ue,expected,tol, 46a0: 75 6e 69 74 73 2c 74 79 70 65 2c 63 6f 6d 6d 65 units,type,comme 46b0: 6e 74 0a 09 09 09 09 09 09 09 20 20 20 20 20 28 nt........ ( 46c0: 6e 65 77 76 61 6c 20 20 28 73 74 72 69 6e 67 2d newval (string- 46d0: 69 6e 74 65 72 73 70 65 72 73 65 20 0a 09 09 09 intersperse .... 46e0: 09 09 09 09 09 20 20 20 20 20 20 20 28 61 70 70 ..... (app 46f0: 65 6e 64 0a 09 09 09 09 09 09 09 09 09 28 6c 69 end..........(li 4700: 73 74 20 0a 09 09 09 09 09 09 09 09 09 20 28 66 st .......... (f 4710: 6f 72 6d 61 74 20 23 66 20 66 6d 74 73 74 72 20 ormat #f fmtstr 4720: 22 43 61 74 65 67 6f 72 79 22 20 22 56 61 72 69 "Category" "Vari 4730: 61 62 6c 65 22 20 22 56 61 6c 75 65 22 20 22 45 able" "Value" "E 4740: 78 70 65 63 74 65 64 22 20 22 54 6f 6c 22 20 22 xpected" "Tol" " 4750: 53 74 61 74 75 73 22 20 22 55 6e 69 74 73 22 20 Status" "Units" 4760: 22 54 79 70 65 22 20 22 43 6f 6d 6d 65 6e 74 22 "Type" "Comment" 4770: 29 0a 09 09 09 09 09 09 09 09 09 20 28 66 6f 72 ).......... (for 4780: 6d 61 74 20 23 66 20 66 6d 74 73 74 72 20 22 3d mat #f fmtstr "= 4790: 3d 3d 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d 3d 3d =======" "====== 47a0: 3d 3d 22 20 22 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d ==" "=====" "=== 47b0: 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d 22 20 22 3d 3d =====" "===" "== 47c0: 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d 3d 22 20 22 3d ====" "=====" "= 47d0: 3d 3d 3d 22 20 22 3d 3d 3d 3d 3d 3d 3d 22 29 29 ===" "=======")) 47e0: 0a 09 09 09 09 09 09 09 09 09 28 6d 61 70 20 28 ..........(map ( 47f0: 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 09 09 09 lambda (x)...... 4800: 09 09 09 09 20 20 20 20 20 20 20 28 66 6f 72 6d .... (form 4810: 61 74 20 23 66 20 66 6d 74 73 74 72 0a 09 09 09 at #f fmtstr.... 4820: 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 64 ....... (d 4830: 62 3a 74 65 73 74 2d 64 61 74 61 2d 67 65 74 2d b:test-data-get- 4840: 63 61 74 65 67 6f 72 79 20 78 29 0a 09 09 09 09 category x)..... 4850: 09 09 09 09 09 09 20 20 20 20 20 20 20 28 64 62 ...... (db 4860: 3a 74 65 73 74 2d 64 61 74 61 2d 67 65 74 2d 76 :test-data-get-v 4870: 61 72 69 61 62 6c 65 20 78 29 0a 09 09 09 09 09 ariable x)...... 4880: 09 09 09 09 09 20 20 20 20 20 20 20 28 64 62 3a ..... (db: 4890: 74 65 73 74 2d 64 61 74 61 2d 67 65 74 2d 76 61 test-data-get-va 48a0: 6c 75 65 20 20 20 20 78 29 0a 09 09 09 09 09 09 lue x)....... 48b0: 09 09 09 09 20 20 20 20 20 20 20 28 64 62 3a 74 .... (db:t 48c0: 65 73 74 2d 64 61 74 61 2d 67 65 74 2d 65 78 70 est-data-get-exp 48d0: 65 63 74 65 64 20 78 29 0a 09 09 09 09 09 09 09 ected x)........ 48e0: 09 09 09 20 20 20 20 20 20 20 28 64 62 3a 74 65 ... (db:te 48f0: 73 74 2d 64 61 74 61 2d 67 65 74 2d 74 6f 6c 20 st-data-get-tol 4900: 20 20 20 20 20 78 29 0a 09 09 09 09 09 09 09 09 x)......... 4910: 09 09 20 20 20 20 20 20 20 28 64 62 3a 74 65 73 .. (db:tes 4920: 74 2d 64 61 74 61 2d 67 65 74 2d 73 74 61 74 75 t-data-get-statu 4930: 73 20 20 20 78 29 0a 09 09 09 09 09 09 09 09 09 s x).......... 4940: 09 20 20 20 20 20 20 20 28 64 62 3a 74 65 73 74 . (db:test 4950: 2d 64 61 74 61 2d 67 65 74 2d 75 6e 69 74 73 20 -data-get-units 4960: 20 20 20 78 29 0a 09 09 09 09 09 09 09 09 09 09 x)........... 4970: 20 20 20 20 20 20 20 28 64 62 3a 74 65 73 74 2d (db:test- 4980: 64 61 74 61 2d 67 65 74 2d 74 79 70 65 20 20 20 data-get-type 4990: 20 20 78 29 0a 09 09 09 09 09 09 09 09 09 09 20 x)........... 49a0: 20 20 20 20 20 20 28 64 62 3a 74 65 73 74 2d 64 (db:test-d 49b0: 61 74 61 2d 67 65 74 2d 63 6f 6d 6d 65 6e 74 20 ata-get-comment 49c0: 20 78 29 29 29 0a 09 09 09 09 09 09 09 09 09 20 x))).......... 49d0: 20 20 20 20 28 64 62 3a 72 65 61 64 2d 74 65 73 (db:read-tes 49e0: 74 2d 64 61 74 61 20 64 62 20 74 65 73 74 2d 69 t-data db test-i 49f0: 64 20 22 25 22 29 29 29 0a 09 09 09 09 09 09 09 d "%")))........ 4a00: 09 20 20 20 20 20 20 20 22 5c 6e 22 29 29 29 0a . "\n"))). 4a10: 09 09 09 09 09 09 09 28 69 66 20 28 6e 6f 74 20 .......(if (not 4a20: 28 65 71 75 61 6c 3f 20 63 75 72 72 76 61 6c 20 (equal? currval 4a30: 6e 65 77 76 61 6c 29 29 0a 09 09 09 09 09 09 09 newval))........ 4a40: 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 (iup:attribu 4a50: 74 65 2d 73 65 74 21 20 74 65 73 74 2d 64 61 74 te-set! test-dat 4a60: 61 20 22 56 41 4c 55 45 22 20 6e 65 77 76 61 6c a "VALUE" newval 4a70: 20 29 29 29 29 29 20 3b 3b 20 22 54 49 54 4c 45 ))))) ;; "TITLE 4a80: 22 20 6e 65 77 76 61 6c 29 29 29 29 29 0a 09 09 " newval)))))... 4a90: 09 09 20 20 20 74 65 73 74 2d 64 61 74 61 29 29 .. test-data)) 4aa0: 29 0a 09 09 09 20 20 20 20 20 20 20 29 29 29 0a ).... ))). 4ab0: 09 20 20 20 20 28 69 75 70 3a 73 68 6f 77 20 73 . (iup:show s 4ac0: 65 6c 66 29 0a 09 20 20 20 20 28 69 75 70 3a 63 elf).. (iup:c 4ad0: 61 6c 6c 62 61 63 6b 2d 73 65 74 21 20 2a 74 69 allback-set! *ti 4ae0: 6d 2a 20 22 41 43 54 49 4f 4e 5f 43 42 22 0a 09 m* "ACTION_CB".. 4af0: 09 09 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 .. (lambda 4b00: 20 28 78 29 0a 09 09 09 09 20 3b 3b 20 4e 6f 77 (x)..... ;; Now 4b10: 20 73 74 61 72 74 20 6b 65 65 70 69 6e 67 20 74 start keeping t 4b20: 68 65 20 67 75 69 20 75 70 64 61 74 65 64 20 66 he gui updated f 4b30: 72 6f 6d 20 74 68 65 20 64 62 0a 09 09 09 09 20 rom the db..... 4b40: 28 72 65 66 72 65 73 68 64 61 74 29 20 3b 3b 20 (refreshdat) ;; 4b50: 75 70 64 61 74 65 20 66 72 6f 6d 20 74 68 65 20 update from the 4b60: 64 62 20 68 65 72 65 0a 09 09 09 09 09 3b 28 74 db here......;(t 4b70: 68 72 65 61 64 2d 73 75 73 70 65 6e 64 21 20 6f hread-suspend! o 4b80: 74 68 65 72 2d 74 68 72 65 61 64 29 0a 09 09 09 ther-thread).... 4b90: 09 20 3b 3b 20 75 70 64 61 74 65 20 74 68 65 20 . ;; update the 4ba0: 67 75 69 20 65 6c 65 6d 65 6e 74 73 20 68 65 72 gui elements her 4bb0: 65 0a 09 09 09 09 20 28 66 6f 72 2d 65 61 63 68 e..... (for-each 4bc0: 20 0a 09 09 09 09 20 20 28 6c 61 6d 62 64 61 20 ..... (lambda 4bd0: 28 6b 65 79 29 0a 09 09 09 09 20 20 20 20 3b 3b (key)..... ;; 4be0: 20 28 70 72 69 6e 74 20 22 55 70 64 61 74 69 6e (print "Updatin 4bf0: 67 20 22 20 6b 65 79 29 0a 09 09 09 09 20 20 20 g " key)..... 4c00: 20 28 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 ((hash-table-re 4c10: 66 20 77 69 64 67 65 74 73 20 6b 65 79 29 20 74 f widgets key) t 4c20: 65 73 74 64 61 74 29 29 0a 09 09 09 09 20 20 28 estdat))..... ( 4c30: 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 hash-table-keys 4c40: 77 69 64 67 65 74 73 29 29 0a 09 09 09 09 20 28 widgets))..... ( 4c50: 75 70 64 61 74 65 2d 73 74 61 74 65 2d 73 74 61 update-state-sta 4c60: 74 75 73 2d 62 75 74 74 6f 6e 73 20 74 65 73 74 tus-buttons test 4c70: 64 61 74 29 0a 09 09 09 09 09 3b 20 28 69 75 70 dat)......; (iup 4c80: 3a 72 65 66 72 65 73 68 20 73 65 6c 66 29 0a 09 :refresh self).. 4c90: 09 09 09 20 28 69 66 20 2a 65 78 69 74 2d 73 74 ... (if *exit-st 4ca0: 61 72 74 65 64 2a 0a 09 09 09 09 20 20 20 20 20 arted*..... 4cb0: 28 73 65 74 21 20 2a 65 78 69 74 2d 73 74 61 72 (set! *exit-star 4cc0: 74 65 64 2a 20 27 6f 6b 29 29 29 29 29 29 29 29 ted* 'ok)))))))) 4cd0: 29 29 0a 0a ))..