Artifact 5d114323130b08d1a9f8196c4a36038c7eb27db9:
- File dashboard-tests.scm — part of check-in [e0c173490e] at 2011-10-08 21:27:59 on branch trunk — All (I hope) interdependencies captured and testing passes (user: matt size: 18528)
0000: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;============== 0010: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0020: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0030: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0040: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 43 6f 70 79 ========.;; Copy 0050: 72 69 67 68 74 20 32 30 30 36 2d 32 30 31 31 2c right 2006-2011, 0060: 20 4d 61 74 74 68 65 77 20 57 65 6c 6c 61 6e 64 Matthew Welland 0070: 2e 0a 3b 3b 20 0a 3b 3b 20 20 54 68 69 73 20 70 ..;; .;; This p 0080: 72 6f 67 72 61 6d 20 69 73 20 6d 61 64 65 20 61 rogram is made a 0090: 76 61 69 6c 61 62 6c 65 20 75 6e 64 65 72 20 74 vailable under t 00a0: 68 65 20 47 4e 55 20 47 50 4c 20 76 65 72 73 69 he GNU GPL versi 00b0: 6f 6e 20 32 2e 30 20 6f 72 0a 3b 3b 20 20 67 72 on 2.0 or.;; gr 00c0: 65 61 74 65 72 2e 20 53 65 65 20 74 68 65 20 61 eater. See the a 00d0: 63 63 6f 6d 70 61 6e 79 69 6e 67 20 66 69 6c 65 ccompanying file 00e0: 20 43 4f 50 59 49 4e 47 20 66 6f 72 20 64 65 74 COPYING for det 00f0: 61 69 6c 73 2e 0a 3b 3b 20 0a 3b 3b 20 20 54 68 ails..;; .;; Th 0100: 69 73 20 70 72 6f 67 72 61 6d 20 69 73 20 64 69 is program is di 0110: 73 74 72 69 62 75 74 65 64 20 57 49 54 48 4f 55 stributed WITHOU 0120: 54 20 41 4e 59 20 57 41 52 52 41 4e 54 59 3b 20 T ANY WARRANTY; 0130: 77 69 74 68 6f 75 74 20 65 76 65 6e 20 74 68 65 without even the 0140: 0a 3b 3b 20 20 69 6d 70 6c 69 65 64 20 77 61 72 .;; implied war 0150: 72 61 6e 74 79 20 6f 66 20 4d 45 52 43 48 41 4e ranty of MERCHAN 0160: 54 41 42 49 4c 49 54 59 20 6f 72 20 46 49 54 4e TABILITY or FITN 0170: 45 53 53 20 46 4f 52 20 41 20 50 41 52 54 49 43 ESS FOR A PARTIC 0180: 55 4c 41 52 0a 3b 3b 20 20 50 55 52 50 4f 53 45 ULAR.;; PURPOSE 0190: 2e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============ 01a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 01b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 01c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 01d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 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 65 78 70 61 6e 64 20 22 48 4f 52 49 ) #:expand "HORI 1080: 5a 4f 4e 54 41 4c 22 29 0a 09 09 09 20 28 6c 61 ZONTAL").... (la 1090: 6d 62 64 61 20 28 74 65 73 74 6d 65 74 61 29 28 mbda (testmeta)( 10a0: 64 62 3a 74 65 73 74 6d 65 74 61 2d 67 65 74 2d db:testmeta-get- 10b0: 64 65 73 63 72 69 70 74 69 6f 6e 20 74 65 73 74 description test 10c0: 6d 65 74 61 29 29 29 0a 09 20 20 20 20 29 29 29 meta))).. ))) 10d0: 29 29 0a 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d ))...;;========= 10e0: 3d 3d 3d 3d 3d 3d 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 0a 3b 3b =============.;; 1120: 20 52 75 6e 20 69 6e 66 6f 20 70 61 6e 65 6c 0a Run info panel. 1130: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;============== 1140: 3d 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 0a 28 64 65 66 69 6e 65 ========.(define 1180: 20 28 72 75 6e 2d 69 6e 66 6f 2d 70 61 6e 65 6c (run-info-panel 1190: 20 6b 65 79 64 61 74 20 74 65 73 74 64 61 74 20 keydat testdat 11a0: 72 75 6e 6e 61 6d 65 29 0a 20 20 28 69 75 70 3a runname). (iup: 11b0: 66 72 61 6d 65 20 0a 20 20 20 23 3a 74 69 74 6c frame . #:titl 11c0: 65 20 22 4d 65 67 61 74 65 73 74 20 52 75 6e 20 e "Megatest Run 11d0: 49 6e 66 6f 22 20 3b 20 23 3a 65 78 70 61 6e 64 Info" ; #:expand 11e0: 20 22 59 45 53 22 0a 20 20 20 28 69 75 70 3a 68 "YES". (iup:h 11f0: 62 6f 78 20 3b 20 23 3a 65 78 70 61 6e 64 20 22 box ; #:expand " 1200: 59 45 53 22 0a 20 20 20 20 28 61 70 70 6c 79 20 YES". (apply 1210: 69 75 70 3a 76 62 6f 78 20 3b 20 23 3a 65 78 70 iup:vbox ; #:exp 1220: 61 6e 64 20 22 59 45 53 22 0a 09 20 20 20 28 61 and "YES".. (a 1230: 70 70 65 6e 64 20 28 6d 61 70 20 28 6c 61 6d 62 ppend (map (lamb 1240: 64 61 20 28 6b 65 79 76 61 6c 29 0a 09 09 09 20 da (keyval).... 1250: 20 28 69 75 70 3a 6c 61 62 65 6c 20 28 63 6f 6e (iup:label (con 1260: 63 20 28 63 61 72 20 6b 65 79 76 61 6c 29 20 22 c (car keyval) " 1270: 20 22 29 20 3b 20 23 3a 65 78 70 61 6e 64 20 22 ") ; #:expand " 1280: 48 4f 52 49 5a 4f 4e 54 41 4c 22 0a 09 09 09 09 HORIZONTAL"..... 1290: 20 20 20 20 20 29 29 0a 09 09 09 6b 65 79 64 61 ))....keyda 12a0: 74 29 0a 09 09 20 20 20 28 6c 69 73 74 20 28 69 t)... (list (i 12b0: 75 70 3a 6c 61 62 65 6c 20 22 72 75 6e 6e 61 6d up:label "runnam 12c0: 65 20 22 29 29 29 29 0a 20 20 20 20 28 61 70 70 e ")))). (app 12d0: 6c 79 20 69 75 70 3a 76 62 6f 78 0a 09 20 20 20 ly iup:vbox.. 12e0: 28 61 70 70 65 6e 64 20 28 6d 61 70 20 28 6c 61 (append (map (la 12f0: 6d 62 64 61 20 28 6b 65 79 76 61 6c 29 0a 09 09 mbda (keyval)... 1300: 09 20 20 28 69 75 70 3a 6c 61 62 65 6c 20 28 63 . (iup:label (c 1310: 61 64 72 20 6b 65 79 76 61 6c 29 20 23 3a 65 78 adr keyval) #:ex 1320: 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c pand "HORIZONTAL 1330: 22 29 29 0a 09 09 09 6b 65 79 64 61 74 29 0a 09 "))....keydat).. 1340: 09 20 20 20 28 6c 69 73 74 20 28 69 75 70 3a 6c . (list (iup:l 1350: 61 62 65 6c 20 72 75 6e 6e 61 6d 65 29 28 69 75 abel runname)(iu 1360: 70 3a 6c 61 62 65 6c 20 22 22 20 23 3a 65 78 70 p:label "" #:exp 1370: 61 6e 64 20 22 56 45 52 54 49 43 41 4c 22 29 29 and "VERTICAL")) 1380: 29 29 29 29 29 0a 20 20 0a 3b 3b 3d 3d 3d 3d 3d ))))). .;;===== 1390: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 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 0a 3b 3b 20 48 6f 73 74 20 69 6e 66 6f 20 70 =.;; Host info p 13e0: 61 6e 65 6c 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d anel.;;========= 13f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 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 0a 28 64 =============.(d 1430: 65 66 69 6e 65 20 28 68 6f 73 74 2d 69 6e 66 6f efine (host-info 1440: 2d 70 61 6e 65 6c 20 74 65 73 74 64 61 74 20 73 -panel testdat s 1450: 74 6f 72 65 2d 6c 61 62 65 6c 29 0a 20 20 28 69 tore-label). (i 1460: 75 70 3a 66 72 61 6d 65 0a 20 20 20 23 3a 74 69 up:frame. #:ti 1470: 74 6c 65 20 22 52 65 6d 6f 74 65 20 68 6f 73 74 tle "Remote host 1480: 20 61 6e 64 20 54 65 73 74 20 52 75 6e 20 49 6e and Test Run In 1490: 66 6f 22 20 3b 20 23 3a 65 78 70 61 6e 64 20 22 fo" ; #:expand " 14a0: 59 45 53 22 0a 20 20 20 28 69 75 70 3a 68 62 6f YES". (iup:hbo 14b0: 78 20 3b 20 23 3a 65 78 70 61 6e 64 20 22 59 45 x ; #:expand "YE 14c0: 53 22 0a 20 20 20 20 28 61 70 70 6c 79 20 69 75 S". (apply iu 14d0: 70 3a 76 62 6f 78 20 3b 20 23 3a 65 78 70 61 6e p:vbox ; #:expan 14e0: 64 20 22 59 45 53 22 20 3b 3b 20 54 68 65 20 68 d "YES" ;; The h 14f0: 65 61 64 69 6e 67 20 6c 61 62 65 6c 73 0a 09 20 eading labels.. 1500: 20 20 28 61 70 70 65 6e 64 20 28 6d 61 70 20 28 (append (map ( 1510: 6c 61 6d 62 64 61 20 28 76 61 6c 29 0a 09 09 09 lambda (val).... 1520: 20 20 28 69 75 70 3a 6c 61 62 65 6c 20 76 61 6c (iup:label val 1530: 20 3b 20 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 ; #:expand "HOR 1540: 49 5a 4f 4e 54 41 4c 22 0a 09 09 09 09 20 20 20 IZONTAL"..... 1550: 20 20 29 29 0a 09 09 09 28 6c 69 73 74 20 22 48 ))....(list "H 1560: 6f 73 74 6e 61 6d 65 3a 20 22 0a 09 09 09 20 20 ostname: ".... 1570: 20 20 20 20 22 55 6e 61 6d 65 20 2d 61 3a 20 22 "Uname -a: " 1580: 0a 09 09 09 20 20 20 20 20 20 22 44 69 73 6b 20 .... "Disk 1590: 66 72 65 65 3a 20 22 0a 09 09 09 20 20 20 20 20 free: ".... 15a0: 20 22 43 50 55 20 4c 6f 61 64 3a 20 22 0a 09 09 "CPU Load: "... 15b0: 09 20 20 20 20 20 20 22 52 75 6e 20 64 75 72 61 . "Run dura 15c0: 74 69 6f 6e 3a 20 22 0a 09 09 09 20 20 20 20 20 tion: ".... 15d0: 20 22 4c 6f 67 66 69 6c 65 3a 20 22 29 29 0a 09 "Logfile: ")).. 15e0: 09 20 20 20 28 69 75 70 3a 6c 61 62 65 6c 20 22 . (iup:label " 15f0: 22 20 23 3a 65 78 70 61 6e 64 20 22 56 45 52 54 " #:expand "VERT 1600: 49 43 41 4c 22 29 29 29 0a 20 20 20 20 28 61 70 ICAL"))). (ap 1610: 70 6c 79 20 69 75 70 3a 76 62 6f 78 20 3b 20 23 ply iup:vbox ; # 1620: 3a 65 78 70 61 6e 64 20 22 59 45 53 22 0a 09 20 :expand "YES".. 1630: 20 20 28 6c 69 73 74 0a 09 20 20 20 20 3b 3b 20 (list.. ;; 1640: 4e 4f 54 45 3a 20 59 65 73 2c 20 74 68 65 20 68 NOTE: Yes, the h 1650: 6f 73 74 20 63 61 6e 20 63 68 61 6e 67 65 21 0a ost can change!. 1660: 09 20 20 20 20 28 73 74 6f 72 65 2d 6c 61 62 65 . (store-labe 1670: 6c 20 22 48 6f 73 74 4e 61 6d 65 22 0a 09 09 09 l "HostName".... 1680: 20 28 69 75 70 3a 6c 61 62 65 6c 20 28 64 62 3a (iup:label (db: 1690: 74 65 73 74 2d 67 65 74 2d 68 6f 73 74 20 74 65 test-get-host te 16a0: 73 74 64 61 74 29 20 23 3a 65 78 70 61 6e 64 20 stdat) #:expand 16b0: 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 29 0a 09 09 "HORIZONTAL")... 16c0: 09 20 28 6c 61 6d 62 64 61 20 28 74 65 73 74 64 . (lambda (testd 16d0: 61 74 29 28 64 62 3a 74 65 73 74 2d 67 65 74 2d at)(db:test-get- 16e0: 68 6f 73 74 20 74 65 73 74 64 61 74 29 29 29 0a host testdat))). 16f0: 09 20 20 20 20 28 73 74 6f 72 65 2d 6c 61 62 65 . (store-labe 1700: 6c 20 22 55 6e 61 6d 65 22 0a 09 09 09 20 28 69 l "Uname".... (i 1710: 75 70 3a 6c 61 62 65 6c 20 22 20 20 20 20 20 20 up:label " 1720: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 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 22 20 23 " # 1750: 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e :expand "HORIZON 1760: 54 41 4c 22 29 0a 09 09 09 20 28 6c 61 6d 62 64 TAL").... (lambd 1770: 61 20 28 74 65 73 74 64 61 74 29 28 64 62 3a 74 a (testdat)(db:t 1780: 65 73 74 2d 67 65 74 2d 75 6e 61 6d 65 20 74 65 est-get-uname te 1790: 73 74 64 61 74 29 29 29 0a 09 20 20 20 20 28 73 stdat))).. (s 17a0: 74 6f 72 65 2d 6c 61 62 65 6c 20 22 44 69 73 6b tore-label "Disk 17b0: 46 72 65 65 22 0a 09 09 09 20 28 69 75 70 3a 6c Free".... (iup:l 17c0: 61 62 65 6c 20 28 63 6f 6e 63 20 28 64 62 3a 74 abel (conc (db:t 17d0: 65 73 74 2d 67 65 74 2d 64 69 73 6b 66 72 65 65 est-get-diskfree 17e0: 20 74 65 73 74 64 61 74 29 29 20 23 3a 65 78 70 testdat)) #:exp 17f0: 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 and "HORIZONTAL" 1800: 29 0a 09 09 09 20 28 6c 61 6d 62 64 61 20 28 74 ).... (lambda (t 1810: 65 73 74 64 61 74 29 28 63 6f 6e 63 20 28 64 62 estdat)(conc (db 1820: 3a 74 65 73 74 2d 67 65 74 2d 64 69 73 6b 66 72 :test-get-diskfr 1830: 65 65 20 74 65 73 74 64 61 74 29 29 29 29 0a 09 ee testdat)))).. 1840: 20 20 20 20 28 73 74 6f 72 65 2d 6c 61 62 65 6c (store-label 1850: 20 22 43 50 55 4c 6f 61 64 22 0a 09 09 09 20 28 "CPULoad".... ( 1860: 69 75 70 3a 6c 61 62 65 6c 20 28 63 6f 6e 63 20 iup:label (conc 1870: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 63 70 75 (db:test-get-cpu 1880: 6c 6f 61 64 20 74 65 73 74 64 61 74 29 29 20 23 load testdat)) # 1890: 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e :expand "HORIZON 18a0: 54 41 4c 22 29 0a 09 09 09 20 28 6c 61 6d 62 64 TAL").... (lambd 18b0: 61 20 28 74 65 73 74 64 61 74 29 28 63 6f 6e 63 a (testdat)(conc 18c0: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 63 70 (db:test-get-cp 18d0: 75 6c 6f 61 64 20 74 65 73 74 64 61 74 29 29 29 uload testdat))) 18e0: 29 0a 09 20 20 20 20 28 73 74 6f 72 65 2d 6c 61 ).. (store-la 18f0: 62 65 6c 20 22 52 75 6e 44 75 72 61 74 69 6f 6e bel "RunDuration 1900: 22 0a 09 09 09 20 28 69 75 70 3a 6c 61 62 65 6c ".... (iup:label 1910: 20 28 63 6f 6e 63 20 28 73 65 63 6f 6e 64 73 2d (conc (seconds- 1920: 3e 68 72 2d 6d 69 6e 2d 73 65 63 20 28 64 62 3a >hr-min-sec (db: 1930: 74 65 73 74 2d 67 65 74 2d 72 75 6e 5f 64 75 72 test-get-run_dur 1940: 61 74 69 6f 6e 20 74 65 73 74 64 61 74 29 29 29 ation testdat))) 1950: 20 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a #:expand "HORIZ 1960: 4f 4e 54 41 4c 22 29 0a 09 09 09 20 28 6c 61 6d ONTAL").... (lam 1970: 62 64 61 20 28 74 65 73 74 64 61 74 29 28 63 6f bda (testdat)(co 1980: 6e 63 20 28 73 65 63 6f 6e 64 73 2d 3e 68 72 2d nc (seconds->hr- 1990: 6d 69 6e 2d 73 65 63 20 28 64 62 3a 74 65 73 74 min-sec (db:test 19a0: 2d 67 65 74 2d 72 75 6e 5f 64 75 72 61 74 69 6f -get-run_duratio 19b0: 6e 20 74 65 73 74 64 61 74 29 29 29 29 29 0a 09 n testdat))))).. 19c0: 20 20 20 20 28 73 74 6f 72 65 2d 6c 61 62 65 6c (store-label 19d0: 20 22 43 50 55 4c 6f 61 64 22 0a 09 09 09 20 28 "CPULoad".... ( 19e0: 69 75 70 3a 6c 61 62 65 6c 20 28 63 6f 6e 63 20 iup:label (conc 19f0: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 66 69 6e (db:test-get-fin 1a00: 61 6c 5f 6c 6f 67 66 20 74 65 73 74 64 61 74 29 al_logf testdat) 1a10: 29 20 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 ) #:expand "HORI 1a20: 5a 4f 4e 54 41 4c 22 29 0a 09 09 09 20 28 6c 61 ZONTAL").... (la 1a30: 6d 62 64 61 20 28 74 65 73 74 64 61 74 29 28 63 mbda (testdat)(c 1a40: 6f 6e 63 20 28 64 62 3a 74 65 73 74 2d 67 65 74 onc (db:test-get 1a50: 2d 66 69 6e 61 6c 5f 6c 6f 67 66 20 74 65 73 74 -final_logf test 1a60: 64 61 74 29 29 29 29 29 29 29 29 29 0a 0a 3b 3b dat)))))))))..;; 1a70: 20 75 73 65 20 61 20 67 6c 6f 62 61 6c 20 66 6f use a global fo 1a80: 72 20 73 65 74 74 69 6e 67 20 74 68 65 20 62 75 r setting the bu 1a90: 74 74 6f 6e 73 20 63 6f 6c 6f 72 73 0a 3b 3b 20 ttons colors.;; 1aa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 1ab0: 20 20 20 20 20 20 20 20 20 20 73 74 61 74 65 20 state 1ac0: 73 74 61 74 75 73 20 74 65 73 74 73 74 65 70 73 status teststeps 1ad0: 0a 28 64 65 66 69 6e 65 20 2a 73 74 61 74 65 2d .(define *state- 1ae0: 73 74 61 74 75 73 2a 20 28 76 65 63 74 6f 72 20 status* (vector 1af0: 23 66 20 23 66 20 23 66 29 29 0a 28 64 65 66 69 #f #f #f)).(defi 1b00: 6e 65 20 28 75 70 64 61 74 65 2d 73 74 61 74 65 ne (update-state 1b10: 2d 73 74 61 74 75 73 2d 62 75 74 74 6f 6e 73 20 -status-buttons 1b20: 74 65 73 74 64 61 74 29 0a 20 20 28 6c 65 74 2a testdat). (let* 1b30: 20 28 28 73 74 61 74 65 20 20 28 64 62 3a 74 65 ((state (db:te 1b40: 73 74 2d 67 65 74 2d 73 74 61 74 65 20 20 74 65 st-get-state te 1b50: 73 74 64 61 74 29 29 0a 09 20 28 73 74 61 74 75 stdat)).. (statu 1b60: 73 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 s (db:test-get-s 1b70: 74 61 74 75 73 20 74 65 73 74 64 61 74 29 29 0a tatus testdat)). 1b80: 09 20 28 63 6f 6c 6f 72 20 20 28 67 65 74 2d 63 . (color (get-c 1b90: 6f 6c 6f 72 2d 66 6f 72 2d 73 74 61 74 65 2d 73 olor-for-state-s 1ba0: 74 61 74 75 73 20 73 74 61 74 65 20 73 74 61 74 tatus state stat 1bb0: 75 73 29 29 29 0a 20 20 20 20 28 28 76 65 63 74 us))). ((vect 1bc0: 6f 72 2d 72 65 66 20 2a 73 74 61 74 65 2d 73 74 or-ref *state-st 1bd0: 61 74 75 73 2a 20 30 29 20 73 74 61 74 65 20 63 atus* 0) state c 1be0: 6f 6c 6f 72 29 0a 20 20 20 20 28 28 76 65 63 74 olor). ((vect 1bf0: 6f 72 2d 72 65 66 20 2a 73 74 61 74 65 2d 73 74 or-ref *state-st 1c00: 61 74 75 73 2a 20 31 29 20 73 74 61 74 75 73 20 atus* 1) status 1c10: 63 6f 6c 6f 72 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d color)))..;;==== 1c20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 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 0a 3b 3b 20 53 65 74 20 66 69 65 6c 64 73 ==.;; Set fields 1c70: 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;============ 1c80: 3d 3d 3d 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 0a 28 64 65 66 69 ==========.(defi 1cc0: 6e 65 20 28 73 65 74 2d 66 69 65 6c 64 73 2d 70 ne (set-fields-p 1cd0: 61 6e 65 6c 20 74 65 73 74 2d 69 64 20 74 65 73 anel test-id tes 1ce0: 74 64 61 74 29 0a 20 20 28 6c 65 74 20 28 28 6e tdat). (let ((n 1cf0: 65 77 63 6f 6d 6d 65 6e 74 20 23 66 29 0a 09 28 ewcomment #f)..( 1d00: 6e 65 77 73 74 61 74 75 73 20 20 23 66 29 0a 09 newstatus #f).. 1d10: 28 6e 65 77 73 74 61 74 65 20 20 20 23 66 29 29 (newstate #f)) 1d20: 0a 20 20 20 20 28 69 75 70 3a 66 72 61 6d 65 0a . (iup:frame. 1d30: 20 20 20 20 20 23 3a 74 69 74 6c 65 20 22 53 65 #:title "Se 1d40: 74 20 66 69 65 6c 64 73 22 0a 20 20 20 20 20 28 t fields". ( 1d50: 69 75 70 3a 76 62 6f 78 0a 20 20 20 20 20 20 28 iup:vbox. ( 1d60: 69 75 70 3a 68 62 6f 78 20 28 69 75 70 3a 6c 61 iup:hbox (iup:la 1d70: 62 65 6c 20 22 43 6f 6d 6d 65 6e 74 3a 22 29 0a bel "Comment:"). 1d80: 09 09 28 69 75 70 3a 74 65 78 74 62 6f 78 20 23 ..(iup:textbox # 1d90: 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 :action (lambda 1da0: 28 76 61 6c 20 61 20 62 29 0a 09 09 09 09 09 28 (val a b)......( 1db0: 64 62 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 db:test-set-stat 1dc0: 65 2d 73 74 61 74 75 73 2d 62 79 2d 69 64 20 2a e-status-by-id * 1dd0: 64 62 2a 20 74 65 73 74 2d 69 64 20 23 66 20 23 db* test-id #f # 1de0: 66 20 62 29 0a 09 09 09 09 09 28 73 65 74 21 20 f b)......(set! 1df0: 6e 65 77 63 6f 6d 6d 65 6e 74 20 62 29 29 0a 09 newcomment b)).. 1e00: 09 09 20 20 20 20 20 23 3a 76 61 6c 75 65 20 28 .. #:value ( 1e10: 64 62 3a 74 65 73 74 2d 67 65 74 2d 63 6f 6d 6d db:test-get-comm 1e20: 65 6e 74 20 74 65 73 74 64 61 74 29 0a 09 09 09 ent testdat).... 1e30: 20 20 20 20 20 23 3a 65 78 70 61 6e 64 20 22 59 #:expand "Y 1e40: 45 53 22 29 29 0a 20 20 20 20 20 20 28 61 70 70 ES")). (app 1e50: 6c 79 20 69 75 70 3a 68 62 6f 78 0a 09 20 20 20 ly iup:hbox.. 1e60: 20 20 28 69 75 70 3a 6c 61 62 65 6c 20 22 53 54 (iup:label "ST 1e70: 41 54 45 3a 22 20 23 3a 73 69 7a 65 20 22 33 30 ATE:" #:size "30 1e80: 78 22 29 0a 09 20 20 20 20 20 28 6c 65 74 2a 20 x").. (let* 1e90: 28 28 62 74 6e 73 20 20 28 6d 61 70 20 28 6c 61 ((btns (map (la 1ea0: 6d 62 64 61 20 28 73 74 61 74 65 29 0a 09 09 09 mbda (state).... 1eb0: 09 20 20 28 6c 65 74 20 28 28 62 74 6e 20 28 69 . (let ((btn (i 1ec0: 75 70 3a 62 75 74 74 6f 6e 20 73 74 61 74 65 0a up:button state. 1ed0: 09 09 09 09 09 09 09 20 23 3a 65 78 70 61 6e 64 ....... #:expand 1ee0: 20 22 59 45 53 22 20 23 3a 73 69 7a 65 20 22 35 "YES" #:size "5 1ef0: 30 78 22 20 23 3a 66 6f 6e 74 20 22 43 6f 75 72 0x" #:font "Cour 1f00: 69 65 72 20 4e 65 77 2c 20 2d 31 30 22 0a 09 09 ier New, -10"... 1f10: 09 09 09 09 09 20 23 3a 61 63 74 69 6f 6e 20 28 ..... #:action ( 1f20: 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 09 09 09 lambda (x)...... 1f30: 09 09 09 20 20 20 20 28 64 62 3a 74 65 73 74 2d ... (db:test- 1f40: 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 set-state-status 1f50: 2d 62 79 2d 69 64 20 2a 64 62 2a 20 74 65 73 74 -by-id *db* test 1f60: 2d 69 64 20 73 74 61 74 65 20 23 66 20 23 66 29 -id state #f #f) 1f70: 0a 09 09 09 09 09 09 09 09 20 20 20 20 28 64 62 ......... (db 1f80: 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 65 21 :test-set-state! 1f90: 20 74 65 73 74 64 61 74 20 73 74 61 74 65 29 29 testdat state)) 1fa0: 29 29 29 0a 09 09 09 09 20 20 20 20 62 74 6e 29 )))..... btn) 1fb0: 29 0a 09 09 09 09 28 6c 69 73 74 20 22 43 4f 4d ).....(list "COM 1fc0: 50 4c 45 54 45 44 22 20 22 4e 4f 54 5f 53 54 41 PLETED" "NOT_STA 1fd0: 52 54 45 44 22 20 22 52 55 4e 4e 49 4e 47 22 20 RTED" "RUNNING" 1fe0: 22 52 45 4d 4f 54 45 48 4f 53 54 53 54 41 52 54 "REMOTEHOSTSTART 1ff0: 22 20 22 4b 49 4c 4c 45 44 22 20 22 4b 49 4c 4c " "KILLED" "KILL 2000: 52 45 51 22 29 29 29 29 0a 09 20 20 20 20 20 20 REQ")))).. 2010: 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 2a 73 (vector-set! *s 2020: 74 61 74 65 2d 73 74 61 74 75 73 2a 20 30 0a 09 tate-status* 0.. 2030: 09 09 20 20 20 20 28 6c 61 6d 62 64 61 20 28 73 .. (lambda (s 2040: 74 61 74 65 20 63 6f 6c 6f 72 29 0a 09 09 09 20 tate color).... 2050: 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 0a (for-each . 2060: 09 09 09 20 20 20 20 20 20 20 28 6c 61 6d 62 64 ... (lambd 2070: 61 20 28 62 74 6e 29 0a 09 09 09 09 20 28 6c 65 a (btn)..... (le 2080: 74 2a 20 28 28 6e 61 6d 65 20 20 20 20 20 28 69 t* ((name (i 2090: 75 70 3a 61 74 74 72 69 62 75 74 65 20 62 74 6e up:attribute btn 20a0: 20 22 54 49 54 4c 45 22 29 29 0a 09 09 09 09 09 "TITLE"))...... 20b0: 28 6e 65 77 63 6f 6c 6f 72 20 28 69 66 20 28 65 (newcolor (if (e 20c0: 71 75 61 6c 3f 20 6e 61 6d 65 20 73 74 61 74 65 qual? name state 20d0: 29 20 63 6f 6c 6f 72 20 22 31 39 32 20 31 39 32 ) color "192 192 20e0: 20 31 39 32 22 29 29 29 0a 09 09 09 09 20 20 20 192")))..... 20f0: 28 69 66 20 28 6e 6f 74 20 28 63 6f 6c 6f 72 73 (if (not (colors 2100: 2d 73 69 6d 69 6c 61 72 3f 20 6e 65 77 63 6f 6c -similar? newcol 2110: 6f 72 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 or (iup:attribut 2120: 65 20 62 74 6e 20 22 42 47 43 4f 4c 4f 52 22 29 e btn "BGCOLOR") 2130: 29 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 69 ))..... (i 2140: 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 up:attribute-set 2150: 21 20 62 74 6e 20 22 42 47 43 4f 4c 4f 52 22 20 ! btn "BGCOLOR" 2160: 6e 65 77 63 6f 6c 6f 72 29 29 29 29 0a 09 09 09 newcolor)))).... 2170: 20 20 20 20 20 20 20 62 74 6e 73 29 29 29 0a 09 btns))).. 2180: 20 20 20 20 20 20 20 62 74 6e 73 29 29 0a 20 20 btns)). 2190: 20 20 20 20 28 61 70 70 6c 79 20 69 75 70 3a 68 (apply iup:h 21a0: 62 6f 78 0a 09 20 20 20 20 20 28 69 75 70 3a 6c box.. (iup:l 21b0: 61 62 65 6c 20 22 53 54 41 54 55 53 3a 22 20 23 abel "STATUS:" # 21c0: 3a 73 69 7a 65 20 22 33 30 78 22 29 0a 09 20 20 :size "30x").. 21d0: 20 20 20 28 6c 65 74 2a 20 28 28 62 74 6e 73 20 (let* ((btns 21e0: 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 73 (map (lambda (s 21f0: 74 61 74 75 73 29 0a 09 09 09 09 20 20 28 6c 65 tatus)..... (le 2200: 74 20 28 28 62 74 6e 20 28 69 75 70 3a 62 75 74 t ((btn (iup:but 2210: 74 6f 6e 20 73 74 61 74 75 73 0a 09 09 09 09 09 ton status...... 2220: 09 09 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53 .. #:expand "YES 2230: 22 20 23 3a 73 69 7a 65 20 22 35 30 78 22 20 23 " #:size "50x" # 2240: 3a 66 6f 6e 74 20 22 43 6f 75 72 69 65 72 20 4e :font "Courier N 2250: 65 77 2c 20 2d 31 30 22 0a 09 09 09 09 09 09 09 ew, -10"........ 2260: 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 #:action (lambd 2270: 61 20 28 78 29 0a 09 09 09 09 09 09 09 09 20 20 a (x)......... 2280: 20 20 28 64 62 3a 74 65 73 74 2d 73 65 74 2d 73 (db:test-set-s 2290: 74 61 74 65 2d 73 74 61 74 75 73 2d 62 79 2d 69 tate-status-by-i 22a0: 64 20 2a 64 62 2a 20 74 65 73 74 2d 69 64 20 23 d *db* test-id # 22b0: 66 20 73 74 61 74 75 73 20 23 66 29 0a 09 09 09 f status #f).... 22c0: 09 09 09 09 09 20 20 20 20 28 64 62 3a 74 65 73 ..... (db:tes 22d0: 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 74 65 t-set-status! te 22e0: 73 74 64 61 74 20 73 74 61 74 75 73 29 29 29 29 stdat status)))) 22f0: 29 0a 09 09 09 09 20 20 20 20 62 74 6e 29 29 0a )..... btn)). 2300: 09 09 09 09 28 6c 69 73 74 20 20 22 50 41 53 53 ....(list "PASS 2310: 22 20 22 57 41 52 4e 22 20 22 46 41 49 4c 22 20 " "WARN" "FAIL" 2320: 22 43 48 45 43 4b 22 20 22 6e 2f 61 22 20 22 57 "CHECK" "n/a" "W 2330: 41 49 56 45 44 22 29 29 29 29 0a 09 20 20 20 20 AIVED")))).. 2340: 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 (vector-set! 2350: 2a 73 74 61 74 65 2d 73 74 61 74 75 73 2a 20 31 *state-status* 1 2360: 0a 09 09 09 20 20 20 20 28 6c 61 6d 62 64 61 20 .... (lambda 2370: 28 73 74 61 74 75 73 20 63 6f 6c 6f 72 29 0a 09 (status color).. 2380: 09 09 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 .. (for-eac 2390: 68 20 0a 09 09 09 20 20 20 20 20 20 20 28 6c 61 h .... (la 23a0: 6d 62 64 61 20 28 62 74 6e 29 0a 09 09 09 09 20 mbda (btn)..... 23b0: 28 6c 65 74 2a 20 28 28 6e 61 6d 65 20 20 20 20 (let* ((name 23c0: 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 20 (iup:attribute 23d0: 62 74 6e 20 22 54 49 54 4c 45 22 29 29 0a 09 09 btn "TITLE"))... 23e0: 09 09 09 28 6e 65 77 63 6f 6c 6f 72 20 28 69 66 ...(newcolor (if 23f0: 20 28 65 71 75 61 6c 3f 20 6e 61 6d 65 20 73 74 (equal? name st 2400: 61 74 75 73 29 20 63 6f 6c 6f 72 20 22 31 39 32 atus) color "192 2410: 20 31 39 32 20 31 39 32 22 29 29 29 0a 09 09 09 192 192"))).... 2420: 09 20 20 20 28 69 66 20 28 6e 6f 74 20 28 63 6f . (if (not (co 2430: 6c 6f 72 73 2d 73 69 6d 69 6c 61 72 3f 20 6e 65 lors-similar? ne 2440: 77 63 6f 6c 6f 72 20 28 69 75 70 3a 61 74 74 72 wcolor (iup:attr 2450: 69 62 75 74 65 20 62 74 6e 20 22 42 47 43 4f 4c ibute btn "BGCOL 2460: 4f 52 22 29 29 29 0a 09 09 09 09 20 20 20 20 20 OR")))..... 2470: 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 (iup:attribute 2480: 2d 73 65 74 21 20 62 74 6e 20 22 42 47 43 4f 4c -set! btn "BGCOL 2490: 4f 52 22 20 6e 65 77 63 6f 6c 6f 72 29 29 29 29 OR" newcolor)))) 24a0: 0a 09 09 09 20 20 20 20 20 20 20 62 74 6e 73 29 .... btns) 24b0: 29 29 0a 09 20 20 20 20 20 20 20 62 74 6e 73 29 )).. btns) 24c0: 29 29 29 29 29 0a 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d )))))...;;====== 24d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 24e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 24f0: 3d 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: 0a 3b 3b 0a 3b 3b 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 3d 3d 3d 3d 3d 3d 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 0a 28 64 65 ============.(de 2560: 66 69 6e 65 20 28 65 78 61 6d 69 6e 65 2d 74 65 fine (examine-te 2570: 73 74 20 64 62 20 74 65 73 74 2d 69 64 29 20 3b st db test-id) ; 2580: 3b 20 72 75 6e 2d 69 64 20 72 75 6e 2d 6b 65 79 ; run-id run-key 2590: 20 6f 72 69 67 74 65 73 74 29 0a 20 20 28 6c 65 origtest). (le 25a0: 74 2a 20 28 28 74 65 73 74 64 61 74 20 20 20 20 t* ((testdat 25b0: 20 20 20 28 64 62 3a 67 65 74 2d 74 65 73 74 2d (db:get-test- 25c0: 64 61 74 61 2d 62 79 2d 69 64 20 64 62 20 74 65 data-by-id db te 25d0: 73 74 2d 69 64 29 29 0a 09 20 28 72 75 6e 2d 69 st-id)).. (run-i 25e0: 64 20 20 20 20 20 20 20 20 28 69 66 20 74 65 73 d (if tes 25f0: 74 64 61 74 20 28 64 62 3a 74 65 73 74 2d 67 65 tdat (db:test-ge 2600: 74 2d 72 75 6e 5f 69 64 20 74 65 73 74 64 61 74 t-run_id testdat 2610: 29 20 23 66 29 29 0a 09 20 28 6b 65 79 64 61 74 ) #f)).. (keydat 2620: 20 20 20 20 20 20 20 20 28 69 66 20 74 65 73 74 (if test 2630: 64 61 74 20 28 6b 65 79 73 3a 67 65 74 2d 6b 65 dat (keys:get-ke 2640: 79 2d 76 61 6c 2d 70 61 69 72 73 20 64 62 20 72 y-val-pairs db r 2650: 75 6e 2d 69 64 29 20 23 66 29 29 0a 09 20 28 72 un-id) #f)).. (r 2660: 75 6e 64 61 74 20 20 20 20 20 20 20 20 28 69 66 undat (if 2670: 20 74 65 73 74 64 61 74 20 28 64 62 3a 67 65 74 testdat (db:get 2680: 2d 72 75 6e 2d 69 6e 66 6f 20 64 62 20 72 75 6e -run-info db run 2690: 2d 69 64 29 20 23 66 29 29 0a 09 20 28 72 75 6e -id) #f)).. (run 26a0: 6e 61 6d 65 20 20 20 20 20 20 20 28 69 66 20 74 name (if t 26b0: 65 73 74 64 61 74 20 28 64 62 3a 67 65 74 2d 76 estdat (db:get-v 26c0: 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 28 alue-by-header ( 26d0: 64 62 3a 67 65 74 2d 72 6f 77 20 72 75 6e 64 61 db:get-row runda 26e0: 74 29 0a 09 09 09 09 09 09 09 20 20 20 20 28 64 t)........ (d 26f0: 62 3a 67 65 74 2d 68 65 61 64 65 72 20 72 75 6e b:get-header run 2700: 64 61 74 29 0a 09 09 09 09 09 09 09 20 20 20 20 dat)........ 2710: 22 72 75 6e 6e 61 6d 65 22 29 20 23 66 29 29 0a "runname") #f)). 2720: 09 20 3b 28 74 65 73 74 73 74 65 70 73 20 20 20 . ;(teststeps 2730: 20 20 28 69 66 20 74 65 73 74 64 61 74 20 28 64 (if testdat (d 2740: 62 3a 67 65 74 2d 73 74 65 70 73 2d 66 6f 72 2d b:get-steps-for- 2750: 74 65 73 74 20 64 62 20 74 65 73 74 2d 69 64 29 test db test-id) 2760: 20 23 66 29 29 0a 09 20 28 6c 6f 67 66 69 6c 65 #f)).. (logfile 2770: 20 20 20 20 20 20 20 22 2f 74 68 69 73 2f 64 69 "/this/di 2780: 72 2f 62 65 74 74 65 72 2f 6e 6f 74 2f 65 78 69 r/better/not/exi 2790: 73 74 22 29 0a 09 20 28 72 75 6e 64 69 72 20 20 st").. (rundir 27a0: 20 20 20 20 20 20 6c 6f 67 66 69 6c 65 29 0a 09 logfile).. 27b0: 20 28 74 65 73 74 66 75 6c 6c 6e 61 6d 65 20 20 (testfullname 27c0: 28 69 66 20 74 65 73 74 64 61 74 20 28 64 62 3a (if testdat (db: 27d0: 74 65 73 74 2d 67 65 74 2d 66 75 6c 6c 6e 61 6d test-get-fullnam 27e0: 65 20 74 65 73 74 64 61 74 29 20 22 47 61 74 68 e testdat) "Gath 27f0: 65 72 69 6e 67 20 64 61 74 61 20 2e 2e 2e 22 29 ering data ...") 2800: 29 0a 09 20 28 74 65 73 74 6e 61 6d 65 20 20 20 ).. (testname 2810: 20 20 20 28 69 66 20 74 65 73 74 64 61 74 20 28 (if testdat ( 2820: 64 62 3a 74 65 73 74 2d 67 65 74 2d 74 65 73 74 db:test-get-test 2830: 6e 61 6d 65 20 74 65 73 74 64 61 74 29 20 22 6e name testdat) "n 2840: 2f 61 22 29 29 0a 09 20 28 74 65 73 74 6d 65 74 /a")).. (testmet 2850: 61 20 20 20 20 20 20 28 69 66 20 74 65 73 74 64 a (if testd 2860: 61 74 20 0a 09 09 09 20 20 20 20 28 6c 65 74 20 at .... (let 2870: 28 28 74 6d 20 28 64 62 3a 74 65 73 74 6d 65 74 ((tm (db:testmet 2880: 61 2d 67 65 74 2d 72 65 63 6f 72 64 20 64 62 20 a-get-record db 2890: 74 65 73 74 6e 61 6d 65 29 29 29 0a 09 09 09 20 testname))).... 28a0: 20 20 20 20 20 28 69 66 20 74 6d 20 74 6d 20 28 (if tm tm ( 28b0: 6d 61 6b 65 2d 64 62 3a 74 65 73 74 6d 65 74 61 make-db:testmeta 28c0: 29 29 29 0a 09 09 09 20 20 20 20 28 6d 61 6b 65 ))).... (make 28d0: 2d 64 62 3a 74 65 73 74 6d 65 74 61 29 29 29 0a -db:testmeta))). 28e0: 0a 09 20 28 6b 65 79 73 74 72 69 6e 67 20 20 28 .. (keystring ( 28f0: 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 string-intersper 2900: 73 65 20 0a 09 09 20 20 20 20 20 20 28 6d 61 70 se ... (map 2910: 20 28 6c 61 6d 62 64 61 20 28 6b 65 79 76 61 6c (lambda (keyval 2920: 29 0a 09 09 09 20 20 20 20 20 28 63 6f 6e 63 20 ).... (conc 2930: 22 3a 22 20 28 63 61 72 20 6b 65 79 76 61 6c 29 ":" (car keyval) 2940: 20 22 20 22 20 28 63 61 64 72 20 6b 65 79 76 61 " " (cadr keyva 2950: 6c 29 29 29 0a 09 09 09 20 20 20 6b 65 79 64 61 l))).... keyda 2960: 74 29 0a 09 09 20 20 20 20 20 20 22 20 22 29 29 t)... " ")) 2970: 0a 09 20 28 69 74 65 6d 2d 70 61 74 68 20 20 28 .. (item-path ( 2980: 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 74 65 6d db:test-get-item 2990: 2d 70 61 74 68 20 74 65 73 74 64 61 74 29 29 0a -path testdat)). 29a0: 09 20 28 76 69 65 77 6c 6f 67 20 20 20 20 28 6c . (viewlog (l 29b0: 61 6d 62 64 61 20 28 78 29 0a 09 09 20 20 20 20 ambda (x)... 29c0: 20 20 20 28 69 66 20 28 66 69 6c 65 2d 65 78 69 (if (file-exi 29d0: 73 74 73 3f 20 6c 6f 67 66 69 6c 65 29 0a 09 09 sts? logfile)... 29e0: 09 20 20 20 3b 28 73 79 73 74 65 6d 20 28 63 6f . ;(system (co 29f0: 6e 63 20 22 66 69 72 65 66 6f 78 20 22 20 6c 6f nc "firefox " lo 2a00: 67 66 69 6c 65 20 22 26 22 29 29 0a 09 09 09 20 gfile "&")).... 2a10: 20 20 28 69 75 70 3a 73 65 6e 64 2d 75 72 6c 20 (iup:send-url 2a20: 6c 6f 67 66 69 6c 65 29 0a 09 09 09 20 20 20 28 logfile).... ( 2a30: 6d 65 73 73 61 67 65 2d 77 69 6e 64 6f 77 20 28 message-window ( 2a40: 63 6f 6e 63 20 22 46 69 6c 65 20 22 20 6c 6f 67 conc "File " log 2a50: 66 69 6c 65 20 22 20 6e 6f 74 20 66 6f 75 6e 64 file " not found 2a60: 22 29 29 29 29 29 0a 09 20 28 78 74 65 72 6d 20 "))))).. (xterm 2a70: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 78 29 (lambda (x) 2a80: 0a 09 09 20 20 20 20 20 20 20 28 69 66 20 28 64 ... (if (d 2a90: 69 72 65 63 74 6f 72 79 2d 65 78 69 73 74 73 3f irectory-exists? 2aa0: 20 72 75 6e 64 69 72 29 0a 09 09 09 20 20 20 28 rundir).... ( 2ab0: 6c 65 74 20 28 28 73 68 65 6c 6c 20 28 69 66 20 let ((shell (if 2ac0: 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 (get-environment 2ad0: 2d 76 61 72 69 61 62 6c 65 20 22 53 48 45 4c 4c -variable "SHELL 2ae0: 22 29 20 0a 09 09 09 09 09 20 20 20 20 28 63 6f ") ...... (co 2af0: 6e 63 20 22 2d 65 20 22 20 28 67 65 74 2d 65 6e nc "-e " (get-en 2b00: 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 vironment-variab 2b10: 6c 65 20 22 53 48 45 4c 4c 22 29 29 0a 09 09 09 le "SHELL")).... 2b20: 09 09 20 20 20 20 22 22 29 29 29 0a 09 09 09 20 .. ""))).... 2b30: 20 20 20 20 28 73 79 73 74 65 6d 20 28 63 6f 6e (system (con 2b40: 63 20 22 63 64 20 22 20 72 75 6e 64 69 72 20 0a c "cd " rundir . 2b50: 09 09 09 09 09 20 20 20 22 3b 78 74 65 72 6d 20 ..... ";xterm 2b60: 2d 54 20 5c 22 22 20 28 73 74 72 69 6e 67 2d 74 -T \"" (string-t 2b70: 72 61 6e 73 6c 61 74 65 20 74 65 73 74 66 75 6c ranslate testful 2b80: 6c 6e 61 6d 65 20 22 28 29 22 20 22 20 20 22 29 lname "()" " ") 2b90: 20 22 5c 22 20 22 20 73 68 65 6c 6c 20 22 26 22 "\" " shell "&" 2ba0: 29 29 29 0a 09 09 09 20 20 20 28 6d 65 73 73 61 ))).... (messa 2bb0: 67 65 2d 77 69 6e 64 6f 77 20 20 28 63 6f 6e 63 ge-window (conc 2bc0: 20 22 44 69 72 65 63 74 6f 72 79 20 22 20 72 75 "Directory " ru 2bd0: 6e 64 69 72 20 22 20 6e 6f 74 20 66 6f 75 6e 64 ndir " not found 2be0: 22 29 29 29 29 29 0a 09 20 28 72 65 66 72 65 73 "))))).. (refres 2bf0: 68 64 61 74 20 28 6c 61 6d 62 64 61 20 28 29 0a hdat (lambda (). 2c00: 09 09 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 .. (let (( 2c10: 6e 65 77 74 65 73 74 64 61 74 20 28 64 62 3a 67 newtestdat (db:g 2c20: 65 74 2d 74 65 73 74 2d 64 61 74 61 2d 62 79 2d et-test-data-by- 2c30: 69 64 20 64 62 20 74 65 73 74 2d 69 64 29 29 29 id db test-id))) 2c40: 0a 09 09 09 20 28 69 66 20 6e 65 77 74 65 73 74 .... (if newtest 2c50: 64 61 74 20 0a 09 09 09 20 20 20 20 20 28 62 65 dat .... (be 2c60: 67 69 6e 0a 09 09 09 20 20 20 20 20 20 20 3b 28 gin.... ;( 2c70: 6d 75 74 65 78 2d 6c 6f 63 6b 21 20 6d 78 31 29 mutex-lock! mx1) 2c80: 0a 09 09 09 20 20 20 20 20 20 20 28 73 65 74 21 .... (set! 2c90: 20 74 65 73 74 64 61 74 20 6e 65 77 74 65 73 74 testdat newtest 2ca0: 64 61 74 29 0a 09 09 09 20 20 20 20 20 20 20 28 dat).... ( 2cb0: 73 65 74 21 20 74 65 73 74 73 74 65 70 73 20 20 set! teststeps 2cc0: 20 20 28 64 62 3a 67 65 74 2d 73 74 65 70 73 2d (db:get-steps- 2cd0: 66 6f 72 2d 74 65 73 74 20 64 62 20 74 65 73 74 for-test db test 2ce0: 2d 69 64 29 29 0a 09 09 09 20 20 20 20 20 20 20 -id)).... 2cf0: 28 73 65 74 21 20 6c 6f 67 66 69 6c 65 20 20 20 (set! logfile 2d00: 20 20 20 28 63 6f 6e 63 20 28 64 62 3a 74 65 73 (conc (db:tes 2d10: 74 2d 67 65 74 2d 72 75 6e 64 69 72 20 74 65 73 t-get-rundir tes 2d20: 74 64 61 74 29 20 22 2f 22 20 28 64 62 3a 74 65 tdat) "/" (db:te 2d30: 73 74 2d 67 65 74 2d 66 69 6e 61 6c 5f 6c 6f 67 st-get-final_log 2d40: 66 20 74 65 73 74 64 61 74 29 29 29 0a 09 09 09 f testdat))).... 2d50: 20 20 20 20 20 20 20 28 73 65 74 21 20 72 75 6e (set! run 2d60: 64 69 72 20 20 20 20 20 20 20 28 64 62 3a 74 65 dir (db:te 2d70: 73 74 2d 67 65 74 2d 72 75 6e 64 69 72 20 74 65 st-get-rundir te 2d80: 73 74 64 61 74 29 29 0a 09 09 09 20 20 20 20 20 stdat)).... 2d90: 20 20 28 73 65 74 21 20 74 65 73 74 66 75 6c 6c (set! testfull 2da0: 6e 61 6d 65 20 28 64 62 3a 74 65 73 74 2d 67 65 name (db:test-ge 2db0: 74 2d 66 75 6c 6c 6e 61 6d 65 20 74 65 73 74 64 t-fullname testd 2dc0: 61 74 29 29 0a 09 09 09 20 20 20 20 20 20 20 3b at)).... ; 2dd0: 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 6d (mutex-unlock! m 2de0: 78 31 29 0a 09 09 09 20 20 20 20 20 20 20 29 0a x1).... ). 2df0: 09 09 09 20 20 20 20 20 28 62 65 67 69 6e 0a 09 ... (begin.. 2e00: 09 09 20 20 20 20 20 20 20 28 64 62 3a 74 65 73 .. (db:tes 2e10: 74 2d 73 65 74 2d 74 65 73 74 6e 61 6d 65 21 20 t-set-testname! 2e20: 74 65 73 74 64 61 74 20 22 44 45 41 44 20 4f 52 testdat "DEAD OR 2e30: 20 44 45 4c 45 54 45 44 20 54 45 53 54 22 29 29 DELETED TEST")) 2e40: 29 29 29 29 0a 09 20 28 77 69 64 67 65 74 73 20 )))).. (widgets 2e50: 20 20 20 20 20 28 6d 61 6b 65 2d 68 61 73 68 2d (make-hash- 2e60: 74 61 62 6c 65 29 29 0a 09 20 28 6d 65 74 61 2d table)).. (meta- 2e70: 77 69 64 67 65 74 73 20 28 6d 61 6b 65 2d 68 61 widgets (make-ha 2e80: 73 68 2d 74 61 62 6c 65 29 29 0a 09 20 28 73 65 sh-table)).. (se 2e90: 6c 66 20 20 20 20 20 20 20 20 20 23 66 29 0a 09 lf #f).. 2ea0: 20 28 73 74 6f 72 65 2d 6c 61 62 65 6c 20 20 28 (store-label ( 2eb0: 6c 61 6d 62 64 61 20 28 6e 61 6d 65 20 6c 62 6c lambda (name lbl 2ec0: 20 63 6d 64 29 0a 09 09 09 20 28 68 61 73 68 2d cmd).... (hash- 2ed0: 74 61 62 6c 65 2d 73 65 74 21 20 77 69 64 67 65 table-set! widge 2ee0: 74 73 20 6e 61 6d 65 20 0a 09 09 09 09 09 20 20 ts name ...... 2ef0: 28 6c 61 6d 62 64 61 20 28 74 65 73 74 64 61 74 (lambda (testdat 2f00: 29 0a 09 09 09 09 09 20 20 20 20 28 6c 65 74 20 )...... (let 2f10: 28 28 6e 65 77 76 61 6c 20 28 63 6d 64 20 74 65 ((newval (cmd te 2f20: 73 74 64 61 74 29 29 0a 09 09 09 09 09 09 20 20 stdat))....... 2f30: 28 6f 6c 64 76 61 6c 20 28 69 75 70 3a 61 74 74 (oldval (iup:att 2f40: 72 69 62 75 74 65 20 6c 62 6c 20 22 54 49 54 4c ribute lbl "TITL 2f50: 45 22 29 29 29 0a 09 09 09 09 09 20 20 20 20 20 E")))...... 2f60: 20 28 69 66 20 28 6e 6f 74 20 28 65 71 75 61 6c (if (not (equal 2f70: 3f 20 6e 65 77 76 61 6c 20 6f 6c 64 76 61 6c 29 ? newval oldval) 2f80: 29 0a 09 09 09 09 09 09 20 20 28 62 65 67 69 6e )....... (begin 2f90: 0a 09 09 09 09 09 09 20 20 20 20 3b 28 6d 75 74 ....... ;(mut 2fa0: 65 78 2d 6c 6f 63 6b 21 20 6d 78 31 29 0a 09 09 ex-lock! mx1)... 2fb0: 09 09 09 09 20 20 20 20 28 69 75 70 3a 61 74 74 .... (iup:att 2fc0: 72 69 62 75 74 65 2d 73 65 74 21 20 6c 62 6c 20 ribute-set! lbl 2fd0: 22 54 49 54 4c 45 22 20 6e 65 77 76 61 6c 29 0a "TITLE" newval). 2fe0: 09 09 09 09 09 09 20 20 20 20 3b 28 6d 75 74 65 ...... ;(mute 2ff0: 78 2d 75 6e 6c 6f 63 6b 21 20 6d 78 31 29 0a 09 x-unlock! mx1).. 3000: 09 09 09 09 09 20 20 20 20 29 29 29 29 29 0a 09 ..... ))))).. 3010: 09 09 20 6c 62 6c 29 29 0a 09 20 28 73 74 6f 72 .. lbl)).. (stor 3020: 65 2d 6d 65 74 61 20 20 28 6c 61 6d 62 64 61 20 e-meta (lambda 3030: 28 6e 61 6d 65 20 6c 62 6c 20 63 6d 64 29 0a 09 (name lbl cmd).. 3040: 09 09 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 .. (hash-table-s 3050: 65 74 21 20 6d 65 74 61 2d 77 69 64 67 65 74 73 et! meta-widgets 3060: 20 6e 61 6d 65 20 0a 09 09 09 09 09 20 20 28 6c name ...... (l 3070: 61 6d 62 64 61 20 28 74 65 73 74 6d 65 74 61 29 ambda (testmeta) 3080: 0a 09 09 09 09 09 20 20 20 20 28 6c 65 74 20 28 ...... (let ( 3090: 28 6e 65 77 76 61 6c 20 28 63 6d 64 20 74 65 73 (newval (cmd tes 30a0: 74 6d 65 74 61 29 29 0a 09 09 09 09 09 09 20 20 tmeta))....... 30b0: 28 6f 6c 64 76 61 6c 20 28 69 75 70 3a 61 74 74 (oldval (iup:att 30c0: 72 69 62 75 74 65 20 6c 62 6c 20 22 54 49 54 4c ribute lbl "TITL 30d0: 45 22 29 29 29 0a 09 09 09 09 09 20 20 20 20 20 E")))...... 30e0: 20 28 69 66 20 28 6e 6f 74 20 28 65 71 75 61 6c (if (not (equal 30f0: 3f 20 6e 65 77 76 61 6c 20 6f 6c 64 76 61 6c 29 ? newval oldval) 3100: 29 0a 09 09 09 09 09 09 20 20 28 62 65 67 69 6e )....... (begin 3110: 0a 09 09 09 09 09 09 20 20 20 20 3b 28 6d 75 74 ....... ;(mut 3120: 65 78 2d 6c 6f 63 6b 21 20 6d 78 31 29 0a 09 09 ex-lock! mx1)... 3130: 09 09 09 09 20 20 20 20 28 69 75 70 3a 61 74 74 .... (iup:att 3140: 72 69 62 75 74 65 2d 73 65 74 21 20 6c 62 6c 20 ribute-set! lbl 3150: 22 54 49 54 4c 45 22 20 6e 65 77 76 61 6c 29 0a "TITLE" newval). 3160: 09 09 09 09 09 09 20 20 20 20 3b 28 6d 75 74 65 ...... ;(mute 3170: 78 2d 75 6e 6c 6f 63 6b 21 20 6d 78 31 29 0a 09 x-unlock! mx1).. 3180: 09 09 09 09 09 20 20 20 20 29 29 29 29 29 0a 09 ..... ))))).. 3190: 09 09 20 6c 62 6c 29 29 0a 09 20 28 73 74 6f 72 .. lbl)).. (stor 31a0: 65 2d 62 75 74 74 6f 6e 20 73 74 6f 72 65 2d 6c e-button store-l 31b0: 61 62 65 6c 29 0a 09 20 28 63 6f 6d 6d 61 6e 64 abel).. (command 31c0: 2d 74 65 78 74 2d 62 6f 78 20 28 69 75 70 3a 74 -text-box (iup:t 31d0: 65 78 74 62 6f 78 20 23 3a 65 78 70 61 6e 64 20 extbox #:expand 31e0: 22 59 45 53 22 20 23 3a 66 6f 6e 74 20 22 43 6f "YES" #:font "Co 31f0: 75 72 69 65 72 20 4e 65 77 2c 20 2d 31 30 22 29 urier New, -10") 3200: 29 0a 09 20 28 63 6f 6d 6d 61 6e 64 2d 6c 61 75 ).. (command-lau 3210: 6e 63 68 2d 62 75 74 74 6f 6e 20 28 69 75 70 3a nch-button (iup: 3220: 62 75 74 74 6f 6e 20 22 45 78 65 63 75 74 65 21 button "Execute! 3230: 22 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 " #:action (lamb 3240: 64 61 20 28 78 29 0a 09 09 09 09 09 09 09 09 20 da (x)......... 3250: 20 28 6c 65 74 20 28 28 63 6d 64 20 28 69 75 70 (let ((cmd (iup 3260: 3a 61 74 74 72 69 62 75 74 65 20 63 6f 6d 6d 61 :attribute comma 3270: 6e 64 2d 74 65 78 74 2d 62 6f 78 20 22 56 41 4c nd-text-box "VAL 3280: 55 45 22 29 29 29 0a 09 09 09 09 09 09 09 09 20 UE")))......... 3290: 20 20 20 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 (system (conc 32a0: 20 63 6d 64 20 22 20 20 26 22 29 29 29 29 29 29 cmd " &")))))) 32b0: 0a 09 20 28 72 75 6e 2d 74 65 73 74 20 20 28 6c .. (run-test (l 32c0: 61 6d 62 64 61 20 28 78 29 0a 09 09 20 20 20 20 ambda (x)... 32d0: 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 (iup:attribute 32e0: 2d 73 65 74 21 20 0a 09 09 20 20 20 20 20 20 20 -set! ... 32f0: 63 6f 6d 6d 61 6e 64 2d 74 65 78 74 2d 62 6f 78 command-text-box 3300: 20 22 56 41 4c 55 45 22 0a 09 09 20 20 20 20 20 "VALUE"... 3310: 20 20 28 63 6f 6e 63 20 22 6d 65 67 61 74 65 73 (conc "megates 3320: 74 20 2d 72 75 6e 74 65 73 74 73 20 22 20 74 65 t -runtests " te 3330: 73 74 6e 61 6d 65 20 22 20 22 20 6b 65 79 73 74 stname " " keyst 3340: 72 69 6e 67 20 22 20 3a 72 75 6e 6e 61 6d 65 20 ring " :runname 3350: 22 20 72 75 6e 6e 61 6d 65 20 0a 09 09 09 20 20 " runname .... 3360: 20 20 20 22 20 2d 69 74 65 6d 70 61 74 74 20 22 " -itempatt " 3370: 20 28 69 66 20 28 65 71 75 61 6c 3f 20 69 74 65 (if (equal? ite 3380: 6d 2d 70 61 74 68 20 22 22 29 0a 09 09 09 09 09 m-path "")...... 3390: 20 20 20 20 20 20 20 22 25 22 20 0a 09 09 09 09 "%" ..... 33a0: 09 20 20 20 20 20 20 20 69 74 65 6d 2d 70 61 74 . item-pat 33b0: 68 29 0a 09 09 09 20 20 20 20 20 22 20 2d 6b 65 h).... " -ke 33c0: 65 70 67 6f 69 6e 67 20 3e 20 72 75 6e 2e 6c 6f epgoing > run.lo 33d0: 67 22 20 29 29 29 29 0a 09 20 28 72 65 6d 6f 76 g" )))).. (remov 33e0: 65 2d 74 65 73 74 20 28 6c 61 6d 62 64 61 20 28 e-test (lambda ( 33f0: 78 29 0a 09 09 09 28 69 75 70 3a 61 74 74 72 69 x)....(iup:attri 3400: 62 75 74 65 2d 73 65 74 21 0a 09 09 09 20 63 6f bute-set!.... co 3410: 6d 6d 61 6e 64 2d 74 65 78 74 2d 62 6f 78 20 22 mmand-text-box " 3420: 56 41 4c 55 45 22 0a 09 09 09 20 28 63 6f 6e 63 VALUE".... (conc 3430: 20 22 6d 65 67 61 74 65 73 74 20 2d 72 65 6d 6f "megatest -remo 3440: 76 65 2d 72 75 6e 73 20 22 20 6b 65 79 73 74 72 ve-runs " keystr 3450: 69 6e 67 20 22 20 3a 72 75 6e 6e 61 6d 65 20 22 ing " :runname " 3460: 20 72 75 6e 6e 61 6d 65 20 22 20 2d 74 65 73 74 runname " -test 3470: 70 61 74 74 20 22 20 74 65 73 74 6e 61 6d 65 20 patt " testname 3480: 22 20 2d 69 74 65 6d 70 61 74 74 20 22 0a 09 09 " -itempatt "... 3490: 09 20 20 20 20 20 20 20 28 69 66 20 28 65 71 75 . (if (equ 34a0: 61 6c 3f 20 69 74 65 6d 2d 70 61 74 68 20 22 22 al? item-path "" 34b0: 29 0a 09 09 09 09 20 20 20 22 25 22 0a 09 09 09 )..... "%".... 34c0: 09 20 20 20 69 74 65 6d 2d 70 61 74 68 29 0a 09 . item-path).. 34d0: 09 09 20 20 20 20 20 20 20 22 20 3e 20 63 6c 65 .. " > cle 34e0: 61 6e 2e 6c 6f 67 22 29 29 29 29 29 0a 20 20 20 an.log"))))). 34f0: 20 28 63 6f 6e 64 0a 20 20 20 20 20 28 28 6e 6f (cond. ((no 3500: 74 20 74 65 73 74 64 61 74 29 28 62 65 67 69 6e t testdat)(begin 3510: 20 28 70 72 69 6e 74 20 22 45 52 52 4f 52 3a 20 (print "ERROR: 3520: 62 61 64 20 74 65 73 74 20 69 6e 66 6f 20 66 6f bad test info fo 3530: 72 20 22 20 74 65 73 74 2d 69 64 29 28 65 78 69 r " test-id)(exi 3540: 74 20 31 29 29 29 0a 20 20 20 20 20 28 28 6e 6f t 1))). ((no 3550: 74 20 72 75 6e 64 61 74 29 28 62 65 67 69 6e 20 t rundat)(begin 3560: 28 70 72 69 6e 74 20 22 45 52 52 4f 52 3a 20 66 (print "ERROR: f 3570: 6f 75 6e 64 20 74 65 73 74 20 69 6e 66 6f 20 62 ound test info b 3580: 75 74 20 74 68 65 72 65 20 69 73 20 61 20 70 72 ut there is a pr 3590: 6f 62 6c 65 6d 20 77 69 74 68 20 74 68 65 20 72 oblem with the r 35a0: 75 6e 20 69 6e 66 6f 20 66 6f 72 20 22 20 72 75 un info for " ru 35b0: 6e 2d 69 64 29 28 65 78 69 74 20 31 29 29 29 0a n-id)(exit 1))). 35c0: 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 20 (else. 35d0: 20 3b 3b 20 20 28 74 65 73 74 2d 73 65 74 2d 73 ;; (test-set-s 35e0: 74 61 74 75 73 21 20 64 62 20 72 75 6e 2d 69 64 tatus! db run-id 35f0: 20 74 65 73 74 2d 6e 61 6d 65 20 73 74 61 74 65 test-name state 3600: 20 73 74 61 74 75 73 20 69 74 65 6d 64 61 74 29 status itemdat) 3610: 0a 20 20 20 20 20 20 28 73 65 74 21 20 73 65 6c . (set! sel 3620: 66 20 3b 20 0a 09 20 20 20 20 28 69 75 70 3a 64 f ; .. (iup:d 3630: 69 61 6c 6f 67 20 23 3a 63 6c 6f 73 65 5f 63 62 ialog #:close_cb 3640: 20 28 6c 61 6d 62 64 61 20 28 61 29 28 65 78 69 (lambda (a)(exi 3650: 74 29 29 20 3b 20 23 3a 65 78 70 61 6e 64 20 22 t)) ; #:expand " 3660: 59 45 53 22 0a 09 20 20 20 20 20 23 3a 74 69 74 YES".. #:tit 3670: 6c 65 20 74 65 73 74 66 75 6c 6c 6e 61 6d 65 0a le testfullname. 3680: 09 20 20 20 20 20 28 69 75 70 3a 76 62 6f 78 20 . (iup:vbox 3690: 3b 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53 22 ; #:expand "YES" 36a0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 . 36b0: 3b 3b 20 54 68 65 20 72 75 6e 20 61 6e 64 20 74 ;; The run and t 36c0: 65 73 74 20 69 6e 66 6f 0a 09 20 20 20 20 20 20 est info.. 36d0: 20 28 69 75 70 3a 68 62 6f 78 20 20 3b 20 23 3a (iup:hbox ; #: 36e0: 65 78 70 61 6e 64 20 22 59 45 53 22 0a 09 09 28 expand "YES"...( 36f0: 72 75 6e 2d 69 6e 66 6f 2d 70 61 6e 65 6c 20 6b run-info-panel k 3700: 65 79 64 61 74 20 74 65 73 74 64 61 74 20 72 75 eydat testdat ru 3710: 6e 6e 61 6d 65 29 0a 09 09 28 74 65 73 74 2d 69 nname)...(test-i 3720: 6e 66 6f 2d 70 61 6e 65 6c 20 74 65 73 74 64 61 nfo-panel testda 3730: 74 20 73 74 6f 72 65 2d 6c 61 62 65 6c 20 77 69 t store-label wi 3740: 64 67 65 74 73 29 0a 09 09 28 74 65 73 74 2d 6d dgets)...(test-m 3750: 65 74 61 2d 70 61 6e 65 6c 20 74 65 73 74 6d 65 eta-panel testme 3760: 74 61 20 73 74 6f 72 65 2d 6d 65 74 61 29 29 0a ta store-meta)). 3770: 09 20 20 20 20 20 20 20 28 68 6f 73 74 2d 69 6e . (host-in 3780: 66 6f 2d 70 61 6e 65 6c 20 74 65 73 74 64 61 74 fo-panel testdat 3790: 20 73 74 6f 72 65 2d 6c 61 62 65 6c 29 0a 09 20 store-label).. 37a0: 20 20 20 20 20 20 3b 3b 20 54 68 65 20 63 6f 6e ;; The con 37b0: 74 72 6f 6c 73 0a 09 20 20 20 20 20 20 20 28 69 trols.. (i 37c0: 75 70 3a 66 72 61 6d 65 20 23 3a 74 69 74 6c 65 up:frame #:title 37d0: 20 22 41 63 74 69 6f 6e 73 22 20 0a 09 09 09 20 "Actions" .... 37e0: 20 28 69 75 70 3a 76 62 6f 78 0a 09 09 09 20 20 (iup:vbox.... 37f0: 20 28 69 75 70 3a 68 62 6f 78 20 0a 09 09 09 20 (iup:hbox .... 3800: 20 20 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 (iup:button " 3810: 56 69 65 77 20 4c 6f 67 22 20 20 20 20 23 3a 61 View Log" #:a 3820: 63 74 69 6f 6e 20 76 69 65 77 6c 6f 67 20 20 20 ction viewlog 3830: 20 20 23 3a 73 69 7a 65 20 22 38 30 78 22 29 0a #:size "80x"). 3840: 09 09 09 20 20 20 20 28 69 75 70 3a 62 75 74 74 ... (iup:butt 3850: 6f 6e 20 22 53 74 61 72 74 20 58 74 65 72 6d 22 on "Start Xterm" 3860: 20 23 3a 61 63 74 69 6f 6e 20 78 74 65 72 6d 20 #:action xterm 3870: 20 20 20 20 20 20 23 3a 73 69 7a 65 20 22 38 30 #:size "80 3880: 78 22 29 0a 09 09 09 20 20 20 20 28 69 75 70 3a x").... (iup: 3890: 62 75 74 74 6f 6e 20 22 52 75 6e 20 54 65 73 74 button "Run Test 38a0: 22 20 20 20 20 23 3a 61 63 74 69 6f 6e 20 72 75 " #:action ru 38b0: 6e 2d 74 65 73 74 20 20 20 20 23 3a 73 69 7a 65 n-test #:size 38c0: 20 22 38 30 78 22 29 0a 09 09 09 20 20 20 20 28 "80x").... ( 38d0: 69 75 70 3a 62 75 74 74 6f 6e 20 22 43 6c 65 61 iup:button "Clea 38e0: 6e 20 54 65 73 74 22 20 20 23 3a 61 63 74 69 6f n Test" #:actio 38f0: 6e 20 72 65 6d 6f 76 65 2d 74 65 73 74 20 23 3a n remove-test #: 3900: 73 69 7a 65 20 22 38 30 78 22 29 0a 09 09 09 20 size "80x").... 3910: 20 20 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 (iup:button " 3920: 43 6c 6f 73 65 22 20 20 20 20 20 20 20 23 3a 61 Close" #:a 3930: 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 78 ction (lambda (x 3940: 29 28 65 78 69 74 29 29 20 23 3a 73 69 7a 65 20 )(exit)) #:size 3950: 22 38 30 78 22 29 29 0a 09 09 09 20 20 20 28 61 "80x")).... (a 3960: 70 70 6c 79 20 0a 09 09 09 20 20 20 20 69 75 70 pply .... iup 3970: 3a 68 62 6f 78 0a 09 09 09 20 20 20 20 28 6c 69 :hbox.... (li 3980: 73 74 20 63 6f 6d 6d 61 6e 64 2d 74 65 78 74 2d st command-text- 3990: 62 6f 78 20 63 6f 6d 6d 61 6e 64 2d 6c 61 75 6e box command-laun 39a0: 63 68 2d 62 75 74 74 6f 6e 29 29 29 29 0a 09 20 ch-button)))).. 39b0: 20 20 20 20 20 20 28 73 65 74 2d 66 69 65 6c 64 (set-field 39c0: 73 2d 70 61 6e 65 6c 20 74 65 73 74 2d 69 64 20 s-panel test-id 39d0: 74 65 73 74 64 61 74 29 0a 09 20 20 20 20 20 20 testdat).. 39e0: 20 28 69 75 70 3a 68 62 6f 78 0a 09 09 28 69 75 (iup:hbox...(iu 39f0: 70 3a 66 72 61 6d 65 20 0a 09 09 20 23 3a 74 69 p:frame ... #:ti 3a00: 74 6c 65 20 22 54 65 73 74 20 53 74 65 70 73 22 tle "Test Steps" 3a10: 0a 09 09 20 28 6c 65 74 20 28 28 73 74 65 70 73 ... (let ((steps 3a20: 64 61 74 20 3b 3b 28 69 75 70 3a 6c 61 62 65 6c dat ;;(iup:label 3a30: 20 22 54 65 73 74 20 73 74 65 70 73 20 2e 2e 2e "Test steps ... 3a40: 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e ................ 3a50: 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e ................ 3a60: 2e 2e 2e 2e 2e 2e 22 20 0a 09 09 09 3b 3b 09 20 ......" ....;;. 3a70: 20 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53 22 #:expand "YES" 3a80: 20 0a 09 09 09 3b 3b 09 20 20 20 23 3a 73 69 7a ....;;. #:siz 3a90: 65 20 22 32 30 30 78 31 35 30 22 0a 09 09 09 3b e "200x150"....; 3aa0: 3b 09 20 20 20 23 3a 61 6c 69 67 6e 6d 65 6e 74 ;. #:alignment 3ab0: 20 22 41 4c 45 46 54 3a 41 54 4f 50 22 29 29 29 "ALEFT:ATOP"))) 3ac0: 0a 09 09 09 28 69 75 70 3a 74 65 78 74 62 6f 78 ....(iup:textbox 3ad0: 20 3b 3b 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 ;; #:action (la 3ae0: 6d 62 64 61 20 28 6f 62 6a 20 63 68 61 72 20 76 mbda (obj char v 3af0: 61 6c 29 0a 09 09 09 09 20 20 20 20 20 3b 3b 20 al)..... ;; 3b00: 20 20 20 09 23 66 29 0a 09 09 09 09 20 20 20 20 .#f)..... 3b10: 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53 22 0a #:expand "YES". 3b20: 09 09 09 09 20 20 20 20 20 23 3a 6d 75 6c 74 69 .... #:multi 3b30: 6c 69 6e 65 20 22 59 45 53 22 0a 09 09 09 09 20 line "YES"..... 3b40: 20 20 20 20 23 3a 66 6f 6e 74 20 22 43 6f 75 72 #:font "Cour 3b50: 69 65 72 20 4e 65 77 2c 20 2d 31 30 22 0a 09 09 ier New, -10"... 3b60: 09 09 20 20 20 20 20 23 3a 73 69 7a 65 20 22 36 .. #:size "6 3b70: 30 78 31 30 30 22 29 29 29 0a 09 09 20 20 20 28 0x100")))... ( 3b80: 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 hash-table-set! 3b90: 77 69 64 67 65 74 73 20 22 54 65 73 74 20 53 74 widgets "Test St 3ba0: 65 70 73 22 20 0a 09 09 09 09 20 20 20 20 28 6c eps" ..... (l 3bb0: 61 6d 62 64 61 20 28 74 65 73 74 64 61 74 29 0a ambda (testdat). 3bc0: 09 09 09 09 20 20 20 20 20 20 28 6c 65 74 2a 20 .... (let* 3bd0: 28 28 63 75 72 72 76 61 6c 20 28 69 75 70 3a 61 ((currval (iup:a 3be0: 74 74 72 69 62 75 74 65 20 73 74 65 70 73 64 61 ttribute stepsda 3bf0: 74 20 22 56 41 4c 55 45 22 29 29 20 3b 3b 20 22 t "VALUE")) ;; " 3c00: 54 49 54 4c 45 22 29 29 0a 09 09 09 09 09 20 20 TITLE"))...... 3c10: 20 20 20 28 66 6d 74 73 74 72 20 20 22 7e 32 30 (fmtstr "~20 3c20: 61 7e 31 30 61 7e 31 30 61 7e 31 32 61 7e 31 35 a~10a~10a~12a~15 3c30: 61 22 29 0a 09 09 09 09 09 20 20 20 20 20 28 63 a")...... (c 3c40: 6f 6d 70 72 73 74 65 70 73 20 28 64 62 3a 67 65 omprsteps (db:ge 3c50: 74 2d 73 74 65 70 73 2d 74 61 62 6c 65 20 64 62 t-steps-table db 3c60: 20 74 65 73 74 2d 69 64 29 29 0a 09 09 09 09 09 test-id))...... 3c70: 20 20 20 20 20 28 6e 65 77 76 61 6c 20 20 28 73 (newval (s 3c80: 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 tring-interspers 3c90: 65 20 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 e ....... 3ca0: 28 61 70 70 65 6e 64 0a 09 09 09 09 09 09 09 28 (append........( 3cb0: 6c 69 73 74 20 0a 09 09 09 09 09 09 09 20 28 66 list ........ (f 3cc0: 6f 72 6d 61 74 20 23 66 20 66 6d 74 73 74 72 20 ormat #f fmtstr 3cd0: 22 53 74 65 70 6e 61 6d 65 22 20 22 53 74 61 72 "Stepname" "Star 3ce0: 74 22 20 22 45 6e 64 22 20 22 53 74 61 74 75 73 t" "End" "Status 3cf0: 22 20 22 54 69 6d 65 22 29 0a 09 09 09 09 09 09 " "Time")....... 3d00: 09 20 28 66 6f 72 6d 61 74 20 23 66 20 66 6d 74 . (format #f fmt 3d10: 73 74 72 20 22 3d 3d 3d 3d 3d 3d 3d 3d 22 20 22 str "========" " 3d20: 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d 22 20 22 3d 3d =====" "===" "== 3d30: 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d 22 29 29 0a 09 ====" "====")).. 3d40: 09 09 09 09 09 09 28 6d 61 70 20 28 6c 61 6d 62 ......(map (lamb 3d50: 64 61 20 28 78 29 0a 09 09 09 09 09 09 09 20 20 da (x)........ 3d60: 20 20 20 20 20 3b 3b 20 74 61 6b 65 20 61 64 76 ;; take adv 3d70: 61 6e 74 61 67 65 20 6f 66 20 74 68 65 20 5c 6e antage of the \n 3d80: 20 6f 6e 20 74 69 6d 65 2d 3e 73 74 72 69 6e 67 on time->string 3d90: 0a 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 ........ ( 3da0: 66 6f 72 6d 61 74 20 23 66 20 66 6d 74 73 74 72 format #f fmtstr 3db0: 0a 09 09 09 09 09 09 09 09 20 20 20 20 20 20 20 ......... 3dc0: 28 76 65 63 74 6f 72 2d 72 65 66 20 78 20 30 29 (vector-ref x 0) 3dd0: 0a 09 09 09 09 09 09 09 09 20 20 20 20 20 20 20 ......... 3de0: 28 6c 65 74 20 28 28 73 20 28 76 65 63 74 6f 72 (let ((s (vector 3df0: 2d 72 65 66 20 78 20 31 29 29 29 0a 09 09 09 09 -ref x 1)))..... 3e00: 09 09 09 09 09 20 28 69 66 20 28 6e 75 6d 62 65 ..... (if (numbe 3e10: 72 3f 20 73 29 28 73 65 63 6f 6e 64 73 2d 3e 74 r? s)(seconds->t 3e20: 69 6d 65 2d 73 74 72 69 6e 67 20 73 29 20 73 29 ime-string s) s) 3e30: 29 0a 09 09 09 09 09 09 09 09 20 20 20 20 20 20 )......... 3e40: 20 28 6c 65 74 20 28 28 73 20 28 76 65 63 74 6f (let ((s (vecto 3e50: 72 2d 72 65 66 20 78 20 32 29 29 29 0a 09 09 09 r-ref x 2))).... 3e60: 09 09 09 09 09 09 20 28 69 66 20 28 6e 75 6d 62 ...... (if (numb 3e70: 65 72 3f 20 73 29 28 73 65 63 6f 6e 64 73 2d 3e er? s)(seconds-> 3e80: 74 69 6d 65 2d 73 74 72 69 6e 67 20 73 29 20 73 time-string s) s 3e90: 29 29 0a 09 09 09 09 09 09 09 09 20 20 20 20 20 ))......... 3ea0: 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 78 20 (vector-ref x 3eb0: 33 29 20 20 20 20 3b 3b 20 73 74 61 74 75 73 0a 3) ;; status. 3ec0: 09 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 ........ ( 3ed0: 76 65 63 74 6f 72 2d 72 65 66 20 78 20 34 29 29 vector-ref x 4)) 3ee0: 29 20 20 3b 3b 20 74 69 6d 65 20 64 65 6c 74 61 ) ;; time delta 3ef0: 0a 09 09 09 09 09 09 09 20 20 20 20 20 28 73 6f ........ (so 3f00: 72 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 76 rt (hash-table-v 3f10: 61 6c 75 65 73 20 63 6f 6d 70 72 73 74 65 70 73 alues comprsteps 3f20: 29 0a 09 09 09 09 09 09 09 09 20 20 20 28 6c 61 )......... (la 3f30: 6d 62 64 61 20 28 61 20 62 29 0a 09 09 09 09 09 mbda (a b)...... 3f40: 09 09 09 20 20 20 20 20 28 6c 65 74 20 28 28 74 ... (let ((t 3f50: 69 6d 65 2d 61 20 28 76 65 63 74 6f 72 2d 72 65 ime-a (vector-re 3f60: 66 20 61 20 31 29 29 0a 09 09 09 09 09 09 09 09 f a 1))......... 3f70: 09 20 20 20 28 74 69 6d 65 2d 62 20 28 76 65 63 . (time-b (vec 3f80: 74 6f 72 2d 72 65 66 20 62 20 31 29 29 29 0a 09 tor-ref b 1))).. 3f90: 09 09 09 09 09 09 09 20 20 20 20 20 28 69 66 20 ....... (if 3fa0: 28 61 6e 64 20 28 6e 75 6d 62 65 72 3f 20 74 69 (and (number? ti 3fb0: 6d 65 2d 61 29 28 6e 75 6d 62 65 72 3f 20 74 69 me-a)(number? ti 3fc0: 6d 65 2d 62 29 29 0a 09 09 09 09 09 09 09 09 09 me-b)).......... 3fd0: 20 28 3c 20 74 69 6d 65 2d 61 20 74 69 6d 65 2d (< time-a time- 3fe0: 62 29 0a 09 09 09 09 09 09 09 09 09 20 23 74 29 b).......... #t) 3ff0: 29 29 29 29 29 0a 09 09 09 09 09 09 20 20 20 20 )))))....... 4000: 20 20 20 22 5c 6e 22 29 29 29 0a 09 09 09 09 09 "\n")))...... 4010: 28 69 66 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f (if (not (equal? 4020: 20 63 75 72 72 76 61 6c 20 6e 65 77 76 61 6c 29 currval newval) 4030: 29 0a 09 09 09 09 09 20 20 20 20 28 69 75 70 3a )...... (iup: 4040: 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 73 attribute-set! s 4050: 74 65 70 73 64 61 74 20 22 56 41 4c 55 45 22 20 tepsdat "VALUE" 4060: 6e 65 77 76 61 6c 20 29 29 29 29 29 20 3b 3b 20 newval ))))) ;; 4070: 22 54 49 54 4c 45 22 20 6e 65 77 76 61 6c 29 29 "TITLE" newval)) 4080: 29 29 29 0a 09 09 20 20 20 73 74 65 70 73 64 61 )))... stepsda 4090: 74 29 29 0a 09 09 3b 3b 20 70 6f 70 75 6c 61 74 t))...;; populat 40a0: 65 20 74 68 65 20 54 65 73 74 20 44 61 74 61 20 e the Test Data 40b0: 70 61 6e 65 6c 0a 09 09 28 69 75 70 3a 66 72 61 panel...(iup:fra 40c0: 6d 65 0a 09 09 20 23 3a 74 69 74 6c 65 20 22 54 me... #:title "T 40d0: 65 73 74 20 44 61 74 61 22 0a 09 09 20 28 6c 65 est Data"... (le 40e0: 74 20 28 28 74 65 73 74 2d 64 61 74 61 0a 09 09 t ((test-data... 40f0: 09 28 69 75 70 3a 74 65 78 74 62 6f 78 20 20 3b .(iup:textbox ; 4100: 3b 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 ; #:action (lamb 4110: 64 61 20 28 6f 62 6a 20 63 68 61 72 20 76 61 6c da (obj char val 4120: 29 0a 09 09 09 09 20 20 20 20 20 20 3b 3b 20 20 )..... ;; 4130: 20 09 23 66 29 0a 09 09 09 09 20 20 20 20 20 20 .#f)..... 4140: 23 3a 65 78 70 61 6e 64 20 22 59 45 53 22 0a 09 #:expand "YES".. 4150: 09 09 09 20 20 20 20 20 20 23 3a 6d 75 6c 74 69 ... #:multi 4160: 6c 69 6e 65 20 22 59 45 53 22 0a 09 09 09 09 20 line "YES"..... 4170: 20 20 20 20 20 23 3a 66 6f 6e 74 20 22 43 6f 75 #:font "Cou 4180: 72 69 65 72 20 4e 65 77 2c 20 2d 31 30 22 0a 09 rier New, -10".. 4190: 09 09 09 20 20 20 20 20 20 23 3a 73 69 7a 65 20 ... #:size 41a0: 22 31 30 30 78 31 30 30 22 29 29 29 0a 09 09 20 "100x100")))... 41b0: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 (hash-table-se 41c0: 74 21 20 77 69 64 67 65 74 73 20 22 54 65 73 74 t! widgets "Test 41d0: 20 44 61 74 61 22 0a 09 09 09 09 20 20 20 20 28 Data"..... ( 41e0: 6c 61 6d 62 64 61 20 28 74 65 73 74 64 61 74 29 lambda (testdat) 41f0: 20 3b 3b 20 0a 09 09 09 09 20 20 20 20 20 20 28 ;; ..... ( 4200: 6c 65 74 2a 20 28 28 63 75 72 72 76 61 6c 20 28 let* ((currval ( 4210: 69 75 70 3a 61 74 74 72 69 62 75 74 65 20 74 65 iup:attribute te 4220: 73 74 2d 64 61 74 61 20 22 56 41 4c 55 45 22 29 st-data "VALUE") 4230: 29 20 3b 3b 20 22 54 49 54 4c 45 22 29 29 0a 09 ) ;; "TITLE")).. 4240: 09 09 09 09 20 20 20 20 20 28 66 6d 74 73 74 72 .... (fmtstr 4250: 20 20 22 7e 31 30 61 7e 31 30 61 7e 31 30 61 7e "~10a~10a~10a~ 4260: 31 30 61 7e 37 61 7e 37 61 7e 36 61 7e 61 22 29 10a~7a~7a~6a~a") 4270: 20 3b 3b 20 63 61 74 65 67 6f 72 79 2c 76 61 72 ;; category,var 4280: 69 61 62 6c 65 2c 76 61 6c 75 65 2c 65 78 70 65 iable,value,expe 4290: 63 74 65 64 2c 74 6f 6c 2c 75 6e 69 74 73 2c 63 cted,tol,units,c 42a0: 6f 6d 6d 65 6e 74 0a 09 09 09 09 09 20 20 20 20 omment...... 42b0: 20 28 6e 65 77 76 61 6c 20 20 28 73 74 72 69 6e (newval (strin 42c0: 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 0a 09 g-intersperse .. 42d0: 09 09 09 09 09 20 20 20 20 20 20 20 28 61 70 70 ..... (app 42e0: 65 6e 64 0a 09 09 09 09 09 09 09 28 6c 69 73 74 end........(list 42f0: 20 0a 09 09 09 09 09 09 09 20 28 66 6f 72 6d 61 ........ (forma 4300: 74 20 23 66 20 66 6d 74 73 74 72 20 22 43 61 74 t #f fmtstr "Cat 4310: 65 67 6f 72 79 22 20 22 56 61 72 69 61 62 6c 65 egory" "Variable 4320: 22 20 22 56 61 6c 75 65 22 20 22 45 78 70 65 63 " "Value" "Expec 4330: 74 65 64 22 20 22 54 6f 6c 22 20 22 53 74 61 74 ted" "Tol" "Stat 4340: 75 73 22 20 22 55 6e 69 74 73 22 20 22 43 6f 6d us" "Units" "Com 4350: 6d 65 6e 74 22 29 0a 09 09 09 09 09 09 09 20 28 ment")........ ( 4360: 66 6f 72 6d 61 74 20 23 66 20 66 6d 74 73 74 72 format #f fmtstr 4370: 20 22 3d 3d 3d 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d "========" "=== 4380: 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d 3d 22 20 22 =====" "=====" " 4390: 3d 3d 3d 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d 22 20 ========" "===" 43a0: 22 3d 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d 3d 22 "======" "=====" 43b0: 20 22 3d 3d 3d 3d 3d 3d 3d 22 29 29 0a 09 09 09 "=======")).... 43c0: 09 09 09 09 28 6d 61 70 20 28 6c 61 6d 62 64 61 ....(map (lambda 43d0: 20 28 78 29 0a 09 09 09 09 09 09 09 20 20 20 20 (x)........ 43e0: 20 20 20 28 66 6f 72 6d 61 74 20 23 66 20 66 6d (format #f fm 43f0: 74 73 74 72 0a 09 09 09 09 09 09 09 09 20 20 20 tstr......... 4400: 20 20 20 20 28 64 62 3a 74 65 73 74 2d 64 61 74 (db:test-dat 4410: 61 2d 67 65 74 2d 63 61 74 65 67 6f 72 79 20 78 a-get-category x 4420: 29 0a 09 09 09 09 09 09 09 09 20 20 20 20 20 20 )......... 4430: 20 28 64 62 3a 74 65 73 74 2d 64 61 74 61 2d 67 (db:test-data-g 4440: 65 74 2d 76 61 72 69 61 62 6c 65 20 78 29 0a 09 et-variable x).. 4450: 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 64 ....... (d 4460: 62 3a 74 65 73 74 2d 64 61 74 61 2d 67 65 74 2d b:test-data-get- 4470: 76 61 6c 75 65 20 20 20 20 78 29 0a 09 09 09 09 value x)..... 4480: 09 09 09 09 20 20 20 20 20 20 20 28 64 62 3a 74 .... (db:t 4490: 65 73 74 2d 64 61 74 61 2d 67 65 74 2d 65 78 70 est-data-get-exp 44a0: 65 63 74 65 64 20 78 29 0a 09 09 09 09 09 09 09 ected x)........ 44b0: 09 20 20 20 20 20 20 20 28 64 62 3a 74 65 73 74 . (db:test 44c0: 2d 64 61 74 61 2d 67 65 74 2d 74 6f 6c 20 20 20 -data-get-tol 44d0: 20 20 20 78 29 0a 09 09 09 09 09 09 09 09 20 20 x)......... 44e0: 20 20 20 20 20 28 64 62 3a 74 65 73 74 2d 64 61 (db:test-da 44f0: 74 61 2d 67 65 74 2d 73 74 61 74 75 73 20 20 20 ta-get-status 4500: 78 29 0a 09 09 09 09 09 09 09 09 20 20 20 20 20 x)......... 4510: 20 20 28 64 62 3a 74 65 73 74 2d 64 61 74 61 2d (db:test-data- 4520: 67 65 74 2d 75 6e 69 74 73 20 20 20 20 78 29 0a get-units x). 4530: 09 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 ........ ( 4540: 64 62 3a 74 65 73 74 2d 64 61 74 61 2d 67 65 74 db:test-data-get 4550: 2d 63 6f 6d 6d 65 6e 74 20 20 78 29 29 29 0a 09 -comment x))).. 4560: 09 09 09 09 09 09 20 20 20 20 20 28 64 62 3a 72 ...... (db:r 4570: 65 61 64 2d 74 65 73 74 2d 64 61 74 61 20 64 62 ead-test-data db 4580: 20 74 65 73 74 2d 69 64 20 22 25 22 29 29 29 0a test-id "%"))). 4590: 09 09 09 09 09 09 20 20 20 20 20 20 20 22 5c 6e ...... "\n 45a0: 22 29 29 29 0a 09 09 09 09 09 28 69 66 20 28 6e ")))......(if (n 45b0: 6f 74 20 28 65 71 75 61 6c 3f 20 63 75 72 72 76 ot (equal? currv 45c0: 61 6c 20 6e 65 77 76 61 6c 29 29 0a 09 09 09 09 al newval))..... 45d0: 09 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 . (iup:attrib 45e0: 75 74 65 2d 73 65 74 21 20 74 65 73 74 2d 64 61 ute-set! test-da 45f0: 74 61 20 22 56 41 4c 55 45 22 20 6e 65 77 76 61 ta "VALUE" newva 4600: 6c 20 29 29 29 29 29 20 3b 3b 20 22 54 49 54 4c l ))))) ;; "TITL 4610: 45 22 20 6e 65 77 76 61 6c 29 29 29 29 29 0a 09 E" newval))))).. 4620: 09 20 20 20 74 65 73 74 2d 64 61 74 61 29 29 29 . test-data))) 4630: 0a 09 09 29 29 29 0a 20 20 20 20 20 20 28 69 75 ...))). (iu 4640: 70 3a 73 68 6f 77 20 73 65 6c 66 29 0a 20 20 20 p:show self). 4650: 20 20 20 28 69 75 70 3a 63 61 6c 6c 62 61 63 6b (iup:callback 4660: 2d 73 65 74 21 20 2a 74 69 6d 2a 20 22 41 43 54 -set! *tim* "ACT 4670: 49 4f 4e 5f 43 42 22 0a 09 09 09 20 28 6c 61 6d ION_CB".... (lam 4680: 62 64 61 20 28 78 29 0a 09 09 09 20 20 20 3b 3b bda (x).... ;; 4690: 20 4e 6f 77 20 73 74 61 72 74 20 6b 65 65 70 69 Now start keepi 46a0: 6e 67 20 74 68 65 20 67 75 69 20 75 70 64 61 74 ng the gui updat 46b0: 65 64 20 66 72 6f 6d 20 74 68 65 20 64 62 0a 09 ed from the db.. 46c0: 09 09 20 20 20 28 72 65 66 72 65 73 68 64 61 74 .. (refreshdat 46d0: 29 20 3b 3b 20 75 70 64 61 74 65 20 66 72 6f 6d ) ;; update from 46e0: 20 74 68 65 20 64 62 20 68 65 72 65 0a 09 09 09 the db here.... 46f0: 09 09 3b 28 74 68 72 65 61 64 2d 73 75 73 70 65 ..;(thread-suspe 4700: 6e 64 21 20 6f 74 68 65 72 2d 74 68 72 65 61 64 nd! other-thread 4710: 29 0a 09 09 09 20 20 20 3b 3b 20 75 70 64 61 74 ).... ;; updat 4720: 65 20 74 68 65 20 67 75 69 20 65 6c 65 6d 65 6e e the gui elemen 4730: 74 73 20 68 65 72 65 0a 09 09 09 20 20 20 28 66 ts here.... (f 4740: 6f 72 2d 65 61 63 68 20 0a 09 09 09 20 20 20 20 or-each .... 4750: 28 6c 61 6d 62 64 61 20 28 6b 65 79 29 0a 09 09 (lambda (key)... 4760: 09 20 20 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 . ;; (print 4770: 20 22 55 70 64 61 74 69 6e 67 20 22 20 6b 65 79 "Updating " key 4780: 29 0a 09 09 09 20 20 20 20 20 20 28 28 68 61 73 ).... ((has 4790: 68 2d 74 61 62 6c 65 2d 72 65 66 20 77 69 64 67 h-table-ref widg 47a0: 65 74 73 20 6b 65 79 29 20 74 65 73 74 64 61 74 ets key) testdat 47b0: 29 29 0a 09 09 09 20 20 20 20 28 68 61 73 68 2d )).... (hash- 47c0: 74 61 62 6c 65 2d 6b 65 79 73 20 77 69 64 67 65 table-keys widge 47d0: 74 73 29 29 0a 09 09 09 20 20 20 28 75 70 64 61 ts)).... (upda 47e0: 74 65 2d 73 74 61 74 65 2d 73 74 61 74 75 73 2d te-state-status- 47f0: 62 75 74 74 6f 6e 73 20 74 65 73 74 64 61 74 29 buttons testdat) 4800: 0a 09 09 09 09 09 3b 20 28 69 75 70 3a 72 65 66 ......; (iup:ref 4810: 72 65 73 68 20 73 65 6c 66 29 0a 09 09 09 20 20 resh self).... 4820: 20 28 69 66 20 2a 65 78 69 74 2d 73 74 61 72 74 (if *exit-start 4830: 65 64 2a 0a 09 09 09 20 20 20 20 20 20 20 28 73 ed*.... (s 4840: 65 74 21 20 2a 65 78 69 74 2d 73 74 61 72 74 65 et! *exit-starte 4850: 64 2a 20 27 6f 6b 29 29 29 29 29 29 29 29 0a 0a d* 'ok))))))))..